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 |
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 GetSurfHBDataForMundtModel(ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR Weixiu Kong
! DATE WRITTEN April 2003
! MODIFIED July 2003 (CC)
! February 2004, fix allocate-deallocate problem (CC)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! map data from surface domain to air domain for each particular zone
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataGlobals, ONLY : NumOfZones
USE DataLoopNode, ONLY : Node
USE DataEnvironment, ONLY : OutBaroPress
USE DataHeatBalFanSys, ONLY : ZoneAirHumRat, MCPI, MAT, SumConvHTRadSys, SysDepZoneLoadsLagged, NonAirSystemResponse
USE DataHeatBalSurface, ONLY : TempSurfIn
USE DataSurfaces, ONLY : Surface
USE DataHeatBalance, ONLY : Zone, HConvIn, ZoneIntGain, RefrigCaseCredit
USE DataZoneEquipment, ONLY : ZoneEquipConfig
USE Psychrometrics, ONLY : PsyWFnTdpPb,PsyCpAirFnWTdb,PsyRhoAirFnPbTdbW
USE InternalHeatGains, ONLY : SumAllInternalConvectionGains, SumAllReturnAirConvectionGains
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ZoneNum ! index number for the specified zone
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SurfNum ! index for surfaces
INTEGER :: NodeNum ! index for air nodes
REAL(r64) :: SumSysMCp ! zone sum of air system MassFlowRate*Cp
REAL(r64) :: SumSysMCpT ! zone sum of air system MassFlowRate*Cp*T
REAL(r64) :: MassFlowRate ! mass flowrate
REAL(r64) :: NodeTemp ! node temperature
REAL(r64) :: CpAir ! specific heat
INTEGER :: ZoneNode ! index number for specified zone node
REAL(r64) :: ZoneMassFlowRate ! zone mass flowrate
INTEGER :: ZoneEquipConfigNum ! index number for zone equipment configuration
REAL(r64) :: ZoneMult ! total zone multiplier
REAL(r64) :: RetAirConvGain
! FLOW:
! determine ZoneEquipConfigNum for this zone
ZoneEquipConfigNum = ZoneNum
! check whether this zone is a controlled zone or not
IF (.NOT. Zone(ZoneNum)%IsControlled) THEN
CALL ShowFatalError('Zones must be controlled for Mundt air model. No system serves zone '//TRIM(Zone(ZoneNum)%Name))
RETURN
END IF
! determine information required by Mundt model
ZoneHeight = Zone(ZoneNum)%CeilingHeight
ZoneFloorArea = Zone(ZoneNum)%FloorArea
ZoneMult = Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier
! supply air flowrate is the same as zone air flowrate
ZoneNode = Zone(ZoneNum)%SystemZoneNodeNumber
ZoneAirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, MAT(ZoneNum), PsyWFnTdpPb(MAT(ZoneNum), OutBaroPress))
ZoneMassFlowRate = Node(ZoneNode)%MassFlowRate
SupplyAirVolumeRate=ZoneMassFlowRate/ZoneAirDensity
IF (ZoneMassFlowRate.LE.0.0001d0) THEN
! system is off
QsysCoolTot = 0.0d0
ELSE
! determine supply air conditions
SumSysMCp = 0.0d0
SumSysMCpT = 0.0d0
DO NodeNum = 1, ZoneEquipConfig(ZoneEquipConfigNum)%NumInletNodes
NodeTemp = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%Temp
MassFlowRate = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%MassFlowRate
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp)
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END DO
! prevent dividing by zero due to zero supply air flow rate
IF (SumSysMCp.LE.0.0d0) THEN
SupplyAirTemp = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(1))%Temp
ELSE
! a weighted average of the inlet temperatures
SupplyAirTemp = SumSysMCpT/SumSysMCp
END IF
! determine cooling load
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), MAT(ZoneNum))
QsysCoolTot = -(SumSysMCpT - ZoneMassFlowRate * CpAir * MAT(ZoneNum))
END IF
! determine heat gains
CALL SumAllInternalConvectionGains(ZoneNum, ConvIntGain)
ConvIntGain = ConvIntGain &
+ SumConvHTRadSys(ZoneNum) &
+ SysDepZoneLoadsLagged(ZoneNum) + NonAirSystemResponse(ZoneNum)/ZoneMult
! Add heat to return air if zonal system (no return air) or cycling system (return air frequently very
! low or zero)
IF (Zone(ZoneNum)%NoHeatToReturnAir) THEN
CALL SumAllReturnAirConvectionGains(ZoneNum, RetAirConvGain )
ConvIntGain = ConvIntGain + RetAirConvGain
END IF
QventCool = - MCPI(ZoneNum)*(Zone(ZoneNum)%OutDryBulbTemp-MAT(ZoneNum))
! get surface data
DO SurfNum = 1, ZoneData(ZoneNum)%NumOfSurfs
MundtAirSurf(MundtZoneNum,SurfNum)%Temp = TempSurfIn(ZoneData(ZoneNum)%SurfFirst+SurfNum-1)
MundtAirSurf(MundtZoneNum,SurfNum)%Hc = HConvIn(ZoneData(ZoneNum)%SurfFirst+SurfNum-1)
ENDDO
RETURN
END SUBROUTINE GetSurfHBDataForMundtModel