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) | :: | sid | |||
| 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 CalcHeatBalHAMT(sid,TempSurfInTmp,TempSurfOutTmp)
! SUBROUTINE INFORMATION:
! AUTHOR Phillip Biddulph
! DATE WRITTEN June 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! To calculate the heat and moisture transfer through the surface
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
USE DataSurfaces, ONLY: OtherSideCondModeledExt, OSCM
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(in) :: sid
REAL(r64), INTENT(inout) :: TempSurfInTmp
REAL(r64), INTENT(inout) :: TempSurfOutTmp
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: TempSurfInP
REAL(r64) :: RhoIn
REAL(r64) :: RhoOut
REAL(r64) :: torsum
REAL(r64) :: oorsum
REAL(r64) :: phioosum
REAL(r64) :: phiorsum
REAL(r64) :: vpoosum
REAL(r64) :: vporsum
REAL(r64) :: rhr1
REAL(r64) :: rhr2
REAL(r64) :: wcap
REAL(r64) :: thermr1
REAL(r64) :: thermr2
REAL(r64) :: tcap
REAL(r64) :: qvp
REAL(r64) :: vaporr1
REAL(r64) :: vaporr2
REAL(r64) :: vpdiff
REAL(r64) :: sumtp1
REAL(r64) :: tempmax
REAL(r64) :: tempmin
INTEGER :: ii
INTEGER :: matid
INTEGER :: itter
INTEGER :: cid
!unused1208 INTEGER :: cid1
INTEGER :: adj
INTEGER :: adjl
! INTEGER, SAVE :: tempErrCount=0
INTEGER, SAVE :: qvpErrCount=0
! INTEGER, SAVE :: tempErrReport=0
INTEGER, SAVE :: qvpErrreport=0
REAL(r64) :: denominator
IF(BeginEnvrnFlag .AND. MyEnvrnFlag(sid))THEN
cells(Extcell(sid))%rh=0.0D0
cells(Extcell(sid))%rhp1=0.0D0
cells(Extcell(sid))%rhp2=0.0D0
cells(Extcell(sid))%temp=10.0D0
cells(Extcell(sid))%tempp1=10.0D0
cells(Extcell(sid))%tempp2=10.0D0
cells(Intcell(sid))%rh=0.0D0
cells(Intcell(sid))%rhp1=0.0D0
cells(Intcell(sid))%rhp2=0.0D0
cells(Intcell(sid))%temp=10.0D0
cells(Intcell(sid))%tempp1=10.0D0
cells(Intcell(sid))%tempp2=10.0D0
DO cid=Extcell(sid)+1,Intcell(sid)-1
matid=cells(cid)%matid
cells(cid)%temp=Material(matid)%itemp
cells(cid)%tempp1=Material(matid)%itemp
cells(cid)%tempp2=Material(matid)%itemp
cells(cid)%rh=Material(matid)%irh
cells(cid)%rhp1=Material(matid)%irh
cells(cid)%rhp2=Material(matid)%irh
ENDDO
MyEnvrnFlag(sid)=.FALSE.
ENDIF
IF(.NOT. BeginEnvrnFlag)THEN
MyEnvrnFlag(sid)=.TRUE.
ENDIF
! Set all the boundary values
cells(ExtRadcell(sid))%temp=TempOutsideAirFD(sid)
cells(ExtConcell(sid))%temp=TempOutsideAirFD(sid)
IF (Surface(sid)%ExtBoundCond == OtherSideCondModeledExt) THEN
!CR8046 switch modeled rad temp for sky temp.
cells(ExtSkycell(sid))%temp = OSCM(Surface(sid)%OSCMPtr)%TRad
cells(Extcell(sid))%Qadds= 0.0D0 ! eliminate incident shortwave on underlying surface
ELSE
cells(ExtSkycell(sid))%temp = SkyTemp
cells(Extcell(sid))%Qadds=Surface(sid)%Area*QRadSWOutAbs(sid)
ENDIF
cells(ExtGrncell(sid))%temp=TempOutsideAirFD(sid)
RhoOut=RhoVaporAirOut(sid)
! Special case when the surface is an internal mass
IF (Surface(sid)%ExtBoundCond == sid) THEN
cells(ExtConcell(sid))%temp= Mat(Surface(sid)%Zone)
RhoOut=RhoVaporAirIn(sid)
ENDIF
RhoIn=RhoVaporAirIn(sid)
cells(ExtRadcell(sid))%htc=HAirFD(sid)
cells(ExtConcell(sid))%htc=HConvExtFD(sid)
cells(ExtSkycell(sid))%htc=HSkyFD(sid)
cells(ExtGrncell(sid))%htc=HGrndFD(sid)
cells(IntConcell(sid))%temp=Mat(Surface(sid)%Zone)
cells(IntConcell(sid))%htc=HConvInFD(sid)
cells(Intcell(sid))%Qadds= &
Surface(sid)%Area*(QRadSWInAbs(sid)+NetLWRadToSurf(sid)+QHtRadSysSurf(sid)+QHWBaseboardSurf(sid)+ &
QSteamBaseboardSurf(sid)+QElecBaseboardSurf(sid)+QRadThermInAbs(sid))
! Check, Is this per unit area or for the whole wall.
! cells(Intcell(sid))%Qadds=QRadSWInAbs(sid)+NetLWRadToSurf(sid)+QHtRadSysSurf(sid)+QRadThermInAbs(sid)
cells(ExtConcell(sid))%rh=PsyRhFnTdbRhov(cells(ExtConcell(sid))%temp,RhoOut,'HAMT-Ext')
cells(IntConcell(sid))%rh=PsyRhFnTdbRhov(cells(IntConcell(sid))%temp,RhoIn,'HAMT-Int')
IF(cells(ExtConcell(sid))%rh>rhmax)THEN
cells(ExtConcell(sid))%rh=rhmax
ENDIF
IF(cells(IntConcell(sid))%rh>rhmax)THEN
cells(IntConcell(sid))%rh=rhmax
ENDIF
! PDB August 2009 Start! Correction for when no vapour transfer coefficient have been defined.
IF(extvtcflag(sid))THEN
cells(ExtConcell(sid))%vtc=extvtc(sid)
ELSE
IF(cells(ExtConcell(sid))%rh>0)THEN
cells(ExtConcell(sid))%vtc= &
HMassConvExtFD(sid)*RhoOut/(PsyPsatFnTemp(TempOutsideAirFD(sid))*cells(ExtConcell(sid))%rh)
ELSE
cells(ExtConcell(sid))%vtc=10000.0d0
ENDIF
ENDIF
IF(intvtcflag(sid))THEN
cells(IntConcell(sid))%vtc=intvtc(sid)
HMassConvInFD(sid)= &
cells(IntConcell(sid))%vtc*PsyPsatFnTemp(Mat(Surface(sid)%Zone))*cells(IntConcell(sid))%rh/RhoIn
ELSE
IF(cells(IntConcell(sid))%rh>0)THEN
cells(IntConcell(sid))%vtc= &
HMassConvInFD(sid)*RhoIn/(PsyPsatFnTemp(Mat(Surface(sid)%Zone))*cells(IntConcell(sid))%rh)
ELSE
cells(IntConcell(sid))%vtc= 10000.0d0
ENDIF
ENDIF
! PDB August 2009 End
! Initialise
DO cid=firstcell(sid),Extcell(sid)-1
cells(cid)%tempp1=cells(cid)%temp
cells(cid)%tempp2=cells(cid)%temp
cells(cid)%rhp1=cells(cid)%rh
cells(cid)%rhp2=cells(cid)%rh
ENDDO
DO cid=Intcell(sid)+1,lastcell(sid)
cells(cid)%tempp1=cells(cid)%temp
cells(cid)%tempp2=cells(cid)%temp
cells(cid)%rhp1=cells(cid)%rh
cells(cid)%rhp2=cells(cid)%rh
ENDDO
itter=0
DO
itter=itter+1
! Update Moisture values
DO cid=firstcell(sid),lastcell(sid)
matid=cells(cid)%matid
cells(cid)%vp=RHTOVP(cells(cid)%rh,cells(cid)%temp)
cells(cid)%vpp1=RHTOVP(cells(cid)%rhp1,cells(cid)%tempp1)
cells(cid)%vpsat=PsyPsatFnTemp(cells(cid)%tempp1)
IF(matid>0)THEN
CALL interp(Material(matid)%niso,Material(matid)%isorh,Material(matid)%isodata,cells(cid)%rhp1, &
cells(cid)%water,cells(cid)%dwdphi)
IF(IsRain.AND.rainswitch)THEN
CALL interp(Material(matid)%nsuc,Material(matid)%sucwater,Material(matid)%sucdata,cells(cid)%water, &
cells(cid)%dw)
ELSE
CALL interp(Material(matid)%nred,Material(matid)%redwater,Material(matid)%reddata,cells(cid)%water, &
cells(cid)%dw)
ENDIF
CALL interp(Material(matid)%nmu,Material(matid)%murh,Material(matid)%mudata,cells(cid)%rhp1, &
cells(cid)%mu)
CALL interp(Material(matid)%ntc,Material(matid)%tcwater,Material(matid)%tcdata,cells(cid)%water, &
cells(cid)%wthermalc)
ENDIF
ENDDO
!Calculate Heat and Vapor resistances,
DO cid=Extcell(sid),Intcell(sid)
torsum=0.0D0
oorsum=0.0D0
vpdiff=0.0D0
DO ii=1,adjmax
adj=cells(cid)%adjs(ii)
adjl=cells(cid)%adjsl(ii)
IF(adj==-1)EXIT
IF(cells(cid)%htc>0)THEN
thermr1=1.0D0/(cells(cid)%overlap(ii)*cells(cid)%htc)
ELSE IF(cells(cid)%matid>0)THEN
thermr1=cells(cid)%dist(ii)/(cells(cid)%overlap(ii)*cells(cid)%wthermalc)
ELSE
thermr1=0.0D0
ENDIF
IF(cells(cid)%vtc>0)THEN
vaporr1=1.0d0/(cells(cid)%overlap(ii)*cells(cid)%vtc)
ELSE IF(cells(cid)%matid>0)THEN
vaporr1=(cells(cid)%dist(ii)*cells(cid)%mu)/(cells(cid)%overlap(ii)*WVDC(cells(cid)%tempp1,OutBaroPress))
ELSE
vaporr1=0.0D0
ENDIF
IF(cells(adj)%htc>0)THEN
thermr2=1.0D0/(cells(cid)%overlap(ii)*cells(adj)%htc)
ELSE IF(cells(adj)%matid>0)THEN
thermr2=cells(adj)%dist(adjl)/(cells(cid)%overlap(ii)*cells(adj)%wthermalc)
ELSE
thermr2=0.0D0
ENDIF
IF(cells(adj)%vtc>0)THEN
vaporr2=1.0D0/(cells(cid)%overlap(ii)*cells(adj)%vtc)
ELSE IF(cells(adj)%matid>0)THEN
vaporr2=cells(adj)%mu*cells(adj)%dist(adjl)/(WVDC(cells(adj)%tempp1,OutBaroPress)*cells(cid)%overlap(ii))
ELSE
vaporr2=0.0D0
ENDIF
IF(thermr1+thermr2>0)THEN
oorsum=oorsum+1.0D0/(thermr1+thermr2)
torsum=torsum+cells(adj)%tempp1/(thermr1+thermr2)
ENDIF
IF(vaporr1+vaporr2>0)THEN
vpdiff=vpdiff+(cells(adj)%vp-cells(cid)%vp)/(vaporr1+vaporr2)
ENDIF
ENDDO
! Calculate Heat Capacitance
tcap=((cells(cid)%density*cells(cid)%spech+cells(cid)%water*wspech)*cells(cid)%volume)
! calculate the latent heat if wanted and check for divergence
qvp=0.0D0
IF((cells(cid)%matid>0).AND.(latswitch))THEN
qvp=vpdiff*whv
ENDIF
IF(ABS(qvp)>qvplim)THEN
IF(.NOT. WarmupFlag)THEN
qvpErrCount=qvpErrCount+1
IF(qvpErrCount < 16)THEN
CALL ShowWarningError('HeatAndMoistureTransfer: Large Latent Heat for Surface '//TRIM(Surface(sid)%Name))
ELSE
CALL ShowRecurringWarningErrorAtEnd('HeatAndMoistureTransfer: Large Latent Heat Errors ',qvpErrReport)
ENDIF
ENDIF
qvp=0.0D0
ENDIF
! Calculate the temperature for the next time step
cells(cid)%tempp1=(torsum+qvp+cells(cid)%Qadds+(tcap*cells(cid)%temp/deltat))/(oorsum+(tcap/deltat))
ENDDO
!Check for silly temperatures
tempmax=MAXVAL(cells%tempp1)
tempmin=MINVAL(cells%tempp1)
IF(tempmax>MaxSurfaceTempLimit)THEN
IF (.NOT. WarmupFlag)THEN
IF (Surface(sid)%HighTempErrCount == 0) THEN
CALL ShowSevereMessage('HAMT: Temperature (high) out of bounds ('//TRIM(RoundSigDigits(tempmax,2))// &
') for surface='//TRIM(Surface(sid)%Name))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('HAMT: Temperature Temperature (high) out of bounds; Surface='// &
TRIM(Surface(sid)%Name), &
Surface(sid)%HighTempErrCount,ReportMinOf=tempmax,ReportMinUnits='C', &
ReportMaxOf=tempmax,ReportMaxUnits='C')
ENDIF
ENDIF
IF(tempmax>MaxSurfaceTempLimitBeforeFatal)THEN
IF (.NOT. WarmupFlag)THEN
CALL ShowSevereError('HAMT: HAMT: Temperature (high) out of bounds ( '//TRIM(RoundSigDigits(tempmax,2))// &
') for surface='//TRIM(Surface(sid)%Name))
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowFatalError('Program terminates due to preceding condition.')
ENDIF
ENDIF
IF(tempmin<MinSurfaceTempLimit)THEN
IF (.NOT. WarmupFlag)THEN
IF (Surface(sid)%HighTempErrCount == 0) THEN
CALL ShowSevereMessage('HAMT: Temperature (low) out of bounds ('//TRIM(RoundSigDigits(tempmin,2))// &
') for surface='//TRIM(Surface(sid)%Name))
CALL ShowContinueErrorTimeStamp(' ')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('HAMT: Temperature Temperature (high) out of bounds; Surface='// &
TRIM(Surface(sid)%Name), &
Surface(sid)%HighTempErrCount,ReportMinOf=tempmin,ReportMinUnits='C', &
ReportMaxOf=tempmin,ReportMaxUnits='C')
ENDIF
ENDIF
IF(tempmin<MinSurfaceTempLimitBeforeFatal)THEN
IF (.NOT. WarmupFlag)THEN
CALL ShowSevereError('HAMT: HAMT: Temperature (low) out of bounds ( '//TRIM(RoundSigDigits(tempmin,2))// &
') for surface='//TRIM(Surface(sid)%Name))
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowFatalError('Program terminates due to preceding condition.')
ENDIF
ENDIF
! Calculate the liquid and vapor resisitances
DO cid=Extcell(sid),Intcell(sid)
phioosum=0.0d0
phiorsum=0.0d0
vpoosum=0.0d0
vporsum=0.0d0
DO ii=1,adjmax
adj=cells(cid)%adjs(ii)
adjl=cells(cid)%adjsl(ii)
IF(adj==-1)EXIT
IF(cells(cid)%vtc>0)THEN
vaporr1=1.0d0/(cells(cid)%overlap(ii)*cells(cid)%vtc)
ELSE IF(cells(cid)%matid>0)THEN
vaporr1=(cells(cid)%dist(ii)*cells(cid)%mu)/(cells(cid)%overlap(ii)*WVDC(cells(cid)%tempp1,OutBaroPress))
ELSE
vaporr1=0.0d0
ENDIF
IF(cells(adj)%vtc>0)THEN
vaporr2=1.0d0/(cells(cid)%overlap(ii)*cells(adj)%vtc)
ELSE IF(cells(adj)%matid>0)THEN
vaporr2=(cells(adj)%dist(adjl)*cells(adj)%mu)/(cells(cid)%overlap(ii)*WVDC(cells(adj)%tempp1,OutBaroPress))
ELSE
vaporr2=0.0d0
ENDIF
IF(vaporr1+vaporr2>0)THEN
vpoosum=vpoosum+1.0d0/(vaporr1+vaporr2)
vporsum=vporsum+(cells(adj)%vpp1/(vaporr1+vaporr2))
ENDIF
IF((cells(cid)%dw>0).AND.(cells(cid)%dwdphi>0))THEN
rhr1=cells(cid)%dist(ii)/(cells(cid)%overlap(ii)*cells(cid)%dw*cells(cid)%dwdphi)
ELSE
rhr1=0.0d0
ENDIF
IF((cells(adj)%dw>0).AND.(cells(adj)%dwdphi>0))THEN
rhr2=cells(adj)%dist(adjl)/(cells(cid)%overlap(ii)*cells(adj)%dw*cells(adj)%dwdphi)
ELSE
rhr2=0.0d0
ENDIF
! IF(rhr1+rhr2>0)THEN
IF(rhr1*rhr2>0)THEN
phioosum=phioosum+1.0d0/(rhr1+rhr2)
phiorsum=phiorsum+(cells(adj)%rhp1/(rhr1+rhr2))
ENDIF
ENDDO
! Moisture Capacitance
IF(cells(cid)%dwdphi>0.0d0)THEN
wcap=cells(cid)%dwdphi*cells(cid)%volume
ELSE
wcap=0.0d0
ENDIF
! Calculate the RH for the next time step
denominator=(phioosum+vpoosum*cells(cid)%vpsat+wcap/deltat)
if (denominator /= 0.0d0) then
cells(cid)%rhp1=(phiorsum+vporsum+(wcap*cells(cid)%rh)/deltat)/denominator
else
call ShowSevereError('CalcHeatBalHAMT: demoninator in calculating RH is zero. Check material properties for accuracy.')
call ShowContinueError('...Problem occurs in Material="'//trim(Material(cells(cid)%MatID)%Name)//'".')
call ShowFatalError('Program terminates due to preceding condition.')
endif
IF(cells(cid)%rhp1>rhmax)THEN
cells(cid)%rhp1=rhmax
ENDIF
ENDDO
!Check for convergence or too many itterations
sumtp1=0.0d0
DO cid=Extcell(sid),Intcell(sid)
IF(sumtp1<ABS(cells(cid)%tempp2-cells(cid)%tempp1))THEN
sumtp1=ABS(cells(cid)%tempp2-cells(cid)%tempp1)
ENDIF
ENDDO
IF(sumtp1<convt)THEN
EXIT
ENDIF
IF(itter>ittermax)THEN
EXIT
ENDIF
DO cid=firstcell(sid),lastcell(sid)
cells(cid)%tempp2=cells(cid)%tempp1
cells(cid)%rhp2=cells(cid)%rhp1
ENDDO
ENDDO
! report back to CalcHeatBalanceInsideSurf
TempSurfOutTmp=cells(Extcell(sid))%tempp1
TempSurfInTmp=cells(Intcell(sid))%tempp1
TempSurfInP=cells(Intcell(sid))%rhp1*PsyPsatFnTemp(cells(Intcell(sid))%tempp1)
RhoVaporSurfIn(sid)=TempSurfInP/(461.52d0*(Mat(Surface(sid)%Zone)+KelvinConv))
END SUBROUTINE CalcHeatBalHAMT