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) | :: | DXCoilNum |
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 InitDXCoil(DXCoilNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN May 2000
! Feb 2005 M. J. Witte, GARD Analytics, Inc.
! Add new coil type COIL:DX:MultiMode:CoolingEmpirical:
! July 2005 R. Raustad, FSEC
! Add new coil type COIL:DX:HEATPUMPWATERHEATER
! June 2007 L. Gu, FSEC
! Add new coil type COIL:DX:MULTISPEED:COOLING and HEATING
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for initializations of DX Coil Components.
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger initializations.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: FanElecPower
USE DataAirLoop, ONLY: AirLoopInputsFilled
USE General, ONLY: TrimSigDigits
USE ReportSizingManager, ONLY: ReportSizingOutput
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT (IN) :: DXCoilNum ! number of the current DX coil unit being simulated
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64) :: SmallDifferenceTest=0.00000001d0
CHARACTER(len=*), PARAMETER :: RoutineName='InitDXCoil'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, ALLOCATABLE,SAVE, DIMENSION(:) :: MyEnvrnFlag ! One time environment flag
LOGICAL, ALLOCATABLE,SAVE, DIMENSION(:) :: MySizeFlag ! One time sizing flag
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE. ! One time flag used to allocate MyEnvrnFlag and MySizeFlag
LOGICAL,SAVE :: CrankcaseHeaterReportVarFlag = .TRUE. ! One time flag used to report crankcase heater power for non-HP coils
REAL(r64) :: RatedHeatPumpIndoorAirTemp ! Indoor dry-bulb temperature to heat pump evaporator at rated conditions [C]
REAL(r64) :: RatedHeatPumpIndoorHumRat ! Inlet humidity ratio to heat pump evaporator at rated conditions [kgWater/kgDryAir]
REAL(r64) :: RatedVolFlowPerRatedTotCap ! Rated Air Volume Flow Rate divided by Rated Total Capacity [m3/s-W)
REAL(r64) :: HPInletAirHumRat ! Rated inlet air humidity ratio for heat pump water heater [kgWater/kgDryAir]
LOGICAL :: ErrorsFound=.FALSE. ! TRUE when errors found
INTEGER :: CapacityStageNum ! Loop index for 1,Number of capacity stages
INTEGER :: DehumidModeNum ! Loop index for 1,Number of enhanced dehumidification modes
INTEGER :: Mode ! Performance mode for MultiMode DX coil; Always 1 for other coil types
INTEGER :: DXCoilNumTemp ! Counter for crankcase heater report variable DO loop
INTEGER :: AirInletNode ! Air inlet node number
IF (MyOneTimeFlag) THEN
! initialize the environment and sizing flags
ALLOCATE(MyEnvrnFlag(NumDXCoils))
ALLOCATE(MySizeFlag(NumDXCoils))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
MyOneTimeFlag = .FALSE.
END IF
! if "ISHundredPercentDOASDXCoil" =.true., then set coil as 100% DOAS dx coil
IF (DXCoil(DXCoilNum)%ISHundredPercentDOASDXCoil) THEN
DXCT = 2
ELSE
DXCT = 1
ENDIF
IF(DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_HeatPumpWaterHeater .AND. MyEnvrnFlag(DXCoilNum)) THEN
CALL SizeDXCoil(DXCoilNum)
RatedVolFlowPerRatedTotCap = DXCoil(DXCoilNum)%RatedAirVolFlowRate(1)/DXCoil(DXCoilNum)%RatedTotCap2
IF (((MinRatedVolFlowPerRatedTotCap(DXCT) - RatedVolFlowPerRatedTotCap) > SmallDifferenceTest).OR. &
((RatedVolFlowPerRatedTotCap - MaxHeatVolFlowPerRatedTotCap(DXCT)) > SmallDifferenceTest)) THEN
CALL ShowSevereError (TRIM(DXCoil(DXCoilNum)%DXCoilType) // ' "'//TRIM(DXCoil(DXCoilNum)%Name)// &
'": Rated air volume flow rate per watt of rated total water '// &
'heating capacity is out of range.')
CALL ShowContinueError('Min Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MinRatedVolFlowPerRatedTotCap(DXCT),3))//'], '// &
'Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(RatedVolFlowPerRatedTotCap,3))//'], Max Rated Vol Flow Per Watt=['// &
TRIM(TrimSigDigits(MaxHeatVolFlowPerRatedTotCap(DXCT),3))//']. See Input-Output Reference Manual for valid range.')
END IF
HPInletAirHumRat = PsyWFnTdbTwbPb(DXCoil(DXCoilNum)%RatedInletDBTemp,DXCoil(DXCoilNum)%RatedInletWBTemp, &
StdBaroPress,RoutineName)
HPWHInletDBTemp = DXCoil(DXCoilNum)%RatedInletDBTemp
HPWHInletWBTemp = DXCoil(DXCoilNum)%RatedInletWBTemp
DXCoil(DXCoilNum)%RatedAirMassFlowRate(1) = DXCoil(DXCoilNum)%RatedAirVolFlowRate(1)* &
PsyRhoAirFnPbTdbW(StdBaroPress,DXCoil(DXCoilNum)%RatedInletDBTemp,HPInletAirHumRat,RoutineName)
! get rated coil bypass factor excluding fan heat
FanElecPower = 0.0d0
! call CalcHPWHDXCoil to determine DXCoil%RatedTotCap(1) for rated CBF calculation below
CALL CalcHPWHDXCoil(DXCoilNum,1.0d0)
IF(MySizeFlag(DXCoilNum))THEN
CALL SizeDXCoil(DXCoilNum)
MySizeFlag(DXCoilNum) = .FALSE.
END IF
DXCoil(DXCoilNum)%RatedCBF(1) = CalcCBF(DXCoil(DXCoilNum)%DXCoilType, DXCoil(DXCoilNum)%Name,&
DXCoil(DXCoilNum)%RatedInletDBTemp,HPInletAirHumRat,DXCoil(DXCoilNum)%RatedTotCap(1), &
DXCoil(DXCoilNum)%RatedAirMassFlowRate(1),DXCoil(DXCoilNum)%RatedSHR(1))
MyEnvrnFlag(DXCoilNum) = .FALSE.
END IF
! Find the companion upstream coil (DX cooling coil) that is used with DX heating coils (HP AC units only)
IF(DXCoil(DXCoilNum)%FindCompanionUpStreamCoil)THEN
IF(DXCoil(DXCoilNum)%DXCoilType_Num .EQ. CoilDX_HeatingEmpirical .OR. &
DXCoil(DXCoilNum)%DXCoilType_Num .EQ. CoilDX_MultiSpeedHeating)THEN
DXCoil(DXCoilNum)%CompanionUpstreamDXCoil = &
GetHPCoolingCoilIndex(DXCoil(DXCoilNum)%DXCoilType, DXCoil(DXCoilNum)%Name, DXCoilNum)
IF(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil .GT. 0)THEN
DXCoil(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil)%ReportCoolingCoilCrankcasePower = .FALSE.
DXCoil(DXCoilNum)%FindCompanionUpStreamCoil = .FALSE.
! Copy condenser node number from DX cooling coil when used with a companion DX heating coil
DO Mode = 1, MaxModes
DXCoil(DXCoilNum)%CondenserInletNodeNum(Mode) = &
DXCoil(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil)%CondenserInletNodeNum(Mode)
END DO
END IF
ELSE
DXCoil(DXCoilNum)%FindCompanionUpStreamCoil = .FALSE.
END IF
END IF !IF(DXCoil(DXCoilNum)%FindCompanionUpStreamCoil)THEN
! CR7308 - Wait for zone and air loop equipment to be simulated, then print out report variables
IF(CrankcaseHeaterReportVarFlag)THEN
IF(AirLoopInputsFilled)THEN
! Set report variables for DX cooling coils that will have a crankcase heater (all DX coils not used in a HP AC unit)
DO DXCoilNumTemp=1,NumDOE2DXCoils+NumDXMulModeCoils
IF (DXCoil(DXCoilNumTemp)%ReportCoolingCoilCrankcasePower) THEN
CALL SetupOutputVariable('Cooling Coil Crankcase Heater Electric Power [W]', &
DXCoil(DXCoilNumTemp)%CrankcaseHeaterPower,'System', 'Average',DXCoil(DXCoilNumTemp)%Name)
CALL SetupOutputVariable('Cooling Coil Crankcase Heater Electric Energy [J]', &
DXCoil(DXCoilNumTemp)%CrankcaseHeaterConsumption, 'System','Sum',DXCoil(DXCoilNumTemp)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',GroupKey='Plant')
DXCoil(DXCoilNumTemp)%ReportCoolingCoilCrankcasePower = .FALSE.
END IF
END DO
CrankcaseHeaterReportVarFlag = .FALSE.
END IF !(AirLoopInputsFilled)THEN
END IF !(CrankcaseHeaterReportVarFlag)THEN
! Find the companion upstream coil (DX cooling coil) that is used with DX heating coils (Multispeed HP units only)
IF(DXCoil(DXCoilNum)%FindCompanionUpStreamCoil)THEN
IF(DXCoil(DXCoilNum)%DXCoilType_Num .EQ. CoilDX_MultiSpeedHeating)THEN
DXCoil(DXCoilNum)%CompanionUpstreamDXCoil = &
GetHPCoolingCoilIndex(DXCoil(DXCoilNum)%DXCoilType, DXCoil(DXCoilNum)%Name, DXCoilNum)
IF(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil .GT. 0)THEN
DXCoil(DXCoil(DXCoilNum)%CompanionUpstreamDXCoil)%ReportCoolingCoilCrankcasePower = .FALSE.
DXCoil(DXCoilNum)%FindCompanionUpStreamCoil = .FALSE.
END IF
ELSE
DXCoil(DXCoilNum)%FindCompanionUpStreamCoil = .FALSE.
END IF
END IF !IF(DXCoil(DXCoilNum)%FindCompanionUpStreamCoil)THEN
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(DXCoilNum)) THEN
! for each coil, do the sizing once.
CALL SizeDXCoil(DXCoilNum)
MySizeFlag(DXCoilNum) = .FALSE.
IF (DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_CoolingSingleSpeed .OR. &
DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_CoolingTwoSpeed .OR. &
DXCoil(DXCoilNum)%DXCoilType_Num == CoilVRF_Cooling) THEN
Mode = 1
! Check for zero capacity or zero max flow rate
IF (DXCoil(DXCoilNum)%RatedTotCap(Mode) <= 0.0d0) THEN
CALL ShowSevereError('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
' has zero rated total capacity')
ErrorsFound=.TRUE.
END IF
IF (DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode) <= 0.0d0) THEN
CALL ShowSevereError('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
' has zero rated air flow rate')
ErrorsFound=.TRUE.
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding condition causes termination.')
ENDIF
!
! Check for valid range of (Rated Air Volume Flow Rate / Rated Total Capacity)
!
RatedVolFlowPerRatedTotCap = DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode)/DXCoil(DXCoilNum)%RatedTotCap(Mode)
IF (((MinRatedVolFlowPerRatedTotCap(DXCT) - RatedVolFlowPerRatedTotCap) > SmallDifferenceTest).OR. &
((RatedVolFlowPerRatedTotCap - MaxRatedVolFlowPerRatedTotCap(DXCT)) > SmallDifferenceTest)) THEN
CALL ShowSevereError ('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType) // ' "'//TRIM(DXCoil(DXCoilNum)%Name)// &
'": Rated air volume flow rate per watt of rated total '// &
'cooling capacity is out of range.')
CALL ShowContinueError('Min Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MinRatedVolFlowPerRatedTotCap(DXCT),3))// &
'], Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(RatedVolFlowPerRatedTotCap,3))// &
'], Max Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MaxRatedVolFlowPerRatedTotCap(DXCT),3))// &
']. See Input Output Reference Manual for valid range.')
END IF
DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode) = DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode)* &
PsyRhoAirFnPbTdbW(StdBaroPress,RatedInletAirTemp,RatedInletAirHumRat,RoutineName)
! get high speed rated coil bypass factor
DXCoil(DXCoilNum)%RatedCBF(Mode) = CalcCBF(DXCoil(DXCoilNum)%DXCoilType,DXCoil(DXCoilNum)%Name,&
RatedInletAirTemp,RatedInletAirHumRat,DXCoil(DXCoilNum)%RatedTotCap(Mode),&
DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode),DXCoil(DXCoilNum)%RatedSHR(Mode))
END IF
IF (DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_CoolingTwoStageWHumControl) THEN
DO DehumidModeNum = 0, DXCoil(DXCoilNum)%NumDehumidModes
DO CapacityStageNum = 1, DXCoil(DXCoilNum)%NumCapacityStages
Mode = DehumidModeNum*2 + CapacityStageNum
! Check for zero capacity or zero max flow rate
IF (DXCoil(DXCoilNum)%RatedTotCap(Mode) <= 0.0d0) THEN
CALL ShowSevereError('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
' has zero rated total capacity')
CALL ShowContinueError('for CoilPerformance:DX:Cooling mode: '// &
TRIM(DXCoil(DXCoilNum)%CoilPerformanceName(Mode)))
ErrorsFound=.TRUE.
END IF
IF (DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode) <= 0.0d0) THEN
CALL ShowSevereError('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
' has zero rated air flow rate')
CALL ShowContinueError('for CoilPerformance:DX:Cooling mode: '// &
TRIM(DXCoil(DXCoilNum)%CoilPerformanceName(Mode)))
ErrorsFound=.TRUE.
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding condition causes termination.')
ENDIF
!
! Check for valid range of (Rated Air Volume Flow Rate / Rated Total Capacity)
!
RatedVolFlowPerRatedTotCap = DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode)/DXCoil(DXCoilNum)%RatedTotCap(Mode)
IF (((MinRatedVolFlowPerRatedTotCap(DXCT) - RatedVolFlowPerRatedTotCap) > SmallDifferenceTest).OR. &
((RatedVolFlowPerRatedTotCap - MaxRatedVolFlowPerRatedTotCap(DXCT)) > SmallDifferenceTest)) THEN
CALL ShowSevereError ('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType) // ' "'//TRIM(DXCoil(DXCoilNum)%Name)// &
'": Rated air volume flow rate per watt of rated total '// &
'cooling capacity is out of range.')
CALL ShowContinueError('Min Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MinRatedVolFlowPerRatedTotCap(DXCT),3))// &
'], Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(RatedVolFlowPerRatedTotCap,3))// &
'], Max Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MaxRatedVolFlowPerRatedTotCap(DXCT),3))// &
']. See Input Output Reference Manual for valid range.')
CALL ShowContinueError('for CoilPerformance:DX:Cooling mode: '// &
TRIM(DXCoil(DXCoilNum)%CoilPerformanceName(Mode)))
END IF
DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode) = DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode)* &
PsyRhoAirFnPbTdbW(StdBaroPress,RatedInletAirTemp,RatedInletAirHumRat,RoutineName)
! get rated coil bypass factor
DXCoil(DXCoilNum)%RatedCBF(Mode) = CalcCBF(DXCoil(DXCoilNum)%CoilPerformanceType(Mode), &
DXCoil(DXCoilNum)%CoilPerformanceName(Mode),&
RatedInletAirTemp,RatedInletAirHumRat,DXCoil(DXCoilNum)%RatedTotCap(Mode),&
DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode),DXCoil(DXCoilNum)%RatedSHR(Mode))
END DO ! End capacity stages loop
END DO ! End dehumidification modes loop
END IF
IF (DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_HeatingEmpirical .OR. &
DXCoil(DXCoilNum)%DXCoilType_Num == CoilVRF_Heating) THEN
Mode = 1
IF (DXCoil(DXCoilNum)%RatedTotCap(Mode) <= 0.0d0) THEN
CALL ShowSevereError('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
' has zero rated total capacity')
ErrorsFound=.TRUE.
END IF
IF (DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode) <= 0.0d0) THEN
CALL ShowSevereError('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
' has zero rated air flow rate')
ErrorsFound=.TRUE.
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding condition causes termination.')
ENDIF
RatedHeatPumpIndoorAirTemp = 21.11d0 ! 21.11C or 70F
RatedHeatPumpIndoorHumRat = 0.00881d0 ! Humidity ratio corresponding to 70F dry bulb/60F wet bulb
DXCoil(DXCoilNum)%RatedAirMassFlowRate(Mode) = DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode)* &
PsyRhoAirFnPbTdbW(StdBaroPress,RatedHeatPumpIndoorAirTemp,RatedHeatPumpIndoorHumRat,RoutineName)
! Check for valid range of (Rated Air Volume Flow Rate / Rated Total Capacity)
!
RatedVolFlowPerRatedTotCap = DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode)/DXCoil(DXCoilNum)%RatedTotCap(Mode)
IF (((MinRatedVolFlowPerRatedTotCap(DXCT) - RatedVolFlowPerRatedTotCap) > SmallDifferenceTest).OR. &
((RatedVolFlowperRatedTotCap - MaxRatedVolFlowPerRatedTotCap(DXCT)) > SmallDifferenceTest)) THEN
CALL ShowSevereError ('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
': Rated air volume flow rate per watt of rated total '// &
'heating capacity is out of range.')
CALL ShowContinueError('Min Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MinRatedVolFlowPerRatedTotCap(DXCT),3))// &
'], Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(RatedVolFlowPerRatedTotCap,3))//'], Max Rated Vol Flow Per Watt=['// &
TRIM(TrimSigDigits(MaxRatedVolFlowPerRatedTotCap(DXCT),3))//']. See Input-Output Reference Manual for valid range.')
END IF
END IF
IF (DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_CoolingTwoSpeed) THEN
!
! Check for valid range of (Rated Air Volume Flow Rate / Rated Total Capacity)
RatedVolFlowPerRatedTotCap = DXCoil(DXCoilNum)%RatedAirVolFlowRate2/DXCoil(DXCoilNum)%RatedTotCap2
IF (((MinRatedVolFlowPerRatedTotCap(DXCT) - RatedVolFlowPerRatedTotCap) > SmallDifferenceTest).OR. &
((RatedVolFlowPerRatedTotCap - MaxRatedVolFlowPerRatedTotCap(DXCT)) > SmallDifferenceTest)) THEN
CALL ShowSevereError ('Coil:Cooling:DX:TwoSpeed "'//TRIM(DXCoil(DXCoilNum)%Name)// &
'": At low speed rated air volume flow rate per watt of rated total '// &
'cooling capacity is out of range.')
CALL ShowContinueError('Min Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MinRatedVolFlowPerRatedTotCap(DXCT),3))// &
'], Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(RatedVolFlowPerRatedTotCap,3))//'], Max Rated Vol Flow Per Watt=['// &
TRIM(TrimSigDigits(MaxRatedVolFlowPerRatedTotCap(DXCT),3))//']. See Input-Output Reference Manual for valid range.')
END IF
DXCoil(DXCoilNum)%RatedAirMassFlowRate2 = DXCoil(DXCoilNum)%RatedAirVolFlowRate2* &
PsyRhoAirFnPbTdbW(StdBaroPress,RatedInletAirTemp,RatedInletAirHumRat,RoutineName)
! get low speed rated coil bypass factor
DXCoil(DXCoilNum)%RatedCBF2 = CalcCBF(DXCoil(DXCoilNum)%DXCoilType,DXCoil(DXCoilNum)%Name,&
RatedInletAirTemp,RatedInletAirHumRat,DXCoil(DXCoilNum)%RatedTotCap2,&
DXCoil(DXCoilNum)%RatedAirMassFlowRate2,DXCoil(DXCoilNum)%RatedSHR2)
! call for standard ratings for two-speeed DX coil
IF (DXCoil(DXCoilNum)%CondenserType(1) == AirCooled) THEN
CALL CalcTwoSpeedDXCoilStandardRating(DXCoilNum)
ENDIF
END IF
! Autosizing is completed in Size routine, however, the HPWH disrupts the flow of the eio and reporting
! is done here while all other coils are sized and reported.
IF(DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_HeatPumpWaterHeater .AND. DXCoil(DXCoilNum)%AirVolFlowAutoSized) THEN
CALL ReportSizingOutput(DXCoil(DXCoilNum)%DXCoilType, DXCoil(DXCoilNum)%Name, &
'Rated Air Volume Flow Rate [m3/s]', DXCoil(DXCoilNum)%RatedAirVolFlowRate(Mode))
DXCoil(DXCoilNum)%AirVolFlowAutoSized = .FALSE.
END IF
IF(DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_HeatPumpWaterHeater .AND. DXCoil(DXCoilNum)%WaterVolFlowAutoSized)THEN
CALL ReportSizingOutput(DXCoil(DXCoilNum)%DXCoilType, DXCoil(DXCoilNum)%Name, &
'Rated Condenser Water Volume Flow Rate [m3/s]', DXCoil(DXCoilNum)%RatedHPWHCondWaterFlow)
DXCoil(DXCoilNum)%WaterVolFlowAutoSized = .FALSE.
END IF
! Multispeed Cooling
IF (DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_MultiSpeedCooling) THEN
Do Mode = 1, DXCoil(DXCoilNum)%NumOfSpeeds
! Check for zero capacity or zero max flow rate
IF (DXCoil(DXCoilNum)%MSRatedTotCap(Mode) <= 0.0d0) THEN
CALL ShowSevereError('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
' has zero rated total capacity at speed '//Trim(TrimSigDigits(Mode)))
ErrorsFound=.TRUE.
END IF
IF (DXCoil(DXCoilNum)%MSRatedAirVolFlowRate(Mode) <= 0.0d0) THEN
CALL ShowSevereError('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType)//' '//TRIM(DXCoil(DXCoilNum)%Name)// &
' has zero rated air flow rate at speed '//Trim(TrimSigDigits(Mode)))
ErrorsFound=.TRUE.
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding condition causes termination.')
ENDIF
!
! Check for valid range of (Rated Air Volume Flow Rate / Rated Total Capacity)
!
RatedVolFlowPerRatedTotCap = DXCoil(DXCoilNum)%MSRatedAirVolFlowRate(Mode)/ &
DXCoil(DXCoilNum)%MSRatedTotCap(Mode)
IF (((MinRatedVolFlowPerRatedTotCap(DXCT) - RatedVolFlowPerRatedTotCap) > SmallDifferenceTest).OR. &
((RatedVolFlowPerRatedTotCap - MaxRatedVolFlowPerRatedTotCap(DXCT)) > SmallDifferenceTest)) THEN
CALL ShowSevereError ('Sizing: '//TRIM(DXCoil(DXCoilNum)%DXCoilType) // ' "'//TRIM(DXCoil(DXCoilNum)%Name)// &
'": Rated air volume flow rate per watt of rated total '// &
'cooling capacity is out of range at speed '//TRIM(TrimSigDigits(Mode)))
CALL ShowContinueError('Min Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MinRatedVolFlowPerRatedTotCap(DXCT),3))// &
'], '//'Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(RatedVolFlowPerRatedTotCap,3))// &
'], Max Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MaxRatedVolFlowPerRatedTotCap(DXCT),3))// &
']. See Input Output Reference Manual for valid range.')
END IF
DXCoil(DXCoilNum)%MSRatedAirMassFlowRate(Mode) = DXCoil(DXCoilNum)%MSRatedAirVolFlowRate(Mode)* &
PsyRhoAirFnPbTdbW(StdBaroPress,RatedInletAirTemp,RatedInletAirHumRat,RoutineName)
! get high speed rated coil bypass factor
DXCoil(DXCoilNum)%MSRatedCBF(Mode) = CalcCBF(DXCoil(DXCoilNum)%DXCoilType,DXCoil(DXCoilNum)%Name,&
RatedInletAirTemp,RatedInletAirHumRat,DXCoil(DXCoilNum)%MSRatedTotCap(Mode),&
DXCoil(DXCoilNum)%MSRatedAirMassFlowRate(Mode),DXCoil(DXCoilNum)%MSRatedSHR(Mode))
END DO
END IF
! Multispeed Heating
IF (DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_MultiSpeedHeating) THEN
RatedHeatPumpIndoorAirTemp = 21.11d0 ! 21.11C or 70F
RatedHeatPumpIndoorHumRat = 0.00881d0 ! Humidity ratio corresponding to 70F dry bulb/60F wet bulb
Do Mode = 1, DXCoil(DXCoilNum)%NumOfSpeeds
DXCoil(DXCoilNum)%MSRatedAirMassFlowRate(Mode) = DXCoil(DXCoilNum)%MSRatedAirVolFlowRate(Mode)* &
PsyRhoAirFnPbTdbW(StdBaroPress,RatedHeatPumpIndoorAirTemp,RatedHeatPumpIndoorHumRat,RoutineName)
! Check for valid range of (Rated Air Volume Flow Rate / Rated Total Capacity)
!
RatedVolFlowPerRatedTotCap = DXCoil(DXCoilNum)%MSRatedAirVolFlowRate(Mode)/ &
DXCoil(DXCoilNum)%MSRatedTotCap(Mode)
IF (((MinRatedVolFlowPerRatedTotCap(DXCT) - RatedVolFlowPerRatedTotCap) > SmallDifferenceTest).OR. &
((RatedVolFlowperRatedTotCap - MaxRatedVolFlowPerRatedTotCap(DXCT)) > SmallDifferenceTest)) THEN
CALL ShowSevereError ('Coil:Heating:DX:MultiSpeed '//TRIM(DXCoil(DXCoilNum)%Name)// &
': Rated air volume flow rate per watt of rated total '// &
'heating capacity is out of range at speed '//TRIM(TrimSigDigits(Mode)))
CALL ShowContinueError('Min Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MinRatedVolFlowPerRatedTotCap(DXCT),3))// &
'], Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(RatedVolFlowPerRatedTotCap,3))// &
'], Max Rated Vol Flow Per Watt=['//TRIM(TrimSigDigits(MaxRatedVolFlowPerRatedTotCap(DXCT),3))// &
']. See Input Output Reference Manual for valid range.')
END IF
End Do
END IF
END IF
AirInletNode = DXCoil(DXCoilNum)%AirInNode
! Each iteration, load the coil data structure with the inlet conditions
DXCoil(DXCoilNum)%InletAirMassFlowRate = Node(AirInletNode)%MassFlowRate
DXCoil(DXCoilNum)%InletAirMassFlowRateMax = MAX(Node(AirInletNode)%MassFlowRateMax,Node(AirInletNode)%MassFlowRate)
DXCoil(DXCoilNum)%InletAirTemp = Node(AirInletNode)%Temp
DXCoil(DXCoilNum)%InletAirHumRat = Node(AirInletNode)%HumRat
DXCoil(DXCoilNum)%InletAirEnthalpy = Node(AirInletNode)%Enthalpy
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! DXCoil(DXCoilNum)%InletAirPressure = Node(AirInletNode)%Press
IF(DXCoil(DXCoilNum)%DXCoilType_Num == CoilDX_HeatPumpWaterHeater) THEN
DXCoil(DXCoilNum)%TotalHeatingEnergyRate = 0.0d0
DXCoil(DXCoilNum)%ElecWaterHeatingPower = 0.0d0
! Eventually inlet air conditions will be used in DX Coil, these lines are commented out and marked with this comment line
! DXCoil(DXCoilNum)%InletAirPressure = StdBaroPress
! HPWH's that use an inlet air temperature schedule also need to have a valid barometric pressure
! The DX Coil used in HPWH's does not know if it is using a scheduled inlet temperature so check the node pressure
IF (DXCoil(DXCoilNum)%CondenserInletNodeNum(1) > 0) THEN
IF(Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%Press == 0.0d0)THEN
Node(DXCoil(DXCoilNum)%CondenserInletNodeNum(1))%Press = StdBaroPress
END IF
END IF
END IF
DXCoil(DXCoilNum)%BasinHeaterPower = 0.0d0
RETURN
END SUBROUTINE InitDXCoil