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) | :: | ZoneNum | |||
real(kind=r64), | intent(in) | :: | FractionHeight |
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 HcUCSDDV(ZoneNum,FractionHeight)
! SUBROUTINE INFORMATION:
! AUTHOR G. Carrilho da Graca
! DATE WRITTEN February 2004
! MODIFIED -
! RE-ENGINEERED -
! PURPOSE OF THIS SUBROUTINE:
! Main subroutine for convection calculation in the UCSD Displacement Ventilation model.
! It calls CalcDetailedHcInForDVModel for convection coefficient
! initial calculations and averages the final result comparing the position of the surface with
! the interface subzone height.
! METHODOLOGY EMPLOYED:
! -
! -
! -
! -
! REFERENCES:
! -
! -
! USE STATEMENTS:
USE DataRoomAirModel , ONLY: AirModel
USE DataHeatBalFanSys
USE DataEnvironment
USE DataHeatBalance
USE InputProcessor
USE ScheduleManager, ONLY: GetScheduleIndex
USE DataGlobals, ONLY: BeginEnvrnFlag
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER,INTENT (IN) :: ZoneNum !
REAL(r64),INTENT (IN) :: FractionHeight !
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: Ctd ! DO loop counter for surfaces
REAL(r64) :: HLD ! Convection coefficient for the lower area of surface
REAL(r64) :: TmedDV ! Average temperature for DV
REAL(r64) :: Z1 ! auxiliary var for lowest height
REAL(r64) :: Z2 ! auxiliary var for highest height
REAL(r64) :: ZSupSurf ! highest height for this surface
REAL(r64) :: ZInfSurf ! lowest height for this surface
REAL(r64) :: HLU ! Convection coefficient for the upper area of surface
REAL(r64) :: LayH ! Height of the Occupied/Mixed subzone interface
REAL(r64) :: LayFrac ! Fraction height of the Occupied/Mixed subzone interface
INTEGER :: SurfNum ! Surface number
HAT_MX = 0.0d0
HAT_OC = 0.0d0
HA_MX = 0.0d0
HA_OC = 0.0d0
HAT_FLOOR = 0.0d0
HA_FLOOR = 0.0d0
! Is the air flow model for this zone set to UCSDDV Displacement Ventilation?
IF(IsZoneDV(ZoneNum)) THEN
LayFrac = FractionHeight
LayH = FractionHeight*(ZoneCeilingHeight((ZoneNum-1)*2 + 2)- &
ZoneCeilingHeight((ZoneNum-1)*2 + 1))
! WALL Hc, HA and HAT calculation
DO Ctd = PosZ_Wall((ZoneNum-1)*2 + 1),PosZ_Wall((ZoneNum-1)*2 + 2)
SurfNum = APos_Wall(Ctd)
Surface(SurfNum)%TAirRef = AdjacentAirTemp
IF (SurfNum == 0) CYCLE
Z1 = MINVAL(Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)%Z)
Z2 = MAXVAL(Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)%Z)
ZSupSurf = Z2 - ZoneCeilingHeight((ZoneNum-1)*2 + 1)
ZInfSurf = Z1 - ZoneCeilingHeight((ZoneNum-1)*2 + 1)
! The Wall surface is in the upper subzone
IF(ZInfSurf > LayH)THEN
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HWall(Ctd)= DVHcIn(SurfNum)
HAT_MX = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HWall(Ctd) + HAT_MX
HA_MX = Surface(SurfNum)%Area*HWall(Ctd) + HA_MX
ENDIF
! The Wall surface is in the lower subzone
IF(ZSupSurf < LayH)THEN
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HWall(Ctd)= DVHcIn(SurfNum)
HAT_OC = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HWall(Ctd) + HAT_OC
HA_OC = Surface(SurfNum)%Area*HWall(Ctd) + HA_OC
ENDIF
! The Wall surface is partially in upper and partially in lower subzone
IF(ZInfSurf <= LayH .and. ZSupSurf >= LayH) THEN
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HLU= DVHcIn(SurfNum)
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HLD= DVHcIn(SurfNum)
TmedDV = ((ZSupSurf-LayH)*ZTMX(ZoneNum) + (LayH-ZInfSurf)*ZTOC(ZoneNum))/(ZSupSurf-ZInfSurf)
HWall(Ctd)= ((LayH-ZInfSurf)*HLD + (ZSupSurf-LayH)*HLU)/(ZSupSurf-ZInfSurf)
HAT_MX = Surface(SurfNum)%Area*(ZSupSurf-LayH)/(ZSupSurf-ZInfSurf)* &
TempSurfIn(SurfNum)*HLU + HAT_MX
HA_MX = Surface(SurfNum)%Area*(ZSupSurf-LayH)/(ZSupSurf-ZInfSurf)*HLU + HA_MX
HAT_OC = Surface(SurfNum)%Area*(LayH-ZInfSurf)/(ZSupSurf-ZInfSurf)* &
TempSurfIn(SurfNum)*HLD + HAT_OC
HA_OC = Surface(SurfNum)%Area*(LayH-ZInfSurf)/(ZSupSurf-ZInfSurf)*HLD + HA_OC
TempEffBulkAir(SurfNum) = TmedDV
ENDIF
DVHcIn(SurfNum) = HWall(Ctd)
END DO ! END WALL
! WINDOW Hc, HA and HAT CALCULATION
DO Ctd = PosZ_Window((ZoneNum-1)*2 + 1),PosZ_Window((ZoneNum-1)*2 + 2)
SurfNum = APos_Window(Ctd)
Surface(SurfNum)%TAirRef = AdjacentAirTemp
IF (SurfNum == 0) CYCLE
IF (Surface(SurfNum)%Tilt > 10.0d0 .AND. Surface(SurfNum)%Tilt < 170.0d0) THEN ! Window Wall
Z1 = MINVAL(Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)%Z)
Z2 = MAXVAL(Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)%Z)
ZSupSurf = Z2-ZoneCeilingHeight((ZoneNum-1)*2 + 1)
ZInfSurf = Z1-ZoneCeilingHeight((ZoneNum-1)*2 + 1)
IF(ZInfSurf > LayH)THEN
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HWindow(Ctd)= DVHcIn(SurfNum)
HAT_MX = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HWindow(Ctd) + HAT_MX
HA_MX = Surface(SurfNum)%Area*HWindow(Ctd) + HA_MX
ENDIF
IF(ZSupSurf < LayH)THEN
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HWindow(Ctd)= DVHcIn(SurfNum)
HAT_OC = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HWindow(Ctd) + HAT_OC
HA_OC = Surface(SurfNum)%Area*HWindow(Ctd) + HA_OC
ENDIF
IF(ZInfSurf <= LayH .and. ZSupSurf >= LayH) THEN
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HLU= DVHcIn(SurfNum)
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HLD= DVHcIn(SurfNum)
TmedDV = ((ZSupSurf-LayH)*ZTMX(ZoneNum) + (LayH-ZInfSurf)*ZTOC(ZoneNum))/(ZSupSurf-ZInfSurf)
HWindow(Ctd) = ((LayH-ZInfSurf)*HLD + (ZSupSurf-LayH)*HLU)/(ZSupSurf-ZInfSurf)
HAT_MX = Surface(SurfNum)%Area*(ZSupSurf-LayH)/(ZSupSurf-ZInfSurf)* &
TempSurfIn(SurfNum)*HLU + HAT_MX
HA_MX = Surface(SurfNum)%Area*(ZSupSurf-LayH)/(ZSupSurf-ZInfSurf)*HLU + HA_MX
HAT_OC = Surface(SurfNum)%Area*(LayH-ZInfSurf)/(ZSupSurf-ZInfSurf)* &
TempSurfIn(SurfNum)*HLD + HAT_OC
HA_OC = Surface(SurfNum)%Area*(LayH-ZInfSurf)/(ZSupSurf-ZInfSurf)*HLD + HA_OC
TempEffBulkAir(SurfNum) = TmedDV
ENDIF
ENDIF
IF (Surface(SurfNum)%Tilt <= 10.0d0) THEN ! Window Ceiling
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HWindow(Ctd)= DVHcIn(SurfNum)
HAT_MX = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HWindow(Ctd) + HAT_MX
HA_MX = Surface(SurfNum)%Area*HWindow(Ctd) + HA_MX
ENDIF
IF (Surface(SurfNum)%Tilt >= 170.0d0) THEN ! Window Floor
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HWindow(Ctd)= DVHcIn(SurfNum)
HAT_OC = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HWindow(Ctd) + HAT_OC
HA_OC = Surface(SurfNum)%Area*HWindow(Ctd) + HA_OC
ENDIF
DVHcIn(SurfNum) = HWindow(Ctd)
END DO ! END WINDOW
! DOOR Hc, HA and HAT CALCULATION
DO Ctd = PosZ_Door((ZoneNum-1)*2 + 1),PosZ_Door((ZoneNum-1)*2 + 2) ! DOOR
SurfNum = APos_Door(Ctd)
Surface(SurfNum)%TAirRef = AdjacentAirTemp
IF (SurfNum == 0) CYCLE
Z1 = MINVAL(Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)%Z)
Z2 = MAXVAL(Surface(SurfNum)%Vertex(1:Surface(SurfNum)%Sides)%Z)
ZSupSurf = Z2-ZoneCeilingHeight((ZoneNum-1)*2 + 1)
ZInfSurf = Z1-ZoneCeilingHeight((ZoneNum-1)*2 + 1)
IF(ZInfSurf > LayH)THEN
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HDoor(Ctd)= DVHcIn(SurfNum)
HAT_MX = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HDoor(Ctd) + HAT_MX
HA_MX = Surface(SurfNum)%Area*HDoor(Ctd) + HA_MX
ENDIF
IF(ZSupSurf < LayH)THEN
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HDoor(Ctd)= DVHcIn(SurfNum)
HAT_OC = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HDoor(Ctd) + HAT_OC
HA_OC = Surface(SurfNum)%Area*HDoor(Ctd) + HA_OC
ENDIF
IF(ZInfSurf <= LayH .and. ZSupSurf >= LayH) THEN
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HLU= DVHcIn(SurfNum)
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HLD= DVHcIn(SurfNum)
TmedDV = ((ZSupSurf-LayH)*ZTMX(ZoneNum) + (LayH-ZInfSurf)*ZTOC(ZoneNum))/(ZSupSurf-ZInfSurf)
HDoor(Ctd) = ((LayH-ZInfSurf)*HLD + (ZSupSurf-LayH)*HLU)/(ZSupSurf-ZInfSurf)
HAT_MX = Surface(SurfNum)%Area*(ZSupSurf-LayH)/(ZSupSurf-ZInfSurf)* &
TempSurfIn(SurfNum)*HLU + HAT_MX
HA_MX = Surface(SurfNum)%Area*(ZSupSurf-LayH)/(ZSupSurf-ZInfSurf)*HLU + HA_MX
HAT_OC = Surface(SurfNum)%Area*(LayH-ZInfSurf)/(ZSupSurf-ZInfSurf)* &
TempSurfIn(SurfNum)*HLD + HAT_OC
HA_OC = Surface(SurfNum)%Area*(LayH-ZInfSurf)/(ZSupSurf-ZInfSurf)*HLD + HA_OC
TempEffBulkAir(SurfNum) = TmedDV
ENDIF
DVHcIn(SurfNum) = HDoor(Ctd)
END DO ! END DOOR
! INTERNAL Hc, HA and HAT CALCULATION
HeightIntMass = MIN(HeightIntMassDefault, &
(ZoneCeilingHeight((ZoneNum-1)*2 + 2)- ZoneCeilingHeight((ZoneNum-1)*2 + 1)))
DO Ctd = PosZ_Internal((ZoneNum-1)*2 + 1),PosZ_Internal((ZoneNum-1)*2 + 2)
SurfNum = APos_Internal(Ctd)
Surface(SurfNum)%TAirRef = AdjacentAirTemp
IF (SurfNum == 0) CYCLE
ZSupSurf = HeightIntMass
ZInfSurf = 0.0d0
IF(ZSupSurf < LayH)THEN
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HInternal(Ctd)= DVHcIn(SurfNum)
HAT_OC = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HInternal(Ctd) + HAT_OC
HA_OC = Surface(SurfNum)%Area*HInternal(Ctd) + HA_OC
ENDIF
IF(ZInfSurf <= LayH .and. ZSupSurf >= LayH) THEN
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HLU= DVHcIn(SurfNum)
TempEffBulkAir(SurfNum) = ZTOC(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HLD= DVHcIn(SurfNum)
TmedDV = ((ZSupSurf-LayH)*ZTMX(ZoneNum) + (LayH-ZInfSurf)*ZTOC(ZoneNum))/(ZSupSurf-ZInfSurf)
HInternal(Ctd) = ((LayH-ZInfSurf)*HLD + (ZSupSurf-LayH)*HLU)/(ZSupSurf-ZInfSurf)
HAT_MX = Surface(SurfNum)%Area*(ZSupSurf-LayH)/(ZSupSurf-ZInfSurf)* &
TempSurfIn(SurfNum)*HLU + HAT_MX
HA_MX = Surface(SurfNum)%Area*(ZSupSurf-LayH)/(ZSupSurf-ZInfSurf)*HLU + HA_MX
HAT_OC = Surface(SurfNum)%Area*(LayH-ZInfSurf)/(ZSupSurf-ZInfSurf)* &
TempSurfIn(SurfNum)*HLD + HAT_OC
HA_OC = Surface(SurfNum)%Area*(LayH-ZInfSurf)/(ZSupSurf-ZInfSurf)*HLD + HA_OC
TempEffBulkAir(SurfNum) = TmedDV
ENDIF
DVHcIn(SurfNum) = HInternal(Ctd)
END DO ! END INTERNAL
! CEILING Hc, HA and HAT CALCULATION
DO Ctd = PosZ_Ceiling((ZoneNum-1)*2 + 1),PosZ_Ceiling((ZoneNum-1)*2 + 2)
SurfNum = APos_Ceiling(Ctd)
Surface(SurfNum)%TAirRef = AdjacentAirTemp
IF (SurfNum == 0) CYCLE
TempEffBulkAir(SurfNum) = ZTMX(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HCeiling(Ctd)= DVHcIn(SurfNum)
HAT_MX = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HCeiling(Ctd) + HAT_MX
HA_MX = Surface(SurfNum)%Area*HCeiling(Ctd) + HA_MX
DVHcIn(SurfNum) = HCeiling(Ctd)
END DO ! END CEILING
! FLOOR Hc, HA and HAT CALCULATION
DO Ctd = PosZ_Floor((ZoneNum-1)*2 + 1),PosZ_Floor((ZoneNum-1)*2 + 2)
SurfNum = APos_Floor(Ctd)
Surface(SurfNum)%TAirRef = AdjacentAirTemp
IF (SurfNum == 0) CYCLE
TempEffBulkAir(SurfNum) = ZTFLOOR(ZoneNum)
CALL CalcDetailedHcInForDVModel(SurfNum,TempSurfIn,DVHcIn)
HFloor(Ctd)= DVHcIn(SurfNum)
HAT_FLOOR = Surface(SurfNum)%Area*TempSurfIn(SurfNum)*HFloor(Ctd) + HAT_FLOOR
HA_FLOOR = Surface(SurfNum)%Area*HFloor(Ctd) + HA_FLOOR
TempEffBulkAir(SurfNum) = ZTFLOOR(ZoneNum)
DVHcIn(SurfNum) = HFloor(Ctd)
END DO ! END FLOOR
ENDIF
END SUBROUTINE HcUCSDDV