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 | ||
---|---|---|---|---|---|---|
logical | :: | RunFlag | ||||
integer | :: | Num |
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 UpdateVerticalGroundHeatExchanger(RunFlag, Num)
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: August, 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Updates the GLHE report variable data structure
! METHODOLOGY EMPLOYED:
!
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY : TrimSigDigits
USE PlantUtilities, ONLY: SafeCopyPlantNode
USE DataPlant, ONLY: PlantLoop
USE FluidProperties, ONLY: GetSpecificHeatGlycol, GetDensityGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL :: RunFlag
INTEGER :: Num
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: DeltaTempLimit = 100.d0 ! temp limit for warnings
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
INTEGER :: GlheInletNode ! Inlet node number of the Glhe
INTEGER :: GlheOutletNode ! Outlet node number of the Glhe
REAL(r64) :: GlhedeltaTemp ! ABS(Outlet temp -inlet temp)
INTEGER, SAVE :: NumErrorCalls = 0
REAL(r64) :: DesignMassFlow
REAL(r64) :: FluidDensity
!set node temperatures
GlheInletNode = VerticalGlhe(Num)%GlheInletNodeNum
GlheOutletNode = VerticalGlhe(Num)%GlheOutletNodeNum
CALL SafeCopyPlantNode(GlheInletNode, GlheOutletNode)
Node(GlheOutletNode)%Temp = GlheOutletTemp
Node(GlheOutletNode)%Enthalpy = GlheOutletTemp * GetSpecificHeatGlycol( &
PlantLoop(VerticalGlhe(Num)%LoopNum)%FluidName, &
GlheOutletTemp, &
PlantLoop(VerticalGlhe(Num)%LoopNum)%FluidIndex, &
'UpdateVerticalGroundHeatExchanger')
GlhedeltaTemp = ABS(GlheOutletTemp-GlheInletTemp)
VerticalGlheReport(Num)%GlheBoreholeTemp = GlheBoreholeTemp
VerticalGlheReport(Num)%GlheOutletTemp = GlheOutletTemp
! calc load from load per unit length.
VerticalGlheReport(Num)%QGlhe = QGlhe * VerticalGlhe(Num)%BoreholeLength * &
VerticalGlhe(Num)%NumBoreholes
VerticalGlheReport(Num)%GlheInletTemp = GlheInletTemp
VerticalGlheReport(Num)%GlheMassFlowRate = GlheMassFlowRate
VerticalGlheReport(Num)%GlheAveFluidTemp = GlheAveFluidTemp
IF (GlhedeltaTemp > DeltaTempLimit .AND. NumErrorCalls < NumVerticalGlhes .AND. .NOT. Warmupflag) THEN
FluidDensity = GetDensityGlycol(PlantLoop(VerticalGlhe(Num)%LoopNum)%FluidName, &
GlheInletTemp, &
PlantLoop(VerticalGlhe(Num)%LoopNum)%FluidIndex, &
'UpdateVerticalGroundHeatExchanger')
DesignMassFlow = VerticalGlhe(Num)%DesignFlow* FluidDensity
CALL ShowWarningError('Check GLHE design inputs & g-functions for consistency')
CALL ShowContinueError('For GroundHeatExchanger:Vertical ' //TRIM(VerticalGlhe(Num)%Name)//'GLHE delta Temp > 100C.')
CALL ShowContinueError('This can be encountered in cases where the GLHE mass flow rate is either significantly')
CALL ShowContinueError(' lower than the design value, or cases where the mass flow rate rapidly changes.')
CALL ShowContinueError('Glhe Current Flow Rate='//TRIM(TrimSigDigits(GlheMassFlowRate,3))// &
'; Glhe Design Flow Rate='//TRIM(TrimSigDigits(DesignMassFlow,3)))
NumErrorCalls = NumErrorCalls + 1
ENDIF
RETURN
END SUBROUTINE UpdateVerticalGroundHeatExchanger