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) | :: | ZoneDehumNum |
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 InitZoneDehumidifier(ZoneDehumNum)
! SUBROUTINE INFORMATION:
! AUTHOR Don Shirey, FSEC
! DATE WRITTEN July/Aug 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes information for the zone dehumidifier model
! METHODOLOGY EMPLOYED:
! Use status flags to trigger various initializations
! REFERENCES:
! na
! USE STATEMENTS:
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList
USE Psychrometrics, ONLY: PsyWFnTdbRhPb,PsyRhoAirFnPbTdbW
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: ZoneDehumNum ! Number of the current zone dehumidifier being simulated
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MyEnvrnFlag ! Used for initializations each begin environment flag
! LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: MySizeFlag ! Used for sizing zone dehumidifier inputs one time
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE. ! initialization flag
LOGICAL,SAVE :: ZoneEquipmentListChecked = .FALSE. ! True after the Zone Equipment List has been checked for items
INTEGER :: LoopIndex ! DO loop index
INTEGER :: AirInletNode ! Inlet air node number
REAL(r64) :: RatedAirHumrat ! Humidity ratio (kg/kg) at rated inlet air conditions of 26.6667C, 60% RH
REAL(r64) :: RatedAirDBTemp ! Dry-bulb air temperature at rated conditions 26.6667C
REAL(r64) :: RatedAirRH ! Relative humidity of air (0.6 --> 60%) at rated conditions
! Do the one time initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumDehumidifiers))
! ALLOCATE(MySizeFlag(NumDehumidifiers))
MyEnvrnFlag = .TRUE.
! MySizeFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
! Need to check all dehumidifiers to see if they are on Zone Equipment List or issue warning
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.TRUE.
DO LoopIndex=1,NumDehumidifiers
IF (CheckZoneEquipmentList(ZoneDehumid(LoopIndex)%UnitType,ZoneDehumid(LoopIndex)%Name)) CYCLE
CALL ShowSevereError('InitZoneDehumidifier: Zone Dehumidifier="'//TRIM(ZoneDehumid(LoopIndex)%UnitType)//','// &
TRIM(ZoneDehumid(LoopIndex)%Name)//'" is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
END DO
END IF
AirInletNode = ZoneDehumid(ZoneDehumNum)%AirInletNodeNum
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(ZoneDehumNum)) THEN
! Set the mass flow rates from the input volume flow rates, at rated conditions of 26.6667C, 60% RH
! Might default back to STP later after discussion with M. Witte, use StdRhoAir instead of calc'd RhoAir at rated conditions
RatedAirDBTemp = 26.6667d0 ! 26.6667 C, 80F
RatedAirRH = 0.6d0 ! 60% RH
RatedAirHumrat = PsyWFnTdbRhPb(RatedAirDBTemp,RatedAirRH,StdBaroPress,'InitZoneDehumidifier')
ZoneDehumid(ZoneDehumNum)%RatedAirMassFlow = PsyRhoAirFnPbTdbW(StdBaroPress,RatedAirDBTemp,RatedAirHumrat, &
'InitZoneDehumidifier') * ZoneDehumid(ZoneDehumNum)%RatedAirVolFlow
! Set the node max and min mass flow rates on inlet node... outlet node gets updated in UPDATE subroutine
Node(AirInletNode)%MassFlowRateMax = ZoneDehumid(ZoneDehumNum)%RatedAirMassFlow
Node(AirInletNode)%MassFlowRateMaxAvail = ZoneDehumid(ZoneDehumNum)%RatedAirMassFlow
Node(AirInletNode)%MassFlowRateMinAvail = 0.0d0
Node(AirInletNode)%MassFlowRateMin = 0.0d0
MyEnvrnFlag(ZoneDehumNum) = .FALSE.
END IF ! End one time inits
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(ZoneDehumNum) = .TRUE.
END IF
! These initializations are done every iteration
Node(AirInletNode)%MassFlowRate = ZoneDehumid(ZoneDehumNum)%RatedAirMassFlow
! Zero out the report variables
ZoneDehumid(ZoneDehumNum)%SensHeatingRate = 0.0d0 ! Zone Dehumidifier Sensible Heating Rate [W]
ZoneDehumid(ZoneDehumNum)%SensHeatingEnergy = 0.0d0 ! Zone Dehumidifier Sensible Heating Energy [J]
ZoneDehumid(ZoneDehumNum)%WaterRemovalRate = 0.0d0 ! Zone Dehumidifier Water Removal Rate [kg/s]
ZoneDehumid(ZoneDehumNum)%WaterRemoved = 0.0d0 ! Zone Dehumidifier Water Removed [kg]
ZoneDehumid(ZoneDehumNum)%ElecPower = 0.0d0 ! Zone Dehumidifier Electric Power [W]
ZoneDehumid(ZoneDehumNum)%ElecConsumption = 0.0d0 ! Zone Dehumidifier Electric Consumption [J]
ZoneDehumid(ZoneDehumNum)%DehumidPLR = 0.0d0 ! Zone Dehumidifier Part-Load Ratio [-]
ZoneDehumid(ZoneDehumNum)%DehumidRTF = 0.0d0 ! Zone Dehumidifier Runtime Fraction [-]
ZoneDehumid(ZoneDehumNum)%OffCycleParasiticElecPower = 0.0d0 ! Zone Dehumidifier Off-Cycle Parasitic Electric Power [W]
ZoneDehumid(ZoneDehumNum)%OffCycleParasiticElecCons = 0.0d0 ! Zone Dehumidifier Off-Cycle Parasitic Electric Consumption [J]
ZoneDehumid(ZoneDehumNum)%DehumidCondVolFlowRate = 0.0d0 ! Zone Dehumidifier Condensate Volumetric Flow Rate [m3/s]
ZoneDehumid(ZoneDehumNum)%DehumidCondVol = 0.0d0 ! Zone Dehumidifier Condensate Volume [m3]
ZoneDehumid(ZoneDehumNum)%OutletAirTemp = Node(AirInletNode)%Temp ! Zone Dehumidifier Outlet Air Temperature [C]
RETURN
END SUBROUTINE InitZoneDehumidifier