source: lmdz_wrf/trunk/WRFV3/phys/module_sf_sfcdiags_ruclsm.F @ 1531

Last change on this file since 1531 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 6.1 KB
Line 
1!WRF:MODEL_LAYER:PHYSICS
2!
3MODULE module_sf_sfcdiags_ruclsm
4
5CONTAINS
6
7   SUBROUTINE SFCDIAGS_RUCLSM(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,       &
8                     T3D,QV3D,RHO3D,P3D,                           &
9                     PSFC,CP,R_d,ROVCP,                            &
10                     ids,ide, jds,jde, kds,kde,                    &
11                     ims,ime, jms,jme, kms,kme,                    &
12                     its,ite, jts,jte, kts,kte                     )
13!-------------------------------------------------------------------
14      IMPLICIT NONE
15!-------------------------------------------------------------------
16      INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
17                                        ims,ime, jms,jme, kms,kme, &
18                                        its,ite, jts,jte, kts,kte
19      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
20                INTENT(IN)                  ::                HFX, &
21                                                              QFX, &
22                                                              TSK, &
23                                                             QSFC
24      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
25                INTENT(INOUT)               ::                 Q2, &
26                                                              TH2, &
27                                                              T2
28      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
29                INTENT(IN)                  ::               PSFC, &
30                                                             CHS2, &
31                                                             CQS2
32      REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
33               INTENT(IN   )    ::                           QV3D, &
34                                                              T3D, &
35                                                              P3D, &
36                                                            rho3D
37
38      REAL,     INTENT(IN   )               ::       CP,R_d,ROVCP
39! LOCAL VARS
40      INTEGER ::  I,J
41      REAL    ::  RHO, x2m, qlev1, tempc, qsat, p2m
42
43
44      DO J=jts,jte
45        DO I=its,ite
46!          RHO = PSFC(I,J)/(R_d * TSK(I,J))
47          RHO = RHO3D(i,1,j)
48          P2m = PSFC(I,J)*EXP(-0.068283/t3d(i,1,j))
49
50          if(CHS2(I,J).lt.1.E-5) then
51!             TH2(I,J) = TSK(I,J)*(1.E5/PSFC(I,J))**ROVCP
52             TH2(I,J) = t3d(i,1,j)*(1.E5/P2m)**ROVCP
53          else
54             TH2(I,J) = TSK(I,J)*(1.E5/PSFC(I,J))**ROVCP - HFX(I,J)/(RHO*CP*CHS2(I,J))
55!tgs             T2(I,J) = TSK(I,J) - HFX(I,J)/(RHO*CP*CHS2(I,J))
56          endif
57!tgs             TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**ROVCP
58             T2(I,J) = TH2(I,J)*(1.E-5*P2m)**ROVCP
59!tgs check that T2 values lie in the range between TSK and T at the 1st level
60             x2m     = MAX(MIN(tsk(i,j),t3d(i,1,j)) , t2(i,j))
61             t2(i,j) = MIN(MAX(tsk(i,j),t3d(i,1,j)) , x2m)
62
63             TH2(I,J) = T2(I,J)*(1.E5/P2m)**ROVCP
64
65!tgs check that Q2 values in the lie between QSFC and Q at the 1st level
66             qlev1 = qv3d(i,1,j)
67!tgs saturation check
68             tempc=t3d(i,1,j)-273.15
69           if (tempc .le. 0.0) then
70! qsat - mixing ratio
71             qsat = rsif(p3d(i,1,j), t3d(i,1,j))
72           else
73             qsat = rslf(p3d(i,1,j), t3d(i,1,j))
74           endif
75             qlev1 = min(qsat, qlev1)
76
77          if(CQS2(I,J).lt.1.E-5) then
78!tgs - here Q2 is 2-m water vapor mixing ratio
79             Q2(I,J)=qlev1
80          else
81             x2m = QSFC(I,J) - QFX(I,J)/(RHO*CQS2(I,J))
82             Q2(I,J)=x2m/(1.-x2m)
83          endif
84
85             x2m     = MAX(MIN(qsfc(i,j)/(1.-qsfc(i,j)),qlev1) , q2(i,j))
86             q2(i,j) = MIN(MAX(qsfc(i,j)/(1.-qsfc(i,j)),qlev1) , x2m)
87!tgs saturation check
88             tempc=t2(i,j)-273.15
89           if (tempc .le. 0.0) then
90! qsat - mixing ratio
91             qsat = rsif(psfc(i,j), t2(i,j))
92           else
93             qsat = rslf(psfc(i,j), t2(i,j))
94           endif
95           
96             q2(i,j) = min(qsat, q2(i,j))
97
98        ENDDO
99      ENDDO
100
101  END SUBROUTINE SFCDIAGS_RUCLSM
102
103!tgs - saturation functions are from Thompson microphysics scheme
104      REAL FUNCTION RSLF(P,T)
105
106      IMPLICIT NONE
107      REAL, INTENT(IN):: P, T
108      REAL:: ESL,X
109      REAL, PARAMETER:: C0= .611583699E03
110      REAL, PARAMETER:: C1= .444606896E02
111      REAL, PARAMETER:: C2= .143177157E01
112      REAL, PARAMETER:: C3= .264224321E-1
113      REAL, PARAMETER:: C4= .299291081E-3
114      REAL, PARAMETER:: C5= .203154182E-5
115      REAL, PARAMETER:: C6= .702620698E-8
116      REAL, PARAMETER:: C7= .379534310E-11
117      REAL, PARAMETER:: C8=-.321582393E-13
118
119      X=MAX(-80.,T-273.16)
120
121!      ESL=612.2*EXP(17.67*X/(T-29.65))
122      ESL=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8)))))))
123      RSLF=.622*ESL/(P-ESL)
124
125      END FUNCTION RSLF
126!
127!    ALTERNATIVE
128!  ; Source: Murphy and Koop, Review of the vapour pressure of ice and
129!             supercooled water for atmospheric applications, Q. J. R.
130!             Meteorol. Soc (2005), 131, pp. 1539-1565.
131!    Psat = EXP(54.842763 - 6763.22 / T - 4.210 * ALOG(T) + 0.000367 * T
132!         + TANH(0.0415 * (T - 218.8)) * (53.878 - 1331.22
133!         / T - 9.44523 * ALOG(T) + 0.014025 * T))
134!
135!+---+-----------------------------------------------------------------+
136! THIS FUNCTION CALCULATES THE ICE SATURATION VAPOR MIXING RATIO AS A
137! FUNCTION OF TEMPERATURE AND PRESSURE
138!
139      REAL FUNCTION RSIF(P,T)
140
141      IMPLICIT NONE
142      REAL, INTENT(IN):: P, T
143      REAL:: ESI,X
144      REAL, PARAMETER:: C0= .609868993E03
145      REAL, PARAMETER:: C1= .499320233E02
146      REAL, PARAMETER:: C2= .184672631E01
147      REAL, PARAMETER:: C3= .402737184E-1
148      REAL, PARAMETER:: C4= .565392987E-3
149      REAL, PARAMETER:: C5= .521693933E-5
150      REAL, PARAMETER:: C6= .307839583E-7
151      REAL, PARAMETER:: C7= .105785160E-9
152      REAL, PARAMETER:: C8= .161444444E-12
153
154      X=MAX(-80.,T-273.16)
155      ESI=C0+X*(C1+X*(C2+X*(C3+X*(C4+X*(C5+X*(C6+X*(C7+X*C8)))))))
156      RSIF=.622*ESI/(P-ESI)
157
158      END FUNCTION RSIF
159
160END MODULE module_sf_sfcdiags_ruclsm
Note: See TracBrowser for help on using the repository browser.