Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | ZoneNum | |||
integer, | intent(in) | :: | ZoneModelType |
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 InitUCSDUF(ZoneNum,ZoneModelType)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN August 2005
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! initialize arrays & variables used by the UCSD UFAD zone models
! METHODOLOGY EMPLOYED:
! Note that much of the initialization is done in RoomAirManager, SharedDVCVUFDataInit
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER,INTENT (IN) :: ZoneNum
INTEGER, INTENT(IN) :: ZoneModelType ! type of zone model; UCSDUFI = 6
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MySizeFlag
REAL(r64) :: NumShadesDown = 0.0d0
INTEGER :: UINum ! index to underfloor interior zone model data
INTEGER :: Ctd=0 ! DO loop index
INTEGER :: SurfNum = 0 ! surface data structure index
! Do the one time initializations
IF (MyOneTimeFlag) THEN
HeightFloorSubzoneTop = 0.2d0
ThickOccupiedSubzoneMin= 0.2d0
HeightIntMassDefault = 2.0d0
MyOneTimeFlag = .FALSE.
ALLOCATE(MySizeFlag(NumOfZones))
MySizeFlag = .TRUE.
END IF
IF ( MySizeFlag(ZoneNum) ) THEN
CALL SizeUCSDUF(ZoneNum,ZoneModelType)
MySizeFlag(ZoneNum) = .FALSE.
END IF
! initialize these variables every timestep
HeightIntMass=HeightIntMassDefault
ZoneUFGamma(ZoneNum) = 0.0d0
ZoneUFPowInPlumes(ZoneNum) = 0.0d0
NumShadesDown = 0.0d0
DO Ctd = PosZ_Window((ZoneNum-1)*2+1),PosZ_Window((ZoneNum-1)*2+2)
SurfNum = APos_Window(ctd)
If (SurfNum == 0) CYCLE
IF (Surface(SurfNum)%ExtBoundCond == ExternalEnvironment .or. Surface(SurfNum)%ExtBoundCond == OtherSideCoefNoCalcExt .or. &
Surface(SurfNum)%ExtBoundCond == OtherSideCoefCalcExt .or. Surface(SurfNum)%ExtBoundCond == OtherSideCondModeledExt) THEN
IF (SurfaceWindow(SurfNum)%ShadingFlag == IntShadeOn .or. SurfaceWindow(SurfNum)%ShadingFlag == IntBlindOn) THEN
NumShadesDown = NumShadesDown + 1
END IF
END IF
END DO
IF (ZoneModelType == RoomAirModel_UCSDUFE) THEN
UINum = ZoneUFPtr(ZoneNum)
IF (ZoneUCSDUE(UINum)%NumExtWin > 1.0d0) THEN
IF (NumShadesDown/ZoneUCSDUE(UINum)%NumExtWin >= 0.5d0) THEN
ZoneUCSDUE(UINum)%ShadeDown = .TRUE.
ELSE
ZoneUCSDUE(UINum)%ShadeDown = .FALSE.
END IF
ELSE
ZoneUCSDUE(UINum)%ShadeDown = .FALSE.
END IF
END IF
RETURN
END SUBROUTINE InitUCSDUF