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) | :: | PurchAirNum |
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 SizePurchasedAir(PurchAirNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN April 2003
! MODIFIED M. Witte, June 2011, add sizing for new capacity fields
! August 2013 Daeho Kang, add component sizing table entries
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing Purchased Air Components for which flow rates have not been
! specified in the input.
! METHODOLOGY EMPLOYED:
! Obtains flow rates from the zone sizing arrays.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE InputProcessor
USE ReportSizingManager, ONLY: ReportSizingOutput
USE Psychrometrics, ONLY: PsyCpAirFnWTdb, RhoH2O, CpHw, CpCw, PsyHFnTdbW
USE General, ONLY: RoundSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(IN) :: PurchAirNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: MixedAirTemp
REAL(r64) :: OutletTemp
REAL(r64) :: MixedAirHumRat
REAL(r64) :: OutletHumRat
REAL(r64) :: DesignLoad
LOGICAL :: IsAutosize ! Indicator to autosize
REAL(r64) :: MaxHeatVolFlowRateDes ! Autosized maximum heating air flow for reporting
REAL(r64) :: MaxHeatVolFlowRateUser ! Hardsized maximum heating air flow for reporting
REAL(r64) :: MaxCoolVolFlowRateDes ! Autosized maximum cooling air flow for reporting
REAL(r64) :: MaxCoolVolFlowRateUser ! Hardsized maximum cooling air flow for reporting
REAL(r64) :: MaxHeatSensCapDes ! Autosized maximum sensible heating capacity for reporting
REAL(r64) :: MaxHeatSensCapUser ! Hardsized maximum sensible heating capacity for reporting
REAL(r64) :: MaxCoolTotCapDes ! Autosized maximum sensible cooling capacity for reporting
REAL(r64) :: MaxCoolTotCapUser ! Hardsized maximum sensible cooling capacity for reporting
IsAutosize = .FALSE.
MaxHeatVolFlowRateDes = 0.0d0
MaxHeatVolFlowRateUser = 0.0d0
MaxCoolVolFlowRateDes = 0.0d0
MaxCoolVolFlowRateUser = 0.0d0
MaxHeatSensCapDes = 0.0d0
MaxHeatSensCapUser = 0.0d0
MaxCoolTotCapDes = 0.0d0
MaxCoolTotCapUser = 0.0d0
IF ((PurchAir(PurchAirNum)%MaxHeatVolFlowRate == AutoSize) .AND. &
((PurchAir(PurchAirNum)%HeatingLimit == LimitFlowRate) .OR. &
(PurchAir(PurchAirNum)%HeatingLimit == LimitFlowRateAndCapacity))) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! Simulation continue
IF (PurchAir(PurchAirNum)%MaxHeatVolFlowRate > 0.0d0) THEN
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'User-Specified Maximum Heating Air Flow Rate [m3/s]', PurchAir(PurchAirNum)%MaxHeatVolFlowRate)
END IF
ELSE
CALL CheckZoneSizing(TRIM(PurchAir(PurchAirNum)%cObjectName), PurchAir(PurchAirNum)%Name)
MaxHeatVolFlowRateDes = FinalZoneSizing(CurZoneEqNum)%DesHeatVolFlow
IF (MaxHeatVolFlowRateDes < SmallAirVolFlow) THEN
MaxHeatVolFlowRateDes = 0.0d0
END IF
IF (IsAutosize) THEN
PurchAir(PurchAirNum)%MaxHeatVolFlowRate = MaxHeatVolFlowRateDes
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'Design Size Maximum Heating Air Flow Rate [m3/s]', MaxHeatVolFlowRateDes)
ELSE
IF (PurchAir(PurchAirNum)%MaxHeatVolFlowRate > 0.0d0 .AND. MaxHeatVolFlowRateDes > 0.0d0) THEN
MaxHeatVolFlowRateUser = PurchAir(PurchAirNum)%MaxHeatVolFlowRate
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'Design Size Maximum Heating Air Flow Rate [m3/s]', MaxHeatVolFlowRateDes, &
'User-Specified Maximum Heating Air Flow Rate [m3/s]', MaxHeatVolFlowRateUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxHeatVolFlowRateDes - MaxHeatVolFlowRateUser)/ MaxHeatVolFlowRateUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizePurchasedAir: Potential issue with equipment sizing for ' &
//TRIM(PurchAir(PurchAirNum)%cObjectName)//' '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('User-Specified Maximum Heating Air Flow Rate of '// &
TRIM(RoundSigDigits(MaxHeatVolFlowRateUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Heating Air Flow Rate of ' // &
TRIM(RoundSigDigits(MaxHeatVolFlowRateDes,5))// ' [m3/s]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
IsAutosize = .FALSE.
IF ((PurchAir(PurchAirNum)%MaxCoolVolFlowRate == AutoSize) .AND. &
((PurchAir(PurchAirNum)%CoolingLimit == LimitFlowRate) .OR. &
(PurchAir(PurchAirNum)%CoolingLimit == LimitFlowRateAndCapacity) .OR. &
(PurchAir(PurchAirNum)%OutdoorAir .AND. PurchAir(PurchAirNum)%EconomizerType .NE. NoEconomizer))) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! Simulation continue
IF (PurchAir(PurchAirNum)%MaxCoolVolFlowRate > 0.0d0) THEN
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'User-Specified Maximum Cooling Air Flow Rate [m3/s]', PurchAir(PurchAirNum)%MaxCoolVolFlowRate)
END IF
ELSE
CALL CheckZoneSizing(TRIM(PurchAir(PurchAirNum)%cObjectName), PurchAir(PurchAirNum)%Name)
MaxCoolVolFlowRateDes = FinalZoneSizing(CurZoneEqNum)%DesCoolVolFlow
IF (MaxCoolVolFlowRateDes < SmallAirVolFlow) THEN
MaxCoolVolFlowRateDes = 0.0d0
END IF
IF (IsAutosize) THEN
PurchAir(PurchAirNum)%MaxCoolVolFlowRate = MaxCoolVolFlowRateDes
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'Design Size Maximum Cooling Air Flow Rate [m3/s]', MaxCoolVolFlowRateDes)
ELSE
IF (PurchAir(PurchAirNum)%MaxCoolVolFlowRate > 0.0d0 .AND. MaxCoolVolFlowRateDes > 0.0d0) THEN
MaxCoolVolFlowRateUser = PurchAir(PurchAirNum)%MaxCoolVolFlowRate
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'Design Size Maximum Cooling Air Flow Rate [m3/s]', MaxCoolVolFlowRateDes, &
'User-Specified Maximum Cooling Air Flow Rate [m3/s]', MaxCoolVolFlowRateUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxCoolVolFlowRateDes - MaxCoolVolFlowRateUser)/MaxCoolVolFlowRateUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizePurchasedAir: Potential issue with equipment sizing for ' &
//TRIM(PurchAir(PurchAirNum)%cObjectName)//' '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('User-Specified Maximum Cooling Air Flow Rate of '// &
TRIM(RoundSigDigits(MaxCoolVolFlowRateUser,5))// ' [m3/s]')
CALL ShowContinueError('differs from Design Size Maximum Cooling Air Flow Rate of ' // &
TRIM(RoundSigDigits(MaxCoolVolFlowRateDes,5))// ' [m3/s]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
IsAutosize = .FALSE.
IF ((PurchAir(PurchAirNum)%MaxHeatSensCap == AutoSize) .AND. &
((PurchAir(PurchAirNum)%HeatingLimit == LimitCapacity) .OR. &
(PurchAir(PurchAirNum)%HeatingLimit == LimitFlowRateAndCapacity))) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! Simulation continue
IF (PurchAir(PurchAirNum)%MaxHeatSensCap > 0.0d0) THEN
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'User-Specified Maximum Sensible Heating Capacity [W]', PurchAir(PurchAirNum)%MaxHeatSensCap)
END IF
ELSE
CALL CheckZoneSizing(TRIM(PurchAir(PurchAirNum)%cObjectName), PurchAir(PurchAirNum)%Name)
MixedAirTemp = FinalZoneSizing(CurZoneEqNum)%DesHeatCoilInTemp
OutletTemp = FinalZoneSizing(CurZoneEqNum)%HeatDesTemp
OutletHumRat = FinalZoneSizing(CurZoneEqNum)%HeatDesHumRat
DesignLoad = PsyCpAirFnWTdb(OutletHumRat, 0.5d0*(MixedAirTemp+OutletTemp), 'SizePurchasedAir') &
* FinalZoneSizing(CurZoneEqNum)%DesHeatMassFlow &
* (OutletTemp-MixedAirTemp)
MaxHeatSensCapDes = DesignLoad
IF (MaxHeatSensCapDes < SmallLoad) THEN
MaxHeatSensCapDes = 0.0d0
END IF
IF (IsAutosize) THEN
PurchAir(PurchAirNum)%MaxHeatSensCap = MaxHeatSensCapDes
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'Design Size Maximum Sensible Heating Capacity [W]', MaxHeatSensCapDes)
! If there is OA, check if sizing calcs have OA>0, throw warning if not
IF ((PurchAir(PurchAirNum)%OutdoorAir) .AND. (FinalZoneSizing(CurZoneEqNum)%MinOA == 0.0)) THEN
CALL ShowWarningError('InitPurchasedAir: In '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('There is outdoor air specified in this object, '// &
'but the design outdoor air flow rate for this ')
CALL ShowContinueError('zone is zero. The Maximum Sensible Heating Capacity will be '// &
'autosized for zero outdoor air flow. ')
CALL ShowContinueError('Check the outdoor air specifications in the Sizing:Zone object for zone '// &
TRIM(FinalZoneSizing(CurZoneEqNum)%ZoneName)//'.')
END IF
ELSE
IF (PurchAir(PurchAirNum)%MaxHeatSensCap > 0.0d0 .AND. MaxHeatSensCapDes > 0.0d0) THEN
MaxHeatSensCapUser = PurchAir(PurchAirNum)%MaxHeatSensCap
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'Design Size Maximum Sensible Heating Capacity [W]', MaxHeatSensCapDes, &
'User-Specified Maximum Sensible Heating Capacity [W]', MaxHeatSensCapUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxHeatSensCapDes - MaxHeatSensCapUser)/MaxHeatSensCapUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizePurchasedAir: Potential issue with equipment sizing for ' &
//TRIM(PurchAir(PurchAirNum)%cObjectName)//' '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('...User-Specified Maximum Sensible Heating Capacity of '// &
TRIM(RoundSigDigits(MaxHeatSensCapUser,2))// ' [W]')
CALL ShowContinueError('...differs from Design Size Maximum Sensible Heating Capacity of ' // &
TRIM(RoundSigDigits(MaxHeatSensCapDes,2))// ' [W]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
IsAutosize = .FALSE.
IF ((PurchAir(PurchAirNum)%MaxCoolTotCap == AutoSize) .AND. &
((PurchAir(PurchAirNum)%CoolingLimit == LimitCapacity) .OR. &
(PurchAir(PurchAirNum)%CoolingLimit == LimitFlowRateAndCapacity))) THEN
IsAutosize = .TRUE.
END IF
IF (CurZoneEqNum > 0) THEN
IF (.NOT. IsAutosize .AND. .NOT. ZoneSizingRunDone) THEN ! Simulation continue
IF (PurchAir(PurchAirNum)%MaxCoolTotCap > 0.0d0) THEN
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'User-Specified Maximum Heating Air Flow Rate [m3/s]', PurchAir(PurchAirNum)%MaxCoolTotCap)
END IF
ELSE
CALL CheckZoneSizing(TRIM(PurchAir(PurchAirNum)%cObjectName), PurchAir(PurchAirNum)%Name)
MixedAirTemp = FinalZoneSizing(CurZoneEqNum)%DesCoolCoilInTemp
OutletTemp = FinalZoneSizing(CurZoneEqNum)%CoolDesTemp
OutletHumRat = FinalZoneSizing(CurZoneEqNum)%CoolDesHumRat
MixedAirHumRat = FinalZoneSizing(CurZoneEqNum)%DesCoolCoilInHumRat
DesignLoad = FinalZoneSizing(CurZoneEqNum)%DesCoolMassFlow &
* (PsyHFnTdbW(MixedAirTemp, MixedAirHumRat, 'SizePurchasedAir') &
-PsyHFnTdbW(OutletTemp, OutletHumRat, 'SizePurchasedAir'))
MaxCoolTotCapDes = DesignLoad
IF (MaxCoolTotCapDes < SmallLoad) THEN
MaxCoolTotCapDes = 0.0d0
END IF
IF (IsAutosize) THEN
PurchAir(PurchAirNum)%MaxCoolTotCap = MaxCoolTotCapDes
CALL ReportSizingOutput(PurchAir(PurchAirNum)%cObjectName, PurchAir(PurchAirNum)%Name, &
'Design Size Maximum Total Cooling Capacity [W]', MaxCoolTotCapDes)
! If there is OA, check if sizing calcs have OA>0, throw warning if not
IF ((PurchAir(PurchAirNum)%OutdoorAir) .AND. (FinalZoneSizing(CurZoneEqNum)%MinOA == 0.0)) THEN
CALL ShowWarningError('SizePurchasedAir: In '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('There is outdoor air specified in this object, '// &
'but the design outdoor air flow rate for this ')
CALL ShowContinueError('zone is zero. The Maximum Total Cooling Capacity will be autosized '// &
'for zero outdoor air flow. ')
CALL ShowContinueError('Check the outdoor air specifications in the Sizing:Zone object for zone '// &
TRIM(FinalZoneSizing(CurZoneEqNum)%ZoneName)//'.')
END IF
ELSE
IF (PurchAir(PurchAirNum)%MaxCoolTotCap > 0.0d0 .AND. MaxCoolTotCapDes > 0.0d0) THEN
MaxCoolTotCapUser = PurchAir(PurchAirNum)%MaxCoolTotCap
CALL ReportSizingOutput(TRIM(PurchAir(PurchAirNum)%cObjectName), PurchAir(PurchAirNum)%Name, &
'Design Size Maximum Total Cooling Capacity [W]', MaxCoolTotCapDes, &
'User-Specified Maximum Total Cooling Capacity [W]', MaxCoolTotCapUser)
IF (DisplayExtraWarnings) THEN
IF ((ABS(MaxCoolTotCapDes - MaxCoolTotCapUser)/MaxCoolTotCapUser) > AutoVsHardSizingThreshold) THEN
CALL ShowMessage('SizePurchasedAir: Potential issue with equipment sizing for ' &
//TRIM(PurchAir(PurchAirNum)%cObjectName)//' '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('User-Specified Maximum Total Cooling Capacity of '// &
TRIM(RoundSigDigits(MaxCoolTotCapUser,2))// ' [W]')
CALL ShowContinueError('differs from Design Size Maximum Total Cooling Capacity of ' // &
TRIM(RoundSigDigits(MaxCoolTotCapDes,2))// ' [W]')
CALL ShowContinueError('This may, or may not, indicate mismatched component sizes.')
CALL ShowContinueError('Verify that the value entered is intended and is consistent with other components.')
END IF
ENDIF
END IF
END IF
END IF
END IF
! IF (PurchAir(PurchAirNum)%OutdoorAir .AND. PurchAir(PurchAirNum)%OutsideAirVolFlowRate == AutoSize) THEN
!
! IF (CurZoneEqNum > 0) THEN
!
! CALL CheckZoneSizing(TRIM(PurchAir(PurchAirNum)%cObjectName), PurchAir(PurchAirNum)%Name)
! PurchAir(PurchAirNum)%OutsideAirVolFlowRate = FinalZoneSizing(CurZoneEqNum)%MinOA
! IF (PurchAir(PurchAirNum)%OutsideAirVolFlowRate < SmallAirVolFlow) THEN
! PurchAir(PurchAirNum)%OutsideAirVolFlowRate = 0.0
! END IF
! CALL ReportSizingOutput(TRIM(PurchAir(PurchAirNum)%cObjectName), PurchAir(PurchAirNum)%Name, &
! 'Outdoor Air Flow Rate [m3/s]', PurchAir(PurchAirNum)%OutsideAirVolFlowRate )
! END IF
!
! END IF
RETURN
END SUBROUTINE SizePurchasedAir