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) | :: | SurfNum | |||
real(kind=r64), | intent(in) | :: | TempSurfIn | |||
real(kind=r64), | intent(in) | :: | TempSurfInOld | |||
real(kind=r64), | intent(in) | :: | TempZone | |||
real(kind=r64), | intent(out) | :: | TempSat |
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 CalcMoistureBalanceEMPD(SurfNum, TempSurfIn, TempSurfInOld, TempZone, TempSat)
! SUBROUTINE INFORMATION:
! Authors: Muthusamy Swami and Lixing Gu
! Date written: August, 1999
! Modified: na
! Re-engineered: na
! PURPOSE OF THIS SUBROUTINE:
! Calculate surface moisture level using EMPD model
! METHODOLOGY EMPLOYED:
! na
! USE STATEMENTS:
USE Psychrometrics, ONLY:PsyRhFnTdbWPb,PsyRhFnTdbRhovLBnd0C,PsyWFnTdbRhPb,PsyRhoAirFnPbTdbW,PsyCpAirFnWTdb,PsyRhovFnTdbWPb
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
Integer, Intent(In) :: SurfNum
REAL(r64), Intent(In) :: TempSurfIn !INSIDE SURFACE TEMPERATURE at current time step
REAL(r64), Intent(In) :: TempSurfInOld !INSIDE SURFACE TEMPERATURE at previous time step.
REAL(r64), Intent(In) :: TempZone !Zone temperature at current time step.
REAL(r64), Intent(OUT) :: TempSat ! Satutare surface temperature.
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: Error = 0.01d0 ! Totlarence (%)
REAL(r64), PARAMETER :: RLXM = 0.3d0 ! Relaxation factor (0-1)
REAL(r64), PARAMETER :: Lam = 2.5d6 ! Heat of vaporization (J/kg)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NOFITR ! Number of iterations
INTEGER :: ZoneNum ! Surface number
INTEGER :: MatNum ! Material number at interior layer
INTEGER :: ConstrNum ! Construction number
REAL(r64) :: RHOBULK ! Material bulk density
REAL(r64) :: HM ! Moisture transfer coefficient
REAL(r64) :: Taver ! Average zone temperature between current time and previous time
! REAL(r64) :: Waver ! Average zone humidity ratio between current time and previous time
REAL(r64) :: RHaver ! Average zone relative humidity {0-1} between current time and previous time
REAL(r64) :: RVaver ! Average zone vapor density
REAL(r64) :: AT
REAL(r64) :: BR
REAL(r64) :: RALPHA ! Zone vapor density
REAL(r64) :: BB ! Coefficient for ODE
REAL(r64) :: CC ! Coefficient for ODE
REAL(r64) :: ErrorM ! Percent error
INTEGER :: Flag ! Convergence flag (0 - converged)
LOGICAL,SAVE :: OneTimeFlag = .True.
REAL(r64) :: Wsurf ! Surface moisture flux
REAL(r64) :: PVsurf ! Surface vapor pressure
! if (OneTimeFlag) then
! Call InitMoistureBalanceEMPD
! OneTimeFlag = .False.
! end if
if (BeginEnvrnFlag .and. OneTimeFlag) then
Call InitMoistureBalanceEMPD
OneTimeFlag = .False.
end if
if (.not. BeginEnvrnFlag) then
OneTimeFlag = .True.
end if
MoistEMPDFlux(SurfNum) = 0.0d0
Flag = 1
NOFITR = 0
If ( .NOT. Surface(SurfNum)%HeatTransSurf ) Then
RETURN
End If
ConstrNum = Surface(SurfNum)%Construction
MatNum = Construct(ConstrNum)%LayerPoint(Construct(ConstrNum)%TotLayers) ! Then find the material pointer
ZoneNum = Surface(SurfNum)%Zone
If (Material(MatNum)%EMPDValue .LE. 0.0d0) Then
MoistEMPDNew(SurfNum)= PsyRhovFnTdbWPb(TempZone,ZoneAirHumRat(ZoneNum),OutBaroPress,'CalcMoistureEMPD')
RETURN
End If
Taver = (TempSurfIn+TempSurfInOld)/2.0d0
DO WHILE (Flag > 0 )
RVaver = (MoistEMPDNew(SurfNum)+MoistEMPDOld(SurfNum))/2.0d0
RHaver = RVaver*461.52d0*(Taver+KelvinConv)*exp(-23.7093d0+4111.0d0/(Taver+237.7d0))
if (RHaver .GT. 1.0d0) RHaver = 1.0d0
if (RHaver .LT. 0.0d0) RHaver = 0.00001d0
AT = (Material(MatNum)%MoistACoeff*Material(MatNum)%MoistBCoeff*RHaver**Material(MatNum)%MoistBCoeff + &
Material(MatNum)%MoistCCoeff*Material(MatNum)%MoistDCoeff*RHaver**Material(MatNum)%MoistDCoeff)/RVaver
BR = (4111.0d0/(Taver+237.7d0)**2-(1.0d0/(Taver+KelvinConv)))*AT*RVaver
RHOBULK = Material(MatNum)%density
HM = HConvIn(SurfNum)/(PsyRhoAirFnPbTdbW(outbaropress,TempZone,ZoneAirHumRat(ZoneNum),'CalcMoistureEMPD') &
*PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum),TempZone,'CalcMoistureEMPD'))
ZoneNum = Surface(SurfNum)%Zone
RALPHA = ZoneAirHumRat(ZoneNum)*OutBaroPress/(461.52d0*(TempZone+KelvinConv) &
*(ZoneAirHumRat(ZoneNum)+0.62198d0))
BB = HM/(RHOBULK*Material(MatNum)%EMPDValue*AT)
CC = BB*RALPHA+BR/AT*(TempSurfIn-TempSurfInOld)/(TimeStepZone*SecInHour)
CALL SolverMoistureBalanceEMPD (MoistEMPDNew(SurfNum),MoistEMPDOld(SurfNum), &
1.0d0,BB,CC)
Flag = 0
ERRORM = ABS((MoistEMPDNew(SurfNum)-MoistEMPDInt(SurfNum))/MoistEMPDInt(SurfNum))*100.0d0
IF (ERRORM .GT. ERROR) Flag = Flag+1
NOFITR = NOFITR+1
IF (NOFITR .GT. 500) THEN
CALL ShowFatalError('Iteration limit exceeded in EMPD model, program terminated.')
ENDIF
if (Flag > 0) then
MoistEMPDNew(SurfNum) = MoistEMPDNew(SurfNum)*RLXM + &
MoistEMPDInt(SurfNum)*(1.0-RLXM)
End If
MoistEMPDInt(SurfNum) = MoistEMPDNew(SurfNum)
END DO
! Calculate latent load
PVsurf = RHaver*exp(23.7093d0-4111.0d0/(Taver+237.7d0))
Wsurf = 0.62198*RHaver/(exp(-23.7093d0+4111.0d0/(Taver+237.7d0))*OutBaroPress-RHaver)
MoistEMPDFlux(SurfNum) = HM*(MoistEMPDNew(SurfNum)- &
PsyRhoAirFnPbTdbW(OutBaroPress, TempZone, ZoneAirHumRat(ZoneNum),'CalcMoistureEMPD')* &
ZoneAirHumRat(ZoneNum))*Lam
! Calculate surface dew point temperature based on surface vapor density
TempSat = 4111.0d0/(23.7093d0-LOG(PVsurf))+35.45d0-KelvinConv
! Put results in the single precision reporting variable
RhoVapEMPD(SurfNum) = MoistEMPDNew(SurfNum)
RHEMPD(SurfNum) = PsyRhFnTdbRhovLBnd0C(TempSurfIn,RhoVapEMPD(SurfNum),'CalcMoistureEMPD')*100.0d0
WSurfEMPD(SurfNum) = PsyWFnTdbRhPb(TempSurfIn,RHEMPD(SurfNum)/100.0,OutBaroPress,'CalcMoistureEMPD')
RETURN
END SUBROUTINE CalcMoistureBalanceEMPD