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

Last change on this file since 5433 was 5390, checked in by yann meurdesoif, 3 weeks ago
  • Remove UTF8 character that inihibit fortran parsing with GPU morphosis
  • Add missing END SUBROUTINE instead of simple END, that inhibit correct parsing with regulat expression parser (quick and dirty parsing)

YM
File size: 4.5 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
10USE yoethf_mod_h
11IMPLICIT NONE
12
13!==================================================================
14! Declarations
15!==================================================================
16
17! arguments
18INTEGER klon,klev,nbsrf,iflag_bug_t2m_stab_ipslcm61
19REAL,DIMENSION(klon),INTENT(IN) :: t1, q1, u1, v1
20REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: t2m, q2m, u10m, v10m
21REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol, pctsrf
22REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs
23REAL,DIMENSION(klon),INTENT(IN) :: qsurf
24REAL,DIMENSION (klon),INTENT(OUT) :: zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor
25REAL,DIMENSION (klon),INTENT(OUT)  :: zrh2m_cor, zqsat2m_cor
26
27
28! local
29INTEGER i,nsrf
30REAL,DIMENSION (klon,nbsrf) :: t2m_cor, q2m_cor, u10m_cor, v10m_cor
31REAL                               :: zx_qs1, zcor1, zdelta1
32
33include "FCTTRE.h"
34!==================================================================
35! Correction of sub surface variables
36!==================================================================
37
38zrh2m_cor=0.
39zqsat2m_cor=0.
40
41DO nsrf=1,nbsrf
42   DO i=1,klon
43    t2m_cor(i,nsrf)=t2m(i,nsrf)
44    q2m_cor(i,nsrf)=q2m(i,nsrf)
45    u10m_cor(i,nsrf)=u10m(i,nsrf)
46    v10m_cor(i,nsrf)=v10m(i,nsrf)
47     IF(iflag_bug_t2m_stab_ipslcm61.EQ.-2.AND.q2m(i,nsrf).LT.0.) THEN
48      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
49      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
50      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
51      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
52      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
53      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
54      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
55     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.-1.AND.(ftsol(i,nsrf).LE.t1(i).OR.q2m(i,nsrf).LT.0.)) THEN
56      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
57      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
58      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
59      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
60      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
61      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
62      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
63     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.1.AND.ftsol(i,nsrf).LE.t1(i)) THEN
64      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
65      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
66      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
67      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
68      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
69      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
70      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
71     ELSEIF(iflag_bug_t2m_stab_ipslcm61.EQ.0) THEN
72      t2m_cor(i,nsrf)=MIN(t2m(i,nsrf),MAX(t1(i),ftsol(i,nsrf)))
73      t2m_cor(i,nsrf)=MAX(t2m_cor(i,nsrf),MIN(t1(i),ftsol(i,nsrf)))
74      q2m_cor(i,nsrf)=MIN(q2m(i,nsrf),MAX(q1(i),qsurf(i)))
75      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),MIN(q1(i),qsurf(i)))
76      q2m_cor(i,nsrf)=MAX(q2m_cor(i,nsrf),0.)
77      u10m_cor(i,nsrf)=SIGN(MIN(ABS(u1(i)),ABS(u10m(i,nsrf))),u1(i))
78      v10m_cor(i,nsrf)=SIGN(MIN(ABS(v1(i)),ABS(v10m(i,nsrf))),v1(i))
79     ENDIF
80!!!
81     zdelta1 = MAX(0.,SIGN(1., rtt-t2m_cor(i,nsrf) ))
82     zx_qs1  = r2es * FOEEW(t2m_cor(i,nsrf),zdelta1)/paprs(i,1)
83     zx_qs1  = MIN(0.5,zx_qs1)
84     zcor1   = 1./(1.-RETV*zx_qs1)
85     zx_qs1  = zx_qs1*zcor1
86     zrh2m_cor(i) = zrh2m_cor(i) + q2m_cor(i,nsrf)/zx_qs1 * pctsrf(i,nsrf)
87     zqsat2m_cor(i) = zqsat2m_cor(i) + zx_qs1  * pctsrf(i,nsrf)
88!!!
89   ENDDO
90ENDDO
91
92!==================================================================
93! Agregation of sub surfaces
94!==================================================================
95
96zt2m_cor=0.
97zq2m_cor=0.
98zu10m_cor=0.
99zv10m_cor=0.
100DO nsrf = 1, nbsrf
101   DO i = 1, klon
102      zt2m_cor(i)  = zt2m_cor(i)  + t2m_cor(i,nsrf)  * pctsrf(i,nsrf)
103      zq2m_cor(i)  = zq2m_cor(i)  + q2m_cor(i,nsrf)  * pctsrf(i,nsrf)
104      zu10m_cor(i) = zu10m_cor(i) + u10m_cor(i,nsrf) * pctsrf(i,nsrf)
105      zv10m_cor(i) = zv10m_cor(i) + v10m_cor(i,nsrf) * pctsrf(i,nsrf)
106   ENDDO
107ENDDO
108
109RETURN
110END SUBROUTINE borne_var_surf
111
112
Note: See TracBrowser for help on using the repository browser.