Directory: | ./ |
---|---|
File: | phys/ajsec.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 55 | 140 | 39.3% |
Branches: | 49 | 132 | 37.1% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | |||
2 | ! $Header$ | ||
3 | |||
4 | 55823760 | SUBROUTINE ajsec(paprs, pplay, t, q, limbas, d_t, d_q) | |
5 | USE dimphy | ||
6 | IMPLICIT NONE | ||
7 | ! ====================================================================== | ||
8 | ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818 | ||
9 | ! Objet: ajustement sec (adaptation du GCM du LMD) | ||
10 | ! ====================================================================== | ||
11 | ! Arguments: | ||
12 | ! t-------input-R- Temperature | ||
13 | |||
14 | ! d_t-----output-R-Incrementation de la temperature | ||
15 | ! ====================================================================== | ||
16 | include "YOMCST.h" | ||
17 | REAL paprs(klon, klev+1), pplay(klon, klev) | ||
18 | REAL t(klon, klev), q(klon, klev) | ||
19 | REAL d_t(klon, klev), d_q(klon, klev) | ||
20 | |||
21 | INTEGER limbas(klon), limhau ! les couches a ajuster | ||
22 | |||
23 | LOGICAL mixq | ||
24 | ! cc PARAMETER (mixq=.TRUE.) | ||
25 | PARAMETER (mixq=.FALSE.) | ||
26 | |||
27 | 1440 | REAL zh(klon, klev) | |
28 | 1440 | REAL zho(klon, klev) | |
29 | 1440 | REAL zq(klon, klev) | |
30 | 1440 | REAL zpk(klon, klev) | |
31 | 1440 | REAL zpkdp(klon, klev) | |
32 | REAL hm, sm, qm | ||
33 | 720 | LOGICAL modif(klon), down | |
34 | INTEGER i, k, k1, k2 | ||
35 | |||
36 | ! Initialisation: | ||
37 | |||
38 | ! ym | ||
39 | limhau = klev | ||
40 | |||
41 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28800 | DO k = 1, klev |
42 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO i = 1, klon |
43 | 27911520 | d_t(i, k) = 0.0 | |
44 | 27939600 | d_q(i, k) = 0.0 | |
45 | END DO | ||
46 | END DO | ||
47 | ! ------------------------------------- detection des profils a modifier | ||
48 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28800 | DO k = 1, limhau |
49 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO i = 1, klon |
50 | 27911520 | zpk(i, k) = pplay(i, k)**rkappa | |
51 | 27911520 | zh(i, k) = rcpd*t(i, k)/zpk(i, k) | |
52 | 27911520 | zho(i, k) = zh(i, k) | |
53 | 27939600 | zq(i, k) = q(i, k) | |
54 | END DO | ||
55 | END DO | ||
56 | |||
57 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28800 | DO k = 1, limhau |
58 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO i = 1, klon |
59 | 27939600 | zpkdp(i, k) = zpk(i, k)*(paprs(i,k)-paprs(i,k+1)) | |
60 | END DO | ||
61 | END DO | ||
62 | |||
63 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716400 | DO i = 1, klon |
64 | 716400 | modif(i) = .FALSE. | |
65 | END DO | ||
66 |
2/2✓ Branch 0 taken 27360 times.
✓ Branch 1 taken 720 times.
|
28080 | DO k = 2, limhau |
67 |
2/2✓ Branch 0 taken 27195840 times.
✓ Branch 1 taken 27360 times.
|
27223920 | DO i = 1, klon |
68 |
4/4✓ Branch 0 taken 23743241 times.
✓ Branch 1 taken 3452599 times.
✓ Branch 2 taken 21721071 times.
✓ Branch 3 taken 2022170 times.
|
27223200 | IF (.NOT. modif(i) .AND. k-1>limbas(i)) THEN |
69 |
2/2✓ Branch 0 taken 97970 times.
✓ Branch 1 taken 21623101 times.
|
21721071 | IF (zh(i,k)<zh(i,k-1)) modif(i) = .TRUE. |
70 | END IF | ||
71 | END DO | ||
72 | END DO | ||
73 | ! ------------------------------------- correction des profils instables | ||
74 |
2/2✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
|
716400 | DO i = 1, klon |
75 |
2/2✓ Branch 0 taken 97970 times.
✓ Branch 1 taken 617710 times.
|
716400 | IF (modif(i)) THEN |
76 | 97970 | k2 = limbas(i) | |
77 | 8000 CONTINUE | ||
78 | 3548528 | k2 = k2 + 1 | |
79 |
2/2✓ Branch 0 taken 3450558 times.
✓ Branch 1 taken 97970 times.
|
3548528 | IF (k2>limhau) GO TO 8001 |
80 |
2/2✓ Branch 0 taken 3344548 times.
✓ Branch 1 taken 106010 times.
|
3450558 | IF (zh(i,k2)<zh(i,k2-1)) THEN |
81 | k1 = k2 - 1 | ||
82 | k = k1 | ||
83 | 106010 | sm = zpkdp(i, k2) | |
84 | hm = zh(i, k2) | ||
85 | 106010 | qm = zq(i, k2) | |
86 | 8020 CONTINUE | ||
87 | 273872 | sm = sm + zpkdp(i, k) | |
88 | 273872 | hm = hm + zpkdp(i, k)*(zh(i,k)-hm)/sm | |
89 | 273872 | qm = qm + zpkdp(i, k)*(zq(i,k)-qm)/sm | |
90 | down = .FALSE. | ||
91 |
2/2✓ Branch 0 taken 50080 times.
✓ Branch 1 taken 223792 times.
|
273872 | IF (k1/=limbas(i)) THEN |
92 |
2/2✓ Branch 0 taken 7037 times.
✓ Branch 1 taken 43043 times.
|
50080 | IF (hm<zh(i,k1-1)) down = .TRUE. |
93 | END IF | ||
94 | IF (down) THEN | ||
95 | k1 = k1 - 1 | ||
96 | k = k1 | ||
97 | ELSE | ||
98 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 266835 times.
|
266835 | IF ((k2==limhau)) GO TO 8021 |
99 |
2/2✓ Branch 0 taken 160825 times.
✓ Branch 1 taken 106010 times.
|
266835 | IF ((zh(i,k2+1)>=hm)) GO TO 8021 |
100 | k2 = k2 + 1 | ||
101 | k = k2 | ||
102 | END IF | ||
103 | 106010 | GO TO 8020 | |
104 | 8021 CONTINUE | ||
105 | ! ------------ nouveau profil : constant (valeur moyenne) | ||
106 |
2/2✓ Branch 0 taken 379882 times.
✓ Branch 1 taken 106010 times.
|
485892 | DO k = k1, k2 |
107 | 379882 | zh(i, k) = hm | |
108 | 485892 | zq(i, k) = qm | |
109 | END DO | ||
110 | 106010 | k2 = k2 + 1 | |
111 | END IF | ||
112 | 97970 | GO TO 8000 | |
113 | 8001 CONTINUE | ||
114 | END IF | ||
115 | END DO | ||
116 | |||
117 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28800 | DO k = 1, limhau |
118 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO i = 1, klon |
119 | 27911520 | d_t(i, k) = (zh(i,k)-zho(i,k))*zpk(i, k)/rcpd | |
120 | 27939600 | d_q(i, k) = zq(i, k) - q(i, k) | |
121 | END DO | ||
122 | END DO | ||
123 | |||
124 | ! FH : les d_q et d_t sont maintenant calcules de facon a valoir | ||
125 | ! effectivement 0. si on ne fait rien. | ||
126 | |||
127 | ! IF (limbas.GT.1) THEN | ||
128 | ! DO k = 1, limbas-1 | ||
129 | ! DO i = 1, klon | ||
130 | ! d_t(i,k) = 0.0 | ||
131 | ! d_q(i,k) = 0.0 | ||
132 | ! ENDDO | ||
133 | ! ENDDO | ||
134 | ! ENDIF | ||
135 | |||
136 | ! IF (limhau.LT.klev) THEN | ||
137 | ! DO k = limhau+1, klev | ||
138 | ! DO i = 1, klon | ||
139 | ! d_t(i,k) = 0.0 | ||
140 | ! d_q(i,k) = 0.0 | ||
141 | ! ENDDO | ||
142 | ! ENDDO | ||
143 | ! ENDIF | ||
144 | |||
145 | IF (.NOT. mixq) THEN | ||
146 |
2/2✓ Branch 0 taken 28080 times.
✓ Branch 1 taken 720 times.
|
28800 | DO k = 1, klev |
147 |
2/2✓ Branch 0 taken 27911520 times.
✓ Branch 1 taken 28080 times.
|
27940320 | DO i = 1, klon |
148 | 27939600 | d_q(i, k) = 0.0 | |
149 | END DO | ||
150 | END DO | ||
151 | END IF | ||
152 | |||
153 | 720 | RETURN | |
154 | END SUBROUTINE ajsec | ||
155 | |||
156 | ✗ | SUBROUTINE ajsec_convv2(paprs, pplay, t, q, d_t, d_q) | |
157 | USE dimphy | ||
158 | IMPLICIT NONE | ||
159 | ! ====================================================================== | ||
160 | ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818 | ||
161 | ! Objet: ajustement sec (adaptation du GCM du LMD) | ||
162 | ! ====================================================================== | ||
163 | ! Arguments: | ||
164 | ! t-------input-R- Temperature | ||
165 | |||
166 | ! d_t-----output-R-Incrementation de la temperature | ||
167 | ! ====================================================================== | ||
168 | include "YOMCST.h" | ||
169 | REAL paprs(klon, klev+1), pplay(klon, klev) | ||
170 | REAL t(klon, klev), q(klon, klev) | ||
171 | REAL d_t(klon, klev), d_q(klon, klev) | ||
172 | |||
173 | INTEGER limbas, limhau ! les couches a ajuster | ||
174 | ! cc PARAMETER (limbas=klev-3, limhau=klev) | ||
175 | ! ym PARAMETER (limbas=1, limhau=klev) | ||
176 | |||
177 | LOGICAL mixq | ||
178 | ! cc PARAMETER (mixq=.TRUE.) | ||
179 | PARAMETER (mixq=.FALSE.) | ||
180 | |||
181 | ✗ | REAL zh(klon, klev) | |
182 | ✗ | REAL zq(klon, klev) | |
183 | ✗ | REAL zpk(klon, klev) | |
184 | ✗ | REAL zpkdp(klon, klev) | |
185 | REAL hm, sm, qm | ||
186 | ✗ | LOGICAL modif(klon), down | |
187 | INTEGER i, k, k1, k2 | ||
188 | |||
189 | ! Initialisation: | ||
190 | |||
191 | ! ym | ||
192 | limbas = 1 | ||
193 | limhau = klev | ||
194 | |||
195 | ✗ | DO k = 1, klev | |
196 | ✗ | DO i = 1, klon | |
197 | ✗ | d_t(i, k) = 0.0 | |
198 | ✗ | d_q(i, k) = 0.0 | |
199 | END DO | ||
200 | END DO | ||
201 | ! ------------------------------------- detection des profils a modifier | ||
202 | ✗ | DO k = limbas, limhau | |
203 | ✗ | DO i = 1, klon | |
204 | ✗ | zpk(i, k) = pplay(i, k)**rkappa | |
205 | ✗ | zh(i, k) = rcpd*t(i, k)/zpk(i, k) | |
206 | ✗ | zq(i, k) = q(i, k) | |
207 | END DO | ||
208 | END DO | ||
209 | |||
210 | ✗ | DO k = limbas, limhau | |
211 | ✗ | DO i = 1, klon | |
212 | ✗ | zpkdp(i, k) = zpk(i, k)*(paprs(i,k)-paprs(i,k+1)) | |
213 | END DO | ||
214 | END DO | ||
215 | |||
216 | ✗ | DO i = 1, klon | |
217 | ✗ | modif(i) = .FALSE. | |
218 | END DO | ||
219 | ✗ | DO k = limbas + 1, limhau | |
220 | ✗ | DO i = 1, klon | |
221 | ✗ | IF (.NOT. modif(i)) THEN | |
222 | ✗ | IF (zh(i,k)<zh(i,k-1)) modif(i) = .TRUE. | |
223 | END IF | ||
224 | END DO | ||
225 | END DO | ||
226 | ! ------------------------------------- correction des profils instables | ||
227 | ✗ | DO i = 1, klon | |
228 | ✗ | IF (modif(i)) THEN | |
229 | k2 = limbas | ||
230 | 8000 CONTINUE | ||
231 | ✗ | k2 = k2 + 1 | |
232 | ✗ | IF (k2>limhau) GO TO 8001 | |
233 | ✗ | IF (zh(i,k2)<zh(i,k2-1)) THEN | |
234 | k1 = k2 - 1 | ||
235 | k = k1 | ||
236 | ✗ | sm = zpkdp(i, k2) | |
237 | hm = zh(i, k2) | ||
238 | ✗ | qm = zq(i, k2) | |
239 | 8020 CONTINUE | ||
240 | ✗ | sm = sm + zpkdp(i, k) | |
241 | ✗ | hm = hm + zpkdp(i, k)*(zh(i,k)-hm)/sm | |
242 | ✗ | qm = qm + zpkdp(i, k)*(zq(i,k)-qm)/sm | |
243 | down = .FALSE. | ||
244 | ✗ | IF (k1/=limbas) THEN | |
245 | ✗ | IF (hm<zh(i,k1-1)) down = .TRUE. | |
246 | END IF | ||
247 | IF (down) THEN | ||
248 | k1 = k1 - 1 | ||
249 | k = k1 | ||
250 | ELSE | ||
251 | ✗ | IF ((k2==limhau)) GO TO 8021 | |
252 | ✗ | IF ((zh(i,k2+1)>=hm)) GO TO 8021 | |
253 | k2 = k2 + 1 | ||
254 | k = k2 | ||
255 | END IF | ||
256 | ✗ | GO TO 8020 | |
257 | 8021 CONTINUE | ||
258 | ! ------------ nouveau profil : constant (valeur moyenne) | ||
259 | ✗ | DO k = k1, k2 | |
260 | ✗ | zh(i, k) = hm | |
261 | ✗ | zq(i, k) = qm | |
262 | END DO | ||
263 | ✗ | k2 = k2 + 1 | |
264 | END IF | ||
265 | ✗ | GO TO 8000 | |
266 | 8001 CONTINUE | ||
267 | END IF | ||
268 | END DO | ||
269 | |||
270 | ✗ | DO k = limbas, limhau | |
271 | ✗ | DO i = 1, klon | |
272 | ✗ | d_t(i, k) = zh(i, k)*zpk(i, k)/rcpd - t(i, k) | |
273 | ✗ | d_q(i, k) = zq(i, k) - q(i, k) | |
274 | END DO | ||
275 | END DO | ||
276 | |||
277 | IF (limbas>1) THEN | ||
278 | DO k = 1, limbas - 1 | ||
279 | DO i = 1, klon | ||
280 | d_t(i, k) = 0.0 | ||
281 | d_q(i, k) = 0.0 | ||
282 | END DO | ||
283 | END DO | ||
284 | END IF | ||
285 | |||
286 | IF (limhau<klev) THEN | ||
287 | DO k = limhau + 1, klev | ||
288 | DO i = 1, klon | ||
289 | d_t(i, k) = 0.0 | ||
290 | d_q(i, k) = 0.0 | ||
291 | END DO | ||
292 | END DO | ||
293 | END IF | ||
294 | |||
295 | IF (.NOT. mixq) THEN | ||
296 | ✗ | DO k = 1, klev | |
297 | ✗ | DO i = 1, klon | |
298 | ✗ | d_q(i, k) = 0.0 | |
299 | END DO | ||
300 | END DO | ||
301 | END IF | ||
302 | |||
303 | ✗ | RETURN | |
304 | END SUBROUTINE ajsec_convv2 | ||
305 | ✗ | SUBROUTINE ajsec_old(paprs, pplay, t, d_t) | |
306 | USE dimphy | ||
307 | IMPLICIT NONE | ||
308 | ! ====================================================================== | ||
309 | ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818 | ||
310 | ! Objet: ajustement sec (adaptation du GCM du LMD) | ||
311 | ! ====================================================================== | ||
312 | ! Arguments: | ||
313 | ! t-------input-R- Temperature | ||
314 | |||
315 | ! d_t-----output-R-Incrementation de la temperature | ||
316 | ! ====================================================================== | ||
317 | include "YOMCST.h" | ||
318 | REAL paprs(klon, klev+1), pplay(klon, klev) | ||
319 | REAL t(klon, klev) | ||
320 | REAL d_t(klon, klev) | ||
321 | |||
322 | ✗ | REAL local_h(klon, klev) | |
323 | REAL hm, sm | ||
324 | ✗ | LOGICAL modif(klon), down | |
325 | INTEGER i, l, l1, l2 | ||
326 | ! ------------------------------------- detection des profils a modifier | ||
327 | ✗ | DO i = 1, klon | |
328 | ✗ | modif(i) = .FALSE. | |
329 | END DO | ||
330 | |||
331 | ✗ | DO l = 1, klev | |
332 | ✗ | DO i = 1, klon | |
333 | ✗ | local_h(i, l) = rcpd*t(i, l)/(pplay(i,l)**rkappa) | |
334 | END DO | ||
335 | END DO | ||
336 | |||
337 | ✗ | DO l = 2, klev | |
338 | ✗ | DO i = 1, klon | |
339 | ✗ | IF (local_h(i,l)<local_h(i,l-1)) THEN | |
340 | ✗ | modif(i) = .TRUE. | |
341 | ELSE | ||
342 | modif(i) = modif(i) | ||
343 | END IF | ||
344 | END DO | ||
345 | END DO | ||
346 | ! ------------------------------------- correction des profils instables | ||
347 | ✗ | DO i = 1, klon | |
348 | ✗ | IF (modif(i)) THEN | |
349 | l2 = 1 | ||
350 | 8000 CONTINUE | ||
351 | ✗ | l2 = l2 + 1 | |
352 | ✗ | IF (l2>klev) GO TO 8001 | |
353 | ✗ | IF (local_h(i,l2)<local_h(i,l2-1)) THEN | |
354 | l1 = l2 - 1 | ||
355 | l = l1 | ||
356 | ✗ | sm = pplay(i, l2)**rkappa*(paprs(i,l2)-paprs(i,l2+1)) | |
357 | hm = local_h(i, l2) | ||
358 | 8020 CONTINUE | ||
359 | ✗ | sm = sm + pplay(i, l)**rkappa*(paprs(i,l)-paprs(i,l+1)) | |
360 | hm = hm + pplay(i, l)**rkappa*(paprs(i,l)-paprs(i,l+1))*(local_h(i,l) & | ||
361 | ✗ | -hm)/sm | |
362 | down = .FALSE. | ||
363 | ✗ | IF (l1/=1) THEN | |
364 | ✗ | IF (hm<local_h(i,l1-1)) THEN | |
365 | down = .TRUE. | ||
366 | END IF | ||
367 | END IF | ||
368 | IF (down) THEN | ||
369 | l1 = l1 - 1 | ||
370 | l = l1 | ||
371 | ELSE | ||
372 | ✗ | IF ((l2==klev)) GO TO 8021 | |
373 | ✗ | IF ((local_h(i,l2+1)>=hm)) GO TO 8021 | |
374 | l2 = l2 + 1 | ||
375 | l = l2 | ||
376 | END IF | ||
377 | ✗ | GO TO 8020 | |
378 | 8021 CONTINUE | ||
379 | ! ------------ nouveau profil : constant (valeur moyenne) | ||
380 | ✗ | DO l = l1, l2 | |
381 | ✗ | local_h(i, l) = hm | |
382 | END DO | ||
383 | ✗ | l2 = l2 + 1 | |
384 | END IF | ||
385 | ✗ | GO TO 8000 | |
386 | 8001 CONTINUE | ||
387 | END IF | ||
388 | END DO | ||
389 | |||
390 | ✗ | DO l = 1, klev | |
391 | ✗ | DO i = 1, klon | |
392 | ✗ | d_t(i, l) = local_h(i, l)*(pplay(i,l)**rkappa)/rcpd - t(i, l) | |
393 | END DO | ||
394 | END DO | ||
395 | |||
396 | ✗ | RETURN | |
397 | END SUBROUTINE ajsec_old | ||
398 |