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) | :: | HumNum |
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 InitHumidifier(HumNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN September 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Humidifier Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE Psychrometrics, ONlY: RhoH2O
USE DataHVACGlobals, ONLY: DoSetPointTest
USE InputProcessor, ONLY: SameString
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
USE EMSManager, ONLY: iHumidityRatioMinSetpoint, CheckIfNodeSetpointManagedByEMS
USE FluidProperties, ONLY: GetSatEnthalpyRefrig, GetSpecificHeatGlycol, FindGlycol, FindRefrigerant
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: HumNum ! number of the current humidifier being simulated
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: CalledFrom='Humidifier:InitHumidifier'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InNode ! inlet node number
INTEGER :: OutNode ! outlet node number
INTEGER :: NumHum
INTEGER :: RefrigerantIndex ! refiferant index
INTEGER :: WaterIndex ! fluid type index
REAL(r64) :: NominalPower ! Nominal power input to humidifier, W
REAL(r64) :: WaterSpecHeat ! specific heat of water , J/kgK
REAL(r64) :: SteamSatEnthalpy ! enthalpy of saturated steam at 100C, J/kg
REAL(r64) :: WaterSatEnthalpy ! enthalpy of saturated water at 100C, J/kg
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE.
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL,SAVE :: MySetPointCheckFlag = .TRUE.
LOGICAL, ALLOCATABLE,SAVE, DIMENSION(:) :: MySizeFlag
! do one time initializations
IF (MyOneTimeFlag) THEN
! initialize the environment and sizing flags
ALLOCATE(MyEnvrnFlag(NumHumidifiers))
ALLOCATE(MySizeFlag(NumHumidifiers))
MyEnvrnFlag = .TRUE.
MyOneTimeFlag = .FALSE.
MySizeFlag = .TRUE.
END IF
! do sizing calculation
IF ( MySizeFlag(HumNum) ) THEN
Call SizeHumidifier(HumNum)
MySizeFlag(HumNum) =.FALSE.
ENDIF
IF ( .NOT. SysSizingCalc .AND. MySetPointCheckFlag .AND. DoSetPointTest) THEN
DO NumHum = 1, NumHumidifiers
OutNode = Humidifier(NumHum)%AirOutNode
IF (OutNode > 0) THEN
IF (Node(OutNode)%HumRatMin == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Humidifiers: Missing humidity setpoint for '// &
trim(HumidifierType(Humidifier(NumHum)%HumType_Code))//' = '//TRIM(Humidifier(HumNum)%Name))
CALL ShowContinueError(' use a Setpoint Manager with Control Variable = "MinimumHumidityRatio" to establish'// &
'a setpoint at the humidifier outlet node.')
CALL ShowContinueError(' expecting it on Node="'//trim(NodeID(OutNode))//'".')
SetPointErrorFlag = .TRUE.
ELSE
CALL CheckIfNodeSetpointManagedByEMS(OutNode,iHumidityRatioMinSetpoint, SetpointErrorFlag)
IF (SetpointErrorFlag) THEN
CALL ShowSevereError('Humidifiers: Missing humidity setpoint for '// &
trim(HumidifierType(Humidifier(NumHum)%HumType_Code))//' = '//TRIM(Humidifier(HumNum)%Name))
CALL ShowContinueError(' use a Setpoint Manager with Control Variable = "MinimumHumidityRatio" to establish'// &
'a setpoint at the humidifier outlet node.')
CALL ShowContinueError(' expecting it on Node="'//trim(NodeID(OutNode))//'".')
CALL ShowContinueError(' or use an EMS actuator to control minimum humidity ratio to establish'// &
'a setpoint at the humidifier outlet node.')
ENDIF
ENDIF
END IF
END IF
END DO
MySetPointCheckFlag = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(HumNum)=.TRUE.
ENDIF
! do these initializations every HVAC time step
InNode = Humidifier(HumNum)%AirInNode
OutNode = Humidifier(HumNum)%AirOutNode
Humidifier(HumNum)%HumRatSet = Node(OutNode)%HumRatMin
Humidifier(HumNum)%AirInTemp = Node(InNode)%Temp
Humidifier(HumNum)%AirInHumRat = Node(InNode)%HumRat
Humidifier(HumNum)%AirInEnthalpy = Node(InNode)%Enthalpy
Humidifier(HumNum)%AirInMassFlowRate = Node(InNode)%MassFlowRate
Humidifier(HumNum)%WaterAdd = 0.0d0
Humidifier(HumNum)%ElecUseEnergy = 0.0d0
Humidifier(HumNum)%ElecUseRate = 0.0d0
Humidifier(HumNum)%WaterCons = 0.0d0
Humidifier(HumNum)%WaterConsRate = 0.0d0
RETURN
END SUBROUTINE InitHumidifier