GCC Code Coverage Report


Directory: ./
File: phys/climb_hq_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 101 147 68.7%
Branches: 187 358 52.2%

Line Branch Exec Source
1 MODULE climb_hq_mod
2 !
3 ! Module to solve the verctical diffusion of "q" and "H";
4 ! specific humidity and potential energi.
5 !
6 USE dimphy
7
8 IMPLICIT NONE
9 SAVE
10 PRIVATE
11 PUBLIC :: climb_hq_down, climb_hq_up, d_h_col_vdf, f_h_bnd
12
13 REAL, DIMENSION(:,:), ALLOCATABLE :: gamaq, gamah
14 !$OMP THREADPRIVATE(gamaq,gamah)
15 REAL, DIMENSION(:,:), ALLOCATABLE :: Ccoef_Q, Dcoef_Q
16 !$OMP THREADPRIVATE(Ccoef_Q, Dcoef_Q)
17 REAL, DIMENSION(:,:), ALLOCATABLE :: Ccoef_H, Dcoef_H
18 !$OMP THREADPRIVATE(Ccoef_H, Dcoef_H)
19 REAL, DIMENSION(:), ALLOCATABLE :: Acoef_Q, Bcoef_Q
20 !$OMP THREADPRIVATE(Acoef_Q, Bcoef_Q)
21 REAL, DIMENSION(:), ALLOCATABLE :: Acoef_H, Bcoef_H
22 !$OMP THREADPRIVATE(Acoef_H, Bcoef_H)
23 REAL, DIMENSION(:,:), ALLOCATABLE :: Kcoefhq
24 !$OMP THREADPRIVATE(Kcoefhq)
25 REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: h_old ! for diagnostics, h before solving diffusion
26 !$OMP THREADPRIVATE(h_old)
27 REAL, SAVE, DIMENSION(:), ALLOCATABLE :: d_h_col_vdf ! for diagnostics, vertical integral of enthalpy change
28 !$OMP THREADPRIVATE(d_h_col_vdf)
29 REAL, SAVE, DIMENSION(:), ALLOCATABLE :: f_h_bnd ! for diagnostics, enthalpy flux at surface
30 !$OMP THREADPRIVATE(f_h_bnd)
31
32 CONTAINS
33 !
34 !****************************************************************************************
35 !
36 60714644 SUBROUTINE climb_hq_down(knon, coefhq, paprs, pplay, &
37 delp, temp, q, dtime, &
38 !!! nrlmd le 02/05/2011
39 Ccoef_H_out, Ccoef_Q_out, Dcoef_H_out, Dcoef_Q_out, &
40 Kcoef_hq_out, gama_q_out, gama_h_out, &
41 !!!
42 1920 Acoef_H_out, Acoef_Q_out, Bcoef_H_out, Bcoef_Q_out)
43
44 ! This routine calculates recursivly the coefficients C and D
45 ! for the quantity X=[Q,H] in equation X(k) = C(k) + D(k)*X(k-1), where k is
46 ! the index of the vertical layer.
47 !
48 ! Input arguments
49 !****************************************************************************************
50 INTEGER, INTENT(IN) :: knon
51 REAL, DIMENSION(klon,klev), INTENT(IN) :: coefhq
52 REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay
53 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
54 REAL, DIMENSION(klon,klev), INTENT(IN) :: temp, delp ! temperature
55 REAL, DIMENSION(klon,klev), INTENT(IN) :: q
56 REAL, INTENT(IN) :: dtime
57
58 ! Output arguments
59 !****************************************************************************************
60 REAL, DIMENSION(klon), INTENT(OUT) :: Acoef_H_out
61 REAL, DIMENSION(klon), INTENT(OUT) :: Acoef_Q_out
62 REAL, DIMENSION(klon), INTENT(OUT) :: Bcoef_H_out
63 REAL, DIMENSION(klon), INTENT(OUT) :: Bcoef_Q_out
64
65 !!! nrlmd le 02/05/2011
66 REAL, DIMENSION(klon,klev), INTENT(OUT) :: Ccoef_H_out
67 REAL, DIMENSION(klon,klev), INTENT(OUT) :: Ccoef_Q_out
68 REAL, DIMENSION(klon,klev), INTENT(OUT) :: Dcoef_H_out
69 REAL, DIMENSION(klon,klev), INTENT(OUT) :: Dcoef_Q_out
70 REAL, DIMENSION(klon,klev), INTENT(OUT) :: Kcoef_hq_out
71 REAL, DIMENSION(klon,klev), INTENT(OUT) :: gama_q_out
72 REAL, DIMENSION(klon,klev), INTENT(OUT) :: gama_h_out
73 !!!
74
75 ! Local variables
76 !****************************************************************************************
77 LOGICAL, SAVE :: first=.TRUE.
78 !$OMP THREADPRIVATE(first)
79 ! JLD now renamed h_old and declared in module
80 ! REAL, DIMENSION(klon,klev) :: local_H
81 3840 REAL, DIMENSION(klon) :: psref
82 REAL :: delz, pkh
83 INTEGER :: k, i, ierr
84 ! Include
85 !****************************************************************************************
86 INCLUDE "YOMCST.h"
87 INCLUDE "compbl.h"
88
89
90 !****************************************************************************************
91 ! 1)
92 ! Allocation at first time step only
93 !
94 !****************************************************************************************
95
96
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1919 times.
1920 IF (first) THEN
97 1 first=.FALSE.
98
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE(Ccoef_Q(klon,klev), STAT=ierr)
99
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc Ccoef_Q, ierr=', ierr
100
101
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE(Dcoef_Q(klon,klev), STAT=ierr)
102
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc Dcoef_Q, ierr=', ierr
103
104
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE(Ccoef_H(klon,klev), STAT=ierr)
105
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc Ccoef_H, ierr=', ierr
106
107
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE(Dcoef_H(klon,klev), STAT=ierr)
108
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc Dcoef_H, ierr=', ierr
109
110
16/32
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✓ Branch 14 taken 1 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 1 times.
✗ Branch 19 not taken.
✗ Branch 20 not taken.
✓ Branch 21 taken 1 times.
✓ Branch 22 taken 1 times.
✗ Branch 23 not taken.
✓ Branch 24 taken 1 times.
✗ Branch 25 not taken.
✓ Branch 26 taken 1 times.
✗ Branch 27 not taken.
✗ Branch 28 not taken.
✓ Branch 29 taken 1 times.
✓ Branch 30 taken 1 times.
✗ Branch 31 not taken.
1 ALLOCATE(Acoef_Q(klon), Bcoef_Q(klon), Acoef_H(klon), Bcoef_H(klon), STAT=ierr)
111
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc Acoef_X and Bcoef_X, ierr=', ierr
112
113
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE(Kcoefhq(klon,klev), STAT=ierr)
114
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc Kcoefhq, ierr=', ierr
115
116
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE(gamaq(1:klon,2:klev), STAT=ierr)
117
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc gamaq, ierr=', ierr
118
119
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE(gamah(1:klon,2:klev), STAT=ierr)
120
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc gamah, ierr=', ierr
121
122
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
✗ Branch 11 not taken.
2 ALLOCATE(h_old(klon,klev), STAT=ierr)
123
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc h_old, ierr=', ierr
124
125
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(d_h_col_vdf(klon), STAT=ierr)
126
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc d_h_col_vdf, ierr=', ierr
127
128
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
1 ALLOCATE(f_h_bnd(klon), STAT=ierr)
129
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF ( ierr /= 0 ) PRINT*,' pb in allloc f_h_bnd, ierr=', ierr
130 END IF
131
132 !****************************************************************************************
133 ! 2)
134 ! Definition of the coeficient K
135 !
136 !****************************************************************************************
137
4/4
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 74430720 times.
✓ Branch 3 taken 74880 times.
74507520 Kcoefhq(:,:) = 0.0
138
2/2
✓ Branch 0 taken 72960 times.
✓ Branch 1 taken 1920 times.
74880 DO k = 2, klev
139
2/2
✓ Branch 0 taken 29961176 times.
✓ Branch 1 taken 72960 times.
30036056 DO i = 1, knon
140 Kcoefhq(i,k) = &
141 coefhq(i,k)*RG*RG*dtime /(pplay(i,k-1)-pplay(i,k)) &
142 72960 *(paprs(i,k)*2/(temp(i,k)+temp(i,k-1))/RD)**2
143 ENDDO
144 ENDDO
145
146 !****************************************************************************************
147 ! 3)
148 ! Calculation of gama for "Q" and "H"
149 !
150 !****************************************************************************************
151 ! surface pressure is used as reference
152
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 psref(:) = paprs(:,1)
153
154 ! definition of gama
155 1920 IF (iflag_pbl == 1) THEN
156 gamaq(:,:) = 0.0
157 gamah(:,:) = -1.0e-03
158 gamah(:,2) = -2.5e-03
159
160 ! conversion de gama
161 DO k = 2, klev
162 DO i = 1, knon
163 delz = RD * (temp(i,k-1)+temp(i,k)) / &
164 2.0 / RG / paprs(i,k) * (pplay(i,k-1)-pplay(i,k))
165 pkh = (psref(i)/paprs(i,k))**RKAPPA
166
167 ! convertie gradient verticale d'humidite specifique en difference d'humidite specifique entre centre de couches
168 gamaq(i,k) = gamaq(i,k) * delz
169 ! convertie gradient verticale de temperature en difference de temperature potentielle entre centre de couches
170 gamah(i,k) = gamah(i,k) * delz * RCPD * pkh
171 ENDDO
172 ENDDO
173
174 ELSE
175
4/4
✓ Branch 0 taken 72960 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 72522240 times.
✓ Branch 3 taken 72960 times.
72597120 gamaq(:,:) = 0.0
176
4/4
✓ Branch 0 taken 72960 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 72522240 times.
✓ Branch 3 taken 72960 times.
72597120 gamah(:,:) = 0.0
177 ENDIF
178
179
180 !****************************************************************************************
181 ! 4)
182 ! Calculte the coefficients C and D for specific humidity, q
183 !
184 !****************************************************************************************
185
186 CALL calc_coef(knon, Kcoefhq(:,:), gamaq(:,:), delp(:,:), q(:,:), &
187 1920 Ccoef_Q(:,:), Dcoef_Q(:,:), Acoef_Q, Bcoef_Q)
188
189 !****************************************************************************************
190 ! 5)
191 ! Calculte the coefficients C and D for potentiel entalpie, H
192 !
193 !****************************************************************************************
194
4/4
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 74430720 times.
✓ Branch 3 taken 74880 times.
74507520 h_old(:,:) = 0.0
195
196
2/2
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
76800 DO k=1,klev
197
2/2
✓ Branch 0 taken 30749628 times.
✓ Branch 1 taken 74880 times.
30826428 DO i = 1, knon
198 ! convertie la temperature en entalpie potentielle
199 h_old(i,k) = RCPD * temp(i,k) * &
200 74880 (psref(i)/pplay(i,k))**RKAPPA
201 ENDDO
202 ENDDO
203
204 CALL calc_coef(knon, Kcoefhq(:,:), gamah(:,:), delp(:,:), h_old(:,:), &
205 1920 Ccoef_H(:,:), Dcoef_H(:,:), Acoef_H, Bcoef_H)
206
207 !****************************************************************************************
208 ! 6)
209 ! Return the first layer in output variables
210 !
211 !****************************************************************************************
212
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 Acoef_H_out = Acoef_H
213
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 Bcoef_H_out = Bcoef_H
214
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 Acoef_Q_out = Acoef_Q
215
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 Bcoef_Q_out = Bcoef_Q
216
217 !****************************************************************************************
218 ! 7)
219 ! If Pbl is split, return also the other layers in output variables
220 !
221 !****************************************************************************************
222 !!! jyg le 07/02/2012
223 !!jyg IF (mod(iflag_pbl_split,2) .eq.1) THEN
224 1920 IF (mod(iflag_pbl_split,10) .ge.1) THEN
225 !!! nrlmd le 02/05/2011
226 DO k= 1, klev
227 DO i= 1, klon
228 Ccoef_H_out(i,k) = Ccoef_H(i,k)
229 Dcoef_H_out(i,k) = Dcoef_H(i,k)
230 Ccoef_Q_out(i,k) = Ccoef_Q(i,k)
231 Dcoef_Q_out(i,k) = Dcoef_Q(i,k)
232 Kcoef_hq_out(i,k) = Kcoefhq(i,k)
233 IF (k.eq.1) THEN
234 gama_h_out(i,k) = 0.
235 gama_q_out(i,k) = 0.
236 ELSE
237 gama_h_out(i,k) = gamah(i,k)
238 gama_q_out(i,k) = gamaq(i,k)
239 ENDIF
240 ENDDO
241 ENDDO
242 !!!
243 ENDIF ! (mod(iflag_pbl_split,2) .ge.1)
244 !!!
245
246 1920 END SUBROUTINE climb_hq_down
247 !
248 !****************************************************************************************
249 !
250 3840 SUBROUTINE calc_coef(knon, Kcoef, gama, delp, X, Ccoef, Dcoef, Acoef, Bcoef)
251 !
252 ! Calculate the coefficients C and D in : X(k) = C(k) + D(k)*X(k-1)
253 ! where X is H or Q, and k the vertical level k=1,klev
254 !
255 INCLUDE "YOMCST.h"
256 ! Input arguments
257 !****************************************************************************************
258 INTEGER, INTENT(IN) :: knon
259 REAL, DIMENSION(klon,klev), INTENT(IN) :: Kcoef, delp
260 REAL, DIMENSION(klon,klev), INTENT(IN) :: X
261 REAL, DIMENSION(klon,2:klev), INTENT(IN) :: gama
262
263 ! Output arguments
264 !****************************************************************************************
265 REAL, DIMENSION(klon), INTENT(OUT) :: Acoef, Bcoef
266 REAL, DIMENSION(klon,klev), INTENT(OUT) :: Ccoef, Dcoef
267
268 ! Local variables
269 !****************************************************************************************
270 INTEGER :: k, i
271 REAL :: buf
272
273 !****************************************************************************************
274 ! Niveau au sommet, k=klev
275 !
276 !****************************************************************************************
277
4/4
✓ Branch 0 taken 3840 times.
✓ Branch 1 taken 149760 times.
✓ Branch 2 taken 148861440 times.
✓ Branch 3 taken 149760 times.
149015040 Ccoef(:,:) = 0.0
278
4/4
✓ Branch 0 taken 149760 times.
✓ Branch 1 taken 3840 times.
✓ Branch 2 taken 148861440 times.
✓ Branch 3 taken 149760 times.
149015040 Dcoef(:,:) = 0.0
279
280
2/2
✓ Branch 0 taken 1576904 times.
✓ Branch 1 taken 3840 times.
1580744 DO i = 1, knon
281 1576904 buf = delp(i,klev) + Kcoef(i,klev)
282
283 1576904 Ccoef(i,klev) = (X(i,klev)*delp(i,klev) - Kcoef(i,klev)*gama(i,klev))/buf
284 1580744 Dcoef(i,klev) = Kcoef(i,klev)/buf
285 END DO
286
287
288 !****************************************************************************************
289 ! Niveau (klev-1) <= k <= 2
290 !
291 !****************************************************************************************
292
293
2/2
✓ Branch 0 taken 142080 times.
✓ Branch 1 taken 3840 times.
145920 DO k=(klev-1),2,-1
294
2/2
✓ Branch 0 taken 58345448 times.
✓ Branch 1 taken 142080 times.
58491368 DO i = 1, knon
295 58345448 buf = delp(i,k) + Kcoef(i,k) + Kcoef(i,k+1)*(1.-Dcoef(i,k+1))
296 Ccoef(i,k) = (X(i,k)*delp(i,k) + Kcoef(i,k+1)*Ccoef(i,k+1) + &
297 58345448 Kcoef(i,k+1)*gama(i,k+1) - Kcoef(i,k)*gama(i,k))/buf
298 58487528 Dcoef(i,k) = Kcoef(i,k)/buf
299 END DO
300 END DO
301
302 !****************************************************************************************
303 ! Niveau k=1
304 !
305 !****************************************************************************************
306
307
2/2
✓ Branch 0 taken 1576904 times.
✓ Branch 1 taken 3840 times.
1580744 DO i = 1, knon
308 1576904 buf = delp(i,1) + Kcoef(i,2)*(1.-Dcoef(i,2))
309 1576904 Acoef(i) = (X(i,1)*delp(i,1) + Kcoef(i,2)*(gama(i,2)+Ccoef(i,2)))/buf
310 3840 Bcoef(i) = -1. * RG / buf
311 END DO
312
313
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1920 times.
60714644 END SUBROUTINE calc_coef
314 !
315 !****************************************************************************************
316 !
317 1920 SUBROUTINE climb_hq_up(knon, dtime, t_old, q_old, &
318 flx_q1, flx_h1, paprs, pplay, &
319 !!! nrlmd le 02/05/2011
320 1920 Acoef_H_in, Acoef_Q_in, Bcoef_H_in, Bcoef_Q_in, &
321 Ccoef_H_in, Ccoef_Q_in, Dcoef_H_in, Dcoef_Q_in, &
322 Kcoef_hq_in, gama_q_in, gama_h_in, &
323 !!!
324 1920 flux_q, flux_h, d_q, d_t)
325 !
326 ! This routine calculates the flux and tendency of the specific humidity q and
327 ! the potential engergi H.
328 ! The quantities q and H are calculated according to
329 ! X(k) = C(k) + D(k)*X(k-1) for X=[q,H], where the coefficients
330 ! C and D are known from before and k is index of the vertical layer.
331 !
332
333 ! Input arguments
334 !****************************************************************************************
335 INTEGER, INTENT(IN) :: knon
336 REAL, INTENT(IN) :: dtime
337 REAL, DIMENSION(klon,klev), INTENT(IN) :: t_old, q_old
338 REAL, DIMENSION(klon), INTENT(IN) :: flx_q1, flx_h1
339 REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
340 REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay
341
342 !!! nrlmd le 02/05/2011
343 REAL, DIMENSION(klon), INTENT(IN) :: Acoef_H_in,Acoef_Q_in, Bcoef_H_in, Bcoef_Q_in
344 REAL, DIMENSION(klon,klev), INTENT(IN) :: Ccoef_H_in, Ccoef_Q_in, Dcoef_H_in, Dcoef_Q_in
345 REAL, DIMENSION(klon,klev), INTENT(IN) :: Kcoef_hq_in, gama_q_in, gama_h_in
346 !!!
347
348 ! Output arguments
349 !****************************************************************************************
350 REAL, DIMENSION(klon,klev), INTENT(OUT) :: flux_q, flux_h, d_q, d_t
351
352 ! Local variables
353 !****************************************************************************************
354 LOGICAL, SAVE :: last=.FALSE.
355 3840 REAL, DIMENSION(klon,klev) :: h_new, q_new
356 3840 REAL, DIMENSION(klon) :: psref
357 INTEGER :: k, i, ierr
358
359 ! Include
360 !****************************************************************************************
361 INCLUDE "YOMCST.h"
362 INCLUDE "compbl.h"
363
364 !****************************************************************************************
365 ! 1)
366 ! Definition of some variables
367 1920 REAL, DIMENSION(klon,klev) :: d_h, zairm
368 !
369 !****************************************************************************************
370
4/4
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 74430720 times.
✓ Branch 3 taken 74880 times.
74507520 flux_q(:,:) = 0.0
371
4/4
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 74430720 times.
✓ Branch 3 taken 74880 times.
74507520 flux_h(:,:) = 0.0
372
4/4
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 74430720 times.
✓ Branch 3 taken 74880 times.
74507520 d_q(:,:) = 0.0
373
4/4
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 74430720 times.
✓ Branch 3 taken 74880 times.
74507520 d_t(:,:) = 0.0
374
4/4
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
✓ Branch 2 taken 74430720 times.
✓ Branch 3 taken 74880 times.
74507520 d_h(:,:) = 0.0
375
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 f_h_bnd(:)= 0.0
376
377
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 psref(1:knon) = paprs(1:knon,1)
378
379 !!! jyg le 07/02/2012
380 !!jyg IF (mod(iflag_pbl_split,2) .eq.1) THEN
381
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (mod(iflag_pbl_split,10) .ge.1) THEN
382 !!! nrlmd le 02/05/2011
383 DO i = 1, knon
384 Acoef_H(i)=Acoef_H_in(i)
385 Acoef_Q(i)=Acoef_Q_in(i)
386 Bcoef_H(i)=Bcoef_H_in(i)
387 Bcoef_Q(i)=Bcoef_Q_in(i)
388 ENDDO
389 DO k = 1, klev
390 DO i = 1, knon
391 Ccoef_H(i,k)=Ccoef_H_in(i,k)
392 Ccoef_Q(i,k)=Ccoef_Q_in(i,k)
393 Dcoef_H(i,k)=Dcoef_H_in(i,k)
394 Dcoef_Q(i,k)=Dcoef_Q_in(i,k)
395 Kcoefhq(i,k)=Kcoef_hq_in(i,k)
396 IF (k.gt.1) THEN
397 gamah(i,k)=gama_h_in(i,k)
398 gamaq(i,k)=gama_q_in(i,k)
399 ENDIF
400 ENDDO
401 ENDDO
402 !!!
403 ENDIF ! (mod(iflag_pbl_split,2) .ge.1)
404 !!!
405
406 !****************************************************************************************
407 ! 2)
408 ! Calculation of Q and H
409 !
410 !****************************************************************************************
411
412 !- First layer
413
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 q_new(1:knon,1) = Acoef_Q(1:knon) + Bcoef_Q(1:knon)*flx_q1(1:knon)*dtime
414
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 h_new(1:knon,1) = Acoef_H(1:knon) + Bcoef_H(1:knon)*flx_h1(1:knon)*dtime
415
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 f_h_bnd(1:knon) = flx_h1(1:knon)
416 !- All the other layers
417
2/2
✓ Branch 0 taken 72960 times.
✓ Branch 1 taken 1920 times.
74880 DO k = 2, klev
418
2/2
✓ Branch 0 taken 29961176 times.
✓ Branch 1 taken 72960 times.
30036056 DO i = 1, knon
419 29961176 q_new(i,k) = Ccoef_Q(i,k) + Dcoef_Q(i,k)*q_new(i,k-1)
420 30034136 h_new(i,k) = Ccoef_H(i,k) + Dcoef_H(i,k)*h_new(i,k-1)
421 END DO
422 END DO
423 !****************************************************************************************
424 ! 3)
425 ! Calculation of the flux for Q and H
426 !
427 !****************************************************************************************
428
429 !- The flux at first layer, k=1
430
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 flux_q(1:knon,1)=flx_q1(1:knon)
431
2/2
✓ Branch 0 taken 788452 times.
✓ Branch 1 taken 1920 times.
790372 flux_h(1:knon,1)=flx_h1(1:knon)
432
433 !- The flux at all layers above surface
434
2/2
✓ Branch 0 taken 72960 times.
✓ Branch 1 taken 1920 times.
74880 DO k = 2, klev
435
2/2
✓ Branch 0 taken 29961176 times.
✓ Branch 1 taken 72960 times.
30036056 DO i = 1, knon
436 flux_q(i,k) = (Kcoefhq(i,k)/RG/dtime) * &
437 29961176 (q_new(i,k)-q_new(i,k-1)+gamaq(i,k))
438
439 flux_h(i,k) = (Kcoefhq(i,k)/RG/dtime) * &
440 30034136 (h_new(i,k)-h_new(i,k-1)+gamah(i,k))
441 END DO
442 END DO
443
444 !****************************************************************************************
445 ! 4)
446 ! Calculation of tendency for Q and H
447 !
448 !****************************************************************************************
449
2/2
✓ Branch 0 taken 1908480 times.
✓ Branch 1 taken 1920 times.
1910400 d_h_col_vdf(:) = 0.0
450
2/2
✓ Branch 0 taken 74880 times.
✓ Branch 1 taken 1920 times.
76800 DO k = 1, klev
451
2/2
✓ Branch 0 taken 30749628 times.
✓ Branch 1 taken 74880 times.
30826428 DO i = 1, knon
452 30749628 d_t(i,k) = h_new(i,k)/(psref(i)/pplay(i,k))**RKAPPA/RCPD - t_old(i,k)
453 30749628 d_q(i,k) = q_new(i,k) - q_old(i,k)
454 30749628 d_h(i,k) = h_new(i,k) - h_old(i,k)
455 !JLD d_t(i,k) = d_h(i,k)/(psref(i)/pplay(i,k))**RKAPPA/RCPD !correction a venir
456 ! layer air mass
457 30749628 zairm(i, k) = (paprs(i,k)-paprs(i,k+1))/rg
458 30824508 d_h_col_vdf(i) = d_h_col_vdf(i) + d_h(i,k)*zairm(i,k)
459 END DO
460 END DO
461
462 !****************************************************************************************
463 ! Some deallocations
464 !
465 !****************************************************************************************
466
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1920 times.
1920 IF (last) THEN
467 DEALLOCATE(Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H,stat=ierr)
468 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H, ierr=', ierr
469 DEALLOCATE(Acoef_Q, Bcoef_Q, Acoef_H, Bcoef_H,stat=ierr)
470 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Acoef_Q, Bcoef_Q, Acoef_H, Bcoef_H, ierr=', ierr
471 DEALLOCATE(gamaq, gamah,stat=ierr)
472 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate gamaq, gamah, ierr=', ierr
473 DEALLOCATE(Kcoefhq,stat=ierr)
474 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Kcoefhq, ierr=', ierr
475 DEALLOCATE(h_old, d_h_col_vdf, f_h_bnd, stat=ierr)
476 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate h_old, d_h_col_vdf, f_h_bnd, ierr=', ierr
477 END IF
478 1576904 END SUBROUTINE climb_hq_up
479 !
480 !****************************************************************************************
481 !
482 END MODULE climb_hq_mod
483
484
485
486
487
488
489