1 | SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, & |
---|
2 | u1, v1, t1, q1, z1, & |
---|
3 | ts1, qsurf, rugos, psol, pat1, & |
---|
4 | t_2m, q_2m, u_10m) |
---|
5 | IMPLICIT NONE |
---|
6 | !------------------------------------------------------------------------- |
---|
7 | ! |
---|
8 | ! Objet : calcul de la temperature et l'humidite relative a 2m et du |
---|
9 | ! module du vent a 10m a partir des relations de Dyer-Businger et |
---|
10 | ! des equations de Louis. |
---|
11 | ! |
---|
12 | ! Reference : Hess, Colman et McAvaney (1995) |
---|
13 | ! |
---|
14 | ! I. Musat, 01.07.2002 |
---|
15 | !------------------------------------------------------------------------- |
---|
16 | ! |
---|
17 | ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude) |
---|
18 | ! knon----input-I- nombre de points pour un type de surface |
---|
19 | ! nsrf----input-I- indice pour le type de surface; voir indicesol.inc |
---|
20 | ! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li |
---|
21 | ! u1------input-R- vent zonal au 1er niveau du modele |
---|
22 | ! v1------input-R- vent meridien au 1er niveau du modele |
---|
23 | ! t1------input-R- temperature de l'air au 1er niveau du modele |
---|
24 | ! q1------input-R- humidite relative au 1er niveau du modele |
---|
25 | ! z1------input-R- geopotentiel au 1er niveau du modele |
---|
26 | ! ts1-----input-R- temperature de l'air a la surface |
---|
27 | ! qsurf---input-R- humidite relative a la surface |
---|
28 | ! rugos---input-R- rugosite |
---|
29 | ! psol----input-R- pression au sol |
---|
30 | ! pat1----input-R- pression au 1er niveau du modele |
---|
31 | ! |
---|
32 | ! t_2m---output-R- temperature de l'air a 2m |
---|
33 | ! q_2m---output-R- humidite relative a 2m |
---|
34 | ! u_10m--output-R- vitesse du vent a 10m |
---|
35 | ! |
---|
36 | INTEGER, intent(in) :: klon, knon, nsrf |
---|
37 | LOGICAL, intent(in) :: zxli |
---|
38 | REAL, dimension(klon), intent(in) :: u1, v1, t1, q1, z1, ts1 |
---|
39 | REAL, dimension(klon), intent(in) :: qsurf, rugos |
---|
40 | REAL, dimension(klon), intent(in) :: psol, pat1 |
---|
41 | ! |
---|
42 | REAL, dimension(klon), intent(out) :: t_2m, q_2m, u_10m |
---|
43 | !------------------------------------------------------------------------- |
---|
44 | #include "YOMCST.inc" |
---|
45 | !IM PLUS |
---|
46 | #include "YOETHF.inc" |
---|
47 | ! |
---|
48 | ! Quelques constantes et options: |
---|
49 | ! |
---|
50 | ! RKAR : constante de von Karman |
---|
51 | REAL, PARAMETER :: RKAR=0.40 |
---|
52 | ! niter : nombre iterations calcul "corrector" |
---|
53 | ! INTEGER, parameter :: niter=6, ncon=niter-1 |
---|
54 | INTEGER, parameter :: niter=2, ncon=niter-1 |
---|
55 | ! |
---|
56 | ! Variables locales |
---|
57 | INTEGER :: i, n |
---|
58 | REAL :: zref |
---|
59 | REAL, dimension(klon) :: speed |
---|
60 | ! tpot : temperature potentielle |
---|
61 | REAL, dimension(klon) :: tpot |
---|
62 | REAL, dimension(klon) :: zri1, cdran |
---|
63 | REAL, dimension(klon) :: cdram, cdrah |
---|
64 | ! ri1 : nb. de Richardson entre la surface --> la 1ere couche |
---|
65 | REAL, dimension(klon) :: ri1 |
---|
66 | REAL, dimension(klon) :: ustar, testar, qstar |
---|
67 | REAL, dimension(klon) :: zdte, zdq |
---|
68 | ! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney |
---|
69 | DOUBLE PRECISION, dimension(klon) :: lmon |
---|
70 | DOUBLE PRECISION, parameter :: eps=1.0D-20 |
---|
71 | REAL, dimension(klon) :: delu, delte, delq |
---|
72 | REAL, dimension(klon) :: u_zref, te_zref, q_zref |
---|
73 | REAL, dimension(klon) :: temp, pref |
---|
74 | LOGICAL :: okri |
---|
75 | REAL, dimension(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p |
---|
76 | !convertgence |
---|
77 | REAL, dimension(klon) :: te_zref_con, q_zref_con |
---|
78 | REAL, dimension(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c |
---|
79 | REAL, dimension(klon) :: ok_pred, ok_corr |
---|
80 | REAL, dimension(klon) :: conv_te, conv_q |
---|
81 | !------------------------------------------------------------------------- |
---|
82 | DO i=1, knon |
---|
83 | speed(i)=SQRT(u1(i)**2+v1(i)**2) |
---|
84 | ri1(i) = 0.0 |
---|
85 | ENDDO |
---|
86 | ! |
---|
87 | okri=.FALSE. |
---|
88 | CALL coefcdrag(klon, knon, nsrf, zxli, & |
---|
89 | speed, t1, q1, z1, psol, & |
---|
90 | ts1, qsurf, rugos, okri, ri1, & |
---|
91 | cdram, cdrah, cdran, zri1, pref) |
---|
92 | ! |
---|
93 | !---------Star variables---------------------------------------------------- |
---|
94 | ! |
---|
95 | DO i = 1, knon |
---|
96 | ri1(i) = zri1(i) |
---|
97 | tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA |
---|
98 | ustar(i) = sqrt(cdram(i) * speed(i) * speed(i)) |
---|
99 | zdte(i) = tpot(i) - ts1(i) |
---|
100 | zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0) |
---|
101 | ! |
---|
102 | testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i) |
---|
103 | qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i) |
---|
104 | lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ & |
---|
105 | (RKAR * RG * testar(i)) |
---|
106 | ENDDO |
---|
107 | ! |
---|
108 | !----------First aproximation of variables at zref -------------------------- |
---|
109 | zref = 2.0 |
---|
110 | CALL screenp(klon, knon, nsrf, speed, tpot, q1, & |
---|
111 | ts1, qsurf, rugos, lmon, & |
---|
112 | ustar, testar, qstar, zref, & |
---|
113 | delu, delte, delq) |
---|
114 | ! |
---|
115 | DO i = 1, knon |
---|
116 | u_zref(i) = delu(i) |
---|
117 | q_zref(i) = max(qsurf(i),0.0) + delq(i) |
---|
118 | te_zref(i) = ts1(i) + delte(i) |
---|
119 | temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA) |
---|
120 | q_zref_p(i) = q_zref(i) |
---|
121 | ! te_zref_p(i) = te_zref(i) |
---|
122 | temp_p(i) = temp(i) |
---|
123 | ENDDO |
---|
124 | ! |
---|
125 | ! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995 |
---|
126 | ! |
---|
127 | DO n = 1, niter |
---|
128 | ! |
---|
129 | okri=.TRUE. |
---|
130 | CALL screenc(klon, knon, nsrf, zxli, & |
---|
131 | u_zref, temp, q_zref, zref, & |
---|
132 | ts1, qsurf, rugos, psol, & |
---|
133 | ustar, testar, qstar, okri, ri1, & |
---|
134 | pref, delu, delte, delq) |
---|
135 | ! |
---|
136 | DO i = 1, knon |
---|
137 | u_zref(i) = delu(i) |
---|
138 | q_zref(i) = delq(i) + max(qsurf(i),0.0) |
---|
139 | te_zref(i) = delte(i) + ts1(i) |
---|
140 | ! |
---|
141 | ! return to normal temperature |
---|
142 | ! |
---|
143 | temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA) |
---|
144 | ! temp(i) = te_zref(i) - (zref* RG)/RCPD/ & |
---|
145 | ! (1 + RVTMP2 * max(q_zref(i),0.0)) |
---|
146 | ! |
---|
147 | !IM +++ |
---|
148 | ! IF(temp(i).GT.350.) THEN |
---|
149 | ! WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i) |
---|
150 | ! ENDIF |
---|
151 | !IM --- |
---|
152 | ! |
---|
153 | IF(n.EQ.ncon) THEN |
---|
154 | te_zref_con(i) = te_zref(i) |
---|
155 | q_zref_con(i) = q_zref(i) |
---|
156 | ENDIF |
---|
157 | ! |
---|
158 | ENDDO |
---|
159 | ! |
---|
160 | ENDDO |
---|
161 | ! |
---|
162 | ! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref |
---|
163 | ! |
---|
164 | DO i = 1, knon |
---|
165 | conv_te(i) = (te_zref(i) - te_zref_con(i))/te_zref_con(i) |
---|
166 | conv_q(i) = (q_zref(i) - q_zref_con(i))/q_zref_con(i) |
---|
167 | !IM +++ |
---|
168 | ! IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN |
---|
169 | ! PRINT*,'DIV','i=',i,te_zref_con(i),te_zref(i),conv_te(i), & |
---|
170 | ! q_zref_con(i),q_zref(i),conv_q(i) |
---|
171 | ! ENDIF |
---|
172 | !IM --- |
---|
173 | ENDDO |
---|
174 | ! |
---|
175 | DO i = 1, knon |
---|
176 | q_zref_c(i) = q_zref(i) |
---|
177 | temp_c(i) = temp(i) |
---|
178 | ! |
---|
179 | ! IF(zri1(i).LT.0.) THEN |
---|
180 | ! IF(nsrf.EQ.1) THEN |
---|
181 | ! ok_pred(i)=1. |
---|
182 | ! ok_corr(i)=0. |
---|
183 | ! ELSE |
---|
184 | ! ok_pred(i)=0. |
---|
185 | ! ok_corr(i)=1. |
---|
186 | ! ENDIF |
---|
187 | ! ELSE |
---|
188 | ! ok_pred(i)=0. |
---|
189 | ! ok_corr(i)=1. |
---|
190 | ! ENDIF |
---|
191 | ! |
---|
192 | ok_pred(i)=0. |
---|
193 | ok_corr(i)=1. |
---|
194 | ! |
---|
195 | t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i) |
---|
196 | q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i) |
---|
197 | !IM +++ |
---|
198 | ! IF(n.EQ.niter) THEN |
---|
199 | ! IF(t_2m(i).LT.t1(i).AND.t_2m(i).LT.ts1(i)) THEN |
---|
200 | ! PRINT*,' BAD t2m LT ',i,nsrf,t_2m(i),t1(i),ts1(i) |
---|
201 | ! ELSEIF(t_2m(i).GT.t1(i).AND.t_2m(i).GT.ts1(i)) THEN |
---|
202 | ! PRINT*,' BAD t2m GT ',i,nsrf,t_2m(i),t1(i),ts1(i) |
---|
203 | ! ENDIF |
---|
204 | ! ENDIF |
---|
205 | !IM --- |
---|
206 | ENDDO |
---|
207 | ! |
---|
208 | ! |
---|
209 | !----------First aproximation of variables at zref -------------------------- |
---|
210 | ! |
---|
211 | zref = 10.0 |
---|
212 | CALL screenp(klon, knon, nsrf, speed, tpot, q1, & |
---|
213 | ts1, qsurf, rugos, lmon, & |
---|
214 | ustar, testar, qstar, zref, & |
---|
215 | delu, delte, delq) |
---|
216 | ! |
---|
217 | DO i = 1, knon |
---|
218 | u_zref(i) = delu(i) |
---|
219 | q_zref(i) = max(qsurf(i),0.0) + delq(i) |
---|
220 | te_zref(i) = ts1(i) + delte(i) |
---|
221 | temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA) |
---|
222 | ! temp(i) = te_zref(i) - (zref* RG)/RCPD/ & |
---|
223 | ! (1 + RVTMP2 * max(q_zref(i),0.0)) |
---|
224 | u_zref_p(i) = u_zref(i) |
---|
225 | ENDDO |
---|
226 | ! |
---|
227 | ! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995 |
---|
228 | ! |
---|
229 | DO n = 1, niter |
---|
230 | ! |
---|
231 | okri=.TRUE. |
---|
232 | CALL screenc(klon, knon, nsrf, zxli, & |
---|
233 | u_zref, temp, q_zref, zref, & |
---|
234 | ts1, qsurf, rugos, psol, & |
---|
235 | ustar, testar, qstar, okri, ri1, & |
---|
236 | pref, delu, delte, delq) |
---|
237 | ! |
---|
238 | DO i = 1, knon |
---|
239 | u_zref(i) = delu(i) |
---|
240 | q_zref(i) = delq(i) + max(qsurf(i),0.0) |
---|
241 | te_zref(i) = delte(i) + ts1(i) |
---|
242 | temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA) |
---|
243 | ! temp(i) = te_zref(i) - (zref* RG)/RCPD/ & |
---|
244 | ! (1 + RVTMP2 * max(q_zref(i),0.0)) |
---|
245 | ENDDO |
---|
246 | ! |
---|
247 | ENDDO |
---|
248 | ! |
---|
249 | DO i = 1, knon |
---|
250 | u_zref_c(i) = u_zref(i) |
---|
251 | ! |
---|
252 | u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i) |
---|
253 | ENDDO |
---|
254 | ! |
---|
255 | RETURN |
---|
256 | END subroutine stdlevvar |
---|