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) | :: | EvapCoolNum |
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 InitEvapCooler(EvapCoolNum)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN October 2000
! MODIFIED B. Griffith, May 2009, added EMS setpoint check
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the EvapCooler Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: DoSetPointTest, SetPointErrorFlag
USE DataEnvironment, ONLY: OutAirDensity, OutDryBulbTemp, OutEnthalpy, OutWetBulbTemp
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
USE EMSManager, ONLY: iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(IN) :: EvapCoolNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
Integer :: InletNode
Integer :: SecInletNode ! local index for secondary inlet node.
REAL(r64) :: RhoAir !Air Density
Integer :: ControlNode
Integer :: OutNode
Integer :: EvapUnitNum
LOGICAL,SAVE :: MySetPointCheckFlag = .TRUE.
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL :: localSetpointCheck = .FALSE.
IF (MyOneTimeFlag) THEN
ALLOCATE(MySizeFlag(NumEvapCool))
MySizeFlag = .TRUE.
MyOneTimeFlag = .false.
ENDIF
! FLOW:
!Check that setpoint is active
IF ( .NOT. SysSizingCalc .AND. MySetPointCheckFlag .AND. DoSetPointTest) THEN
DO EvapUnitNum = 1, NumEvapCool
!only check evap coolers that are supposed to have a control node
IF (( EvapCond(EvapCoolNum)%EvapCoolerType /= iEvapCoolerInDirectRDDSpecial) &
.AND. (EvapCond(EvapCoolNum)%EvapCoolerType /= iEvapCoolerDirectResearchSpecial) ) CYCLE
ControlNode = EvapCond(EvapUnitNum)%EvapControlNodeNum
IF (ControlNode > 0) THEN
IF (Node(ControlNode)%TempSetPoint == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Missing temperature setpoint for Evap Cooler unit ' // &
TRIM(EvapCond(EvapCoolNum)%EvapCoolerName))
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the unit control node.')
ELSE
localSetpointCheck = .FALSE.
CALL CheckIfNodeSetpointManagedByEMS(ControlNode, iTemperatureSetpoint, localSetpointCheck)
IF (localSetpointCheck) THEN
CALL ShowSevereError('Missing temperature setpoint for Evap Cooler unit ' // &
TRIM(EvapCond(EvapCoolNum)%EvapCoolerName))
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the unit control node.')
CALL ShowContinueError(' or use an EMS actuator to establish a setpoint at the unit control node.')
ENDIF
ENDIF
END IF
END IF
END DO
MySetPointCheckFlag = .FALSE.
END IF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(EvapCoolNum)) THEN
! for each cooler, do the sizing once.
CALL SizeEvapCooler(EvapCoolNum)
MySizeFlag(EvapCoolNum) = .FALSE.
END IF
! Do the following initializations (every time step): This should be the info from
! the previous components outlets or the node data in this section.
!Transfer the node data to EvapCond data structure
InletNode = EvapCond(EvapCoolNum)%InletNode
RhoAir = PsyRhoAirFnPbTdbW(OutBaroPress,Node(InletNode)%Temp,Node(InletNode)%HumRat)
! set the volume flow rates from the input mass flow rates
EvapCond(EvapCoolNum)%VolFlowRate = Node(InletNode)%MassFlowRate/RhoAir
! Calculate the entering wet bulb temperature for inlet conditions
EvapCond(EvapCoolNum)%InletWetBulbTemp=PsyTwbFnTdbWPb(Node(InletNode)%Temp,Node(InletNode)%HumRat,OutBaroPress)
!Set all of the inlet mass flow variables from the nodes
EvapCond(EvapCoolNum)%InletMassFlowRate = Node(InletNode)%MassFlowRate
EvapCond(EvapCoolNum)%InletMassFlowRateMaxAvail = Node(InletNode)%MassFlowRateMaxAvail
EvapCond(EvapCoolNum)%InletMassFlowRateMinAvail = Node(InletNode)%MassFlowRateMinAvail
!Set all of the inlet state variables from the inlet nodes
EvapCond(EvapCoolNum)%InletTemp = Node(InletNode)%Temp
EvapCond(EvapCoolNum)%InletHumRat = Node(InletNode)%HumRat
EvapCond(EvapCoolNum)%InletEnthalpy = Node(InletNode)%Enthalpy
EvapCond(EvapCoolNum)%InletPressure = Node(InletNode)%Press
!Set default outlet state to inlet states(?)
EvapCond(EvapCoolNum)%OutletTemp = EvapCond(EvapCoolNum)%InletTemp
EvapCond(EvapCoolNum)%OutletHumRat = EvapCond(EvapCoolNum)%InletHumRat
EvapCond(EvapCoolNum)%OutletEnthalpy = EvapCond(EvapCoolNum)%InletEnthalpy
EvapCond(EvapCoolNum)%OutletPressure = EvapCond(EvapCoolNum)%InletPressure
EvapCond(EvapCoolNum)%OutletMassFlowRate = EvapCond(EvapCoolNum)%InletMassFlowRate
EvapCond(EvapCoolNum)%OutletMassFlowRateMaxAvail = EvapCond(EvapCoolNum)%InletMassFlowRateMaxAvail
EvapCond(EvapCoolNum)%OutletMassFlowRateMinAvail = EvapCond(EvapCoolNum)%InletMassFlowRateMinAvail
!Set all of the secondary inlet mass flow variables from the nodes
SecInletNode = EvapCond(EvapCoolNum)%SecondaryInletNode
IF (SecInletNode /= 0) THEN
EvapCond(EvapCoolNum)%SecInletMassFlowRate = Node(SecInletNode)%MassFlowRate
EvapCond(EvapCoolNum)%SecInletMassFlowRateMaxAvail = Node(SecInletNode)%MassFlowRateMaxAvail
EvapCond(EvapCoolNum)%SecInletMassFlowRateMinAvail = Node(SecInletNode)%MassFlowRateMinAvail
EvapCond(EvapCoolNum)%SecInletTemp = Node(SecInletNode)%Temp
EvapCond(EvapCoolNum)%SecInletHumRat = Node(SecInletNode)%HumRat
EvapCond(EvapCoolNum)%SecInletEnthalpy = Node(SecInletNode)%Enthalpy
EvapCond(EvapCoolNum)%SecInletPressure = Node(SecInletNode)%Press
ELSE
EvapCond(EvapCoolNum)%SecInletMassFlowRate = EvapCond(EvapCoolNum)%IndirectVolFlowRate * OutAirDensity
EvapCond(EvapCoolNum)%SecInletMassFlowRateMaxAvail = EvapCond(EvapCoolNum)%IndirectVolFlowRate * OutAirDensity
EvapCond(EvapCoolNum)%SecInletMassFlowRateMinAvail = 0.0d0
EvapCond(EvapCoolNum)%SecInletTemp = OutDryBulbTemp
EvapCond(EvapCoolNum)%SecInletHumRat = PsyWFnTdbTwbPb(OutDryBulbTemp,OutWetBulbTemp,OutBaroPress)
EvapCond(EvapCoolNum)%SecInletEnthalpy = OutEnthalpy
EvapCond(EvapCoolNum)%SecInletPressure = OutBaroPress
ENDIF
!Set the energy consumption to zero each time through for reporting
EvapCond(EvapCoolNum)%EvapCoolerEnergy = 0.0d0
EvapCond(EvapCoolNum)%EvapCoolerPower = 0.0d0
EvapCond(EvapCoolNum)%DewPointBoundFlag = 0
!Set the water consumption to zero each time through for reporting
EvapCond(EvapCoolNum)%EvapWaterConsumpRate = 0.0d0
EvapCond(EvapCoolNum)%EvapWaterConsump = 0.0d0
EvapCond(EvapCoolNum)%EvapWaterStarvMakup = 0.0d0
!Set the Saturation and Stage Efficiency to zero each time through for reporting
EvapCond(EvapCoolNum)%StageEff = 0.0d0
EvapCond(EvapCoolNum)%SatEff = 0.0d0
! These initializations are done every iteration
OutNode = EvapCond(EvapCoolNum)%OutletNode
ControlNode = EvapCond(EvapCoolNum)%EvapControlNodeNum
IF (ControlNode.EQ.0) THEN
EvapCond(EvapCoolNum)%DesiredOutletTemp = 0.0d0
ELSE IF (ControlNode.EQ.OutNode) THEN
EvapCond(EvapCoolNum)%DesiredOutletTemp = Node(ControlNode)%TempSetPoint
ELSE
EvapCond(EvapCoolNum)%DesiredOutletTemp = Node(ControlNode)%TempSetPoint - &
(Node(ControlNode)%Temp - Node(OutNode)%Temp)
END IF
RETURN
END SUBROUTINE InitEvapCooler