source: LMDZ6/trunk/libf/phylmd/borne_var_surf.f90 @ 5274

Last change on this file since 5274 was 5274, checked in by abarral, 31 hours ago

Replace yomcst.h by existing module
File size: 5.3 KB
Line 
1SUBROUTINE borne_var_surf(klon,klev,nbsrf,                   &
2         iflag_bug_t2m_stab_ipslcm61,                        &
3         t1,q1,u1,v1,                                        &
4         ftsol, qsurf, pctsrf, paprs,                        &
5         t2m, q2m, u10m, v10m,                               &
6         zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor,           &
7         zrh2m_cor, zqsat2m_cor)
8
9USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
10          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
11          , R_ecc, R_peri, R_incl                                      &
12          , RA, RG, R1SA                                         &
13          , RSIGMA                                                     &
14          , R, RMD, RMV, RD, RV, RCPD                    &
15          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
16          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
17          , RCW, RCS                                                 &
18          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
19          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
20          , RALPD, RBETD, RGAMD
21IMPLICIT NONE
22
23!==================================================================
24! Declarations
25!==================================================================
26
27! arguments
28INTEGER klon,klev,nbsrf,iflag_bug_t2m_stab_ipslcm61
29REAL,DIMENSION(klon),INTENT(IN) :: t1, q1, u1, v1
30REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: t2m, q2m, u10m, v10m
31REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol, pctsrf
32REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs
33REAL,DIMENSION(klon),INTENT(IN) :: qsurf
34REAL,DIMENSION (klon),INTENT(OUT) :: zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor
35REAL,DIMENSION (klon),INTENT(OUT)  :: zrh2m_cor, zqsat2m_cor
36
37
38! local
39INTEGER i,nsrf
40REAL,DIMENSION (klon,nbsrf) :: t2m_cor, q2m_cor, u10m_cor, v10m_cor
41REAL                               :: zx_qs1, zcor1, zdelta1
42
43include "YOETHF.h"
44include "FCTTRE.h"
45!==================================================================
46! Correction of sub surface variables
47!==================================================================
48
49zrh2m_cor=0.
50zqsat2m_cor=0.
51
52DO nsrf=1,nbsrf
53   DO i=1,klon
54    t2m_cor(i,nsrf)=t2m(i,nsrf)
55    q2m_cor(i,nsrf)=q2m(i,nsrf)
56    u10m_cor(i,nsrf)=u10m(i,nsrf)
57    v10m_cor(i,nsrf)=v10m(i,nsrf)
58     IF(iflag_bug_t2m_stab_ipslcm61.EQ.-2.AND.q2m(i,nsrf).LT.0.) THEN
59      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
60      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
61      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
62      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
63      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
64      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
65      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
66     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.-1.AND.(ftsol(i,nsrf).LE.t1(i).OR.q2m(i,nsrf).LT.0.)) THEN
67      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
68      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
69      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
70      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
71      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
72      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
73      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
74     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.1.AND.ftsol(i,nsrf).LE.t1(i)) THEN
75      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
76      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
77      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
78      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
79      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
80      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
81      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
82     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.0) THEN
83      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
84      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
85      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
86      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
87      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
88      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
89      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
90     ENDIF
91!!!
92     zdelta1 = MAX(0.,SIGN(1., rtt-t2m_cor(i,nsrf) ))
93     zx_qs1  = r2es * FOEEW(t2m_cor(i,nsrf),zdelta1)/paprs(i,1)
94     zx_qs1  = MIN(0.5,zx_qs1)
95     zcor1   = 1./(1.-RETV*zx_qs1)
96     zx_qs1  = zx_qs1*zcor1
97     zrh2m_cor(i) = zrh2m_cor(i) + q2m_cor(i,nsrf)/zx_qs1 * pctsrf(i,nsrf)
98     zqsat2m_cor(i) = zqsat2m_cor(i) + zx_qs1  * pctsrf(i,nsrf)
99!!!
100   ENDDO
101ENDDO
102
103!==================================================================
104! Agregation of sub surfaces
105!==================================================================
106
107zt2m_cor=0.
108zq2m_cor=0.
109zu10m_cor=0.
110zv10m_cor=0.
111DO nsrf = 1, nbsrf
112   DO i = 1, klon
113      zt2m_cor(i)  = zt2m_cor(i)  + t2m_cor(i,nsrf)  * pctsrf(i,nsrf)
114      zq2m_cor(i)  = zq2m_cor(i)  + q2m_cor(i,nsrf)  * pctsrf(i,nsrf)
115      zu10m_cor(i) = zu10m_cor(i) + u10m_cor(i,nsrf) * pctsrf(i,nsrf)
116      zv10m_cor(i) = zv10m_cor(i) + v10m_cor(i,nsrf) * pctsrf(i,nsrf)
117   ENDDO
118ENDDO
119
120RETURN
121END
122
123
Note: See TracBrowser for help on using the repository browser.