SUBROUTINE SimHVAC
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: April 1997
! DATE MODIFIED: May 1998 (RKS,RDT)
! PURPOSE OF THIS SUBROUTINE: Selects and calls the HVAC loop managers
! METHODOLOGY EMPLOYED: Each loop manager is called or passed over
! in succession based on the logical flags associated with the manager.
! The logical flags are set in the manager routines and passed
! as parameters to this routine. Each loop manager potentially
! affects a different set of other loop managers.
! Future development could involve specifying any number of user
! selectable control schemes based on the logical flags used in
! this default control algorithm.
! REFERENCES: none
! USE STATEMENTS:
USE DataConvergParams
USE SetPointManager, ONLY : ManageSetPoints
USE SystemAvailabilityManager, ONLY : ManageSystemAvailability
USE ZoneEquipmentManager, ONLY : ManageZoneEquipment
USE NonZoneEquipmentManager, ONLY : ManageNonZoneEquipment
USE ManageElectricPower, ONLY : ManageElectricLoadCenters
USE DataEnvironment, ONLY : EnvironmentName,CurMnDy
USE General, ONLY : CreateSysTimeIntervalString,RoundSigDigits
USE EMSManager, ONLY : ManageEMS
USE PlantManager, ONLY : GetPlantLoopData,GetPlantInput,SetupReports, &
ManagePlantLoops, SetupInitialPlantCallingOrder , SetupBranchControlTypes , &
ReInitPlantLoopsAtFirstHVACIteration, InitOneTimePlantSizingInfo
USE PlantCondLoopOperation, ONLY: SetupPlantEMSActuators
USE SimAirServingZones, ONLY : ManageAirLoops
USE DataPlant, ONLY : SetAllPlantSimFlagsToValue, TotNumLoops, &
PlantManageSubIterations, PlantManageHalfLoopCalls, &
DemandSide, SupplySide, PlantLoop, NumConvergenceHistoryTerms, &
ConvergenceHistoryARR
USE PlantUtilities, ONLY : CheckPlantMixerSplitterConsistency, &
CheckForRunawayPlantTemps, AnyPlantSplitterMixerLacksContinuity
USE DataGlobals, ONLY : AnyPlantInModel
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
LOGICAL, PARAMETER :: IsPlantLoop = .TRUE.
LOGICAL, PARAMETER :: NotPlantLoop = .FALSE.
LOGICAL, PARAMETER :: SimWithPlantFlowUnlocked = .FALSE.
LOGICAL, PARAMETER :: SimWithPlantFlowLocked = .TRUE.
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: FirstHVACIteration ! True when solution technique on first iteration
LOGICAL, SAVE :: IterSetup = .false. ! Set to TRUE after the variable is setup for Output Reporting
INTEGER, SAVE :: ErrCount=0 ! Number of times that the maximum iterations was exceeded
LOGICAL, SAVE :: MySetPointInit = .TRUE.
CHARACTER(len=10) :: CharErrOut ! a character string equivalent of ErrCount
INTEGER :: que
INTEGER, SAVE :: MaxErrCount=0
CHARACTER(len=MaxNameLength*2),SAVE :: ErrEnvironmentName=' '
INTEGER :: LoopNum
INTEGER :: LoopSide
INTEGER :: ThisLoopSide
INTEGER :: AirSysNum
INTEGER :: StackDepth
CHARACTER(len=10) :: HistoryStack
CHARACTER(len=500) :: HistoryTrace
INTEGER :: ZoneInSysIndex
REAL(r64) :: SlopeHumRat
REAL(r64) :: SlopeMdot
REAL(r64) :: SlopeTemps
REAL(r64) :: AvgValue
LOGICAL :: FoundOscillationByDuplicate
INTEGER :: ZoneNum
INTEGER :: NodeIndex
LOGICAL :: MonotonicIncreaseFound
LOGICAL :: MonotonicDecreaseFound
! Initialize all of the simulation flags to true for the first iteration
SimZoneEquipmentFlag = .TRUE.
SimNonZoneEquipmentFlag = .TRUE.
SimAirLoopsFlag = .TRUE.
SimPlantLoopsFlag = .TRUE.
SimElecCircuitsFlag = .TRUE.
FirstHVACIteration = .TRUE.
IF(AirLoopInputsFilled)THEN
! Reset air loop control info for cooling coil active flag (used in TU's for reheat air flow control)
AirLoopControlInfo%CoolingActiveFlag = .FALSE.
! Reset air loop control info for heating coil active flag (used in OA controller for HX control)
AirLoopControlInfo%HeatingActiveFlag = .FALSE.
! reset outside air system HX to off first time through
AirLoopControlInfo%HeatRecoveryBypass = .TRUE.
! set HX check status flag to check for custom control in MixedAir.f90
AirLoopControlInfo%CheckHeatRecoveryBypassStatus = .TRUE.
! set OA comp simulated flag to false
AirLoopControlInfo%OASysComponentsSimulated = .FALSE.
! set economizer flow locked flag to false, will reset if custom HX control is used
AirLoopControlInfo%EconomizerFlowLocked = .FALSE.
! set air loop resim flags for when heat recovery is used and air loop needs another iteration
AirLoopControlInfo%HeatRecoveryResimFlag = .TRUE.
AirLoopControlInfo%HeatRecoveryResimFlag2 = .FALSE.
AirLoopControlInfo%ResimAirLoopFlag = .FALSE.
END IF
! This setups the reports for the Iteration variable that limits how many times
! it goes through all of the HVAC managers before moving on.
! The plant loop 'get inputs' and initialization are also done here in order to allow plant loop connected components
! simulated by managers other than the plant manager to run correctly.
HVACManageIteration = 0
PLANTManageSubIterations = 0
PlantManageHalfLoopCalls = 0
CALL SetAllPlantSimFlagsToValue(.TRUE.)
IF (.not. IterSetup) THEN
CALL SetupOutputVariable('HVAC System Solver Iteration Count []',HVACManageIteration,'HVAC','Sum','SimHVAC')
CALL SetupOutputVariable('Air System Solver Iteration Count []',RepIterAir,'HVAC','Sum','SimHVAC')
CALL ManageSetPoints !need to call this before getting plant loop data so setpoint checks can complete okay
CALL GetPlantLoopData
CALL GetPlantInput
CALL SetupInitialPlantCallingOrder
CALL SetupBranchControlTypes !new routine to do away with input for branch control type
! CALL CheckPlantLoopData
CALL SetupReports
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupPlantEMSActuators
ENDIF
IF (TotNumLoops > 0) THEN
CALL SetupOutputVariable('Plant Solver Sub Iteration Count []',PLANTManageSubIterations,'HVAC','Sum','SimHVAC')
CALL SetupOutputVariable('Plant Solver Half Loop Calls Count []',PlantManageHalfLoopCalls,'HVAC','Sum','SimHVAC')
DO LoopNum = 1, TotNumLoops
! init plant sizing numbers in main plant data structure
CALL InitOneTimePlantSizingInfo(LoopNum)
ENDDO
ENDIF
IterSetup=.true.
ENDIF
IF (ZoneSizingCalc) THEN
CALL ManageZoneEquipment(FirstHVACIteration,SimZoneEquipmentFlag,SimAirLoopsFlag)
! need to call non zone equipment so water use zone gains can be included in sizing calcs
CALL ManageNonZoneEquipment(FirstHVACIteration,SimNonZoneEquipmentFlag)
CALL ManageElectricLoadCenters(FirstHVACIteration,SimElecCircuitsFlag, .FALSE.)
RETURN
END IF
! Before the HVAC simulation, reset control flags and specified flow
! rates that might have been set by the set point and availability
! managers.
CALL ResetHVACControl
! Before the HVAC simulation, call ManageSetPoints to set all the HVAC
! node setpoints
CAll ManageEMS(emsCallFromBeforeHVACManagers) ! calling point
CALL ManageSetPoints
! re-initialize plant loop and nodes.
CALL ReInitPlantLoopsAtFirstHVACIteration
! Before the HVAC simulation, call ManageSystemAvailability to set
! the system on/off flags
CALL ManageSystemAvailability
CAll ManageEMS(emsCallFromAfterHVACManagers)! calling point
! first explicitly call each system type with FirstHVACIteration,
! Manages the various component simulations
CALL SimSelectedEquipment(SimAirLoopsFlag,SimZoneEquipmentFlag,SimNonZoneEquipmentFlag,SimPlantLoopsFlag,&
SimElecCircuitsFlag, FirstHVACIteration, SimWithPlantFlowUnlocked)
! Eventually, when all of the flags are set to false, the
! simulation has converged for this system time step.
SimPlantLoopsFlag = .TRUE.
CALL SetAllPlantSimFlagsToValue(.TRUE.) !set so loop to simulate at least once on non-first hvac
FirstHVACIteration = .FALSE.
! then iterate among all systems after first HVAC iteration is over
! Main iteration loop for HVAC. If any of the simulation flags are
! true, then specific components must be resimulated.
DO WHILE ( (SimAirLoopsFlag .OR. SimZoneEquipmentFlag .OR. SimNonZoneEquipmentFlag .OR. SimPlantLoopsFlag .OR. &
SimElecCircuitsFlag ) .AND. (HVACManageIteration.LE.MaxIter) )
CAll ManageEMS(emsCallFromHVACIterationLoop) ! calling point id
! Manages the various component simulations
CALL SimSelectedEquipment(SimAirLoopsFlag,SimZoneEquipmentFlag,SimNonZoneEquipmentFlag,SimPlantLoopsFlag,&
SimElecCircuitsFlag, FirstHVACIteration, SimWithPlantFlowUnlocked)
! Eventually, when all of the flags are set to false, the
! simulation has converged for this system time step.
CALL UpdateZoneInletConvergenceLog
HVACManageIteration = HVACManageIteration + 1 ! Increment the iteration counter
END DO
IF (AnyPlantInModel) THEN
If (AnyPlantSplitterMixerLacksContinuity()) THEN
! rerun systems in a "Final flow lock/last iteration" mode
! now call for one second to last plant simulation
SimAirLoopsFlag = .FALSE.
SimZoneEquipmentFlag = .FALSE.
SimNonZoneEquipmentFlag = .FALSE.
SimPlantLoopsFlag = .TRUE.
SimElecCircuitsFlag = .FALSE.
CALL SimSelectedEquipment(SimAirLoopsFlag,SimZoneEquipmentFlag,SimNonZoneEquipmentFlag,SimPlantLoopsFlag,&
SimElecCircuitsFlag, FirstHVACIteration, SimWithPlantFlowUnlocked)
! now call for all non-plant simulation, but with plant flow lock on
SimAirLoopsFlag = .TRUE.
SimZoneEquipmentFlag = .TRUE.
SimNonZoneEquipmentFlag = .TRUE.
SimPlantLoopsFlag = .FALSE.
SimElecCircuitsFlag = .TRUE.
CALL SimSelectedEquipment(SimAirLoopsFlag,SimZoneEquipmentFlag,SimNonZoneEquipmentFlag,SimPlantLoopsFlag,&
SimElecCircuitsFlag, FirstHVACIteration, SimWithPlantFlowLocked)
CALL UpdateZoneInletConvergenceLog
! now call for a last plant simulation
SimAirLoopsFlag = .FALSE.
SimZoneEquipmentFlag = .FALSE.
SimNonZoneEquipmentFlag = .FALSE.
SimPlantLoopsFlag = .TRUE.
SimElecCircuitsFlag = .FALSE.
CALL SimSelectedEquipment(SimAirLoopsFlag,SimZoneEquipmentFlag,SimNonZoneEquipmentFlag,SimPlantLoopsFlag,&
SimElecCircuitsFlag, FirstHVACIteration, SimWithPlantFlowUnlocked)
! now call for a last all non-plant simulation, but with plant flow lock on
SimAirLoopsFlag = .TRUE.
SimZoneEquipmentFlag = .TRUE.
SimNonZoneEquipmentFlag = .TRUE.
SimPlantLoopsFlag = .FALSE.
SimElecCircuitsFlag = .TRUE.
CALL SimSelectedEquipment(SimAirLoopsFlag,SimZoneEquipmentFlag,SimNonZoneEquipmentFlag,SimPlantLoopsFlag,&
SimElecCircuitsFlag, FirstHVACIteration, SimWithPlantFlowLocked)
CALL UpdateZoneInletConvergenceLog
ENDIF
ENDIF
!DSU Test plant loop for errors
DO LoopNum = 1, TotNumLoops
DO LoopSide = DemandSide,SupplySide
CALL CheckPlantMixerSplitterConsistency(LoopNum,LoopSide,1, 1,FirstHVACIteration)
Call CheckForRunawayPlantTemps(LoopNum,LoopSide)
ENDDO
ENDDO
IF ((HVACManageIteration > MaxIter).AND.(.NOT.WarmUpFlag)) THEN
ErrCount = ErrCount + 1
IF (ErrCount < 15) THEN
ErrEnvironmentName=EnvironmentName
WRITE(CharErrOut,'(I5)') MaxIter
CharErrOut=ADJUSTL(CharErrOut)
CALL ShowWarningError ('SimHVAC: Maximum iterations ('//TRIM(CharErrOut)//') exceeded for all HVAC loops, at '// &
TRIM(EnvironmentName)//', '//TRIM(CurMnDy)//' '//TRIM(CreateSysTimeIntervalString()))
IF (SimAirLoopsFlag) THEN
CALL ShowContinueError('The solution for one or more of the Air Loop HVAC systems did not appear to converge')
ENDIF
IF (SimZoneEquipmentFlag) THEN
CALL ShowContinueError('The solution for zone HVAC equipment did not appear to converge')
ENDIF
IF (SimNonZoneEquipmentFlag) THEN
CALL ShowContinueError('The solution for non-zone equipment did not appear to converge')
ENDIF
IF (SimPlantLoopsFlag) THEN
CALL ShowContinueError('The solution for one or more plant systems did not appear to converge')
ENDIF
IF (SimElecCircuitsFlag) THEN
CALL ShowContinueError('The solution for on-site electric generators did not appear to converge')
ENDIF
IF (ErrCount == 1 .and. .not. DisplayExtraWarnings) THEN
CALL ShowContinueError('...use Output:Diagnostics,DisplayExtraWarnings; '// &
' to show more details on each max iteration exceeded.')
ENDIF
IF (DisplayExtraWarnings) THEN
DO AirSysNum = 1, NumPrimaryAirSys
IF (AirLoopConvergence(AirSysNum)%HVACMassFlowNotConverged) THEN
CALL ShowContinueError('Air System Named = '//TRIM(AirToZoneNodeInfo(AirSysNum)%AirLoopName) &
// ' did not converge for mass flow rate')
CALL ShowContinueError('Check values should be zero. Most Recent values listed first.')
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACFlowDemandToSupplyTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Demand-to-Supply interface mass flow rate check value iteration history trace: ' &
//TRIM(HistoryTrace) )
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACFlowSupplyDeck1ToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-demand interface deck 1 mass flow rate check value iteration history trace: ' &
//TRIM(HistoryTrace) )
IF (AirToZoneNodeInfo(AirSysNum)%NumSupplyNodes >= 2) THEN
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACFlowSupplyDeck2ToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-demand interface deck 2 mass flow rate check value iteration history trace: ' &
//TRIM(HistoryTrace) )
ENDIF
ENDIF ! mass flow rate not converged
IF (AirLoopConvergence(AirSysNum)%HVACHumRatNotConverged) THEN
CALL ShowContinueError('Air System Named = '//TRIM(AirToZoneNodeInfo(AirSysNum)%AirLoopName) &
// ' did not converge for humidity ratio')
CALL ShowContinueError('Check values should be zero. Most Recent values listed first.')
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACHumDemandToSupplyTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Demand-to-Supply interface humidity ratio check value iteration history trace: ' &
//TRIM(HistoryTrace) )
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACHumSupplyDeck1ToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-demand interface deck 1 humidity ratio check value iteration history trace: ' &
//TRIM(HistoryTrace) )
IF (AirToZoneNodeInfo(AirSysNum)%NumSupplyNodes >= 2) THEN
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACHumSupplyDeck2ToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-demand interface deck 2 humidity ratio check value iteration history trace: ' &
//TRIM(HistoryTrace) )
ENDIF
ENDIF ! humidity ratio not converged
IF (AirLoopConvergence(AirSysNum)%HVACTempNotConverged) THEN
CALL ShowContinueError('Air System Named = '//TRIM(AirToZoneNodeInfo(AirSysNum)%AirLoopName) &
// ' did not converge for temperature')
CALL ShowContinueError('Check values should be zero. Most Recent values listed first.')
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACTempDemandToSupplyTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Demand-to-Supply interface temperature check value iteration history trace: ' &
//TRIM(HistoryTrace) )
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACTempSupplyDeck1ToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-demand interface deck 1 temperature check value iteration history trace: ' &
//TRIM(HistoryTrace) )
IF (AirToZoneNodeInfo(AirSysNum)%NumSupplyNodes >= 2) THEN
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACTempSupplyDeck1ToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-demand interface deck 2 temperature check value iteration history trace: ' &
//TRIM(HistoryTrace) )
ENDIF
ENDIF ! Temps not converged
IF (AirLoopConvergence(AirSysNum)%HVACEnergyNotConverged) THEN
CALL ShowContinueError('Air System Named = '//TRIM(AirToZoneNodeInfo(AirSysNum)%AirLoopName) &
// ' did not converge for energy')
CALL ShowContinueError('Check values should be zero. Most Recent values listed first.')
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACEnergyDemandToSupplyTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Demand-to-Supply interface energy check value iteration history trace: ' &
//TRIM(HistoryTrace) )
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACEnergySupplyDeck1ToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-demand interface deck 1 energy check value iteration history trace: ' &
//TRIM(HistoryTrace) )
IF (AirToZoneNodeInfo(AirSysNum)%NumSupplyNodes >= 2) THEN
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(AirLoopConvergence(AirSysNum)%HVACEnergySupplyDeck2ToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-demand interface deck 2 energy check value iteration history trace: ' &
//TRIM(HistoryTrace) )
ENDIF
ENDIF ! energy not converged
ENDDO ! loop over air loop systems
! loop over zones and check for issues with zone inlet nodes
DO ZoneNum = 1, NumOfZones
DO NodeIndex = 1, ZoneInletConvergence(ZoneNum)%NumInletNodes
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NotConvergedHumRate = .FALSE.
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NotConvergedMassFlow = .FALSE.
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NotConvergedTemp = .FALSE.
! Check humidity ratio
FoundOscillationByDuplicate = .FALSE.
MonotonicDecreaseFound = .FALSE.
MonotonicIncreaseFound = .FALSE.
! check for evidence of oscillation by indentify duplicates when latest value not equal to average
AvgValue = SUM(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio) &
/ REAL(ConvergLogStackDepth, r64)
IF (ABS(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio(1) - AvgValue) &
> HVACHumRatOscillationToler ) THEN ! last iterate differs from average
FoundOscillationByDuplicate = .FALSE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ABS(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio(1) - &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio(StackDepth)) &
< HVACHumRatOscillationToler) THEN
FoundOscillationByDuplicate = .TRUE.
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NotConvergedHumRate = .TRUE.
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows oscillating humidity ratio across iterations with a repeated value of ' &
//TRIM(RoundSigDigits( &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio(1), 6) ) )
EXIT
ENDIF
ENDDO
IF (.NOT. FoundOscillationByDuplicate) THEN
SlopeHumRat = ( SUM( ConvergLogStackARR) &
*SUM(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio)&
- REAL(ConvergLogStackDepth, r64) * SUM((ConvergLogStackARR &
* ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio)) ) &
/ ( SUM(ConvergLogStackARR)**2 &
- REAL(ConvergLogStackDepth, r64)*SUM( ConvergLogStackARR**2) )
IF (ABS(SlopeHumRat) > HVACHumRatSlopeToler) THEN
IF (SlopeHumRat < 0.d0) THEN ! check for monotic decrease
MonotonicDecreaseFound = .TRUE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio(StackDepth-1) > &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio(StackDepth)) THEN
MonotonicDecreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicDecreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows monotonically decreasing humidity ratio with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeHumRat, 6)) &
//' [ kg-water/kg-dryair/iteration]' )
ENDIF
ELSE ! check for monotic incrase
MonotonicIncreaseFound = .TRUE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio(StackDepth-1) < &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%HumidityRatio(StackDepth)) THEN
MonotonicIncreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicIncreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows monotonically increasing humidity ratio with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeHumRat, 6)) &
//' [ kg-water/kg-dryair/iteration]' )
ENDIF
ENDIF
ENDIF ! significant slope in iterates
ENDIF !no osciallation
ENDIF ! last value does not equal average of stack.
IF (MonotonicDecreaseFound .OR. MonotonicIncreaseFound .OR. FoundOscillationByDuplicate) THEN
HistoryTrace = ' '
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex) &
%HumidityRatio(StackDepth), 6) ) // ','
ENDDO
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' humidity ratio [kg-water/kg-dryair] iteration history trace (most recent first): ' &
//TRIM(HistoryTrace) )
ENDIF ! need to report trace
! end humidity ratio
! Check Mass flow rate
FoundOscillationByDuplicate = .FALSE.
MonotonicDecreaseFound = .FALSE.
MonotonicIncreaseFound = .FALSE.
! check for evidence of oscillation by indentify duplicates when latest value not equal to average
AvgValue = SUM(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate) &
/ REAL(ConvergLogStackDepth, r64)
IF (ABS(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate(1) - AvgValue) &
> HVACFlowRateOscillationToler ) THEN ! last iterate differs from average
FoundOscillationByDuplicate = .FALSE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ABS(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate(1) - &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate(StackDepth)) &
< HVACFlowRateOscillationToler) THEN
FoundOscillationByDuplicate = .TRUE.
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NotConvergedMassFlow = .TRUE.
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows oscillating mass flow rate across iterations with a repeated value of ' &
//TRIM(RoundSigDigits( &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate(1), 6) ) )
EXIT
ENDIF
ENDDO
IF (.NOT. FoundOscillationByDuplicate) THEN
SlopeMdot = ( SUM( ConvergLogStackARR) &
*SUM(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate)&
- REAL(ConvergLogStackDepth, r64) * SUM((ConvergLogStackARR &
* ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate)) ) &
/ ( SUM(ConvergLogStackARR)**2 &
- REAL(ConvergLogStackDepth, r64)*SUM( ConvergLogStackARR**2) )
IF (ABS(SlopeMdot) > HVACFlowRateSlopeToler) THEN
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NotConvergedMassFlow = .TRUE.
IF (SlopeMdot < 0.d0) THEN ! check for monotic decrease
MonotonicDecreaseFound = .TRUE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate(StackDepth-1) > &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate(StackDepth)) THEN
MonotonicDecreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicDecreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows monotonically decreasing mass flow rate with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeMdot, 6)) &
//' [kg/s/iteration]' )
ENDIF
ELSE ! check for monotic incrase
MonotonicIncreaseFound = .TRUE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate(StackDepth-1) < &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%MassFlowRate(StackDepth)) THEN
MonotonicIncreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicIncreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows monotonically increasing mass flow rate with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeMdot, 6)) &
//' [kg/s/iteration]' )
ENDIF
ENDIF
ENDIF ! significant slope in iterates
ENDIF !no osciallation
ENDIF ! last value does not equal average of stack.
IF (MonotonicDecreaseFound .OR. MonotonicIncreaseFound .OR. FoundOscillationByDuplicate) THEN
HistoryTrace = ' '
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex) &
%MassFlowRate(StackDepth), 6) ) // ','
ENDDO
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' mass flow rate [kg/s] iteration history trace (most recent first): ' &
//TRIM(HistoryTrace) )
ENDIF ! need to report trace
! end mass flow rate
! Check Temperatures
FoundOscillationByDuplicate = .FALSE.
MonotonicDecreaseFound = .FALSE.
MonotonicIncreaseFound = .FALSE.
! check for evidence of oscillation by indentify duplicates when latest value not equal to average
AvgValue = SUM(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature) &
/ REAL(ConvergLogStackDepth, r64)
IF (ABS(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature(1) - AvgValue) &
> HVACTemperatureOscillationToler ) THEN ! last iterate differs from average
FoundOscillationByDuplicate = .FALSE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ABS(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature(1) - &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature(StackDepth)) &
< HVACTemperatureOscillationToler) THEN
FoundOscillationByDuplicate = .TRUE.
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NotConvergedTemp = .TRUE.
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows oscillating temperatures across iterations with a repeated value of ' &
//TRIM(RoundSigDigits( &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature(1), 6) ) )
EXIT
ENDIF
ENDDO
IF (.NOT. FoundOscillationByDuplicate) THEN
SlopeTemps = ( SUM( ConvergLogStackARR) &
*SUM(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature)&
- REAL(ConvergLogStackDepth, r64) * SUM((ConvergLogStackARR &
* ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature)) ) &
/ ( SUM(ConvergLogStackARR)**2 &
- REAL(ConvergLogStackDepth, r64)*SUM( ConvergLogStackARR**2) )
IF (ABS(SlopeTemps) > HVACTemperatureSlopeToler) THEN
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NotConvergedTemp = .TRUE.
IF (SlopeTemps < 0.d0) THEN ! check for monotic decrease
MonotonicDecreaseFound = .TRUE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature(StackDepth-1) > &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature(StackDepth)) THEN
MonotonicDecreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicDecreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows monotonically decreasing temperature with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeTemps, 4)) &
//' [C/iteration]' )
ENDIF
ELSE ! check for monotic incrase
MonotonicIncreaseFound = .TRUE.
DO StackDepth = 2, ConvergLogStackDepth
IF (ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature(StackDepth-1) < &
ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%Temperature(StackDepth)) THEN
MonotonicIncreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicIncreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' shows monotonically increasing temperatures with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeTemps, 4)) &
//' [C/iteration]' )
ENDIF
ENDIF
ENDIF ! significant slope in iterates
ENDIF !no osciallation
ENDIF ! last value does not equal average of stack.
IF (MonotonicDecreaseFound .OR. MonotonicIncreaseFound .OR. FoundOscillationByDuplicate) THEN
HistoryTrace = ' '
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex) &
%Temperature(StackDepth), 6) ) // ','
ENDDO
CALL ShowContinueError('Node named ' &
//TRIM(NodeID(ZoneInletConvergence(ZoneNum)%InletNode(NodeIndex)%NodeNum)) &
//' temperature [C] iteration history trace (most recent first): ' &
//TRIM(HistoryTrace) )
ENDIF ! need to report trace
! end Temperature checks
ENDDO ! loop over zone inlet nodes
ENDDO ! loop over zones
DO LoopNum = 1, TotNumLoops
IF (PlantConvergence(LoopNum)%PlantMassFlowNotConverged) THEN
CALL ShowContinueError('Plant System Named = '//TRIM(PlantLoop(LoopNum)%Name) &
// ' did not converge for mass flow rate')
CALL ShowContinueError('Check values should be zero. Most Recent values listed first.')
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(PlantConvergence(LoopNum)%PlantFlowDemandToSupplyTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Demand-to-Supply interface mass flow rate check value iteration history trace: ' &
//TRIM(HistoryTrace) )
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(PlantConvergence(LoopNum)%PlantFlowSupplyToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-Demand interface mass flow rate check value iteration history trace: ' &
//TRIM(HistoryTrace) )
! now work with history logs for mass flow to detect issues
DO ThisLoopSide = 1, SIZE(PlantLoop(LoopNum)%LoopSide)
! loop side inlet node
FoundOscillationByDuplicate = .FALSE.
MonotonicDecreaseFound = .FALSE.
MonotonicIncreaseFound = .FALSE.
AvgValue = SUM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory) &
/ REAL(NumConvergenceHistoryTerms, r64)
IF (ABS(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory(1) - AvgValue) &
> PlantFlowRateOscillationToler) THEN
FoundOscillationByDuplicate = .FALSE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (ABS(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory(1) - &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory(StackDepth)) &
< PlantFlowRateOscillationToler) THEN
FoundOscillationByDuplicate = .TRUE.
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameIn) &
//' shows oscillating flow rates across iterations with a repeated value of ' &
//TRIM(RoundSigDigits( &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory(1), 7) ) )
EXIT
ENDIF
ENDDO
ENDIF
IF (.NOT. FoundOscillationByDuplicate) THEN
SlopeMdot = ( SUM( ConvergenceHistoryARR) &
*SUM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory)&
- REAL(NumConvergenceHistoryTerms, r64) * SUM((ConvergenceHistoryARR &
* PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory)) ) &
/ ( SUM(ConvergenceHistoryARR)**2 &
- REAL(NumConvergenceHistoryTerms, r64)*SUM( ConvergenceHistoryARR**2) )
IF (ABS(SlopeMdot) > PlantFlowRateSlopeToler) THEN
IF (SlopeMdot < 0.d0) THEN ! check for monotonic decrease
MonotonicDecreaseFound = .TRUE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory(StackDepth-1) > &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory(StackDepth)) THEN
MonotonicDecreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicDecreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameIn) &
//' shows monotonically decreasing mass flow rate with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeMdot, 7)) &
//' [kg/s/iteration]' )
ENDIF
ELSE ! check for monotonic incrase
MonotonicIncreaseFound = .TRUE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory(StackDepth-1) < &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%MassFlowRateHistory(StackDepth)) THEN
MonotonicIncreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicIncreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameIn) &
//' shows monotonically increasing mass flow rate with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeMdot, 7)) &
//' [kg/s/iteration]' )
ENDIF
ENDIF
ENDIF ! significant slope found
ENDIF ! no oscillation found
IF (MonotonicDecreaseFound .OR. MonotonicIncreaseFound .OR. FoundOscillationByDuplicate) THEN
HistoryTrace = ' '
DO StackDepth = 1, NumConvergenceHistoryTerms
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode &
%MassFlowRateHistory(StackDepth), 7) ) // ','
ENDDO
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameIn) &
//' mass flow rate [kg/s] iteration history trace (most recent first): ' &
//TRIM(HistoryTrace) )
ENDIF ! need to report trace
! end of inlet node
! loop side outlet node
FoundOscillationByDuplicate = .FALSE.
MonotonicDecreaseFound = .FALSE.
MonotonicIncreaseFound = .FALSE.
AvgValue = SUM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory) &
/ REAL(NumConvergenceHistoryTerms, r64)
IF (ABS(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory(1) - AvgValue) &
> PlantFlowRateOscillationToler) THEN
FoundOscillationByDuplicate = .FALSE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (ABS(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory(1) - &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory(StackDepth)) &
< PlantFlowRateOscillationToler) THEN
FoundOscillationByDuplicate = .TRUE.
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameOut) &
//' shows oscillating flow rates across iterations with a repeated value of ' &
//TRIM(RoundSigDigits( &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory(1), 7) ) )
EXIT
ENDIF
ENDDO
ENDIF
IF (.NOT. FoundOscillationByDuplicate) THEN
SlopeMdot = ( SUM( ConvergenceHistoryARR) &
*SUM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory)&
- REAL(NumConvergenceHistoryTerms, r64) * SUM((ConvergenceHistoryARR &
* PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory)) ) &
/ ( SUM(ConvergenceHistoryARR)**2 &
- REAL(NumConvergenceHistoryTerms, r64)*SUM( ConvergenceHistoryARR**2) )
IF (ABS(SlopeMdot) > PlantFlowRateSlopeToler) THEN
IF (SlopeMdot < 0.d0) THEN ! check for monotonic decrease
MonotonicDecreaseFound = .TRUE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory(StackDepth-1) > &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory(StackDepth)) THEN
MonotonicDecreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicDecreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameOut) &
//' shows monotonically decreasing mass flow rate with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeMdot, 7)) &
//' [kg/s/iteration]' )
ENDIF
ELSE ! check for monotonic incrase
MonotonicIncreaseFound = .TRUE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory(StackDepth-1) < &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%MassFlowRateHistory(StackDepth)) THEN
MonotonicIncreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicIncreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameOut) &
//' shows monotonically increasing mass flow rate with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeMdot, 7)) &
//' [kg/s/iteration]' )
ENDIF
ENDIF
ENDIF ! significant slope found
ENDIF ! no oscillation found
IF (MonotonicDecreaseFound .OR. MonotonicIncreaseFound .OR. FoundOscillationByDuplicate) THEN
HistoryTrace = ' '
DO StackDepth = 1, NumConvergenceHistoryTerms
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode &
%MassFlowRateHistory(StackDepth), 7) ) // ','
ENDDO
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameOut) &
//' mass flow rate [kg/s] iteration history trace (most recent first): ' &
//TRIM(HistoryTrace) )
ENDIF ! need to report trace
! end of Outlet node
END DO ! plant loop sides
ENDIF ! mass flow not converged
IF (PlantConvergence(LoopNum)%PlantTempNotConverged) THEN
CALL ShowContinueError('Plant System Named = '//TRIM(PlantLoop(LoopNum)%Name) &
// ' did not converge for temperature')
CALL ShowContinueError('Check values should be zero. Most Recent values listed first.')
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(PlantConvergence(LoopNum)%PlantTempDemandToSupplyTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Demand-to-Supply interface temperature check value iteration history trace: ' &
//TRIM(HistoryTrace) )
HistoryTrace = ''
DO StackDepth = 1, ConvergLogStackDepth
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(PlantConvergence(LoopNum)%PlantTempSupplyToDemandTolValue(StackDepth), 6)) &
// ','
ENDDO
CALL ShowContinueError('Supply-to-Demand interface temperature check value iteration history trace: ' &
//TRIM(HistoryTrace) )
! now work with history logs for mass flow to detect issues
DO ThisLoopSide = 1, SIZE(PlantLoop(LoopNum)%LoopSide)
! loop side inlet node
FoundOscillationByDuplicate = .FALSE.
MonotonicDecreaseFound = .FALSE.
MonotonicIncreaseFound = .FALSE.
AvgValue = SUM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory) &
/ REAL(NumConvergenceHistoryTerms, r64)
IF (ABS(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory(1) - AvgValue) &
> PlantTemperatureOscillationToler) THEN
FoundOscillationByDuplicate = .FALSE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (ABS(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory(1) - &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory(StackDepth)) &
< PlantTemperatureOscillationToler) THEN
FoundOscillationByDuplicate = .TRUE.
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameIn) &
//' shows oscillating temperatures across iterations with a repeated value of ' &
//TRIM(RoundSigDigits( &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory(1), 5) ) )
EXIT
ENDIF
ENDDO
ENDIF
IF (.NOT. FoundOscillationByDuplicate) THEN
SlopeTemps = ( SUM( ConvergenceHistoryARR) &
*SUM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory)&
- REAL(NumConvergenceHistoryTerms, r64) * SUM((ConvergenceHistoryARR &
* PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory)) ) &
/ ( SUM(ConvergenceHistoryARR)**2 &
- REAL(NumConvergenceHistoryTerms, r64)*SUM( ConvergenceHistoryARR**2) )
IF (ABS(SlopeTemps) > PlantTemperatureSlopeToler) THEN
IF (SlopeTemps < 0.d0) THEN ! check for monotic decrease
MonotonicDecreaseFound = .TRUE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory(StackDepth-1) > &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory(StackDepth)) THEN
MonotonicDecreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicDecreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameIn) &
//' shows monotonically decreasing temperatures with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeTemps, 5)) &
//' [C/iteration]' )
ENDIF
ELSE ! check for monotic incrase
MonotonicIncreaseFound = .TRUE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory(StackDepth-1) < &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode%TemperatureHistory(StackDepth)) THEN
MonotonicIncreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicIncreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameIn) &
//' shows monotonically increasing temperatures with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeTemps, 5)) &
//' [C/iteration]' )
ENDIF
ENDIF
ENDIF ! significant slope found
ENDIF ! no oscillation found
IF (MonotonicDecreaseFound .OR. MonotonicIncreaseFound .OR. FoundOscillationByDuplicate) THEN
HistoryTrace = ' '
DO StackDepth = 1, NumConvergenceHistoryTerms
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%InletNode &
%TemperatureHistory(StackDepth), 5) ) // ','
ENDDO
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameIn) &
//' temperature [C] iteration history trace (most recent first): ' &
//TRIM(HistoryTrace) )
ENDIF ! need to report trace
! end of inlet node
! loop side outlet node
FoundOscillationByDuplicate = .FALSE.
MonotonicDecreaseFound = .FALSE.
MonotonicIncreaseFound = .FALSE.
AvgValue = SUM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory) &
/ REAL(NumConvergenceHistoryTerms, r64)
IF (ABS(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory(1) - AvgValue) &
> PlantTemperatureOscillationToler) THEN
FoundOscillationByDuplicate = .FALSE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (ABS(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory(1) - &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory(StackDepth)) &
< PlantTemperatureOscillationToler) THEN
FoundOscillationByDuplicate = .TRUE.
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameOut) &
//' shows oscillating temperatures across iterations with a repeated value of ' &
//TRIM(RoundSigDigits( &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory(1), 5) ) )
EXIT
ENDIF
ENDDO
ENDIF
IF (.NOT. FoundOscillationByDuplicate) THEN
SlopeTemps = ( SUM( ConvergenceHistoryARR) &
*SUM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory)&
- REAL(NumConvergenceHistoryTerms, r64) * SUM((ConvergenceHistoryARR &
* PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory)) ) &
/ ( SUM(ConvergenceHistoryARR)**2 &
- REAL(NumConvergenceHistoryTerms, r64)*SUM( ConvergenceHistoryARR**2) )
IF (ABS(SlopeTemps) > PlantFlowRateSlopeToler) THEN
IF (SlopeTemps < 0.d0) THEN ! check for monotic decrease
MonotonicDecreaseFound = .TRUE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory(StackDepth-1) > &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory(StackDepth)) THEN
MonotonicDecreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicDecreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameOut) &
//' shows monotonically decreasing temperatures with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeTemps, 5)) &
//' [C/iteration]' )
ENDIF
ELSE ! check for monotic incrase
MonotonicIncreaseFound = .TRUE.
DO StackDepth = 2, NumConvergenceHistoryTerms
IF (PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory(StackDepth-1) < &
PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode%TemperatureHistory(StackDepth)) THEN
MonotonicIncreaseFound = .FALSE.
EXIT
ENDIF
ENDDO
IF (MonotonicIncreaseFound) THEN
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameOut) &
//' shows monotonically increasing temperatures with a trend rate across iterations of ' &
//TRIM(RoundSigDigits(SlopeTemps, 5)) &
//' [C/iteration]' )
ENDIF
ENDIF
ENDIF ! significant slope found
ENDIF ! no oscillation found
IF (MonotonicDecreaseFound .OR. MonotonicIncreaseFound .OR. FoundOscillationByDuplicate) THEN
HistoryTrace = ' '
DO StackDepth = 1, NumConvergenceHistoryTerms
HistoryTrace = TRIM(HistoryTrace) &
// TRIM(roundSigDigits(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%OutletNode &
%TemperatureHistory(StackDepth), 5) ) // ','
ENDDO
CALL ShowContinueError('Node named ' &
//TRIM(PlantLoop(LoopNum)%LoopSide(ThisLoopSide)%NodeNameOut) &
//' temperature [C] iteration history trace (most recent first): ' &
//TRIM(HistoryTrace) )
ENDIF ! need to report trace
! end of Outlet node
END DO ! plant loop sides
ENDIF !temperature not converged
ENDDO ! loop over plant loop systems
ENDIF
ELSE
IF (EnvironmentName == ErrEnvironmentName) THEN
CALL ShowRecurringWarningErrorAtEnd('SimHVAC: Exceeding Maximum iterations for all HVAC loops, during '// &
TRIM(EnvironmentName)//' continues', MaxErrCount)
ELSE
MaxErrCount=0
ErrEnvironmentName=EnvironmentName
CALL ShowRecurringWarningErrorAtEnd('SimHVAC: Exceeding Maximum iterations for all HVAC loops, during '// &
TRIM(EnvironmentName)//' continues', MaxErrCount)
ENDIF
ENDIF
END IF
! Set node setpoints to a flag value so that controllers can check whether their sensed nodes
! have a setpoint
IF ( .NOT. ZoneSizingCalc .AND. .NOT. SysSizingCalc) THEN
IF (MySetPointInit) THEN
IF (NumOfNodes > 0) THEN
Node%TempSetPoint = SensedNodeFlagValue
Node%HumRatSetPoint = SensedNodeFlagValue
Node%HumRatMin = SensedNodeFlagValue
Node%HumRatMax = SensedNodeFlagValue
Node%MassFlowRateSetPoint = SensedNodeFlagValue ! BG 5-26-2009 (being checked in HVACControllers.f90)
DefaultNodeValues%TempSetPoint = SensedNodeFlagValue
DefaultNodeValues%HumRatSetPoint = SensedNodeFlagValue
DefaultNodeValues%HumRatMin = SensedNodeFlagValue
DefaultNodeValues%HumRatMax = SensedNodeFlagValue
DefaultNodeValues%MassFlowRateSetPoint = SensedNodeFlagValue ! BG 5-26-2009 (being checked in HVACControllers.f90)
ENDIF
MySetPointInit = .FALSE.
DoSetPointTest = .TRUE.
ELSE
DoSetPointTest = .FALSE.
END IF
END IF
IF (SetPointErrorFlag) THEN
CALL ShowFatalError('Previous severe set point errors cause program termination')
END IF
RETURN
END SUBROUTINE SimHVAC