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) | :: | ExchNum | |||
integer, | intent(in) | :: | CompanionCoilIndex |
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 InitHeatRecovery(ExchNum, CompanionCoilIndex)
! SUBROUTINE INFORMATION:
! AUTHOR Michael Wetter
! DATE WRITTEN March 1999
! MODIFIED F Buhl Nov 2000, D Shirey Feb 2003
! B Griffith May 2009, EMS setpoint check
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of the Heat Recovery Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
USE DXCoils, ONLY: DXCoilFullLoadOutAirTemp, DXCoilFullLoadOutAirHumRat
! USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList
USE EMSManager, ONLY: iTemperatureSetpoint, CheckIfNodeSetpointManagedByEMS, iHumidityRatioMaxSetpoint
USE DataGLobals, ONLY: AnyEnergyManagementSystemInModel
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: ExchNum ! number of the current heat exchanger being simulated
INTEGER, INTENT (IN) :: CompanionCoilIndex
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ExIndex ! do loop index
INTEGER :: SupInNode ! supply air inlet node number
INTEGER :: SecInNode ! secondary air inlet node number
REAL(r64) :: CMIN0 ! minimum capacity flow
REAL(r64) :: CMAX0 ! maximum capacity flow
REAL(r64) :: Eps0 ! effectiveness at rated conditions
REAL(r64) :: NTU0 ! NTU at rated conditions
REAL(r64) :: RhoAir ! air density at outside pressure & standard temperature and humidity
REAL(r64) :: CpAir ! heat capacity of air
! of humidity ratio and temperature
LOGICAL,SAVE :: MyEnvrnFlag=.TRUE.
LOGICAL,SAVE :: MyOneTimeAllocate=.TRUE.
LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: MySetPointTest
LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: MySizeFlag
INTEGER :: ErrStat ! error status returned by CalculateNTUfromEpsAndZ
LOGICAL :: FatalError ! fatal error flag
LOGICAL :: LocalWarningError ! warning error flag
REAL(r64) :: Z ! Min/max flow ratio
! LOGICAL,SAVE :: ZoneEquipmentListChecked = .false. ! True after the Zone Equipment List has been checked for items
IF(MyOneTimeAllocate)THEN
ALLOCATE(MySetPointTest(NumHeatExchangers))
ALLOCATE(MySizeFlag(NumHeatExchangers))
MySetPointTest = .TRUE.
MySizeFlag = .TRUE.
MyOneTimeAllocate = .FALSE.
END IF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(ExchNum) ) THEN
CALL SizeHeatRecovery(ExchNum)
MySizeFlag(ExchNum) = .FALSE.
END IF
FatalError = .FALSE.
LocalWarningError = .false.
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag) THEN
!I believe that all of these initializations should be taking place at the SCFM conditions
RhoAir = StdRhoAir
! RhoAir = PsyRhoAirFnPbTdbW(101325.0,20.0,0.0) do we want standard air density at sea level for generic ERVs per ARI 1060?
CpAir = PsyCpAirFnWTdb(0.0d0,20.0d0)
DO ExIndex=1,NumHeatExchangers
SELECT CASE(ExchCond(ExIndex)%ExchTypeNum)
CASE(HX_AIRTOAIR_FLATPLATE)
ExchCond(ExIndex)%NomSupAirMassFlow = RhoAir * ExchCond(ExIndex)%NomSupAirVolFlow
ExchCond(ExIndex)%NomSecAirMassFlow = RhoAir * ExchCond(ExIndex)%NomSecAirVolFlow
! Note: the capacity stream is here simply the mass flow
! since the thermal capacity can be assumed to be
! equal for both streams
IF (ExchCond(ExIndex)%NomSupAirMassFlow > ExchCond(ExIndex)%NomSecAirMassFlow) THEN
CMIN0 = ExchCond(ExIndex)%NomSecAirMassFlow
CMAX0 = ExchCond(ExIndex)%NomSupAirMassFlow
ELSE
CMIN0 = ExchCond(ExIndex)%NomSupAirMassFlow
CMAX0 = ExchCond(ExIndex)%NomSecAirMassFlow
END IF
Eps0 = ExchCond(ExIndex)%NomSupAirMassFlow * &
SafeDiv( ExchCond(ExIndex)%NomSupAirOutTemp - ExchCond(ExIndex)%NomSupAirInTemp, &
CMin0*(ExchCond(ExIndex)%NomSecAirInTemp - ExchCond(ExIndex)%NomSupAirInTemp) )
Z = CMIN0/CMAX0
ErrStat=0
CALL CalculateNTUfromEpsAndZ(NTU0, ErrStat, Z, ExchCond(ExIndex)%FlowArr, Eps0)
IF (ErrStat == 1) THEN
FatalError = .TRUE.
CALL ShowSevereError('In the HeatExchanger:AirToAir:FlatPlate component ' // TRIM(ExchCond(ExIndex)%Name) )
CALL ShowContinueError(' the mass flow ratio is out of bounds')
CALL ShowContinueError('The mass flow ratio is (Min_Mass_Flow_Rate / Max_Mass_Flow_Rate) = ' // &
TRIM(RoundSigDigits(Z,2)))
CALL ShowContinueError('The mass flow ratio should be >= 0.0 and <= 1.0')
CALL ShowContinueError('Min_Mass_Flow_Rate = ' // TRIM(RoundSigDigits(RhoAir,2)) // ' [air density] * ' // &
TRIM(RoundSigDigits(MIN(ExchCond(ExIndex)%NomSupAirVolFlow, &
ExchCond(ExIndex)%NomSecAirVolFlow),1)) // ' [Min_Vol_Flow_Rate]' )
CALL ShowContinueError('Max_Mass_Flow_Rate = ' // TRIM(RoundSigDigits(RhoAir,2)) // ' [air density] * ' // &
TRIM(RoundSigDigits(MAX(ExchCond(ExIndex)%NomSupAirVolFlow, &
ExchCond(ExIndex)%NomSecAirVolFlow),1)) // ' [Max_Vol_Flow_Rate]' )
ELSE IF (ErrStat == 2) THEN
FatalError = .TRUE.
CALL ShowSevereError('In the HeatExchanger:AirToAir:FlatPlate component ' // TRIM(ExchCond(ExIndex)%Name) )
CALL ShowContinueError(' the calculated nominal effectiveness is out of bounds')
CALL ShowContinueError('The effectiveness is ' // TRIM(RoundSigDigits(Eps0,3)))
CALL ShowContinueError('The effectiveness should be >= 0.0 and <= ' // &
TRIM(RoundSigDigits(1.0d0/(1.0d0+Z),3)))
CALL ShowContinueError('Eff = (Nom_Sup_Mass_Flow_Rate/Min_Mass_Flow_Rate)*(T_nom_sup_out-T_nom_sup_in)' &
// '/(T_nom_sec_in-T_nom_sup_in)')
CALL ShowContinueError('The temperatures are user inputs. The mass flow rates are user input volume flow rates')
CALL ShowContinueError(' times the density of air [' // TRIM(RoundSigDigits(RhoAir,2)) // ' kg/m3]' )
CALL ShowContinueError('Change these inputs to obtain a physically realizable heat exchanger effectiveness')
ELSE IF (ErrStat == 3) THEN
FatalError = .TRUE.
CALL ShowSevereError('In the HeatExchanger:AirToAir:FlatPlate component ' // TRIM(ExchCond(ExIndex)%Name) )
CALL ShowContinueError(' the calculated nominal effectiveness is out of bounds')
CALL ShowContinueError('The effectiveness is ' // TRIM(RoundSigDigits(Eps0,3)))
CALL ShowContinueError('The effectiveness should be >= 0.0 and <= ' // &
TRIM(RoundSigDigits((1.0d0-EXP(-Z))/Z,3)))
CALL ShowContinueError('Eff = (Nom_Sup_Mass_Flow_Rate/Min_Mass_Flow_Rate)*(T_nom_sup_out-T_nom_sup_in)' &
// '/(T_nom_sec_in-T_nom_sup_in)')
CALL ShowContinueError('The temperatures are user inputs. The mass flow rates are user input volume flow rates')
CALL ShowContinueError(' times the density of air [' // TRIM(RoundSigDigits(RhoAir,2)) // ' kg/m3]' )
CALL ShowContinueError('Change these inputs to obtain a physically realizable heat exchanger effectiveness')
ELSE IF (ErrStat == 4) THEN
FatalError = .TRUE.
CALL ShowSevereError('In the HeatExchanger:AirToAir:FlatPlate component ' // TRIM(ExchCond(ExIndex)%Name))
CALL ShowContinueError(' the quantity Eff_nom*(Min_Mass_Flow_Rate / Max_Mass_Flow_Rate) is out of bounds')
CALL ShowContinueError('The value is ' // TRIM(RoundSigDigits(Eps0*Z,3)))
CALL ShowContinueError('The value should be >= 0.0 and <= ' // &
TRIM(RoundSigDigits(1.0d0-EXP(Z*(SMALL-1.0d0)),3)))
CALL ShowContinueError('Eff_nom = (Nom_Sup_Mass_Flow_Rate/Min_Mass_Flow_Rate) * (T_nom_sup_out - T_nom_sup_in)' &
// '/(T_nom_sec_in - T_nom_sup_in)')
CALL ShowContinueError('The temperatures are user inputs. The mass flow rates are user input volume flow rates')
CALL ShowContinueError(' times the density of air [' // TRIM(RoundSigDigits(RhoAir,2)) // ' kg/m3]' )
CALL ShowContinueError('Change these inputs to obtain a physically realizable product of effectiveness' &
// 'times min/max mass ratio for this heat exchanger')
ELSE IF (ErrStat == 5) THEN
FatalError = .TRUE.
CALL ShowSevereError('In the HeatExchanger:AirToAir:FlatPlate component ' // TRIM(ExchCond(ExIndex)%Name) )
CALL ShowContinueError(' the calculated nominal effectiveness is out of bounds')
CALL ShowContinueError('The effectiveness is ' // TRIM(RoundSigDigits(Eps0,3)))
CALL ShowContinueError('The effectiveness should be >= 0.0 and <= 1.0')
CALL ShowContinueError('Eff = (Nom_Sup_Mass_Flow_Rate/Min_Mass_Flow_Rate)*(T_nom_sup_out-T_nom_sup_in)' &
// '/(T_nom_sec_in-T_nom_sup_in)')
CALL ShowContinueError('The temperatures are user inputs. The mass flow rates are user input volume flow rates')
CALL ShowContinueError(' times the density of air [' // TRIM(RoundSigDigits(RhoAir,2)) // ' kg/m3]' )
CALL ShowContinueError('Change these inputs to obtain a physically realizable heat exchanger effectiveness')
END IF
IF (FatalError) THEN
CALL ShowFatalError('Heat exchanger design calculation caused fatal error: program terminated.')
END IF
ExchCond(ExIndex)%UA0 = NTU0 * CMin0 *CpAir
ExchCond(ExIndex)%mTSup0 = ExchCond(ExIndex)%NomSupAirMassFlow * (ExchCond(ExIndex)%NomSupAirInTemp + KELVZERO)
ExchCond(ExIndex)%mTSec0 = ExchCond(ExIndex)%NomSecAirMassFlow * (ExchCond(ExIndex)%NomSecAirInTemp + KELVZERO)
! check validity
IF (ExchCond(ExIndex)%NomSupAirMassFlow * ExchCond(ExIndex)%NomSecAirMassFlow < SmallMassFlow*SmallMassFlow) THEN
CALL ShowFatalError("Mass flow in HeatExchanger:AirToAir:FlatPlate too small in initialization.")
END IF
IF (ExchCond(ExIndex)%mTSup0 < SmallMassFlow) THEN
CALL ShowFatalError("(m*T)Sup,in in HeatExchanger:AirToAir:FlatPlate too small in initialization.")
END IF
IF (ExchCond(ExIndex)%mTSec0 < SmallMassFlow) THEN
CALL ShowFatalError("(m*T)Sec,in in HeatExchanger:AirToAir:FlatPlate too small in initialization.")
END IF
IF (CMin0 < SmallMassFlow) THEN
CALL ShowFatalError("CMin0 in HeatExchanger:AirToAir:FlatPlate too small in initialization.")
END IF
CASE(HX_AIRTOAIR_GENERIC)
IF (ExchCond(ExIndex)%SupOutletNode > 0 .AND. ExchCond(ExIndex)%ControlToTemperatureSetPoint) THEN
IF (Node(ExchCond(ExIndex)%SupOutletNode)%TempSetPoint == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowSevereError('Missing temperature setpoint for ' // &
TRIM(cHXTypes(ExchCond(ExIndex)%ExchTypeNum)) //' "'//TRIM(ExchCond(ExIndex)%Name) // '" :')
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the supply air outlet node ' // &
'of the Heat Exchanger.')
CALL ShowFatalError(' Previous condition causes program termination.')
ELSE
! need call to EMS to check node
CALL CheckIfNodeSetpointManagedByEMS(ExchCond(ExIndex)%SupOutletNode,iTemperatureSetpoint, FatalError)
IF (FatalError) THEN
CALL ShowSevereError('Missing temperature setpoint for ' // &
TRIM(cHXTypes(ExchCond(ExIndex)%ExchTypeNum)) //' "'//TRIM(ExchCond(ExIndex)%Name) // '" :')
CALL ShowContinueError(' use a Setpoint Manager to establish a setpoint at the supply air outlet node ' // &
'of the Heat Exchanger.')
CALL ShowContinueError(' or use an EMS actuator to establish a setpoint at the supply air outlet node ' // &
'of the Heat Exchanger.')
CALL ShowFatalError(' Previous condition causes program termination.')
ENDIF
ENDIF
END IF
END IF
CASE(HX_DESICCANT_BALANCED)
CASE DEFAULT
! Will never get here
END SELECT
END DO
MyEnvrnFlag = .FALSE.
END IF
IF (.NOT. BeginEnvrnFlag) THEN
MyEnvrnFlag=.TRUE.
ENDIF
! Do these initializations every time step
SupInNode = ExchCond(ExchNum)%SupInletNode
SecInNode = ExchCond(ExchNum)%SecInletNode
! Get information from inlet nodes
ExchCond(ExchNum)%SupInTemp = Node(SupInNode)%Temp
ExchCond(ExchNum)%SupInHumRat = Node(SupInNode)%HumRat
ExchCond(ExchNum)%SupInEnth = Node(SupInNode)%Enthalpy
ExchCond(ExchNum)%SupInMassFlow = Node(SupInNode)%MassFlowRate
ExchCond(ExchNum)%SecInTemp = Node(SecInNode)%Temp
ExchCond(ExchNum)%SecInHumRat = Node(SecInNode)%HumRat
ExchCond(ExchNum)%SecInEnth = Node(SecInNode)%Enthalpy
ExchCond(ExchNum)%SecInMassFlow = Node(SecInNode)%MassFlowRate
! initialize the output variables
ExchCond(ExchNum)%SensHeatingRate = 0.0d0
ExchCond(ExchNum)%SensHeatingEnergy = 0.0d0
ExchCond(ExchNum)%LatHeatingRate = 0.0d0
ExchCond(ExchNum)%LatHeatingEnergy = 0.0d0
ExchCond(ExchNum)%TotHeatingRate = 0.0d0
ExchCond(ExchNum)%TotHeatingEnergy = 0.0d0
ExchCond(ExchNum)%SensCoolingRate = 0.0d0
ExchCond(ExchNum)%SensCoolingEnergy = 0.0d0
ExchCond(ExchNum)%LatCoolingRate = 0.0d0
ExchCond(ExchNum)%LatCoolingEnergy = 0.0d0
ExchCond(ExchNum)%TotCoolingRate = 0.0d0
ExchCond(ExchNum)%TotCoolingEnergy = 0.0d0
ExchCond(ExchNum)%ElecUseRate = 0.0d0
ExchCond(ExchNum)%ElecUseEnergy = 0.0d0
ExchCond(ExchNum)%SensEffectiveness = 0.0d0
ExchCond(ExchNum)%LatEffectiveness = 0.0d0
ExchCond(ExchNum)%SupBypassMassFlow = 0.0d0
ExchCond(ExchNum)%SecBypassMassFlow = 0.0d0
! Initialize inlet conditions
SELECT CASE(ExchCond(ExchNum)%ExchTypeNum)
CASE(HX_AIRTOAIR_FLATPLATE)
CASE(HX_AIRTOAIR_GENERIC)
CASE(HX_DESICCANT_BALANCED)
IF(MySetPointTest(ExchNum))THEN
IF ( .NOT. SysSizingCalc .AND. DoSetPointTest) THEN
IF(.NOT. CalledFromParentObject)THEN
IF (Node(ExchCond(ExchNum)%SecOutletNode)%HumRatMax == SensedNodeFlagValue) THEN
IF (.NOT. AnyEnergyManagementSystemInModel) THEN
CALL ShowWarningError('Missing optional HumRatMax setpoint for ' // &
TRIM(cHXTypes(ExchCond(ExchNum)%ExchTypeNum)) //' "'//TRIM(ExchCond(ExchNum)%Name) // '"')
CALL ShowContinueError('...the simulation will continue without control of the desiccant heat exchanger to'// &
' a maximum humidity ratio setpoint.')
CALL ShowContinueError('...use a Setpoint Manager to establish a setpoint at the process air outlet node ' // &
'of the desiccant Heat Exchanger if control is desired.')
ELSE
! need call to EMS to check node
CALL CheckIfNodeSetpointManagedByEMS(ExchCond(ExchNum)%SecOutletNode,iHumidityRatioMaxSetpoint, LocalWarningError)
IF (LocalWarningError) THEN
CALL ShowWarningError('Missing optional HumRatMax setpoint for ' // &
TRIM(cHXTypes(ExchCond(ExchNum)%ExchTypeNum)) //' "'//TRIM(ExchCond(ExchNum)%Name) // '"')
CALL ShowContinueError('...the simulation will continue without control of the desiccant heat exchanger to'// &
' a maximum humidity ratio setpoint.')
CALL ShowContinueError('...use a Setpoint Manager to establish a setpoint at the process air outlet node ' // &
'of the desiccant Heat Exchanger if control is desired.')
CALL ShowContinueError('...or use an EMS Actuator to establish a maximum humidity ratio setpoint at the ' &
//'process air outlet node of the desiccant Heat Exchanger if control is desired.')
ENDIF
ENDIF
END IF
END IF
MySetPointTest(ExchNum) = .FALSE.
END IF
END IF
IF(CompanionCoilIndex .GT. 0) THEN
IF(DXCoilFullLoadOutAirTemp(CompanionCoilIndex) == 0.0d0 .OR. DXCoilFullLoadOutAirHumRat(CompanionCoilIndex) == 0.0d0)THEN
! DX Coil is OFF, read actual inlet conditions
FullLoadOutAirTemp = ExchCond(ExchNum)%SecInTemp
FullLoadOutAirHumRat = ExchCond(ExchNum)%SecInHumRat
ELSE
! DX Coil is ON, read full load DX coil outlet conditions (conditions HX sees when ON)
FullLoadOutAirTemp = DXCoilFullLoadOutAirTemp(CompanionCoilIndex)
FullLoadOutAirHumRat = DXCoilFullLoadOutAirHumRat(CompanionCoilIndex)
END IF
ELSE
! HX only (not used in conjunction with DX coil), read inlet conditions
FullLoadOutAirTemp = ExchCond(ExchNum)%SecInTemp
FullLoadOutAirHumRat = ExchCond(ExchNum)%SecInHumRat
END IF
CASE DEFAULT
! Will never get here
END SELECT
RETURN
END SUBROUTINE InitHeatRecovery