Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | NumberOfZones |
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 ComputeDifSolExcZonesWIZWindows(NumberOfZones)
! SUBROUTINE INFORMATION:
! AUTHOR Legacy Code
! DATE WRITTEN
! MODIFIED Jun 2007 - Lawrie - Speed enhancements.
! RE-ENGINEERED Winkelmann, Lawrie
! PURPOSE OF THIS SUBROUTINE:
! This subroutine computes the diffuse solar exchange factors between zones with
! interzone windows.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: NumberOfZones ! Number of zones
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64), ALLOCATABLE, DIMENSION(:,:), SAVE :: D
INTEGER SurfNum,IZ,JZ,KZ,LZ,MZ,NZ
IF (.not. ALLOCATED(FractDifShortZtoZ)) THEN
ALLOCATE(FractDifShortZtoZ(NumberOfZones,NumberOfZones))
ALLOCATE(RecDifShortFromZ(NumberOfZones))
ALLOCATE(D(NumberOfZones,NumberOfZones))
ENDIF
RecDifShortFromZ=.FALSE.
FractDifShortZtoZ = 0.0d0
D = 0.0d0
DO NZ=1,NumberOfZones
D(NZ,NZ)=1.0d0
ENDDO
! IF (.not. ANY(Zone%HasInterZoneWindow)) RETURN ! this caused massive diffs
IF (KickOffSimulation .or. KickOffSizing) RETURN
! Compute fraction transmitted in one pass.
DO SurfNum=1,TotSurfaces
IF (.not. Surface(SurfNum)%HeatTransSurf) CYCLE
IF (Surface(SurfNum)%ExtBoundCond <= 0) CYCLE
IF (Surface(SurfNum)%ExtBoundCond == SurfNum) CYCLE
IF (Construct(Surface(SurfNum)%Construction)%TransDiff <= 0.0d0) CYCLE
NZ=Surface(SurfNum)%Zone
if (.not. Zone(NZ)%HasInterZoneWindow) CYCLE
MZ=Surface(Surface(SurfNum)%ExtBoundCond)%Zone
FractDifShortZtoZ(MZ,NZ)=FractDifShortZtoZ(MZ,NZ)+ &
Construct(Surface(SurfNum)%Construction)%TransDiff*VMULT(NZ)*Surface(SurfNum)%Area
IF (VMULT(NZ) /= 0.0d0) RecDifShortFromZ(NZ)=.TRUE.
END DO
! Compute fractions for multiple passes.
DO NZ=1,NumberOfZones
DO MZ=1,NumberOfZones
IF (MZ == NZ) CYCLE
D(MZ,NZ)=FractDifShortZtoZ(MZ,NZ)/(1.0d0-FractDifShortZtoZ(MZ,NZ)*FractDifShortZtoZ(NZ,MZ))
D(NZ,NZ)=D(NZ,NZ)+FractDifShortZtoZ(NZ,MZ)*D(MZ,NZ)
ENDDO
ENDDO
FractDifShortZtoZ=D
! added for CR 7999 & 7869
DO NZ = 1, NumberOfZones
DO MZ = 1, NumberOfZones
IF (MZ == NZ) CYCLE
IF (FractDifShortZtoZ(MZ,NZ) > 0.0d0) THEN
RecDifShortFromZ(NZ) = .TRUE.
EXIT
ENDIF
ENDDO
ENDDO
! Compute fractions for multiple zones.
DO IZ=1,NumberOfZones
IF(.NOT. RecDifShortFromZ(IZ)) CYCLE
DO JZ=1,NumberOfZones
IF(.NOT. RecDifShortFromZ(JZ)) CYCLE
IF(IZ == JZ) CYCLE
IF(D(JZ,IZ) == 0.0d0) CYCLE
DO KZ=1,NumberOfZones
IF(.NOT. RecDifShortFromZ(KZ)) CYCLE
IF(IZ == KZ) CYCLE
IF(JZ == KZ) CYCLE
IF(D(KZ,JZ) == 0.0d0) CYCLE
FractDifShortZtoZ(KZ,IZ)=FractDifShortZtoZ(KZ,IZ)+D(KZ,JZ)*D(JZ,IZ)
DO LZ=1,NumberOfZones
IF(.NOT. RecDifShortFromZ(LZ)) CYCLE
IF(IZ == LZ) CYCLE
IF(JZ == LZ) CYCLE
IF(KZ == LZ) CYCLE
IF(D(LZ,KZ) == 0.0d0) CYCLE
FractDifShortZtoZ(LZ,IZ)=FractDifShortZtoZ(LZ,IZ)+D(LZ,KZ)*D(KZ,JZ)*D(JZ,IZ)
DO MZ=1,NumberOfZones
IF(.NOT. RecDifShortFromZ(MZ)) CYCLE
IF(IZ == MZ) CYCLE
IF(JZ == MZ) CYCLE
IF(KZ == MZ) CYCLE
IF(LZ == MZ) CYCLE
IF(D(MZ,LZ) == 0.0d0) CYCLE
FractDifShortZtoZ(MZ,IZ)=FractDifShortZtoZ(MZ,IZ)+D(MZ,LZ)*D(LZ,KZ)*D(KZ,JZ)*D(JZ,IZ)
ENDDO ! MZ Loop
ENDDO ! LZ Loop
ENDDO ! KZ Loop
ENDDO ! JZ Loop
ENDDO ! IZ Loop
RETURN
END SUBROUTINE ComputeDifSolExcZonesWIZWindows