GCC Code Coverage Report

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