/[lmdze]/trunk/dyn3d/calfis.f
ViewVC logotype

Contents of /trunk/dyn3d/calfis.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 34 - (show annotations)
Wed Jun 2 11:01:12 2010 UTC (14 years ago) by guez
Original Path: trunk/libf/dyn3d/calfis.f90
File size: 13459 byte(s)
Split "ini_hist.f90" into single-procedure files.

In "calfis" and "physiq", removed dummy argument "nq" since "nq" must
be equal to "nqmx".

In "calfis", renamed dummy argument "pq" to "q", same name as actual
argument in "leapfrog". Renamed local variable "zqfi" to "qx", same
name as dummy argument in "physiq".

Removed arguments "itop_con" and "ibas_con" of "phytrac", which were
not used.

1 module calfis_m
2
3 ! Clean: no C preprocessor directive, no include line
4
5 IMPLICIT NONE
6
7 contains
8
9 SUBROUTINE calfis(lafin, rdayvrai, heure, pucov, pvcov, pteta, q, &
10 pmasse, pps, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, pw, &
11 pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)
12
13 ! From dyn3d/calfis.F, v 1.3 2005/05/25 13:10:09
14
15 ! Auteurs : P. Le Van, F. Hourdin
16
17 ! 1. rearrangement des tableaux et transformation
18 ! variables dynamiques > variables physiques
19 ! 2. calcul des termes physiques
20 ! 3. retransformation des tendances physiques en tendances dynamiques
21
22 ! remarques:
23 ! ----------
24
25 ! - les vents sont donnes dans la physique par leurs composantes
26 ! naturelles.
27 ! - la variable thermodynamique de la physique est une variable
28 ! intensive : T
29 ! pour la dynamique on prend T * (preff / p(l)) **kappa
30 ! - les deux seules variables dependant de la geometrie necessaires
31 ! pour la physique sont la latitude pour le rayonnement et
32 ! l'aire de la maille quand on veut integrer une grandeur
33 ! horizontalement.
34
35 ! Input :
36 ! -------
37 ! pucov covariant zonal velocity
38 ! pvcov covariant meridional velocity
39 ! pteta potential temperature
40 ! pps surface pressure
41 ! pmasse masse d'air dans chaque maille
42 ! pts surface temperature (K)
43 ! callrad clef d'appel au rayonnement
44
45 ! Output :
46 ! --------
47 ! pdufi tendency for the natural zonal velocity (ms-1)
48 ! pdvfi tendency for the natural meridional velocity
49 ! pdhfi tendency for the potential temperature
50 ! pdtsfi tendency for the surface temperature
51
52 ! pdtrad radiative tendencies \ both input
53 ! pfluxrad radiative fluxes / and output
54
55 use dimens_m, only: iim, jjm, llm, nqmx
56 use dimphy, only: klon
57 use comconst, only: kappa, cpp, dtphys, g, pi
58 use comvert, only: preff
59 use comgeom, only: apoln, cu_2d, cv_2d, unsaire_2d, apols, rlonu, rlonv
60 use iniadvtrac_m, only: niadv
61 use grid_change, only: dyn_phy, gr_fi_dyn
62 use physiq_m, only: physiq
63 use pressure_var, only: p3d, pls
64
65 ! Arguments :
66
67 LOGICAL, intent(in):: lafin
68 REAL, intent(in):: heure ! heure de la journée en fraction de jour
69
70 REAL pvcov(iim + 1, jjm, llm)
71 REAL pucov(iim + 1, jjm + 1, llm)
72 REAL pteta(iim + 1, jjm + 1, llm)
73 REAL pmasse(iim + 1, jjm + 1, llm)
74
75 REAL, intent(in):: q(iim + 1, jjm + 1, llm, nqmx)
76 ! (mass fractions of advected fields)
77
78 REAL pphis(iim + 1, jjm + 1)
79 REAL pphi(iim + 1, jjm + 1, llm)
80
81 REAL pdvcov(iim + 1, jjm, llm)
82 REAL pducov(iim + 1, jjm + 1, llm)
83 REAL pdteta(iim + 1, jjm + 1, llm)
84 REAL pdq(iim + 1, jjm + 1, llm, nqmx)
85
86 REAL pw(iim + 1, jjm + 1, llm)
87
88 REAL pps(iim + 1, jjm + 1)
89 REAL, intent(in):: ppk(iim + 1, jjm + 1, llm)
90
91 REAL pdvfi(iim + 1, jjm, llm)
92 REAL pdufi(iim + 1, jjm + 1, llm)
93 REAL pdhfi(iim + 1, jjm + 1, llm)
94 REAL pdqfi(iim + 1, jjm + 1, llm, nqmx)
95 REAL pdpsfi(iim + 1, jjm + 1)
96
97 INTEGER, PARAMETER:: longcles = 20
98
99 ! Local variables :
100
101 INTEGER i, j, l, ig0, ig, iq, iiq
102 REAL zpsrf(klon)
103 REAL zplev(klon, llm+1), zplay(klon, llm)
104 REAL zphi(klon, llm), zphis(klon)
105
106 REAL zufi(klon, llm), zvfi(klon, llm)
107 REAL ztfi(klon, llm) ! temperature
108 real qx(klon, llm, nqmx) ! mass fractions of advected fields
109
110 REAL pcvgu(klon, llm), pcvgv(klon, llm)
111 REAL pcvgt(klon, llm), pcvgq(klon, llm, 2)
112
113 REAL pvervel(klon, llm)
114
115 REAL zdufi(klon, llm), zdvfi(klon, llm)
116 REAL zdtfi(klon, llm), zdqfi(klon, llm, nqmx)
117 REAL zdpsrf(klon)
118
119 REAL zsin(iim), zcos(iim), z1(iim)
120 REAL zsinbis(iim), zcosbis(iim), z1bis(iim)
121 REAL pksurcp(iim + 1, jjm + 1)
122
123 ! I. Musat: diagnostic PVteta, Amip2
124 INTEGER, PARAMETER:: ntetaSTD=3
125 REAL:: rtetaSTD(ntetaSTD) = (/350., 380., 405./)
126 REAL PVteta(klon, ntetaSTD)
127
128 REAL SSUM
129
130 LOGICAL:: firstcal = .true.
131 REAL, intent(in):: rdayvrai
132
133 !-----------------------------------------------------------------------
134
135 !!print *, "Call sequence information: calfis"
136
137 ! 1. Initialisations :
138 ! latitude, longitude et aires des mailles pour la physique:
139
140 ! 40. transformation des variables dynamiques en variables physiques:
141 ! 41. pressions au sol (en Pascals)
142
143 zpsrf(1) = pps(1, 1)
144
145 ig0 = 2
146 DO j = 2, jjm
147 CALL SCOPY(iim, pps(1, j), 1, zpsrf(ig0), 1)
148 ig0 = ig0+iim
149 ENDDO
150
151 zpsrf(klon) = pps(1, jjm + 1)
152
153 ! 42. pression intercouches :
154
155 ! .... zplev definis aux (llm +1) interfaces des couches ....
156 ! .... zplay definis aux (llm) milieux des couches ....
157
158 ! ... Exner = cp * (p(l) / preff) ** kappa ....
159
160 forall (l = 1: llm+1) zplev(:, l) = pack(p3d(:, :, l), dyn_phy)
161
162 ! 43. temperature naturelle (en K) et pressions milieux couches .
163 DO l=1, llm
164 pksurcp = ppk(:, :, l) / cpp
165 pls(:, :, l) = preff * pksurcp**(1./ kappa)
166 zplay(:, l) = pack(pls(:, :, l), dyn_phy)
167 ztfi(:, l) = pack(pteta(:, :, l) * pksurcp, dyn_phy)
168 pcvgt(:, l) = pack(pdteta(:, :, l) * pksurcp / pmasse(:, :, l), dyn_phy)
169 ENDDO
170
171 ! 43.bis traceurs
172
173 DO iq=1, nqmx
174 iiq=niadv(iq)
175 DO l=1, llm
176 qx(1, l, iq) = q(1, 1, l, iiq)
177 ig0 = 2
178 DO j=2, jjm
179 DO i = 1, iim
180 qx(ig0, l, iq) = q(i, j, l, iiq)
181 ig0 = ig0 + 1
182 ENDDO
183 ENDDO
184 qx(ig0, l, iq) = q(1, jjm + 1, l, iiq)
185 ENDDO
186 ENDDO
187
188 ! convergence dynamique pour les traceurs "EAU"
189
190 DO iq=1, 2
191 DO l=1, llm
192 pcvgq(1, l, iq)= pdq(1, 1, l, iq) / pmasse(1, 1, l)
193 ig0 = 2
194 DO j=2, jjm
195 DO i = 1, iim
196 pcvgq(ig0, l, iq) = pdq(i, j, l, iq) / pmasse(i, j, l)
197 ig0 = ig0 + 1
198 ENDDO
199 ENDDO
200 pcvgq(ig0, l, iq)= pdq(1, jjm + 1, l, iq) / pmasse(1, jjm + 1, l)
201 ENDDO
202 ENDDO
203
204 ! Geopotentiel calcule par rapport a la surface locale:
205
206 forall (l = 1:llm) zphi(:, l) = pack(pphi(:, :, l), dyn_phy)
207 zphis = pack(pphis, dyn_phy)
208 DO l=1, llm
209 DO ig=1, klon
210 zphi(ig, l)=zphi(ig, l)-zphis(ig)
211 ENDDO
212 ENDDO
213
214 ! .... Calcul de la vitesse verticale (en Pa*m*s ou Kg/s) ....
215
216 DO l=1, llm
217 pvervel(1, l)=pw(1, 1, l) * g /apoln
218 ig0=2
219 DO j=2, jjm
220 DO i = 1, iim
221 pvervel(ig0, l) = pw(i, j, l) * g * unsaire_2d(i, j)
222 ig0 = ig0 + 1
223 ENDDO
224 ENDDO
225 pvervel(ig0, l)=pw(1, jjm + 1, l) * g /apols
226 ENDDO
227
228 ! 45. champ u:
229
230 DO l=1, llm
231
232 DO j=2, jjm
233 ig0 = 1+(j-2)*iim
234 zufi(ig0+1, l)= 0.5 * &
235 (pucov(iim, j, l)/cu_2d(iim, j) + pucov(1, j, l)/cu_2d(1, j))
236 pcvgu(ig0+1, l)= 0.5 * &
237 (pducov(iim, j, l)/cu_2d(iim, j) + pducov(1, j, l)/cu_2d(1, j))
238 DO i=2, iim
239 zufi(ig0+i, l)= 0.5 * &
240 (pucov(i-1, j, l)/cu_2d(i-1, j) &
241 + pucov(i, j, l)/cu_2d(i, j))
242 pcvgu(ig0+i, l)= 0.5 * &
243 (pducov(i-1, j, l)/cu_2d(i-1, j) &
244 + pducov(i, j, l)/cu_2d(i, j))
245 end DO
246 end DO
247
248 end DO
249
250 ! 46.champ v:
251
252 DO l = 1, llm
253 DO j = 2, jjm
254 ig0 = 1 + (j - 2) * iim
255 DO i = 1, iim
256 zvfi(ig0+i, l)= 0.5 * (pvcov(i, j-1, l) / cv_2d(i, j-1) &
257 + pvcov(i, j, l) / cv_2d(i, j))
258 pcvgv(ig0+i, l)= 0.5 * &
259 (pdvcov(i, j-1, l)/cv_2d(i, j-1) &
260 + pdvcov(i, j, l)/cv_2d(i, j))
261 ENDDO
262 ENDDO
263 ENDDO
264
265 ! 47. champs de vents au pôle nord
266 ! U = 1 / pi * integrale [ v * cos(long) * d long ]
267 ! V = 1 / pi * integrale [ v * sin(long) * d long ]
268
269 DO l=1, llm
270
271 z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, 1, l)/cv_2d(1, 1)
272 z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, 1, l)/cv_2d(1, 1)
273 DO i=2, iim
274 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, 1, l)/cv_2d(i, 1)
275 z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i, 1, l)/cv_2d(i, 1)
276 ENDDO
277
278 DO i=1, iim
279 zcos(i) = COS(rlonv(i))*z1(i)
280 zcosbis(i)= COS(rlonv(i))*z1bis(i)
281 zsin(i) = SIN(rlonv(i))*z1(i)
282 zsinbis(i)= SIN(rlonv(i))*z1bis(i)
283 ENDDO
284
285 zufi(1, l) = SSUM(iim, zcos, 1)/pi
286 pcvgu(1, l) = SSUM(iim, zcosbis, 1)/pi
287 zvfi(1, l) = SSUM(iim, zsin, 1)/pi
288 pcvgv(1, l) = SSUM(iim, zsinbis, 1)/pi
289
290 ENDDO
291
292 ! 48. champs de vents au pôle sud:
293 ! U = 1 / pi * integrale [ v * cos(long) * d long ]
294 ! V = 1 / pi * integrale [ v * sin(long) * d long ]
295
296 DO l=1, llm
297
298 z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1, jjm, l) &
299 /cv_2d(1, jjm)
300 z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1, jjm, l) &
301 /cv_2d(1, jjm)
302 DO i=2, iim
303 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i, jjm, l)/cv_2d(i, jjm)
304 z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i, jjm, l)/cv_2d(i, jjm)
305 ENDDO
306
307 DO i=1, iim
308 zcos(i) = COS(rlonv(i))*z1(i)
309 zcosbis(i) = COS(rlonv(i))*z1bis(i)
310 zsin(i) = SIN(rlonv(i))*z1(i)
311 zsinbis(i) = SIN(rlonv(i))*z1bis(i)
312 ENDDO
313
314 zufi(klon, l) = SSUM(iim, zcos, 1)/pi
315 pcvgu(klon, l) = SSUM(iim, zcosbis, 1)/pi
316 zvfi(klon, l) = SSUM(iim, zsin, 1)/pi
317 pcvgv(klon, l) = SSUM(iim, zsinbis, 1)/pi
318
319 ENDDO
320
321 !IM calcul PV a teta=350, 380, 405K
322 CALL PVtheta(klon, llm, pucov, pvcov, pteta, &
323 ztfi, zplay, zplev, &
324 ntetaSTD, rtetaSTD, PVteta)
325
326 ! Appel de la physique:
327
328 CALL physiq(firstcal, lafin, rdayvrai, heure, dtphys, zplev, zplay, zphi, &
329 zphis, zufi, zvfi, ztfi, qx, pvervel, zdufi, zdvfi, zdtfi, zdqfi, &
330 zdpsrf, pducov, PVteta) ! IM diagnostique PVteta, Amip2
331
332 ! transformation des tendances physiques en tendances dynamiques:
333
334 ! tendance sur la pression :
335
336 pdpsfi = gr_fi_dyn(zdpsrf)
337
338 ! 62. enthalpie potentielle
339
340 DO l=1, llm
341
342 DO i=1, iim + 1
343 pdhfi(i, 1, l) = cpp * zdtfi(1, l) / ppk(i, 1 , l)
344 pdhfi(i, jjm + 1, l) = cpp * zdtfi(klon, l)/ ppk(i, jjm + 1, l)
345 ENDDO
346
347 DO j=2, jjm
348 ig0=1+(j-2)*iim
349 DO i=1, iim
350 pdhfi(i, j, l) = cpp * zdtfi(ig0+i, l) / ppk(i, j, l)
351 ENDDO
352 pdhfi(iim + 1, j, l) = pdhfi(1, j, l)
353 ENDDO
354
355 ENDDO
356
357 ! 62. humidite specifique
358
359 DO iq=1, nqmx
360 DO l=1, llm
361 DO i=1, iim + 1
362 pdqfi(i, 1, l, iq) = zdqfi(1, l, iq)
363 pdqfi(i, jjm + 1, l, iq) = zdqfi(klon, l, iq)
364 ENDDO
365 DO j=2, jjm
366 ig0=1+(j-2)*iim
367 DO i=1, iim
368 pdqfi(i, j, l, iq) = zdqfi(ig0+i, l, iq)
369 ENDDO
370 pdqfi(iim + 1, j, l, iq) = pdqfi(1, j, l, iq)
371 ENDDO
372 ENDDO
373 ENDDO
374
375 ! 63. traceurs
376
377 ! initialisation des tendances
378 pdqfi=0.
379
380 DO iq=1, nqmx
381 iiq=niadv(iq)
382 DO l=1, llm
383 DO i=1, iim + 1
384 pdqfi(i, 1, l, iiq) = zdqfi(1, l, iq)
385 pdqfi(i, jjm + 1, l, iiq) = zdqfi(klon, l, iq)
386 ENDDO
387 DO j=2, jjm
388 ig0=1+(j-2)*iim
389 DO i=1, iim
390 pdqfi(i, j, l, iiq) = zdqfi(ig0+i, l, iq)
391 ENDDO
392 pdqfi(iim + 1, j, l, iiq) = pdqfi(1, j, l, iq)
393 ENDDO
394 ENDDO
395 ENDDO
396
397 ! 65. champ u:
398
399 DO l=1, llm
400
401 DO i=1, iim + 1
402 pdufi(i, 1, l) = 0.
403 pdufi(i, jjm + 1, l) = 0.
404 ENDDO
405
406 DO j=2, jjm
407 ig0=1+(j-2)*iim
408 DO i=1, iim-1
409 pdufi(i, j, l)= &
410 0.5*(zdufi(ig0+i, l)+zdufi(ig0+i+1, l))*cu_2d(i, j)
411 ENDDO
412 pdufi(iim, j, l)= &
413 0.5*(zdufi(ig0+1, l)+zdufi(ig0+iim, l))*cu_2d(iim, j)
414 pdufi(iim + 1, j, l)=pdufi(1, j, l)
415 ENDDO
416
417 ENDDO
418
419 ! 67. champ v:
420
421 DO l=1, llm
422
423 DO j=2, jjm-1
424 ig0=1+(j-2)*iim
425 DO i=1, iim
426 pdvfi(i, j, l)= &
427 0.5*(zdvfi(ig0+i, l)+zdvfi(ig0+i+iim, l))*cv_2d(i, j)
428 ENDDO
429 pdvfi(iim + 1, j, l) = pdvfi(1, j, l)
430 ENDDO
431 ENDDO
432
433 ! 68. champ v pres des poles:
434 ! v = U * cos(long) + V * SIN(long)
435
436 DO l=1, llm
437
438 DO i=1, iim
439 pdvfi(i, 1, l)= &
440 zdufi(1, l)*COS(rlonv(i))+zdvfi(1, l)*SIN(rlonv(i))
441 pdvfi(i, jjm, l)=zdufi(klon, l)*COS(rlonv(i)) &
442 +zdvfi(klon, l)*SIN(rlonv(i))
443 pdvfi(i, 1, l)= &
444 0.5*(pdvfi(i, 1, l)+zdvfi(i+1, l))*cv_2d(i, 1)
445 pdvfi(i, jjm, l)= &
446 0.5*(pdvfi(i, jjm, l)+zdvfi(klon-iim-1+i, l))*cv_2d(i, jjm)
447 ENDDO
448
449 pdvfi(iim + 1, 1, l) = pdvfi(1, 1, l)
450 pdvfi(iim + 1, jjm, l)= pdvfi(1, jjm, l)
451
452 ENDDO
453
454 firstcal = .FALSE.
455
456 END SUBROUTINE calfis
457
458 end module calfis_m

  ViewVC Help
Powered by ViewVC 1.1.21