Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer, | intent(in) | :: | N | |||
| real(kind=r64), | intent(in), | DIMENSION(N) | :: | A | ||
| real(kind=r64), | intent(inout), | DIMENSION(N,N) | :: | F | ||
| integer, | intent(in) | :: | ZoneNum | |||
| real(kind=r64), | intent(inout) | :: | OriginalCheckValue | |||
| real(kind=r64), | intent(inout) | :: | FixedCheckValue | |||
| real(kind=r64), | intent(inout) | :: | FinalCheckValue | |||
| integer, | intent(inout) | :: | NumIterations | |||
| real(kind=r64), | intent(inout) | :: | RowSum |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE FixViewFactors(N,A,F,ZoneNum,OriginalCheckValue,FixedCheckValue,FinalCheckValue,NumIterations,RowSum)
! SUBROUTINE INFORMATION:
! AUTHOR Curt Pedersen
! DATE WRITTEN July 2000
! MODIFIED September 2000 (RKS for EnergyPlus)
! April 2005,COP added capability to handle a
! surface larger than sum of all others (nonenclosure)
! by using a Fii view factor for that surface. Process is
! now much more robust and stable.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine fixes approximate view factors and enforces reciprocity
! and completeness.
! METHODOLOGY EMPLOYED:
! A(i)*F(i,j)=A(j)*F(j,i); F(i,i)=0.; SUM(F(i,j)=1.0, j=1,N)
! Subroutine takes approximate view factors and enforces reciprocity by
! averaging AiFij and AjFji. Then it determines a set of row coefficients
! which can be multipled by each AF product to force the sum of AiFij for
! each row to equal Ai, and applies them. Completeness is checked, and if
! not satisfied, the AF averaging and row modifications are repeated until
! completeness is within a preselected small deviation from 1.0
! The routine also checks the number of surfaces and if N<=3, just enforces reciprocity.
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENTS:
INTEGER, INTENT (IN) :: N ! NUMBER OF SURFACES
REAL(r64), INTENT (IN), DIMENSION(N) :: A ! AREA VECTOR- ASSUMED,BE N ELEMENTS LONG
REAL(r64), INTENT (INOUT), DIMENSION(N,N) :: F ! APPROXIMATE DIRECT VIEW FACTOR MATRIX (N X N)
INTEGER, INTENT (IN) :: ZoneNum ! Zone number being fixe
REAL(r64), INTENT (INOUT) :: OriginalCheckValue ! check of SUM(F) - N
REAL(r64), INTENT (INOUT) :: FixedCheckValue ! check after fixed of SUM(F) - N
REAL(r64), INTENT (INOUT) :: FinalCheckValue ! the one to go with
INTEGER, INTENT (INOUT) :: NumIterations ! number of iterations to fixed
REAL(r64), INTENT (INOUT) :: RowSum ! RowSum of Fixed
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: PrimaryConvergence =0.001d0
REAL(r64), PARAMETER :: DifferenceConvergence=0.00001d0
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: AF ! = (AREA * DIRECT VIEW FACTOR) MATRIX
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: AFTranspose
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: AFAverage
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: FixedAF
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: FixedF ! CORRECTED MATRIX OF VIEW FACTORS (N X N)
REAL(r64), ALLOCATABLE, DIMENSION(:,:) :: FixedAFTranspose
REAL(r64), ALLOCATABLE, DIMENSION(:) :: RowCoefficient
REAL(r64) :: LargestArea
REAL(r64) :: ConvrgNew
REAL(r64) :: ConvrgOld
REAL(r64) :: Accelerator ! RowCoefficient multipler to accelerate convergence
REAL(r64) :: CheckConvergeTolerance ! check value for actual warning
LOGICAL :: Converged
INTEGER :: I
INTEGER :: J
INTEGER :: LargestSurf=0
! FLOW:
OriginalCheckValue=ABS(SUM(F)-N)
! Allocate and zero arrays
ALLOCATE(AF(N,N))
ALLOCATE(AFTranspose(N,N))
ALLOCATE(AFAverage(N,N))
ALLOCATE(FixedAF(N,N))
ALLOCATE(FixedAFTranspose(N,N))
AF = 0.0d0
AFTranspose = 0.0d0
FixedAF = 0.0d0
Accelerator = 1.0d0
ConvrgOld = 10.0d0
LargestArea=MAXVAL(A)
FixedAF=F ! store for largest area check
! Check for Strange Geometry
IF (LargestArea > (SUM(A)-LargestArea)) THEN
DO I=1,N
IF (LargestArea /= A(I)) CYCLE
LargestSurf=I
EXIT
END DO
FixedAF(LargestSurf,LargestSurf)=MIN(0.9D0,1.2d0*LargestArea/SUM(A)) ! Give self view to big surface
END IF
! Set up AF matrix.
DO I=1,N
DO J = 1,N
AF(I,J)=FixedAF(I,J)*A(I)
END DO
END DO
! Enforce reciprocity by averaging AiFij and AjFji
AFTranspose = TRANSPOSE(AF)
AFAverage = 0.5d0*(AF+AFTranspose)
FixedAF=AFAverage !Initialize Fixed Matrix
DEALLOCATE(AF)
DEALLOCATE(AFTranspose)
DEALLOCATE(AFAverage)
ALLOCATE(FixedF(N,N))
ALLOCATE(RowCoefficient(N))
FixedF = 0.0d0
RowCoefficient = 1.0d0
NumIterations =0
RowSum=0.0d0
! Check for physically unreasonable enclosures.
If (N<=3 ) Then
DO I=1,N
DO J=1,N
FixedF(i,j)=FixedAF(i,j)/A(i)
END DO
END DO
CALL ShowWarningError('Surfaces in Zone="'//TRIM(Zone(ZoneNum)%Name)//'" do not define an enclosure.')
CALL ShowContinueError('Number of surfaces <= 3, view factors are set to force reciprocity.')
F=FixedF
FixedCheckValue=ABS(SUM(FixedF)-N)
FinalCheckValue=FixedCheckValue
RowSum=0.0d0
DO I = 1 , N
RowSum=RowSum+SUM(FixedF(I,:))
ENDDO
Zone(ZoneNum)%EnforcedReciprocity=.true.
DEALLOCATE(FixedAF)
DEALLOCATE(FixedF)
DEALLOCATE(FixedAFTranspose)
DEALLOCATE(RowCoefficient)
RETURN ! Do not iterate, stop with reciprocity satisfied.
END IF ! N <= 3 Case
! Regular fix cases
Converged = .false.
DO WHILE ( .not. Converged )
NumIterations = NumIterations + 1
DO I=1,N
! Determine row coefficients which will enforce closure.
IF (ABS(SUM(FixedAF(i,1:N))) > 1.0d-10) THEN
RowCoefficient(i)=A(i)/SUM(FixedAF(i,1:N))
ELSE
RowCoefficient(i)=1.0d0
ENDIF
FixedAF(i,1:N)=FixedAF(i,1:N)*RowCoefficient(i)
END DO
! Enforce reciprocity by averaging AiFij and AjFji
FixedAFTranspose = TRANSPOSE(FixedAF)
FixedAF=0.5d0*(FixedAFTranspose+FixedAF)
! Form FixedF matrix
DO I=1,N
DO J=1,N
FixedF(i,j)=FixedAF(i,j)/A(i)
IF (ABS(FixedF(i,j)) < 1.d-10) Then
FixedF(i,j)=0.0d0
FixedAF(i,j) = 0.0d0
END IF
END DO
END DO
ConvrgNew=ABS(SUM(FixedF)-N)
IF (ABS(ConvrgOld-ConvrgNew) < DifferenceConvergence .or. &
ConvrgNew <= PrimaryConvergence) THEN ! Change in sum of Fs must be small.
Converged = .true.
END IF
ConvrgOld = ConvrgNew
IF (NumIterations > 400 ) THEN ! If everything goes bad,enforce reciprocity and go home.
! Enforce reciprocity by averaging AiFij and AjFji
FixedAFTranspose = TRANSPOSE(FixedAF)
FixedAF=0.5d0*(FixedAFTranspose+FixedAF)
! Form FixedF matrix
DO I=1,N
DO J=1,N
FixedF(i,j)=FixedAF(i,j)/A(i)
END DO
END DO
CheckConvergeTolerance=ABS(SUM(FixedF)-N)
IF (CheckConvergeTolerance > .005d0) THEN
CALL ShowWarningError('FixViewFactors: View factors not complete. Check for '//&
'bad surface descriptions or unenclosed zone="'//TRIM(Zone(ZoneNum)%Name)//'".')
CALL ShowContinueError('Enforced reciprocity has tolerance (ideal is 0)=['// &
TRIM(RoundSigDigits(CheckConvergeTolerance,6))//'], Row Sum (ideal is '// &
trim(RoundSigDigits(N))//')=['//trim(RoundSigDigits(RowSum,2))//'].')
CALL ShowContinueError('If zone is unusual, or tolerance is on the order of 0.001, view factors are probably OK.')
ENDIF
FixedCheckValue=ABS(SUM(FixedF)-N)
FinalCheckValue=FixedCheckValue
IF (ABS(FixedCheckValue) < ABS(OriginalCheckValue)) THEN
F=FixedF
FinalCheckValue=FixedCheckValue
ENDIF
RowSum=0.0d0
DO I = 1,N
RowSum=RowSum+SUM(FixedF(I,:))
ENDDO
DEALLOCATE(FixedAF)
DEALLOCATE(FixedF)
DEALLOCATE(FixedAFTranspose)
DEALLOCATE(RowCoefficient)
Return
END IF
END DO
FixedCheckValue=ConvrgNew
IF (FixedCheckValue < OriginalCheckValue) THEN
F=FixedF
FinalCheckValue=FixedCheckValue
ELSE
FinalCheckValue=OriginalCheckValue
RowSum=0.0d0
DO I = 1,N
RowSum=RowSum+SUM(FixedF(I,:))
ENDDO
IF (ABS(RowSum-N) < PrimaryConvergence) THEN
F=FixedF
FinalCheckValue=FixedCheckValue
ELSE
CALL ShowWarningError('FixViewFactors: View factors not complete. Check for '//&
'bad surface descriptions or unenclosed zone="'//TRIM(Zone(ZoneNum)%Name)//'".')
ENDIF
ENDIF
DEALLOCATE(FixedAF)
DEALLOCATE(FixedF)
DEALLOCATE(FixedAFTranspose)
DEALLOCATE(RowCoefficient)
RETURN
END SUBROUTINE FixViewFactors