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) | :: | AirLoopNum | |||
integer, | intent(in) | :: | CalledFrom | |||
integer, | intent(in) | :: | OutletNode | |||
integer, | intent(in) | :: | InletNode | |||
logical, | intent(inout) | :: | OutOfToleranceFlag |
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 UpdateHVACInterface(AirLoopNum, CalledFrom, OutletNode,InletNode,OutOfToleranceFlag)
! SUBROUTINE INFORMATION:
! AUTHOR Rick Strand
! DATE WRITTEN October 1998
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine manages any generic HVAC loop interface.
! METHODOLOGY EMPLOYED:
! This is a simple "forward" interface where all of the properties
! from the outlet of one side of the loop get transfered directly
! to the inlet node of the corresponding other side of the loop.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataLoopNode, ONLY : Node
USE DataConvergParams
USE DataContaminantBalance, ONLY: Contaminant
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: AirLoopNum ! airloop number for which air loop this is
INTEGER, INTENT(IN) :: CalledFrom !
INTEGER, INTENT(IN) :: OutletNode ! Node number for the outlet of the side of the loop just simulated
INTEGER, INTENT(IN) :: InletNode ! Node number for the inlet of the side that needs the outlet node data
LOGICAL, INTENT(INOUT) :: OutOfToleranceFlag ! True when the other side of the loop need to be (re)simulated
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64), DIMENSION(ConvergLogStackDepth) :: TmpRealARR
REAL(r64) :: DeltaEnergy
! FLOW:
!Calculate the approximate energy difference across interface for comparison
DeltaEnergy = HVACCpApprox*((Node(OutletNode)%MassFlowRate*Node(OutletNode)%Temp) - &
(Node(InletNode)%MassFlowRate*Node(InletNode)%Temp))
AirLoopConvergence(AirLoopNum)%HVACMassFlowNotConverged = .FALSE.
AirLoopConvergence(AirLoopNum)%HVACHumRatNotConverged = .FALSE.
AirLoopConvergence(AirLoopNum)%HVACTempNotConverged = .FALSE.
AirLoopConvergence(AirLoopNum)%HVACEnergyNotConverged = .FALSE.
AirLoopConvergence(AirLoopNum)%HVACEnthalpyNotConverged = .FALSE.
AirLoopConvergence(AirLoopNum)%HVACPressureNotConverged = .FALSE.
SELECT CASE (CalledFrom)
CASE (CalledFromAirSystemDemandSide)
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACFlowDemandToSupplyTolValue
AirLoopConvergence(AirLoopNum)%HVACFlowDemandToSupplyTolValue(1) = &
ABS(Node(OutletNode)%MassFlowRate-Node(InletNode)%MassFlowRate)
AirLoopConvergence(AirLoopNum)%HVACFlowDemandToSupplyTolValue(2:ConvergLogStackDepth) = &
TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACFlowDemandToSupplyTolValue(1) > HVACFlowRateToler) THEN
AirLoopConvergence(AirLoopNum)%HVACMassFlowNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACHumDemandToSupplyTolValue
AirLoopConvergence(AirLoopNum)%HVACHumDemandToSupplyTolValue(1) = ABS(Node(OutletNode)%HumRat-Node(InletNode)%HumRat)
AirLoopConvergence(AirLoopNum)%HVACHumDemandToSupplyTolValue(2:ConvergLogStackDepth) = TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACHumDemandToSupplyTolValue(1) > HVACHumRatToler) THEN
AirLoopConvergence(AirLoopNum)%HVACHumRatNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACTempDemandToSupplyTolValue
AirLoopConvergence(AirLoopNum)%HVACTempDemandToSupplyTolValue(1) = ABS(Node(OutletNode)%Temp-Node(InletNode)%Temp)
AirLoopConvergence(AirLoopNum)%HVACTempDemandToSupplyTolValue(2:ConvergLogStackDepth) = TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACTempDemandToSupplyTolValue(1) > HVACTemperatureToler) THEN
AirLoopConvergence(AirLoopNum)%HVACTempNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACEnergyDemandToSupplyTolValue
AirLoopConvergence(AirLoopNum)%HVACEnergyDemandToSupplyTolValue(1) = ABS(DeltaEnergy)
AirLoopConvergence(AirLoopNum)%HVACEnergyDemandToSupplyTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (ABS(DeltaEnergy) > HVACEnergyToler) THEN
AirLoopConvergence(AirLoopNum)%HVACEnergyNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACEnthalpyDemandToSupplyTolValue
AirLoopConvergence(AirLoopNum)%HVACEnthalpyDemandToSupplyTolValue(1) = ABS(Node(OutletNode)%Enthalpy-Node(InletNode)%Enthalpy)
AirLoopConvergence(AirLoopNum)%HVACEnthalpyDemandToSupplyTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACEnthalpyDemandToSupplyTolValue(1) > HVACEnthalpyToler) THEN
AirLoopConvergence(AirLoopNum)%HVACEnthalpyNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACPressureDemandToSupplyTolValue
AirLoopConvergence(AirLoopNum)%HVACPressureDemandToSupplyTolValue(1) = ABS(Node(OutletNode)%Press-Node(InletNode)%Press)
AirLoopConvergence(AirLoopNum)%HVACPressureDemandToSupplyTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACPressureDemandToSupplyTolValue(1) > HVACPressToler) THEN
AirLoopConvergence(AirLoopNum)%HVACPressureNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
CASE (CalledFromAirSystemSupplySideDeck1)
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACFlowSupplyDeck1ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACFlowSupplyDeck1ToDemandTolValue(1) &
= ABS(Node(OutletNode)%MassFlowRate-Node(InletNode)%MassFlowRate)
AirLoopConvergence(AirLoopNum)%HVACFlowSupplyDeck1ToDemandTolValue(2:ConvergLogStackDepth)&
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACFlowSupplyDeck1ToDemandTolValue(1) > HVACFlowRateToler) THEN
AirLoopConvergence(AirLoopNum)%HVACMassFlowNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACHumSupplyDeck1ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACHumSupplyDeck1ToDemandTolValue(1) = ABS(Node(OutletNode)%HumRat-Node(InletNode)%HumRat)
AirLoopConvergence(AirLoopNum)%HVACHumSupplyDeck1ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACHumSupplyDeck1ToDemandTolValue(1) > HVACHumRatToler) THEN
AirLoopConvergence(AirLoopNum)%HVACHumRatNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACTempSupplyDeck1ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACTempSupplyDeck1ToDemandTolValue(1) = ABS(Node(OutletNode)%Temp-Node(InletNode)%Temp)
AirLoopConvergence(AirLoopNum)%HVACTempSupplyDeck1ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACTempSupplyDeck1ToDemandTolValue(1) > HVACTemperatureToler) THEN
AirLoopConvergence(AirLoopNum)%HVACTempNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACEnergySupplyDeck1ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACEnergySupplyDeck1ToDemandTolValue(1) = DeltaEnergy
AirLoopConvergence(AirLoopNum)%HVACEnergySupplyDeck1ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (ABS(DeltaEnergy) > HVACEnergyToler) THEN
AirLoopConvergence(AirLoopNum)%HVACEnergyNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACEnthalpySupplyDeck1ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACEnthalpySupplyDeck1ToDemandTolValue(1) &
= ABS(Node(OutletNode)%Enthalpy-Node(InletNode)%Enthalpy)
AirLoopConvergence(AirLoopNum)%HVACEnthalpySupplyDeck1ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACEnthalpySupplyDeck1ToDemandTolValue(1) > HVACEnthalpyToler) THEN
AirLoopConvergence(AirLoopNum)%HVACEnthalpyNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACPressureSupplyDeck1ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACPressureSupplyDeck1ToDemandTolValue(1) &
= ABS(Node(OutletNode)%Press-Node(InletNode)%Press)
AirLoopConvergence(AirLoopNum)%HVACPressureSupplyDeck1ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACPressureSupplyDeck1ToDemandTolValue(1) > HVACPressToler) THEN
AirLoopConvergence(AirLoopNum)%HVACPressureNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
CASE (CalledFromAirSystemSupplySideDeck2)
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACFlowSupplyDeck2ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACFlowSupplyDeck2ToDemandTolValue(1) &
= ABS(Node(OutletNode)%MassFlowRate-Node(InletNode)%MassFlowRate)
AirLoopConvergence(AirLoopNum)%HVACFlowSupplyDeck2ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACFlowSupplyDeck2ToDemandTolValue(1) > HVACFlowRateToler) THEN
AirLoopConvergence(AirLoopNum)%HVACMassFlowNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACHumSupplyDeck2ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACHumSupplyDeck2ToDemandTolValue(1) &
= ABS(Node(OutletNode)%HumRat-Node(InletNode)%HumRat)
AirLoopConvergence(AirLoopNum)%HVACHumSupplyDeck2ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACHumSupplyDeck2ToDemandTolValue(1) > HVACHumRatToler) THEN
AirLoopConvergence(AirLoopNum)%HVACHumRatNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACTempSupplyDeck2ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACTempSupplyDeck2ToDemandTolValue(1) &
= ABS(Node(OutletNode)%Temp-Node(InletNode)%Temp)
AirLoopConvergence(AirLoopNum)%HVACTempSupplyDeck2ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACTempSupplyDeck2ToDemandTolValue(1) > HVACTemperatureToler) THEN
AirLoopConvergence(AirLoopNum)%HVACTempNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
END IF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACEnergySupplyDeck2ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACEnergySupplyDeck2ToDemandTolValue(1) = DeltaEnergy
AirLoopConvergence(AirLoopNum)%HVACEnergySupplyDeck2ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (ABS(DeltaEnergy) > HVACEnergyToler) THEN
AirLoopConvergence(AirLoopNum)%HVACEnergyNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACEnthalpySupplyDeck2ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACEnthalpySupplyDeck2ToDemandTolValue(1) &
= ABS(Node(OutletNode)%Enthalpy-Node(InletNode)%Enthalpy)
AirLoopConvergence(AirLoopNum)%HVACEnthalpySupplyDeck2ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACEnthalpySupplyDeck2ToDemandTolValue(1) > HVACEnthalpyToler) THEN
AirLoopConvergence(AirLoopNum)%HVACEnthalpyNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
TmpRealARR = AirLoopConvergence(AirLoopNum)%HVACPressueSupplyDeck2ToDemandTolValue
AirLoopConvergence(AirLoopNum)%HVACPressueSupplyDeck2ToDemandTolValue(1) &
= ABS(Node(OutletNode)%Press-Node(InletNode)%Press)
AirLoopConvergence(AirLoopNum)%HVACPressueSupplyDeck2ToDemandTolValue(2:ConvergLogStackDepth) &
= TmpRealARR(1:ConvergLogStackDepth-1)
IF (AirLoopConvergence(AirLoopNum)%HVACPressueSupplyDeck2ToDemandTolValue(1) > HVACPressToler) THEN
AirLoopConvergence(AirLoopNum)%HVACPressureNotConverged = .TRUE.
OutOfToleranceFlag = .TRUE. ! Something has changed--resimulate the other side of the loop
ENDIF
END SELECT
! Always update the new inlet conditions
Node(InletNode)%Temp = Node(OutletNode)%Temp
Node(InletNode)%MassFlowRate = Node(OutletNode)%MassFlowRate
Node(InletNode)%MassFlowRateMinAvail = Node(OutletNode)%MassFlowRateMinAvail
Node(InletNode)%MassFlowRateMaxAvail = Node(OutletNode)%MassFlowRateMaxAvail
Node(InletNode)%Quality = Node(OutletNode)%Quality
Node(InletNode)%Press = Node(OutletNode)%Press
Node(InletNode)%Enthalpy = Node(OutletNode)%Enthalpy
Node(InletNode)%HumRat = Node(OutletNode)%HumRat
IF (Contaminant%CO2Simulation) Then
Node(InletNode)%CO2 = Node(OutletNode)%CO2
End If
IF (Contaminant%GenericContamSimulation) Then
Node(InletNode)%GenContam = Node(OutletNode)%GenContam
End If
RETURN
END SUBROUTINE UpdateHVACInterface