GCC Code Coverage Report

Directory: ./
File: dyn_phys/calfis.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 196 196 100.0%
Branches: 185 188 98.4%
Line Branch Exec Source
1 !
2 ! $Id: calfis.F 2604 2016-07-26 15:37:18Z emillour $
3 !
4 C
5 C
6 480 SUBROUTINE calfis(lafin,
7 $ jD_cur, jH_cur,
8 $ pucov,
9 $ pvcov,
10 $ pteta,
11 480 $ pq,
12 $ pmasse,
13 $ pps,
14 $ pp,
15 $ ppk,
16 $ pphis,
17 $ pphi,
18 $ pducov,
19 $ pdvcov,
20 $ pdteta,
21 $ pdq,
22 $ flxw,
23 $ pdufi,
24 $ pdvfi,
25 $ pdhfi,
26 $ pdqfi,
27 $ pdpsfi)
28 c
29 c Auteur : P. Le Van, F. Hourdin
30 c .........
31 USE infotrac, ONLY: nqtot, niadv, tname
32 USE control_mod, ONLY: planet_type, nsplit_phys
33 USE callphysiq_mod, ONLY: call_physiq
34 USE comconst_mod, ONLY: cpp, daysec, dtphys, dtvr, kappa, pi
35 USE comvert_mod, ONLY: preff, presnivs
36
37 IMPLICIT NONE
38 c=======================================================================
39 c
40 c 1. rearrangement des tableaux et transformation
41 c variables dynamiques > variables physiques
42 c 2. calcul des termes physiques
43 c 3. retransformation des tendances physiques en tendances dynamiques
44 c
45 c remarques:
46 c ----------
47 c
48 c - les vents sont donnes dans la physique par leurs composantes
49 c naturelles.
50 c - la variable thermodynamique de la physique est une variable
51 c intensive : T
52 c pour la dynamique on prend T * ( preff / p(l) ) **kappa
53 c - les deux seules variables dependant de la geometrie necessaires
54 c pour la physique sont la latitude pour le rayonnement et
55 c l'aire de la maille quand on veut integrer une grandeur
56 c horizontalement.
57 c - les points de la physique sont les points scalaires de la
58 c la dynamique; numerotation:
59 c 1 pour le pole nord
60 c (jjm-1)*iim pour l'interieur du domaine
61 c ngridmx pour le pole sud
62 c ---> ngridmx=2+(jjm-1)*iim
63 c
64 c Input :
65 c -------
66 c pucov covariant zonal velocity
67 c pvcov covariant meridional velocity
68 c pteta potential temperature
69 c pps surface pressure
70 c pmasse masse d'air dans chaque maille
71 c pts surface temperature (K)
72 c callrad clef d'appel au rayonnement
73 c
74 c Output :
75 c --------
76 c pdufi tendency for the natural zonal velocity (ms-1)
77 c pdvfi tendency for the natural meridional velocity
78 c pdhfi tendency for the potential temperature
79 c pdtsfi tendency for the surface temperature
80 c
81 c pdtrad radiative tendencies \ both input
82 c pfluxrad radiative fluxes / and output
83 c
84 c=======================================================================
85 c
86 c-----------------------------------------------------------------------
87 c
88 c 0. Declarations :
89 c ------------------
90
91 include "dimensions.h"
92 include "paramet.h"
93
94 INTEGER ngridmx
95 PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm )
96
97 include "comgeom2.h"
98 include "iniprint.h"
99
100 c Arguments :
101 c -----------
102 LOGICAL,INTENT(IN) :: lafin ! .true. for the very last call to physics
103 REAL,INTENT(IN):: jD_cur, jH_cur
104 REAL,INTENT(IN) :: pvcov(iip1,jjm,llm) ! covariant meridional velocity
105 REAL,INTENT(IN) :: pucov(iip1,jjp1,llm) ! covariant zonal velocity
106 REAL,INTENT(IN) :: pteta(iip1,jjp1,llm) ! potential temperature
107 REAL,INTENT(IN) :: pmasse(iip1,jjp1,llm) ! mass in each cell ! not used
108 REAL,INTENT(IN) :: pq(iip1,jjp1,llm,nqtot) ! tracers
109 REAL,INTENT(IN) :: pphis(iip1,jjp1) ! surface geopotential
110 REAL,INTENT(IN) :: pphi(iip1,jjp1,llm) ! geopotential
111
112 REAL,INTENT(IN) :: pdvcov(iip1,jjm,llm) ! dynamical tendency on vcov
113 REAL,INTENT(IN) :: pducov(iip1,jjp1,llm) ! dynamical tendency on ucov
114 REAL,INTENT(IN) :: pdteta(iip1,jjp1,llm) ! dynamical tendency on teta
115 ! NB: pdteta is used only to compute pcvgt which is in fact not used...
116 REAL,INTENT(IN) :: pdq(iip1,jjp1,llm,nqtot) ! dynamical tendency on tracers
117 ! NB: pdq is only used to compute pcvgq which is in fact not used...
118
119 REAL,INTENT(IN) :: pps(iip1,jjp1) ! surface pressure (Pa)
120 REAL,INTENT(IN) :: pp(iip1,jjp1,llmp1) ! pressure at mesh interfaces (Pa)
121 REAL,INTENT(IN) :: ppk(iip1,jjp1,llm) ! Exner at mid-layer
122 REAL,INTENT(IN) :: flxw(iip1,jjp1,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0)
123
124 ! tendencies (in */s) from the physics
125 REAL,INTENT(OUT) :: pdvfi(iip1,jjm,llm) ! tendency on covariant meridional wind
126 REAL,INTENT(OUT) :: pdufi(iip1,jjp1,llm) ! tendency on covariant zonal wind
127 REAL,INTENT(OUT) :: pdhfi(iip1,jjp1,llm) ! tendency on potential temperature (K/s)
128 REAL,INTENT(OUT) :: pdqfi(iip1,jjp1,llm,nqtot) ! tendency on tracers
129 REAL,INTENT(OUT) :: pdpsfi(iip1,jjp1) ! tendency on surface pressure (Pa/s)
130
131
132 c Local variables :
133 c -----------------
134
135 INTEGER i,j,l,ig0,ig,iq,iiq
136 REAL zpsrf(ngridmx)
137 REAL zplev(ngridmx,llm+1),zplay(ngridmx,llm)
138 REAL zphi(ngridmx,llm),zphis(ngridmx)
139 c
140 REAL zrot(iip1,jjm,llm) ! AdlC May 2014
141 REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
142 REAL zrfi(ngridmx,llm) ! relative wind vorticity
143 960 REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot)
144 REAL zpk(ngridmx,llm)
145 c
146 REAL pcvgu(ngridmx,llm), pcvgv(ngridmx,llm)
147 REAL pcvgt(ngridmx,llm), pcvgq(ngridmx,llm,2)
148 c
149 REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
150 960 REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqtot)
151 REAL zdpsrf(ngridmx)
152 c
153 REAL zdufic(ngridmx,llm),zdvfic(ngridmx,llm)
154 960 REAL zdtfic(ngridmx,llm),zdqfic(ngridmx,llm,nqtot)
155 REAL jH_cur_split,zdt_split
156 LOGICAL debut_split,lafin_split
157 INTEGER isplit
158
159 REAL zsin(iim),zcos(iim),z1(iim)
160 REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
161 REAL unskap, pksurcp
162 c
163 REAL flxwfi(ngridmx,llm) ! Flux de masse verticale sur la grille physiq
164 c
165
166 REAL SSUM
167
168 LOGICAL,SAVE :: firstcal=.true., debut=.true.
169 ! REAL rdayvrai
170
171 c
172 c-----------------------------------------------------------------------
173 c
174 c 1. Initialisations :
175 c --------------------
176 c
177 c
178
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
 480 IF ( firstcal ) THEN
179 1 debut = .TRUE.
180 IF (ngridmx.NE.2+(jjm-1)*iim) THEN
181 write(lunout,*) 'STOP dans calfis'
182 write(lunout,*)
183 & 'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
184 write(lunout,*) ' ngridmx jjm iim '
185 write(lunout,*) ngridmx,jjm,iim
186 STOP
187 ENDIF
188 ELSE
189 479 debut = .FALSE.
190 ENDIF ! of IF (firstcal)
191
192 c
193 c
194 c-----------------------------------------------------------------------
195 c 40. transformation des variables dynamiques en variables physiques:
196 c ---------------------------------------------------------------
197
198 c 41. pressions au sol (en Pascals)
199 c ----------------------------------
200
201
202 480 zpsrf(1) = pps(1,1)
203
204 ig0 = 2
205
2/2
✓ Branch 0 taken 14880 times.
✓ Branch 1 taken 480 times.
 15360 DO j = 2,jjm
206 14880 CALL SCOPY( iim,pps(1,j),1,zpsrf(ig0), 1 )
207 15360 ig0 = ig0+iim
208 ENDDO
209
210 480 zpsrf(ngridmx) = pps(1,jjp1)
211
212
213 c 42. pression intercouches et fonction d'Exner:
214 c
215 c -----------------------------------------------------------------
216 c .... zplev definis aux (llm +1) interfaces des couches ....
217 c .... zplay definis aux ( llm ) milieux des couches ....
218 c -----------------------------------------------------------------
219
220 c ... Exner = cp * ( p(l) / preff ) ** kappa ....
221 c
222 480 unskap = 1./ kappa
223 c
224
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l = 1, llm
225 18720 zpk( 1,l ) = ppk(1,1,l)
226 18720 zplev( 1,l ) = pp(1,1,l)
227 ig0 = 2
228
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
 599040 DO j = 2, jjm
229
2/2
✓ Branch 0 taken 18570240 times.
✓ Branch 1 taken 580320 times.
 19169280 DO i =1, iim
230 18570240 zpk( ig0,l ) = ppk(i,j,l)
231 18570240 zplev( ig0,l ) = pp(i,j,l)
232 19150560 ig0 = ig0 +1
233 ENDDO
234 ENDDO
235 18720 zpk( ngridmx,l ) = ppk(1,jjp1,l)
236 19200 zplev( ngridmx,l ) = pp(1,jjp1,l)
237 ENDDO
238 480 zplev( 1,llmp1 ) = pp(1,1,llmp1)
239 ig0 = 2
240
2/2
✓ Branch 0 taken 14880 times.
✓ Branch 1 taken 480 times.
 15360 DO j = 2, jjm
241
2/2
✓ Branch 0 taken 476160 times.
✓ Branch 1 taken 14880 times.
 491520 DO i =1, iim
242 476160 zplev( ig0,llmp1 ) = pp(i,j,llmp1)
243 491040 ig0 = ig0 +1
244 ENDDO
245 ENDDO
246 480 zplev( ngridmx,llmp1 ) = pp(1,jjp1,llmp1)
247 c
248 c
249
250 c 43. temperature naturelle (en K) et pressions milieux couches .
251 c ---------------------------------------------------------------
252
253
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
254
255 18720 pksurcp = ppk(1,1,l) / cpp
256 18720 zplay(1,l) = preff * pksurcp ** unskap
257 18720 ztfi(1,l) = pteta(1,1,l) * pksurcp
258 18720 pcvgt(1,l) = pdteta(1,1,l) * pksurcp / pmasse(1,1,l)
259 ig0 = 2
260
261
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
 599040 DO j = 2, jjm
262
2/2
✓ Branch 0 taken 18570240 times.
✓ Branch 1 taken 580320 times.
 19169280 DO i = 1, iim
263 18570240 pksurcp = ppk(i,j,l) / cpp
264 18570240 zplay(ig0,l) = preff * pksurcp ** unskap
265 18570240 ztfi(ig0,l) = pteta(i,j,l) * pksurcp
266 18570240 pcvgt(ig0,l) = pdteta(i,j,l) * pksurcp / pmasse(i,j,l)
267 19150560 ig0 = ig0 + 1
268 ENDDO
269 ENDDO
270
271 18720 pksurcp = ppk(1,jjp1,l) / cpp
272 18720 zplay(ig0,l) = preff * pksurcp ** unskap
273 18720 ztfi (ig0,l) = pteta(1,jjp1,l) * pksurcp
274 19200 pcvgt(ig0,l) = pdteta(1,jjp1,l) * pksurcp/ pmasse(1,jjp1,l)
275
276 ENDDO
277
278 c 43.bis traceurs
279 c ---------------
280 c
281
2/2
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
 2880 DO iq=1,nqtot
282 2400 iiq=niadv(iq)
283
2/2
✓ Branch 0 taken 93600 times.
✓ Branch 1 taken 2400 times.
 96480 DO l=1,llm
284 93600 zqfi(1,l,iq) = pq(1,1,l,iiq)
285 ig0 = 2
286
2/2
✓ Branch 0 taken 2901600 times.
✓ Branch 1 taken 93600 times.
 2995200 DO j=2,jjm
287
2/2
✓ Branch 0 taken 92851200 times.
✓ Branch 1 taken 2901600 times.
 95846400 DO i = 1, iim
288 92851200 zqfi(ig0,l,iq) = pq(i,j,l,iiq)
289 95752800 ig0 = ig0 + 1
290 ENDDO
291 ENDDO
292 96000 zqfi(ig0,l,iq) = pq(1,jjp1,l,iiq)
293 ENDDO
294 ENDDO
295
296 c convergence dynamique pour les traceurs "EAU"
297 ! Earth-specific treatment of first 2 tracers (water)
298
1/2
✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
 480 if (planet_type=="earth") then
299
2/2
✓ Branch 0 taken 960 times.
✓ Branch 1 taken 480 times.
 1440 DO iq=1,2
300
2/2
✓ Branch 0 taken 37440 times.
✓ Branch 1 taken 960 times.
 38880 DO l=1,llm
301 37440 pcvgq(1,l,iq)= pdq(1,1,l,iq) / pmasse(1,1,l)
302 ig0 = 2
303
2/2
✓ Branch 0 taken 1160640 times.
✓ Branch 1 taken 37440 times.
 1198080 DO j=2,jjm
304
2/2
✓ Branch 0 taken 37140480 times.
✓ Branch 1 taken 1160640 times.
 38338560 DO i = 1, iim
305 37140480 pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)
306 38301120 ig0 = ig0 + 1
307 ENDDO
308 ENDDO
309 38400 pcvgq(ig0,l,iq)= pdq(1,jjp1,l,iq) / pmasse(1,jjp1,l)
310 ENDDO
311 ENDDO
312 endif ! of if (planet_type=="earth")
313
314
315 c Geopotentiel calcule par rapport a la surface locale:
316 c -----------------------------------------------------
317
318 480 CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,pphi,zphi)
319 480 CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
320
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
321
2/2
✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
 18626880 DO ig=1,ngridmx
322 18626400 zphi(ig,l)=zphi(ig,l)-zphis(ig)
323 ENDDO
324 ENDDO
325
326 c .... Calcul de la vitesse verticale ( en Pa*m*s ou Kg/s ) ....
327 c JG : ancien calcule de omega utilise dans physiq.F. Maintenant le flux
328 c de masse est calclue dans advtrac.F
329 c DO l=1,llm
330 c pvervel(1,l)=pw(1,1,l) * g /apoln
331 c ig0=2
332 c DO j=2,jjm
333 c DO i = 1, iim
334 c pvervel(ig0,l) = pw(i,j,l) * g * unsaire(i,j)
335 c ig0 = ig0 + 1
336 c ENDDO
337 c ENDDO
338 c pvervel(ig0,l)=pw(1,jjp1,l) * g /apols
339 c ENDDO
340
341 c
342 c 45. champ u:
343 c ------------
344
345
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO 50 l=1,llm
346
347
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
 599040 DO 25 j=2,jjm
348 580320 ig0 = 1+(j-2)*iim
349 zufi(ig0+1,l)= 0.5 *
350 580320 $ ( pucov(iim,j,l)/cu(iim,j) + pucov(1,j,l)/cu(1,j) )
351 pcvgu(ig0+1,l)= 0.5 *
352 580320 $ ( pducov(iim,j,l)/cu(iim,j) + pducov(1,j,l)/cu(1,j) )
353
2/2
✓ Branch 0 taken 17989920 times.
✓ Branch 1 taken 580320 times.
 18570240 DO 10 i=2,iim
354 zufi(ig0+i,l)= 0.5 *
355 17989920 $ ( pucov(i-1,j,l)/cu(i-1,j) + pucov(i,j,l)/cu(i,j) )
356 pcvgu(ig0+i,l)= 0.5 *
357 17989920 $ ( pducov(i-1,j,l)/cu(i-1,j) + pducov(i,j,l)/cu(i,j) )
358 580320 10 CONTINUE
359 18720 25 CONTINUE
360
361 480 50 CONTINUE
362
363
364 C Alvaro de la Camara (May 2014)
365 C 46.1 Calcul de la vorticite et passage sur la grille physique
366 C --------------------------------------------------------------
367
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
368
2/2
✓ Branch 0 taken 599040 times.
✓ Branch 1 taken 18720 times.
 618240 do i=1,iim
369
2/2
✓ Branch 0 taken 19169280 times.
✓ Branch 1 taken 599040 times.
 19787040 do j=1,jjm
370 zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l)
371 $ + pucov(i,j+1,l) - pucov(i,j,l))
372 $ / (cu(i,j)+cu(i,j+1))
373 19768320 $ / (cv(i+1,j)+cv(i,j)) *4
374 enddo
375 enddo
376 ENDDO
377
378 c 46.champ v:
379 c -----------
380
381
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
382
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
 599520 DO j=2,jjm
383 580320 ig0=1+(j-2)*iim
384
2/2
✓ Branch 0 taken 18570240 times.
✓ Branch 1 taken 580320 times.
 19150560 DO i=1,iim
385 zvfi(ig0+i,l)= 0.5 *
386 18570240 $ ( pvcov(i,j-1,l)/cv(i,j-1) + pvcov(i,j,l)/cv(i,j) )
387 pcvgv(ig0+i,l)= 0.5 *
388 19150560 $ ( pdvcov(i,j-1,l)/cv(i,j-1) + pdvcov(i,j,l)/cv(i,j) )
389 ENDDO
390 zrfi(ig0 + 1,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l)
391 580320 & +zrot(1,j-1,l)+zrot(1,j,l))
392
2/2
✓ Branch 0 taken 17989920 times.
✓ Branch 1 taken 580320 times.
 18588960 DO i=2,iim
393 zrfi(ig0 + i,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l)
394 18570240 $ +zrot(i,j-1,l)+zrot(i,j,l)) ! AdlC MAY 2014
395 ENDDO
396 ENDDO
397 ENDDO
398
399
400 c 47. champs de vents aux pole nord
401 c ------------------------------
402 c U = 1 / pi * integrale [ v * cos(long) * d long ]
403 c V = 1 / pi * integrale [ v * sin(long) * d long ]
404
405
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
406
407 18720 z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
408 18720 z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
409
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
 599040 DO i=2,iim
410 580320 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
411 599040 z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
412 ENDDO
413
414
2/2
✓ Branch 0 taken 599040 times.
✓ Branch 1 taken 18720 times.
 617760 DO i=1,iim
415 599040 zcos(i) = COS(rlonv(i))*z1(i)
416 599040 zcosbis(i)= COS(rlonv(i))*z1bis(i)
417 599040 zsin(i) = SIN(rlonv(i))*z1(i)
418 617760 zsinbis(i)= SIN(rlonv(i))*z1bis(i)
419 ENDDO
420
421 18720 zufi(1,l) = SSUM(iim,zcos,1)/pi
422 18720 pcvgu(1,l) = SSUM(iim,zcosbis,1)/pi
423 18720 zvfi(1,l) = SSUM(iim,zsin,1)/pi
424 18720 pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi
425 19200 zrfi(1, l) = 0.
426 ENDDO
427
428
429 c 48. champs de vents aux pole sud:
430 c ---------------------------------
431 c U = 1 / pi * integrale [ v * cos(long) * d long ]
432 c V = 1 / pi * integrale [ v * sin(long) * d long ]
433
434
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
435
436 18720 z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
437 18720 z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
438
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
 599040 DO i=2,iim
439 580320 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
440 599040 z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
441 ENDDO
442
443
2/2
✓ Branch 0 taken 599040 times.
✓ Branch 1 taken 18720 times.
 617760 DO i=1,iim
444 599040 zcos(i) = COS(rlonv(i))*z1(i)
445 599040 zcosbis(i) = COS(rlonv(i))*z1bis(i)
446 599040 zsin(i) = SIN(rlonv(i))*z1(i)
447 617760 zsinbis(i) = SIN(rlonv(i))*z1bis(i)
448 ENDDO
449
450 18720 zufi(ngridmx,l) = SSUM(iim,zcos,1)/pi
451 18720 pcvgu(ngridmx,l) = SSUM(iim,zcosbis,1)/pi
452 18720 zvfi(ngridmx,l) = SSUM(iim,zsin,1)/pi
453 18720 pcvgv(ngridmx,l) = SSUM(iim,zsinbis,1)/pi
454 19200 zrfi(ngridmx, l) = 0.
455 ENDDO
456 c
457 c On change de grille, dynamique vers physiq, pour le flux de masse verticale
458 480 CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,flxw,flxwfi)
459
460 c-----------------------------------------------------------------------
461 c Appel de la physique:
462 c ---------------------
463
464
465
466 ! write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
467 480 zdt_split=dtphys/nsplit_phys
468 480 zdufic(:,:)=0.
469 480 zdvfic(:,:)=0.
470 480 zdtfic(:,:)=0.
471
6/6
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 93600 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 93038400 times.
✓ Branch 5 taken 93600 times.
 93134880 zdqfic(:,:,:)=0.
472
473
474
2/2
✓ Branch 0 taken 480 times.
✓ Branch 1 taken 480 times.
 960 do isplit=1,nsplit_phys
475
476 480 jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
477
3/4
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
 480 debut_split=debut.and.isplit==1
478
3/4
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
 480 lafin_split=lafin.and.isplit==nsplit_phys
479
480 CALL call_physiq(ngridmx,llm,nqtot,tname,
481 & debut_split,lafin_split,
482 & jD_cur,jH_cur_split,zdt_split,
483 & zplev,zplay,
484 & zpk,zphi,zphis,
485 & presnivs,
486 & zufi,zvfi,zrfi,ztfi,zqfi,
487 & flxwfi,pducov,
488 480 & zdufi,zdvfi,zdtfi,zdqfi,zdpsrf)
489
490 ! if (planet_type=="earth") then
491 !
492 ! CALL physiq (ngridmx,
493 ! . llm,
494 ! . debut_split,
495 ! . lafin_split,
496 ! . jD_cur,
497 ! . jH_cur_split,
498 ! . zdt_split,
499 ! . zplev,
500 ! . zplay,
501 ! . zphi,
502 ! . zphis,
503 ! . presnivs,
504 ! . zufi,
505 ! . zvfi, zrfi,
506 ! . ztfi,
507 ! . zqfi,
508 ! . flxwfi,
509 ! . zdufi,
510 ! . zdvfi,
511 ! . zdtfi,
512 ! . zdqfi,
513 ! . zdpsrf,
514 ! . pducov)
515 !
516 ! else if ( planet_type=="generic" ) then
517 !
518 ! CALL physiq (ngridmx, !! ngrid
519 ! . llm, !! nlayer
520 ! . nqtot, !! nq
521 ! . tname, !! tracer names from dynamical core (given in infotrac)
522 ! . debut_split, !! firstcall
523 ! . lafin_split, !! lastcall
524 ! . jD_cur, !! pday. see leapfrog
525 ! . jH_cur_split, !! ptime "fraction of day"
526 ! . zdt_split, !! ptimestep
527 ! . zplev, !! pplev
528 ! . zplay, !! pplay
529 ! . zphi, !! pphi
530 ! . zufi, !! pu
531 ! . zvfi, !! pv
532 ! . ztfi, !! pt
533 ! . zqfi, !! pq
534 ! . flxwfi, !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
535 ! . zdufi, !! pdu
536 ! . zdvfi, !! pdv
537 ! . zdtfi, !! pdt
538 ! . zdqfi, !! pdq
539 ! . zdpsrf, !! pdpsrf
540 ! . tracerdyn) !! tracerdyn <-- utilite ???
541 !
542 ! endif ! of if (planet_type=="earth")
543
544
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split
545
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 zvfi(:,:)=zvfi(:,:)+zdvfi(:,:)*zdt_split
546
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 ztfi(:,:)=ztfi(:,:)+zdtfi(:,:)*zdt_split
547
6/6
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 93600 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 93038400 times.
✓ Branch 5 taken 93600 times.
 93134880 zqfi(:,:,:)=zqfi(:,:,:)+zdqfi(:,:,:)*zdt_split
548
549
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 zdufic(:,:)=zdufic(:,:)+zdufi(:,:)
550
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 zdvfic(:,:)=zdvfic(:,:)+zdvfi(:,:)
551
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 zdtfic(:,:)=zdtfic(:,:)+zdtfi(:,:)
552
6/6
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 93600 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 93038400 times.
✓ Branch 5 taken 93600 times.
 93135360 zdqfic(:,:,:)=zdqfic(:,:,:)+zdqfi(:,:,:)
553
554 enddo ! of do isplit=1,nsplit_phys
555
556 ! of #ifdef 1
557
558
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 zdufi(:,:)=zdufic(:,:)/nsplit_phys
559
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 zdvfi(:,:)=zdvfic(:,:)/nsplit_phys
560
4/4
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
 18626880 zdtfi(:,:)=zdtfic(:,:)/nsplit_phys
561
6/6
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 93600 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 93038400 times.
✓ Branch 5 taken 93600 times.
 93134880 zdqfi(:,:,:)=zdqfic(:,:,:)/nsplit_phys
562
563
564 500 CONTINUE
565
566 c-----------------------------------------------------------------------
567 c transformation des tendances physiques en tendances dynamiques:
568 c ---------------------------------------------------------------
569
570 c tendance sur la pression :
571 c -----------------------------------
572
573 480 CALL gr_fi_dyn(1,ngridmx,iip1,jjp1,zdpsrf,pdpsfi)
574 c
575 c 62. enthalpie potentielle
576 c ---------------------
577
578
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
579
580
2/2
✓ Branch 0 taken 617760 times.
✓ Branch 1 taken 18720 times.
 636480 DO i=1,iip1
581 617760 pdhfi(i,1,l) = cpp * zdtfi(1,l) / ppk(i, 1 ,l)
582 636480 pdhfi(i,jjp1,l) = cpp * zdtfi(ngridmx,l)/ ppk(i,jjp1,l)
583 ENDDO
584
585
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
 599520 DO j=2,jjm
586 580320 ig0=1+(j-2)*iim
587
2/2
✓ Branch 0 taken 18570240 times.
✓ Branch 1 taken 580320 times.
 19150560 DO i=1,iim
588 19150560 pdhfi(i,j,l) = cpp * zdtfi(ig0+i,l) / ppk(i,j,l)
589 ENDDO
590 599040 pdhfi(iip1,j,l) = pdhfi(1,j,l)
591 ENDDO
592
593 ENDDO
594
595
596 c 62. humidite specifique
597 c ---------------------
598 ! Ehouarn: removed this useless bit: was overwritten at step 63 anyways
599 ! DO iq=1,nqtot
600 ! DO l=1,llm
601 ! DO i=1,iip1
602 ! pdqfi(i,1,l,iq) = zdqfi(1,l,iq)
603 ! pdqfi(i,jjp1,l,iq) = zdqfi(ngridmx,l,iq)
604 ! ENDDO
605 ! DO j=2,jjm
606 ! ig0=1+(j-2)*iim
607 ! DO i=1,iim
608 ! pdqfi(i,j,l,iq) = zdqfi(ig0+i,l,iq)
609 ! ENDDO
610 ! pdqfi(iip1,j,l,iq) = pdqfi(1,j,l,iq)
611 ! ENDDO
612 ! ENDDO
613 ! ENDDO
614
615 c 63. traceurs
616 c ------------
617 C initialisation des tendances
618
8/8
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 93600 times.
✓ Branch 3 taken 2400 times.
✓ Branch 4 taken 3088800 times.
✓ Branch 5 taken 93600 times.
✓ Branch 6 taken 101930400 times.
✓ Branch 7 taken 3088800 times.
 105115680 pdqfi(:,:,:,:)=0.
619 C
620
2/2
✓ Branch 0 taken 2400 times.
✓ Branch 1 taken 480 times.
 2880 DO iq=1,nqtot
621 2400 iiq=niadv(iq)
622
2/2
✓ Branch 0 taken 93600 times.
✓ Branch 1 taken 2400 times.
 96480 DO l=1,llm
623
2/2
✓ Branch 0 taken 3088800 times.
✓ Branch 1 taken 93600 times.
 3182400 DO i=1,iip1
624 3088800 pdqfi(i,1,l,iiq) = zdqfi(1,l,iq)
625 3182400 pdqfi(i,jjp1,l,iiq) = zdqfi(ngridmx,l,iq)
626 ENDDO
627
2/2
✓ Branch 0 taken 2901600 times.
✓ Branch 1 taken 93600 times.
 2997600 DO j=2,jjm
628 2901600 ig0=1+(j-2)*iim
629
2/2
✓ Branch 0 taken 92851200 times.
✓ Branch 1 taken 2901600 times.
 95752800 DO i=1,iim
630 95752800 pdqfi(i,j,l,iiq) = zdqfi(ig0+i,l,iq)
631 ENDDO
632 2995200 pdqfi(iip1,j,l,iiq) = pdqfi(1,j,l,iq)
633 ENDDO
634 ENDDO
635 ENDDO
636
637 c 65. champ u:
638 c ------------
639
640
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
641
642
2/2
✓ Branch 0 taken 617760 times.
✓ Branch 1 taken 18720 times.
 636480 DO i=1,iip1
643 617760 pdufi(i,1,l) = 0.
644 636480 pdufi(i,jjp1,l) = 0.
645 ENDDO
646
647
2/2
✓ Branch 0 taken 580320 times.
✓ Branch 1 taken 18720 times.
 599520 DO j=2,jjm
648 580320 ig0=1+(j-2)*iim
649
2/2
✓ Branch 0 taken 17989920 times.
✓ Branch 1 taken 580320 times.
 18570240 DO i=1,iim-1
650 pdufi(i,j,l)=
651 18570240 $ 0.5*(zdufi(ig0+i,l)+zdufi(ig0+i+1,l))*cu(i,j)
652 ENDDO
653 pdufi(iim,j,l)=
654 580320 $ 0.5*(zdufi(ig0+1,l)+zdufi(ig0+iim,l))*cu(iim,j)
655 599040 pdufi(iip1,j,l)=pdufi(1,j,l)
656 ENDDO
657
658 ENDDO
659
660
661 c 67. champ v:
662 c ------------
663
664
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
665
666
2/2
✓ Branch 0 taken 561600 times.
✓ Branch 1 taken 18720 times.
 580800 DO j=2,jjm-1
667 561600 ig0=1+(j-2)*iim
668
2/2
✓ Branch 0 taken 17971200 times.
✓ Branch 1 taken 561600 times.
 18532800 DO i=1,iim
669 pdvfi(i,j,l)=
670 18532800 $ 0.5*(zdvfi(ig0+i,l)+zdvfi(ig0+i+iim,l))*cv(i,j)
671 ENDDO
672 580320 pdvfi(iip1,j,l) = pdvfi(1,j,l)
673 ENDDO
674 ENDDO
675
676
677 c 68. champ v pres des poles:
678 c ---------------------------
679 c v = U * cos(long) + V * SIN(long)
680
681
2/2
✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
 19200 DO l=1,llm
682
683
2/2
✓ Branch 0 taken 599040 times.
✓ Branch 1 taken 18720 times.
 617760 DO i=1,iim
684 pdvfi(i,1,l)=
685 599040 $ zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i))
686 pdvfi(i,jjm,l)=zdufi(ngridmx,l)*COS(rlonv(i))
687 599040 $ +zdvfi(ngridmx,l)*SIN(rlonv(i))
688 pdvfi(i,1,l)=
689 599040 $ 0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1)
690 pdvfi(i,jjm,l)=
691 617760 $ 0.5*(pdvfi(i,jjm,l)+zdvfi(ngridmx-iip1+i,l))*cv(i,jjm)
692 ENDDO
693
694 18720 pdvfi(iip1,1,l) = pdvfi(1,1,l)
695 19200 pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
696
697 ENDDO
698
699 c-----------------------------------------------------------------------
700
701 700 CONTINUE
702
703 480 firstcal = .FALSE.
704
705 480 RETURN
706 END
707