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