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) | :: | Surf | |||
real(kind=r64), | intent(inout) | :: | TempSurfInTmp | |||
real(kind=r64), | intent(inout) | :: | TempSurfOutTmp |
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 CalcHeatBalFiniteDiff(Surf,TempSurfInTmp,TempSurfOutTmp)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN Oct 2003
! MODIFIED Aug 2006 by C O Pedersen to include implicit solution and variable properties with
! material enthalpy added for Phase Change Materials.
! Sept 2010 B. Griffith, remove allocate/deallocate, use structure variables
! March 2011 P. Tabares, add relaxation factor and add surfIteration to
! update TD and TDT, correct interzone partition
! May 2011 B. Griffith add logging and errors when inner GS loop does not converge
! November 2011 P. Tabares fixed problems with adiabatic walls/massless walls and PCM stability problems
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! this routine controls the calculation of the fluxes and temperatures using
! finite difference procedures for
! all building surface constructs.
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY : RoundSigDigits
USE DataHeatBalance, ONLY : CondFDRelaxFactor
USE DataGlobals, ONLY : KickOffSimulation
USE DataSurfaces, ONLY : HeatTransferModel_CondFD
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(In) :: Surf
REAL(r64), INTENT(InOut) :: TempSurfInTmp !INSIDE SURFACE TEMPERATURE OF EACH HEAT TRANSFER SURF.
REAL(r64), INTENT(InOut) :: TempSurfOutTmp !Outside Surface Temperature of each Heat Transfer Surface
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: HMovInsul ! Equiv H for TIM layer, Comes with call to
! EvalOutsideMovableInsulation
INTEGER :: RoughIndexMovInsul ! roughness Movable insulation
REAL(r64) :: AbsExt ! exterior absorptivity movable insulation
INTEGER :: I ! Node number in construction
INTEGER :: J
INTEGER :: Lay
INTEGER :: ctr
INTEGER :: ConstrNum
INTEGER :: TotLayers
INTEGER :: TotNodes
INTEGER :: delt
INTEGER :: GSiter ! iteration counter for implicit repeat calculation
REAL(r64) :: MaxDelTemp = 0.0d0
INTEGER :: NodeNum
ConstrNum=Surface(surf)%Construction
TotNodes = ConstructFD(ConstrNum)%TotNodes
TotLayers = Construct(ConstrNum)%TotLayers
TempSurfInTmp =0.0d0
TempSurfOutTmp=0.0d0
Delt = ConstructFD(ConstrNum)%DeltaTime ! (seconds)
CALL EvalOutsideMovableInsulation(Surf,HMovInsul,RoughIndexMovInsul,AbsExt)
! Start stepping through the slab with time.
DO J=1,NINT((TimeStepZone*SecInHour)/Delt) !PT testing higher time steps
DO GSiter = 1, MaxGSiter ! Iterate implicit equations
SurfaceFD(Surf)%TDTLast = SurfaceFD(Surf)%TDT ! Save last iteration's TDT (New temperature) values
SurfaceFD(Surf)%EnthLast = SurfaceFD(Surf)%EnthNew ! Last iterations new enthalpy value
! Original loop version
I= 1 ! Node counter
DO Lay = 1, TotLayers ! Begin layer loop ...
!For the exterior surface node with a convective boundary condition
IF(I == 1 .and. Lay ==1)THEN
CALL ExteriorBCEqns(Delt,I,Lay,Surf,SurfaceFD(Surf)%T, &
SurfaceFD(Surf)%TT, &
SurfaceFD(Surf)%Rhov, &
SurfaceFD(Surf)%RhoT, &
SurfaceFD(Surf)%RH, &
SurfaceFD(Surf)%TD, &
SurfaceFD(Surf)%TDT,&
SurfaceFD(Surf)%EnthOld, &
SurfaceFD(Surf)%EnthNew, &
TotNodes,HMovInsul)
END IF
!For the Layer Interior nodes. Arrive here after exterior surface node or interface node
IF(TotNodes .ne. 1) THEN
DO Ctr=2,ConstructFD(ConstrNum)%NodeNumPoint(Lay)
I=I+1
CALL InteriorNodeEqns(Delt,I,Lay,Surf,SurfaceFD(Surf)%T, &
SurfaceFD(Surf)%TT, &
SurfaceFD(Surf)%Rhov, &
SurfaceFD(Surf)%RhoT,&
SurfaceFD(Surf)%RH, &
SurfaceFD(Surf)%TD, &
SurfaceFD(Surf)%TDT, &
SurfaceFD(Surf)%EnthOld, &
SurfaceFD(Surf)%EnthNew)
END DO
END IF
IF(Lay < TotLayers .and. TotNodes .ne. 1) THEN
!Interface equations for 2 capactive materials
I=I+1
CALL IntInterfaceNodeEqns(Delt,I,Lay,Surf,SurfaceFD(Surf)%T, &
SurfaceFD(Surf)%TT, &
SurfaceFD(Surf)%Rhov, &
SurfaceFD(Surf)%RhoT, &
SurfaceFD(Surf)%RH, &
SurfaceFD(Surf)%TD, &
SurfaceFD(Surf)%TDT, &
SurfaceFD(Surf)%EnthOld, &
SurfaceFD(Surf)%EnthNew,GSiter)
ELSE IF (Lay == TotLayers) THEN
!For the Interior surface node with a convective boundary condition
I=I+1
CALL InteriorBCEqns(Delt,I,Lay,Surf, &
SurfaceFD(Surf)%T, &
SurfaceFD(Surf)%TT, &
SurfaceFD(Surf)%Rhov, &
SurfaceFD(Surf)%RhoT, &
SurfaceFD(Surf)%RH, &
SurfaceFD(Surf)%TD, &
SurfaceFD(Surf)%TDT, &
SurfaceFD(Surf)%EnthOld, &
SurfaceFD(Surf)%EnthNew, &
SurfaceFD(Surf)%TDReport)
END IF
END DO !The end of the layer loop
IF (Gsiter .gt. 5) THEN
!apply Relaxation factor for stability, use current (TDT) and previous (TDTLast) iteration temperature values
!to obtain the actual temperature that is going to be used for next iteration. THis would mostly happen with PCM
SurfaceFD(Surf)%TDT = SurfaceFD(Surf)%TDTLast+ (SurfaceFD(Surf)%TDT-SurfaceFD(Surf)%TDTLast) * 0.5d0
ENDIF
IF (Gsiter .gt. 10) THEN
!apply Relaxation factor for stability, use current (TDT) and previous (TDTLast) iteration temperature values
!to obtain the actual temperature that is going to be used for next iteration. THis would mostly happen with PCM
SurfaceFD(Surf)%TDT = SurfaceFD(Surf)%TDTLast+ (SurfaceFD(Surf)%TDT-SurfaceFD(Surf)%TDTLast) * 0.25d0
ENDIF
IF (Gsiter .gt. 15) THEN
!apply Relaxation factor for stability, use current (TDT) and previous (TDTLast) iteration temperature values
!to obtain the actual temperature that is going to be used for next iteration. THis would mostly happen with PCM
SurfaceFD(Surf)%TDT = SurfaceFD(Surf)%TDTLast+ (SurfaceFD(Surf)%TDT-SurfaceFD(Surf)%TDTLast) * 0.10d0
ENDIF
! the following could blow up when all the node temps sum to less than 1.0. seems poorly formulated for temperature in C.
!PT delete one zero and decrese number of minimum iterations, from 3 (which actually requires 4 iterations) to 2.
IF (Gsiter .gt. 2 .and.ABS(SUM(SurfaceFD(Surf)%TDT-SurfaceFD(Surf)%TDTLast)/SUM(SurfaceFD(Surf)%TDT)) < 0.00001d0 ) EXIT
!SurfaceFD(Surf)%GSloopCounter = Gsiter !PT moved out of GSloop so it can actually count all iterations
!feb2012 the following could blow up when all the node temps sum to less than 1.0. seems poorly formulated for temperature in C.
!feb2012 IF (Gsiter .gt. 3 .and.ABS(SUM(SurfaceFD(Surf)%TDT-SurfaceFD(Surf)%TDTLast)/SUM(SurfaceFD(Surf)%TDT)) < 0.000001d0 ) EXIT
!feb2012 SurfaceFD(Surf)%GSloopCounter = Gsiter
! IF ((GSiter == MaxGSiter) .AND. (SolutionAlgo /= UseCondFDSimple)) THEN ! didn't ever converge
! IF (.NOT. WarmupFlag .AND. (.NOT. KickOffSimulation)) THEN
! ErrCount=ErrCount+1
! ErrorSignal = ABS(SUM(SurfaceFD(Surf)%TDT-SurfaceFD(Surf)%TDTLast)/SUM(SurfaceFD(Surf)%TDT))
! IF (ErrCount < 10) THEN
! CALL ShowWarningError('ConductionFiniteDifference inner iteration loop did not converge for surface named ='// &
! TRIM(Surface(Surf)%Name) // &
! ', with error signal ='//TRIM(RoundSigDigits(ErrorSignal, 8)) // &
! ' vs criteria of 0.000001')
! CALL ShowContinueErrorTimeStamp(' ')
! ELSE
! CALL ShowRecurringWarningErrorAtEnd('ConductionFiniteDifference convergence problem continues for surface named ='// &
! TRIM(Surface(Surf)%Name) , &
! SurfaceFD(Surf)%GSloopErrorCount,ReportMaxOf=ErrorSignal,ReportMinOf=ErrorSignal, &
! ReportMaxUnits='[ ]',ReportMinUnits='[ ]')
! ENDIF
!
! ENDIF
!
! ENDIF
END DO ! End of Gauss Seidell iteration loop
SurfaceFD(Surf)%GSloopCounter = Gsiter !outputs GSloop iterations, useful for pinpointing stability issues with condFD
IF (CondFDRelaxFactor/=1.0d0) THEN
!apply Relaxation factor for stability, use current (TDT) and previous (TDreport) temperature values
! to obtain the actual temperature that is going to be exported/use
SurfaceFD(Surf)%TDT = SurfaceFD(Surf)%TDreport+ (SurfaceFD(Surf)%TDT-SurfaceFD(Surf)%TDreport) * CondFDRelaxFactor
SurfaceFD(Surf)%EnthOld = SurfaceFD(Surf)%EnthNew
ENDIF
END DO !The end of the Time Loop !PT solving time steps
TempSurfOutTmp = SurfaceFD(Surf)%TDT(1)
TempSurfInTmp = SurfaceFD(Surf)%TDT(TotNodes+1)
RhoVaporSurfIn(surf) = 0.0d0
! determine largest change in node temps
MaxDelTemp = 0.0d0
DO NodeNum = 1, TotNodes+1 !need to consider all nodes
MaxDelTemp = MAX(ABS(SurfaceFD(Surf)%TDT(NodeNum) - SurfaceFD(Surf)%TDreport(NodeNum)), MaxDelTemp)
ENDDO
SurfaceFD(Surf)%MaxNodeDelTemp = MaxDelTemp
! SurfaceFD(Surf)%TDOld = SurfaceFD(Surf)%TDT
SurfaceFD(Surf)%TDreport = SurfaceFD(Surf)%TDT
SurfaceFD(Surf)%EnthOld = SurfaceFD(Surf)%EnthNew
RETURN
End SUBROUTINE CalcHeatBalFiniteDiff