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 | |||
logical, | intent(in) | :: | FirstHVACIteration | |||
integer, | intent(in) | :: | ControlledZoneNum | |||
integer, | intent(in) | :: | ActualZoneNum |
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 InitPurchasedAir(PurchAirNum,FirstHVACIteration,ControlledZoneNum,ActualZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN Nov 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Initialize the PurchAir data structure.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHeatBalance, ONLY: Zone
USE General, ONLY: RoundSigDigits
USE DataZoneEquipment, ONLY: ZoneEquipInputsFilled,CheckZoneEquipmentList,ZoneEquipConfig
USE DataSizing, ONLY: OARequirements ! to access DesignSpecification:OutdoorAir inputs
USE DataHeatBalance, ONLY: Zone ! to access zone area, volume, and multipliers
USE General, ONLY: FindNumberinList
USE DataLoopNode, ONLY: NodeID
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: FirstHVACIteration !unused1208
INTEGER, INTENT(IN) :: PurchAirNum
INTEGER, INTENT(IN) :: ControlledZoneNum
INTEGER, INTENT(IN) :: ActualZoneNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL,SAVE :: ZoneEquipmentListChecked = .false. ! True after the Zone Equipment List has been checked for items
Integer :: Loop
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MyEnvrnFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: MySizeFlag
LOGICAL, ALLOCATABLE,Save, DIMENSION(:) :: OneTimeUnitInitsDone ! True if one-time inits for PurchAirNum are completed
! LOGICAL :: ErrorsFound = .false. ! If errors detected in input
LOGICAL :: UnitOn ! simple checks for error
LOGICAL :: CoolOn ! simple checks for error
LOGICAL :: HeatOn ! simple checks for error
Integer :: SupplyNodeNum ! Node number for ideal loads supply node
Integer :: ExhaustNodeNum ! Node number for ideal loads exhaust node
Integer :: NodeIndex ! Array index of zone inlet or zone exhaust node that matches ideal loads node
LOGICAL :: UseReturnNode ! simple checks for error
! Do the Begin Simulation initializations
IF (MyOneTimeFlag) THEN
ALLOCATE(MyEnvrnFlag(NumPurchAir))
ALLOCATE(MySizeFlag(NumPurchAir))
ALLOCATE(OneTimeUnitInitsDone(NumPurchAir))
MyEnvrnFlag = .TRUE.
MySizeFlag = .TRUE.
OneTimeUnitInitsDone = .false.
MyOneTimeFlag = .false.
END IF
! need to check all units to see if they are on Zone Equipment List or issue warning
IF (.not. ZoneEquipmentListChecked .and. ZoneEquipInputsFilled) THEN
ZoneEquipmentListChecked=.true.
DO Loop=1,NumPurchAir
IF (CheckZoneEquipmentList(PurchAir(Loop)%cObjectName,PurchAir(Loop)%Name)) CYCLE
CALL ShowSevereError('InitPurchasedAir: '//TRIM(PurchAir(Loop)%cObjectName)//' = '// &
TRIM(PurchAir(Loop)%Name)//' is not on any ZoneHVAC:EquipmentList. It will not be simulated.')
ENDDO
ENDIF
! one time inits for each unit - links PurchAirNum with static input data from ControlledZoneNum and ActualZoneNum
IF (.not. OneTimeUnitInitsDone(PurchAirNum)) THEN
OneTimeUnitInitsDone(PurchAirNum) = .true.
! Is the supply node really a zone inlet node?
! this check has to be done here because of SimPurchasedAir passing in ControlledZoneNum
SupplyNodeNum = PurchAir(PurchAirNum)%ZoneSupplyAirNodeNum
IF (SupplyNodeNum .GT. 0) THEN
NodeIndex = FindNumberinList(SupplyNodeNum, ZoneEquipConfig(ControlledZoneNum)%InletNode, &
ZoneEquipConfig(ControlledZoneNum)%NumInletNodes)
IF (NodeIndex == 0) THEN
CALL ShowSevereError('InitPurchasedAir: In '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('Zone Supply Air Node Name='//TRIM(NodeID(SupplyNodeNum))//' is not a zone inlet node.')
CALL ShowContinueError('Check ZoneHVAC:EquipmentConnections for zone='// &
TRIM(ZoneEquipConfig(ControlledZoneNum)%ZoneName))
CALL ShowFatalError('Preceding condition causes termination.')
END IF
END IF
! Set recirculation node number
! If exhaust node is specified, then recirculation is exhaust node, otherwise use zone return node
! this check has to be done here because of SimPurchasedAir passing in ControlledZoneNum
UseReturnNode = .false.
IF (PurchAir(PurchAirNum)%ZoneExhaustAirNodeNum .GT. 0) THEN
ExhaustNodeNum = PurchAir(PurchAirNum)%ZoneExhaustAirNodeNum
NodeIndex = FindNumberinList(ExhaustNodeNum, ZoneEquipConfig(ControlledZoneNum)%ExhaustNode, &
ZoneEquipConfig(ControlledZoneNum)%NumExhaustNodes)
IF (NodeIndex == 0) THEN
CALL ShowSevereError('InitPurchasedAir: In '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('Zone Exhaust Air Node Name='//TRIM(NodeID(ExhaustNodeNum))//' is not a zone exhaust node.')
CALL ShowContinueError('Check ZoneHVAC:EquipmentConnections for zone='// &
TRIM(ZoneEquipConfig(ControlledZoneNum)%ZoneName))
CALL ShowContinueError('Zone return air node will be used for ideal loads recirculation air.')
UseReturnNode = .true.
ELSE
PurchAir(PurchAirNum)%ZoneRecircAirNodeNum = PurchAir(PurchAirNum)%ZoneExhaustAirNodeNum
END IF
ELSE
UseReturnNode = .true.
END IF
IF(UseReturnNode) THEN
IF (ZoneEquipConfig(ControlledZoneNum)%ReturnAirNode .GT. 0) THEN
PurchAir(PurchAirNum)%ZoneRecircAirNodeNum = ZoneEquipConfig(ControlledZoneNum)%ReturnAirNode
ELSE
CALL ShowFatalError('InitPurchasedAir: In '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError(' Invalid recirculation node. No exhaust or return node has been'// &
' specified for this zone in ZoneHVAC:EquipmentConnections.')
CALL ShowFatalError('Preceding condition causes termination.')
END IF
END IF
! If there is OA and economizer is active, then there must be a limit on cooling flow rate
IF (PurchAir(PurchAirNum)%OutdoorAir .AND. (PurchAir(PurchAirNum)%EconomizerType /= NoEconomizer)) THEN
IF ((PurchAir(PurchAirNum)%CoolingLimit == NoLimit) .OR. (PurchAir(PurchAirNum)%CoolingLimit == LimitCapacity)) THEN
CALL ShowSevereError('InitPurchasedAir: In '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name))
CALL ShowContinueError('There is outdoor air with economizer active but there is no limit on cooling air flow rate.')
CALL ShowContinueError('Cooling Limit must be set to LimitFlowRate or LimitFlowRateAndCapacity, and '// &
'Maximum Cooling Air Flow Rate must be set to a value or autosize.')
CALL ShowContinueError('Simulation will proceed with no limit on outdoor air flow rate.')
END IF
END IF
END IF
IF ( .NOT. SysSizingCalc .AND. MySizeFlag(PurchAirNum) ) THEN
CALL SizePurchasedAir(PurchAirNum)
MySizeFlag(PurchAirNum) = .FALSE.
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. MyEnvrnFlag(PurchAirNum)) THEN
IF ((PurchAir(PurchAirNum)%HeatingLimit == LimitFlowRate) .OR. &
(PurchAir(PurchAirNum)%HeatingLimit == LimitFlowRateAndCapacity)) THEN
PurchAir(PurchAirNum)%MaxHeatMassFlowRate = StdRhoAir * PurchAir(PurchAirNum)%MaxHeatVolFlowRate
ELSE
PurchAir(PurchAirNum)%MaxHeatMassFlowRate = 0.0d0
END IF
IF ((PurchAir(PurchAirNum)%CoolingLimit == LimitFlowRate) .OR. &
(PurchAir(PurchAirNum)%CoolingLimit == LimitFlowRateAndCapacity)) THEN
PurchAir(PurchAirNum)%MaxCoolMassFlowRate = StdRhoAir * PurchAir(PurchAirNum)%MaxCoolVolFlowRate
ELSE
PurchAir(PurchAirNum)%MaxCoolMassFlowRate = 0.0d0
END IF
MyEnvrnFlag(PurchAirNum) = .FALSE.
END IF
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag(PurchAirNum) = .TRUE.
ENDIF
! These initializations are done every iteration
! check that supply air temps can meet the zone thermostat setpoints
IF (PurchAir(PurchAirNum)%MinCoolSuppAirTemp > ZoneThermostatSetPointHi(ActualZoneNum) .AND. &
ZoneThermostatSetPointHi(ActualZoneNum) .NE. 0 .and. PurchAir(PurchAirNum)%CoolingLimit == NoLimit) THEN
! Check if the unit is scheduled off
UnitOn = .true.
! IF (PurchAir(PurchAirNum)%AvailSchedPtr > 0) THEN
IF (GetCurrentScheduleValue(PurchAir(PurchAirNum)%AvailSchedPtr) <= 0) THEN
UnitOn = .FALSE.
END IF
! END IF
! Check if cooling available
CoolOn = .TRUE.
! IF (PurchAir(PurchAirNum)%CoolSchedPtr > 0) THEN
IF (GetCurrentScheduleValue(PurchAir(PurchAirNum)%CoolSchedPtr) <= 0) THEN
CoolOn = .FALSE.
END IF
! END IF
IF (UnitOn .and. CoolOn) THEN
IF (PurchAir(PurchAirNum)%CoolErrIndex == 0) THEN
CALL ShowSevereError('InitPurchasedAir: For '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name) //' serving Zone ' // TRIM(Zone(ActualZoneNum)%Name) )
CALL ShowContinueError('..the minimum supply air temperature for cooling ['// &
TRIM(RoundSigDigits(PurchAir(PurchAirNum)%MinCoolSuppAirTemp,2))// &
'] is greater than the zone cooling mean air temperature (MAT) setpoint ['// &
TRIM(RoundSigDigits(ZoneThermostatSetPointHi(ActualZoneNum),2))//'].')
CALL ShowContinueError('..For operative and comfort thermostat controls, the MAT setpoint is computed.')
CALL ShowContinueError('..This error may indicate that the mean radiant temperature '// &
'or another comfort factor is too warm.')
CALL ShowContinueError('Unit availability is nominally ON and Cooling availability is nominally ON.')
CALL ShowContinueError('Limit Cooling Capacity Type='//trim(cLimitType(PurchAir(PurchAirNum)%CoolingLimit)))
! could check for optemp control or comfort control here
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringSevereErrorAtEnd('InitPurchasedAir: For '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name) //' serving Zone ' // TRIM(Zone(ActualZoneNum)%Name)// &
', the minimum supply air temperature for cooling error continues', &
PurchAir(PurchAirNum)%CoolErrIndex,ReportMinOf=PurchAir(PurchAirNum)%MinCoolSuppAirTemp, &
ReportMaxOf=PurchAir(PurchAirNum)%MinCoolSuppAirTemp,ReportMinUnits='C',ReportMaxUnits='C')
ENDIF
END IF
IF (PurchAir(PurchAirNum)%MaxHeatSuppAirTemp < ZoneThermostatSetPointLo(ActualZoneNum) .AND. &
ZoneThermostatSetPointLo(ActualZoneNum) .NE. 0 .and. PurchAir(PurchAirNum)%HeatingLimit == NoLimit) THEN
! Check if the unit is scheduled off
UnitOn = .true.
! IF (PurchAir(PurchAirNum)%AvailSchedPtr > 0) THEN
IF (GetCurrentScheduleValue(PurchAir(PurchAirNum)%AvailSchedPtr) <= 0) THEN
UnitOn = .FALSE.
END IF
! END IF
! Check if heating and cooling available
HeatOn = .TRUE.
! IF (PurchAir(PurchAirNum)%HeatSchedPtr > 0) THEN
IF (GetCurrentScheduleValue(PurchAir(PurchAirNum)%HeatSchedPtr) <= 0) THEN
HeatOn = .FALSE.
END IF
! END IF
IF (UnitOn .and. HeatOn) THEN
IF (PurchAir(PurchAirNum)%HeatErrIndex == 0) THEN
CALL ShowSevereMessage('InitPurchasedAir: For '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '//&
TRIM(PurchAir(PurchAirNum)%Name) // ' serving Zone ' // TRIM(Zone(ActualZoneNum)%Name) )
CALL ShowContinueError('..the maximum supply air temperature for heating ['// &
TRIM(RoundSigDigits(PurchAir(PurchAirNum)%MaxHeatSuppAirTemp,2))// &
'] is less than the zone mean air temperature heating setpoint ['// &
TRIM(RoundSigDigits(ZoneThermostatSetPointLo(ActualZoneNum),2))//'].')
CALL ShowContinueError('..For operative and comfort thermostat controls, the MAT setpoint is computed.')
CALL ShowContinueError('..This error may indicate that the mean radiant temperature '// &
'or another comfort factor is too cold.')
CALL ShowContinueError('Unit availability is nominally ON and Heating availability is nominally ON.')
CALL ShowContinueError('Limit Heating Capacity Type='//trim(cLimitType(PurchAir(PurchAirNum)%HeatingLimit)))
! could check for optemp control or comfort control here
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringSevereErrorAtEnd('InitPurchasedAir: For '//TRIM(PurchAir(PurchAirNum)%cObjectName)//' = '// &
TRIM(PurchAir(PurchAirNum)%Name) //' serving Zone ' // TRIM(Zone(ActualZoneNum)%Name)// &
', maximum supply air temperature for heating error continues', &
PurchAir(PurchAirNum)%HeatErrIndex,ReportMinOf=PurchAir(PurchAirNum)%MaxHeatSuppAirTemp, &
ReportMaxOf=PurchAir(PurchAirNum)%MaxHeatSuppAirTemp,ReportMinUnits='C',ReportMaxUnits='C')
ENDIF
END IF
! IF (ErrorsFound .and. .not. WarmupFlag) THEN
! CALL ShowFatalError('Preceding conditions cause termination.')
! ENDIF
RETURN
END SUBROUTINE InitPurchasedAir