| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=r64), | intent(in) | :: | g | |||
| real(kind=r64), | intent(inout) | :: | Rho | |||
| real(kind=r64), | intent(in) | :: | Z | |||
| real(kind=r64), | intent(inout) | :: | T | |||
| real(kind=r64), | intent(inout) | :: | X | |||
| real(kind=r64), | intent(out) | :: | Dp | |||
| integer, | intent(in) | :: | zone | |||
| real(kind=r64), | intent(in) | :: | Pz | |||
| real(kind=r64), | intent(in) | :: | Pbz | |||
| real(kind=r64), | intent(out) | :: | RhoDr |
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 LClimb(G,Rho,Z,T,X,Dp,zone,Pz,Pbz,RhoDr)
! FUNCTION INFORMATION:
! AUTHOR Lixing Gu
! DATE WRITTEN Oct. 2005
! MODIFIED na
! RE-ENGINEERED This subroutine is revised based on subroutine IClimb from COMIS
! PURPOSE OF THIS SUBROUTINE:
! This function the differential pressure from the reflevel in a zone To Z, the level of a link
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: g ! gravity field strength [N/kg]
REAL(r64), INTENT(INOUT) :: Rho ! Density link level (initialized with rho zone) [kg/m3]
REAL(r64), INTENT(IN) :: Z ! Height of the link above the zone reference [m]
REAL(r64), INTENT(INOUT) :: T ! temperature at link level [C]
REAL(r64), INTENT(INOUT) :: X ! absolute humidity at link level [kg/kg]
REAL(r64), INTENT(OUT) :: Dp ! Stackpressure to the linklevel [Pa]
INTEGER, INTENT(IN) :: zone ! Zone number
REAL(r64), INTENT(IN) :: Pz ! Zone Pressure (reflevel) [Pa]
REAL(r64), INTENT(IN) :: Pbz ! Barometric pressure at entrance level [Pa]
REAL(r64), INTENT(OUT) :: RhoDr ! Air density of dry air on the link level used
! for the concentration routine [kg/m3]
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) H ! Start Height of the layer
REAL(r64) BetaT ! Temperature gradient of this layer
REAL(r64) BetaXfct ! Humidity gradient factor of this layer
REAL(r64) BetaCfct ! Concentration 1 gradient factor of this layer
REAL(r64) X0
REAL(r64) P,Htop,Hbot
REAL(r64) Rho0,Rho1,Betarho
INTEGER :: L=0
INTEGER :: ilayptr=0
! FLOW:
Dp=0.0d0
Rho0=Rho
x0=x
IF (Z.GT.0.0d0) THEN
! initialize start values
H=0.0d0
BetaT=0.0d0
BetaXfct=0.0d0
BetaCfct=0.0d0
BetaRho=0.0d0
Hbot=0.0d0
DO WHILE (H.LT.0.0d0)
! loop until H>0 ; The start of the layer is above 0
BetaT=0.0d0
BetaXfct=0.0d0
BetaCfct=0.0d0
L=L+9
ilayptr = 0
if (zone .eq. 0) ilayptr = 9
IF (L.GE.ilayptr) THEN
H=Z+1.0d0
ELSE
H=0.0d0
ENDIF
END DO
! The link is in this layer also if it is on the top of it.
DO
IF (H.GE.Z) THEN
! the link ends in this layer , we reached the final Dp and BetaRho
Htop=Z
P=Pz+Dp
IF (Htop.NE.Hbot)THEN
Rho0 = PsyRhoAirFnPbTdbW(Pbz+p,t,x)
T=T+(Htop-Hbot)*BetaT
X=X+(Htop-Hbot)*BetaXfct*X0
Rho1 = PsyRhoAirFnPbTdbW(Pbz+p,t,x)
BetaRho=(Rho1-Rho0)/(Htop-Hbot)
Dp=Dp+psz(Pbz+p,Rho0,BetaRho,Hbot,Htop,G)
ENDIF
Rhodr = PsyRhoAirFnPbTdbW(Pbz+pz+dp,t,x)
Rho = PsyRhoAirFnPbTdbW(Pbz+pz+dp,t,x)
RETURN
ELSE
! bottom of the layer is below Z (Z above ref)
Htop=H
! P is the pressure up to the start height of the layer we just reached
P=Pz+dp
IF (Htop.NE.Hbot)THEN
Rho0 = PsyRhoAirFnPbTdbW(Pbz+p,t,x)
T=T+(Htop-Hbot)*BetaT
X=X+(Htop-Hbot)*BetaXfct*X0
Rho1 = PsyRhoAirFnPbTdbW(Pbz+p,t,x)
BetaRho=(Rho1-Rho0)/(Htop-Hbot)
Dp=Dp+psz(Pbz+p,Rho0,BetaRho,Hbot,Htop,G)
ENDIF
Rhodr = PsyRhoAirFnPbTdbW(Pbz+pz+dp,t,x)
Rho = PsyRhoAirFnPbTdbW(Pbz+pz+dp,t,x)
! place current values Hbot and Beta's
Hbot=H
BetaT=0.0d0
BetaXfct=0.0d0
BetaCfct=0.0d0
L=L+9
ilayptr = 0
if (zone .eq. 0) ilayptr = 9
IF (L.GE.ilayptr) THEN
H=Z+1.0d0
ELSE
H=0.0d0
ENDIF
ENDIF
END DO
ELSE
! This is the ELSE for negative linkheights Z below the refplane
H=0.0d0
BetaT=0.0d0
BetaXfct=0.0d0
BetaCfct=0.0d0
BetaRho=0.0d0
Htop=0.0d0
DO WHILE (H.GT.0.0d0)
! loop until H<0 ; The start of the layer is below the zone refplane
L=L-9
ilayptr = 0
if (zone .eq. 0) ilayptr = 1
IF (L.LT.ilayptr) THEN
! with H=Z (negative) this loop will exit, no data for interval Z-refplane
H=Z
BetaT=0.0d0
BetaXfct=0.0d0
BetaCfct=0.0d0
BetaRho=0.0d0
ELSE
H=0.0d0
BetaT=0.0d0
BetaXfct=0.0d0
BetaCfct=0.0d0
ENDIF
END DO
! The link is in this layer also if it is on the bottom of it.
DO
IF (H.LE.Z) THEN
Hbot=Z
P=Pz+dp
IF (Htop.NE.Hbot)THEN
Rho1 = PsyRhoAirFnPbTdbW(Pbz+p,t,x)
T=T+(Hbot-Htop)*BetaT
X=X+(Hbot-Htop)*BetaXfct*X0
Rho0 = PsyRhoAirFnPbTdbW(Pbz+p,t,x)
BetaRho=(Rho1-Rho0)/(Htop-Hbot)
Dp=Dp-psz(Pbz+p,Rho0,BetaRho,Hbot,Htop,G)
ENDIF
Rhodr = PsyRhoAirFnPbTdbW(Pbz+pz+dp,t,x)
Rho = PsyRhoAirFnPbTdbW(Pbz+pz+dp,t,x)
RETURN
ELSE
! bottom of the layer is below Z (Z below ref)
Hbot=H
P=Pz+dp
IF (Htop.NE.Hbot)THEN
Rho1 = PsyRhoAirFnPbTdbW(Pbz+p,t,x)
! T,X,C calculated for the lower height
T=T+(Hbot-Htop)*BetaT
X=X+(Hbot-Htop)*BetaXfct*X0
Rho0 = PsyRhoAirFnPbTdbW(Pbz+p,t,x)
BetaRho=(Rho1-Rho0)/(htop-hbot)
Dp=Dp-psz(Pbz+p,Rho0,BetaRho,Hbot,Htop,G)
ENDIF
Rhodr = PsyRhoAirFnPbTdbW(Pbz+pz+dp,t,x)
Rho = PsyRhoAirFnPbTdbW(Pbz+pz+dp,t,x)
! place current values Hbot and Beta's
Htop=H
L=L-9
ilayptr = 0
if (zone .eq. 0) ilayptr = 1
IF (L.LT.ilayptr) THEN
H=Z-1.0d0
BetaT=0.0d0
BetaXfct=0.0d0
BetaCfct=0.0d0
ELSE
H=0.0d0
BetaT=0.0d0
BetaXfct=0.0d0
BetaCfct=0.0d0
ENDIF
ENDIF
! ENDIF H<Z
END DO
ENDIF
RETURN
END SUBROUTINE LClimb