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) | :: | SurfaceGHENum | |||
logical, | intent(in) | :: | FirstHVACIteration |
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 CalcSurfaceGroundHeatExchanger(SurfaceGHENum, FirstHVACIteration) !DSU
! AUTHOR Simon Rees
! DATE WRITTEN August 2002
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine does all of the stuff that is necessary to simulate
! a surface ground heat exchanger. Calls are made to appropriate subroutines
! either in this module or outside of it.
! METHODOLOGY EMPLOYED:
! To update temperature and flux histories it is necessary to make a surface
! flux/temperature calculation at the begining of each zone time step using the
! weather data from the previous step, and using the average source flux.
! Once this has been done a new source flux, and current surface temperatures,
! are calculated using the current weather data. These surface temperatures and
! fluxes are used for the rest of the system time steps. During subsequent system
! time steps only the source flux is updated.
! Surface fluxes are calculated from the QTF equations using assumed surface
! temperatures. Surface fluxes are then dependant only on source flux. Constant
! and terms and terms that multiply the source flux from the QTF equations, are
! grouped together for convenience. These are calculated in "CalcBottomFluxCoefficents"
! etc. It is necessary to iterate on these equations, updating the current surface
! temperatures at each step.
! REFERENCES:
! See 'LowTempRadiantSystem' module
! IBLAST-QTF research program, completed in January 1995 (unreleased)
! Strand, R.K. 1995. "Heat Source Transfer Functions and Their Application to
! Low Temperature Radiant Heating Systems", Ph.D. dissertation, University
! of Illinois at Urbana-Champaign, Department of Mechanical and Industrial
! Engineering.
! Seem, J.E. 1986. "Heat Transfer in Buildings", Ph.D. dissertation, University
! of Wisconsin-Madison.
! USE STATEMENTS:
USE DataLoopNode, ONLY : Node
USE DataHVACGlobals, ONLY : TimeStepSys, SysTimeElapsed, FirstTimeStepSysFlag
USE DataEnvironment
USE DataPlant, ONLY : PlantLoop
USE General, ONLY : TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL, INTENT(IN) :: FirstHVACIteration ! TRUE if 1st HVAC simulation of system timestep
INTEGER, INTENT(IN) :: SurfaceGHENum ! component number
! INTEGER, INTENT(IN) :: FlowLock ! flow initialization/condition flag !DSU
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: SurfFluxTol = 0.001d0 ! tolerance on the surface fluxes
REAL(r64), PARAMETER :: SrcFluxTol = 0.001d0 ! tolerance on the source flux
REAL(r64), PARAMETER :: RelaxT = 0.1d0 ! temperature relaxation factor
INTEGER, PARAMETER :: Maxiter = 100
INTEGER, PARAMETER :: Maxiter1 = 100
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! variables used with previous environmental conditions
!! not used REAL(r64) :: Concentration ! set to 0.5 if glycol, 0.0 if water
REAL(r64) :: PastFluxTop ! top surface flux - past value
REAL(r64) :: PastFluxBtm ! bottom surface flux - past value
REAL(r64) :: PastTempBtm ! bottom surface temp - past value
REAL(r64) :: PastTempTop ! top surface temp - past value
REAL(r64) :: OldPastFluxTop ! top surface flux - past value used during iteration
REAL(r64) :: OldPastFluxBtm ! bottom surface flux - past value used during iteration
! variables used with current environmental conditions
REAL(r64),SAVE :: FluxTop ! top surface flux
REAL(r64),SAVE :: FluxBtm ! bottom surface flux
REAL(r64),SAVE :: TempBtm ! bottom surface temp
REAL(r64),SAVE :: TempTop ! top surface temp
REAL(r64) :: TempT ! top surface temp - used in underrelaxation
REAL(r64) :: TempB ! bottom surface temp - used in underrelaxation
REAL(r64) :: OldFluxTop ! top surface flux - value used during iteration
REAL(r64) :: OldFluxBtm ! bottom surface flux - value used during iteration
REAL(r64) :: OldSourceFlux ! previous value of source flux - used during iteration
INTEGER :: Iter
INTEGER :: Iter1
! INTEGER, SAVE ::ErrCount1=0
! INTEGER, SAVE ::ErrCount2=0
! INTEGER, SAVE ::ErrCount3=0
LOGICAL, SAVE ::InitializeTempTop = .FALSE.
INTEGER :: LoopNum
INTEGER :: LoopSideNum
LoopNum = SurfaceGHE(SurfaceGHENum)%LoopNum
LoopSideNum = SurfaceGHE(SurfaceGHENum)%LoopSideNum
! check if we are in very first call for this zone time step
IF (BeginTimeStepFlag.AND.FirstHVACIteration.AND.PlantLoop(LoopNum)%Loopside(LoopSideNum)%FlowLock==1) THEN !DSU
! calc temps and fluxes with past env. conditions and average source flux
SourceFlux = SurfaceGHEQTF(SurfaceGHENum)%QsrcAvg
! starting values for the surface temps
PastTempBtm = SurfaceGHEQTF(SurfaceGHENum)%TbtmHistory(1)
PastTempTop = SurfaceGHEQTF(SurfaceGHENum)%TtopHistory(1)
OldPastFluxTop = 1.0d+30
OldPastFluxBtm = 1.0d+30
OldSourceFlux = 1.0d+30
TempB=0.0d0
TempT=0.0d0
iter=0
DO ! iterate to find surface heat balances
! update coefficients
iter = iter +1
CALL CalcTopFluxCoefficents(SurfaceGHENum, PastTempBtm, PastTempTop)
! calc top surface flux
PastFluxTop = SurfaceGHEQTF(SurfaceGHENum)%QtopConstCoef + &
SurfaceGHEQTF(SurfaceGHENum)%QtopVarCoef * SourceFlux
!calc new top surface temp
CALL CalcTopSurfTemp(SurfaceGHENum, -PastFluxTop, TempT, PastOutDryBulbTemp, &
PastOutWetBulbTemp, PastSkyTemp, PastBeamSolarRad, &
PastDifSolarRad, PastSolarDirCosVert, PastWindSpeed, &
PastIsRain, PastIsSnow)
! under relax
PastTempTop = PastTempTop*(1.0-RelaxT) + RelaxT*TempT
! update coefficients
CALL CalcBottomFluxCoefficents(SurfaceGHENum, PastTempBtm, PastTempTop)
PastFluxBtm = SurfaceGHEQTF(SurfaceGHENum)%QbtmConstCoef + &
SurfaceGHEQTF(SurfaceGHENum)%QbtmVarCoef * SourceFlux
IF(ABS((OldPastFluxTop - PastFluxTop)/OldPastFluxTop) <= SurfFluxTol .AND. &
ABS((OldPastFluxBtm - PastFluxBtm)/OldPastFluxBtm) <= SurfFluxTol) EXIT
!calc new surface temps
CALL CalcBottomSurfTemp(SurfaceGHENum, PastFluxBtm, TempB, PastOutDryBulbTemp, &
PastWindSpeed, PastGroundTemp)
! underrelax
PastTempBtm = PastTempBtm*(1.0-RelaxT) + RelaxT*TempB
! update flux record
OldPastFluxTop = PastFluxTop
OldPastFluxBtm = PastFluxBtm
!Check for non-convergence
IF(iter > maxiter) THEN
IF (SurfaceGHE(SurfaceGHENum)%ConvErrIndex1 == 0) THEN
CALL ShowWarningMessage('CalcSurfaceGroundHeatExchanger="'//TRIM(SurfaceGHE(SurfaceGHENum)%Name)// &
'", Did not converge (part 1), Iterations='//trim(TrimSigDigits(maxiter)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('CalcSurfaceGroundHeatExchanger="'//TRIM(SurfaceGHE(SurfaceGHENum)%Name)// &
'", Did not converge (part 1)',SurfaceGHE(SurfaceGHENum)%ConvErrIndex1)
EXIT
ENDIF
END DO
IF(.NOT. InitializeTempTop) THEN
TempTop = TempT
TempBtm = TempB
FluxTop = PastFluxTop
FluxBtm = PastFluxBtm
InitializeTempTop = .TRUE.
END IF
! update module variables
TopSurfTemp = TempTop
BtmSurfTemp = TempBtm
TopSurfFlux = -FluxTop
BtmSurfFlux = FluxBtm
! get source temp for output
CALL CalcSourceTempCoefficents(SurfaceGHENum, PastTempBtm, PastTempTop)
SourceTemp = SurfaceGHEQTF(SurfaceGHENum)%TsrcConstCoef + &
SurfaceGHEQTF(SurfaceGHENum)%TsrcVarCoef * SourceFlux
! update histories
CALL UpdateHistories(SurfaceGHENum, PastFluxTop, PastFluxBtm, SourceFlux, SourceTemp)
! At the beginning of a time step, reset to zero so average calculation can start again
SurfaceGHEQTF(SurfaceGHENum)%QsrcAvg = 0.0D0
SurfaceGHEQTF(SurfaceGHENum)%LastSysTimeElapsed = 0.0D0
SurfaceGHEQTF(SurfaceGHENum)%LastTimeStepSys = 0.0D0
! get current env. conditions
PastBeamSolarRad = BeamSolarRad
PastSolarDirCosVert = SOLCOS(3)
PastDifSolarRad = DifSolarRad
PastGroundTemp = GroundTemp_Surface
PastIsRain = IsRain
PastIsSnow = IsSnow
PastOutBaroPress = OutBaroPress
PastOutDryBulbTemp = OutDryBulbTempAt(SurfaceHXHeight)
PastOutHumRat = OutHumRat
PastOutAirDensity = OutAirDensity
PastOutWetBulbTemp = OutWetBulbTempAt(SurfaceHXHeight)
PastOutDewPointTemp = OutDewPointTempAt(SurfaceHXHeight)
PastSkyTemp = SkyTemp
PastWindSpeed = WindSpeedAt(SurfaceHXHeight)
PastCloudFraction = CloudFraction
TempBtm = SurfaceGHEQTF(SurfaceGHENum)%TbtmHistory(1)
TempTop = SurfaceGHEQTF(SurfaceGHENum)%TtopHistory(1)
OldFluxTop = 1.0d+30
OldFluxBtm = 1.0d+30
OldSourceFlux = 1.0d+30
SourceFlux = CalcSourceFlux(SurfaceGHENum)
iter = 0
DO ! iterate to find source flux
iter = iter +1
iter1=0
DO ! iterate to find surface heat balances
iter1=iter1+1
! update top coefficients
CALL CalcTopFluxCoefficents(SurfaceGHENum, TempBtm, TempTop)
! calc top surface fluxe
FluxTop = SurfaceGHEQTF(SurfaceGHENum)%QtopConstCoef + &
SurfaceGHEQTF(SurfaceGHENum)%QtopVarCoef * SourceFlux
!calc new surface temps
CALL CalcTopSurfTemp(SurfaceGHENum, -FluxTop, TempT, PastOutDryBulbTemp, &
PastOutWetBulbTemp, PastSkyTemp, PastBeamSolarRad, &
PastDifSolarRad, PastSolarDirCosVert, PastWindSpeed, &
PastIsRain, PastIsSnow)
! under-relax
TempTop = TempTop*(1.0-RelaxT) + RelaxT*TempT
! update bottom coefficients
CALL CalcBottomFluxCoefficents(SurfaceGHENum, TempBtm, TempTop)
FluxBtm = SurfaceGHEQTF(SurfaceGHENum)%QbtmConstCoef + &
SurfaceGHEQTF(SurfaceGHENum)%QbtmVarCoef * SourceFlux
! convergence test on surface fluxes
IF(ABS((OldFluxTop - FluxTop)/OldFluxTop) <= SurfFluxTol .AND. &
ABS((OldFluxBtm - FluxBtm)/OldFluxBtm) <= SurfFluxTol) EXIT
!calc new surface temps
CALL CalcBottomSurfTemp(SurfaceGHENum, FluxBtm, TempB, PastOutDryBulbTemp, &
PastOutDryBulbTemp, GroundTemp_Surface)
! under-relax
TempBtm = TempBtm*(1.0-RelaxT) + RelaxT*TempB
! update flux record
OldFluxBtm = FluxBtm
OldFluxTop = FluxTop
!Check for non-convergence
IF(iter1 > maxiter1) THEN
IF (SurfaceGHE(SurfaceGHENum)%ConvErrIndex2 == 0) THEN
CALL ShowWarningMessage('CalcSurfaceGroundHeatExchanger="'//TRIM(SurfaceGHE(SurfaceGHENum)%Name)// &
'", Did not converge (part 2), Iterations='//trim(TrimSigDigits(maxiter)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('CalcSurfaceGroundHeatExchanger="'//TRIM(SurfaceGHE(SurfaceGHENum)%Name)// &
'", Did not converge (part 2)',SurfaceGHE(SurfaceGHENum)%ConvErrIndex2)
EXIT
ENDIF
END DO
! update the source temp coefficients and update the source flux
CALL CalcSourceTempCoefficents(SurfaceGHENum, TempBtm, TempTop)
SourceFlux = CalcSourceFlux(SurfaceGHENum)
! check source flux convergence
IF(ABS((OldSourceFlux - SourceFlux)/(1.0d-20+OldSourceFlux)) <= SrcFluxTol) EXIT
OldSourceFlux = SourceFlux
!Check for non-convergence
IF(iter > maxiter) THEN
IF (SurfaceGHE(SurfaceGHENum)%ConvErrIndex3 == 0) THEN
CALL ShowWarningMessage('CalcSurfaceGroundHeatExchanger="'//TRIM(SurfaceGHE(SurfaceGHENum)%Name)// &
'", Did not converge (part 3), Iterations='//trim(TrimSigDigits(maxiter)))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('CalcSurfaceGroundHeatExchanger="'//TRIM(SurfaceGHE(SurfaceGHENum)%Name)// &
'", Did not converge (part 3)',SurfaceGHE(SurfaceGHENum)%ConvErrIndex3)
EXIT
ENDIF
END DO ! end surface heat balance iteration
ELSE ! end source flux iteration
! For the rest of the system time steps ...
! update source flux from Twi
SourceFlux = CalcSourceFlux(SurfaceGHENum)
END IF
RETURN
END SUBROUTINE CalcSurfaceGroundHeatExchanger