LMDZ
bilan_dyn_p.F
Go to the documentation of this file.
1 !
2 ! $Id: bilan_dyn_p.F 1907 2013-11-26 13:10:46Z lguez $
3 !
4  SUBROUTINE bilan_dyn_p (ntrac,dt_app,dt_cum,
5  s ps,masse,pk,flux_u,flux_v,teta,phi,ucov,vcov,trac)
6 
7 c AFAIRE
8 c Prevoir en champ nq+1 le diagnostique de l'energie
9 c en faisant Qzon=Cv T + L * ...
10 c vQ..A=Cp T + L * ...
11 
12 #ifdef CPP_IOIPSL
13  USE ioipsl
14 #endif
15  USE parallel_lmdz
16  USE mod_hallo
17  use misc_mod
18  use write_field_p
19  IMPLICIT NONE
20 
21 #include "dimensions.h"
22 #include "paramet.h"
23 #include "comconst.h"
24 #include "comvert.h"
25 #include "comgeom2.h"
26 #include "temps.h"
27 #include "iniprint.h"
28 
29 c====================================================================
30 c
31 c Sous-programme consacre à des diagnostics dynamiques de base
32 c
33 c
34 c De facon generale, les moyennes des scalaires Q sont ponderees par
35 c la masse.
36 c
37 c Les flux de masse sont eux simplement moyennes.
38 c
39 c====================================================================
40 
41 c Arguments :
42 c ===========
43 
44  integer ntrac
45  real dt_app,dt_cum
46  real ps(iip1,jjp1)
47  real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)
48  real flux_u(iip1,jjp1,llm)
49  real flux_v(iip1,jjm,llm)
50  real teta(iip1,jjp1,llm)
51  real phi(iip1,jjp1,llm)
52  real ucov(iip1,jjp1,llm)
53  real vcov(iip1,jjm,llm)
54  real trac(iip1,jjp1,llm,ntrac)
55 
56 c Local :
57 c =======
58 
59  integer,save :: icum,ncum
60 !$OMP THREADPRIVATE(icum,ncum)
61  logical,SAVE :: first=.true.
62 !$OMP THREADPRIVATE(first)
63 
64  real zz,zqy
65  real,save :: zfactv(jjm,llm)
66 
67  integer,parameter :: nQ=7
68 
69 
70 cym character*6 nom(nQ)
71 cym character*6 unites(nQ)
72  character(len=6),save :: nom(nq)
73  character(len=6),save :: unites(nq)
74 
75  character(len=10) file
76  integer ifile
77  parameter(ifile=4)
78 
79  integer,PARAMETER :: itemp=1,igeop=2,iecin=3,iang=4,iu=5
80  INTEGER,PARAMETER :: iovap=6,iun=7
81  integer,PARAMETER :: i_sortie=1
82 
83  real,SAVE :: time=0.
84  integer,SAVE :: itau=0.
85 !$OMP THREADPRIVATE(time,itau)
86 
87  real ww
88 
89 c variables dynamiques intermédiaires
90  REAL,save :: vcont(iip1,jjm,llm),ucont(iip1,jjp1,llm)
91  REAL,save :: ang(iip1,jjp1,llm),unat(iip1,jjp1,llm)
92  REAL,save :: massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
93  REAL,save :: vorpot(iip1,jjm,llm)
94  REAL,save :: w(iip1,jjp1,llm),ecin(iip1,jjp1,llm)
95  REAL,save ::convm(iip1,jjp1,llm)
96  REAL,save :: bern(iip1,jjp1,llm)
97 
98 c champ contenant les scalaires advectés.
99  real,save :: Q(iip1,jjp1,llm,nq)
100 
101 c champs cumulés
102  real,save :: ps_cum(iip1,jjp1)
103  real,save :: masse_cum(iip1,jjp1,llm)
104  real,save :: flux_u_cum(iip1,jjp1,llm)
105  real,save :: flux_v_cum(iip1,jjm,llm)
106  real,save :: Q_cum(iip1,jjp1,llm,nq)
107  real,save :: flux_uQ_cum(iip1,jjp1,llm,nq)
108  real,save :: flux_vQ_cum(iip1,jjm,llm,nq)
109  real,save :: flux_wQ_cum(iip1,jjp1,llm,nq)
110  real,save :: dQ(iip1,jjp1,llm,nq)
111 
112 
113 c champs de tansport en moyenne zonale
114  integer ntr,itr
115  parameter(ntr=5)
116 
117 cym character*10 znom(ntr,nQ)
118 cym character*20 znoml(ntr,nQ)
119 cym character*10 zunites(ntr,nQ)
120  character*10,save :: znom(ntr,nq)
121  character*20,save :: znoml(ntr,nq)
122  character*10,save :: zunites(ntr,nq)
123 
124  INTEGER,PARAMETER :: iave=1,itot=2,immc=3,itrs=4,istn=5
125 
126  character*3 ctrs(ntr)
127  data ctrs/' ','TOT','MMC','TRS','STN'/
128 
129  real,save :: zvQ(jjm,llm,ntr,nq),zvQtmp(jjm,llm)
130  real,save :: zavQ(jjm,ntr,nq),psiQ(jjm,llm+1,nq)
131  real,save :: zmasse(jjm,llm),zamasse(jjm)
132 
133  real,save :: zv(jjm,llm),psi(jjm,llm+1)
134 
135  integer i,j,l,iQ
136 
137 
138 c Initialisation du fichier contenant les moyennes zonales.
139 c ---------------------------------------------------------
140 
141  character*10 infile
142 
143  integer fileid
144  integer thoriid, zvertiid
145  save fileid
146 
147  integer,save :: ndex3d(jjm*llm)
148 
149 C Variables locales
150 C
151  integer tau0
152  real zjulian
153  character*3 str
154  character*10 ctrac
155  integer ii,jj
156  integer zan, dayref
157 C
158  real,save :: rlong(jjm),rlatg(jjm)
159  integer :: jjb,jje,jjn,ijb,ije
160  type(request),SAVE :: Req
161 !$OMP THREADPRIVATE(Req)
162 
163 ! definition du domaine d'ecriture pour le rebuild
164 
165  INTEGER,DIMENSION(1) :: ddid
166  INTEGER,DIMENSION(1) :: dsg
167  INTEGER,DIMENSION(1) :: dsl
168  INTEGER,DIMENSION(1) :: dpf
169  INTEGER,DIMENSION(1) :: dpl
170  INTEGER,DIMENSION(1) :: dhs
171  INTEGER,DIMENSION(1) :: dhe
172 
173  INTEGER :: bilan_dyn_domain_id
174 
175 
176 c=====================================================================
177 c Initialisation
178 c=====================================================================
179  if (adjust) return
180 
181  time=time+dt_app
182  itau=itau+1
183 
184  if (first) then
185 
186  ndex3d=0
187 
188  icum=0
189 c initialisation des fichiers
190  first=.false.
191 c ncum est la frequence de stokage en pas de temps
192  ncum=dt_cum/dt_app
193  if (abs(ncum*dt_app-dt_cum).gt.1.e-5*dt_app) then
194  WRITE(lunout,*)
195  . 'Pb : le pas de cumule doit etre multiple du pas'
196  WRITE(lunout,*)'dt_app=',dt_app
197  WRITE(lunout,*)'dt_cum=',dt_cum
198  stop
199  else
200  write(lunout,*) "bilan_dyn_p: ncum=",ncum
201  endif
202 
203 ! if (i_sortie.eq.1) then
204 ! file='dynzon'
205 ! if (mpi_rank==0) then
206 ! call inigrads(ifile,1
207 ! s ,0.,180./pi,0.,0.,jjm,rlatv,-90.,90.,180./pi
208 ! s ,llm,presnivs,1.
209 ! s ,dt_cum,file,'dyn_zon ')
210 ! endif
211 ! endif
212 
213 !$OMP MASTER
214  nom(itemp)='T'
215  nom(igeop)='gz'
216  nom(iecin)='K'
217  nom(iang)='ang'
218  nom(iu)='u'
219  nom(iovap)='ovap'
220  nom(iun)='un'
221 
222  unites(itemp)='K'
223  unites(igeop)='m2/s2'
224  unites(iecin)='m2/s2'
225  unites(iang)='ang'
226  unites(iu)='m/s'
227  unites(iovap)='kg/kg'
228  unites(iun)='un'
229 
230 
231 c Initialisation du fichier contenant les moyennes zonales.
232 c ---------------------------------------------------------
233 
234  infile='dynzon'
235 
236  zan = annee_ref
237  dayref = day_ref
238  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
239  tau0 = itau_dyn
240 
241  rlong=0.
242  rlatg=rlatv*180./pi
243 
244  jjb=jj_begin
245  jje=jj_end
246  jjn=jj_nb
247  IF (pole_sud) THEN
248  jjn=jj_nb-1
249  jje=jj_end-1
250  ENDIF
251 
252  ddid=(/ 2 /)
253  dsg=(/ jjm /)
254  dsl=(/ jjn /)
255  dpf=(/ jjb /)
256  dpl=(/ jje /)
257  dhs=(/ 0 /)
258  dhe=(/ 0 /)
259 
260  call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
261  . 'box',bilan_dyn_domain_id)
262 
263  call histbeg(trim(infile),
264  . 1, rlong(jjb:jje), jjn, rlatg(jjb:jje),
265  . 1, 1, 1, jjn,
266  . tau0, zjulian, dt_cum, thoriid, fileid,
267  . bilan_dyn_domain_id)
268 
269 C
270 C Appel a histvert pour la grille verticale
271 C
272  call histvert(fileid, 'presnivs', 'Niveaux sigma','mb',
273  . llm, presnivs, zvertiid)
274 C
275 C Appels a histdef pour la definition des variables a sauvegarder
276  do iq=1,nq
277  do itr=1,ntr
278  if(itr.eq.1) then
279  znom(itr,iq)=nom(iq)
280  znoml(itr,iq)=nom(iq)
281  zunites(itr,iq)=unites(iq)
282  else
283  znom(itr,iq)=ctrs(itr)//'v'//nom(iq)
284  znoml(itr,iq)='transport : v * '//nom(iq)//' '//ctrs(itr)
285  zunites(itr,iq)='m/s * '//unites(iq)
286  endif
287  enddo
288  enddo
289 
290 c Declarations des champs avec dimension verticale
291 c print*,'1HISTDEF'
292  do iq=1,nq
293  do itr=1,ntr
294  IF (prt_level > 5)
295  . WRITE(lunout,*)'var ',itr,iq
296  . ,znom(itr,iq),znoml(itr,iq),zunites(itr,iq)
297  call histdef(fileid,znom(itr,iq),znoml(itr,iq),
298  . zunites(itr,iq),1,jjn,thoriid,llm,1,llm,zvertiid,
299  . 32,'ave(X)',dt_cum,dt_cum)
300  enddo
301 c Declarations pour les fonctions de courant
302 c print*,'2HISTDEF'
303  call histdef(fileid,'psi'//nom(iq)
304  . ,'stream fn. '//znoml(itot,iq),
305  . zunites(itot,iq),1,jjn,thoriid,llm,1,llm,zvertiid,
306  . 32,'ave(X)',dt_cum,dt_cum)
307  enddo
308 
309 
310 c Declarations pour les champs de transport d'air
311 c print*,'3HISTDEF'
312  call histdef(fileid, 'masse', 'masse',
313  . 'kg', 1, jjn, thoriid, llm, 1, llm, zvertiid,
314  . 32, 'ave(X)', dt_cum, dt_cum)
315  call histdef(fileid, 'v', 'v',
316  . 'm/s', 1, jjn, thoriid, llm, 1, llm, zvertiid,
317  . 32, 'ave(X)', dt_cum, dt_cum)
318 c Declarations pour les fonctions de courant
319 c print*,'4HISTDEF'
320  call histdef(fileid,'psi','stream fn. MMC ','mega t/s',
321  . 1,jjn,thoriid,llm,1,llm,zvertiid,
322  . 32,'ave(X)',dt_cum,dt_cum)
323 
324 
325 c Declaration des champs 1D de transport en latitude
326 c print*,'5HISTDEF'
327  do iq=1,nq
328  do itr=2,ntr
329  call histdef(fileid,'a'//znom(itr,iq),znoml(itr,iq),
330  . zunites(itr,iq),1,jjn,thoriid,1,1,1,-99,
331  . 32,'ave(X)',dt_cum,dt_cum)
332  enddo
333  enddo
334 
335 
336 c print*,'8HISTDEF'
337  CALL histend(fileid)
338 
339 !$OMP END MASTER
340 !$OMP BARRIER
341  endif
342 
343 
344 c=====================================================================
345 c Calcul des champs dynamiques
346 c ----------------------------
347 
348  jjb=jj_begin
349  jje=jj_end
350 
351 c énergie cinétique
352 ! ucont(:,jjb:jje,:)=0
353 
354  call register_hallo(ucov,ip1jmp1,llm,1,1,1,1,req)
355  call register_hallo(vcov,ip1jm,llm,1,1,1,1,req)
356  call sendrequest(req)
357 c$OMP BARRIER
358  call waitrequest(req)
359 c$OMP BARRIER
360 
361  CALL covcont_p(llm,ucov,vcov,ucont,vcont)
362  CALL enercin_p(vcov,ucov,vcont,ucont,ecin)
363 
364 c moment cinétique
365 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
366  do l=1,llm
367  ang(:,jjb:jje,l)=ucov(:,jjb:jje,l)+constang(:,jjb:jje)
368  unat(:,jjb:jje,l)=ucont(:,jjb:jje,l)*cu(:,jjb:jje)
369  enddo
370 !$OMP END DO
371 
372 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
373  DO l=1,llm
374  q(:,jjb:jje,l,itemp)=teta(:,jjb:jje,l)*pk(:,jjb:jje,l)/cpp
375  q(:,jjb:jje,l,igeop)=phi(:,jjb:jje,l)
376  q(:,jjb:jje,l,iecin)=ecin(:,jjb:jje,l)
377  q(:,jjb:jje,l,iang)=ang(:,jjb:jje,l)
378  q(:,jjb:jje,l,iu)=unat(:,jjb:jje,l)
379  q(:,jjb:jje,l,iovap)=trac(:,jjb:jje,l,1)
380  q(:,jjb:jje,l,iun)=1.
381  ENDDO
382 !$OMP END DO NOWAIT
383 
384 c=====================================================================
385 c Cumul
386 c=====================================================================
387 c
388  if(icum.EQ.0) then
389  jjb=jj_begin
390  jje=jj_end
391 
392 !$OMP MASTER
393  ps_cum(:,jjb:jje)=0.
394 !$OMP END MASTER
395 !$OMP BARRIER
396 
397 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
398  DO l=1,llm
399  masse_cum(:,jjb:jje,l)=0.
400  flux_u_cum(:,jjb:jje,l)=0.
401  q_cum(:,jjb:jje,l,:)=0.
402  flux_uq_cum(:,jjb:jje,l,:)=0.
403  if (pole_sud) jje=jj_end-1
404  flux_v_cum(:,jjb:jje,l)=0.
405  flux_vq_cum(:,jjb:jje,l,:)=0.
406  ENDDO
407 !$OMP END DO NOWAIT
408  endif
409 
410  IF (prt_level > 5)
411  . WRITE(lunout,*)'dans bilan_dyn ',icum,'->',icum+1
412  icum=icum+1
413 
414 c accumulation des flux de masse horizontaux
415  jjb=jj_begin
416  jje=jj_end
417 
418 !$OMP MASTER
419  ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)+ps(:,jjb:jje)
420 !$OMP END MASTER
421 !$OMP BARRIER
422 
423 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
424  DO l=1,llm
425  masse_cum(:,jjb:jje,l)=masse_cum(:,jjb:jje,l)+masse(:,jjb:jje,l)
426  flux_u_cum(:,jjb:jje,l)=flux_u_cum(:,jjb:jje,l)
427  . +flux_u(:,jjb:jje,l)
428  ENDDO
429 !$OMP END DO NOWAIT
430 
431  if (pole_sud) jje=jj_end-1
432 
433 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
434  DO l=1,llm
435  flux_v_cum(:,jjb:jje,l)=flux_v_cum(:,jjb:jje,l)
436  . +flux_v(:,jjb:jje,l)
437  ENDDO
438 !$OMP END DO NOWAIT
439 
440  jjb=jj_begin
441  jje=jj_end
442 
443  do iq=1,nq
444 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
445  DO l=1,llm
446  q_cum(:,jjb:jje,l,iq)=q_cum(:,jjb:jje,l,iq)
447  . +q(:,jjb:jje,l,iq)*masse(:,jjb:jje,l)
448  ENDDO
449 !$OMP END DO NOWAIT
450  enddo
451 
452 c=====================================================================
453 c FLUX ET TENDANCES
454 c=====================================================================
455 
456 c Flux longitudinal
457 c -----------------
458  do iq=1,nq
459 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
460  do l=1,llm
461  do j=jjb,jje
462  do i=1,iim
463  flux_uq_cum(i,j,l,iq)=flux_uq_cum(i,j,l,iq)
464  s +flux_u(i,j,l)*0.5*(q(i,j,l,iq)+q(i+1,j,l,iq))
465  enddo
466  flux_uq_cum(iip1,j,l,iq)=flux_uq_cum(1,j,l,iq)
467  enddo
468  enddo
469 !$OMP END DO NOWAIT
470  enddo
471 
472 c flux méridien
473 c -------------
474  do iq=1,nq
475  call register_hallo(q(1,1,1,iq),ip1jmp1,llm,0,1,1,0,req)
476  enddo
477  call sendrequest(req)
478 !$OMP BARRIER
479  call waitrequest(req)
480 !$OMP BARRIER
481 
482  jjb=jj_begin
483  jje=jj_end
484  if (pole_sud) jje=jj_end-1
485 
486  do iq=1,nq
487 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
488  do l=1,llm
489  do j=jjb,jje
490  do i=1,iip1
491  flux_vq_cum(i,j,l,iq)=flux_vq_cum(i,j,l,iq)
492  s +flux_v(i,j,l)*0.5*(q(i,j,l,iq)+q(i,j+1,l,iq))
493  enddo
494  enddo
495  enddo
496 !$OMP END DO NOWAIT
497  enddo
498 
499 
500 c tendances
501 c ---------
502 
503 c convergence horizontale
504  call register_hallo(flux_uq_cum,ip1jmp1,llm,2,2,2,2,req)
505  call register_hallo(flux_vq_cum,ip1jm,llm,2,2,2,2,req)
506  call sendrequest(req)
507 !$OMP BARRIER
508  call waitrequest(req)
509 c$OMP BARRIER
510 
511  call convflu_p(flux_uq_cum,flux_vq_cum,llm*nq,dq)
512 
513 c calcul de la vitesse verticale
514  call register_hallo(flux_u_cum,ip1jmp1,llm,2,2,2,2,req)
515  call register_hallo(flux_v_cum,ip1jm,llm,2,2,2,2,req)
516  call sendrequest(req)
517 !$OMP BARRIER
518  call waitrequest(req)
519 c$OMP BARRIER
520 
521  call convmas_p(flux_u_cum,flux_v_cum,convm)
522  CALL vitvert_p(convm,w)
523 !$OMP BARRIER
524 
525  jjb=jj_begin
526  jje=jj_end
527 
528  do iq=1,nq
529 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
530  do l=1,llm
531  IF (l<llm) THEN
532  do j=jjb,jje
533  do i=1,iip1
534  ww=-0.5*w(i,j,l+1)*(q(i,j,l,iq)+q(i,j,l+1,iq))
535  dq(i,j,l ,iq)=dq(i,j,l ,iq)-ww
536  dq(i,j,l+1,iq)=dq(i,j,l+1,iq)+ww
537  enddo
538  enddo
539  ENDIF
540  IF (l>2) THEN
541  do j=jjb,jje
542  do i=1,iip1
543  ww=-0.5*w(i,j,l)*(q(i,j,l-1,iq)+q(i,j,l,iq))
544  dq(i,j,l,iq)=dq(i,j,l,iq)+ww
545  enddo
546  enddo
547  ENDIF
548  enddo
549 !$OMP ENDDO NOWAIT
550  enddo
551  IF (prt_level > 5)
552  . WRITE(lunout,*)'Apres les calculs fait a chaque pas'
553 c=====================================================================
554 c PAS DE TEMPS D'ECRITURE
555 c=====================================================================
556  if (icum.eq.ncum) then
557 c=====================================================================
558 
559  IF (prt_level > 5)
560  . WRITE(lunout,*)'Pas d ecriture'
561 
562  jjb=jj_begin
563  jje=jj_end
564 
565 c Normalisation
566  do iq=1,nq
567 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
568  do l=1,llm
569  q_cum(:,jjb:jje,l,iq)=q_cum(:,jjb:jje,l,iq)
570  . /masse_cum(:,jjb:jje,l)
571  enddo
572 !$OMP ENDDO NOWAIT
573  enddo
574 
575  zz=1./REAL(ncum)
576 
577 !$OMP MASTER
578  ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)*zz
579 !$OMP END MASTER
580 
581 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
582  DO l=1,llm
583  masse_cum(:,jjb:jje,l)=masse_cum(:,jjb:jje,l)*zz
584  flux_u_cum(:,jjb:jje,l)=flux_u_cum(:,jjb:jje,l)*zz
585  flux_uq_cum(:,jjb:jje,l,:)=flux_uq_cum(:,jjb:jje,l,:)*zz
586  dq(:,jjb:jje,l,:)=dq(:,jjb:jje,l,:)*zz
587  ENDDO
588 !$OMP ENDDO NOWAIT
589 
590 
591  IF (pole_sud) jje=jj_end-1
592 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
593  DO l=1,llm
594  flux_v_cum(:,jjb:jje,l)=flux_v_cum(:,jjb:jje,l)*zz
595  flux_vq_cum(:,jjb:jje,l,:)=flux_vq_cum(:,jjb:jje,l,:)*zz
596  ENDDO
597 !$OMP ENDDO
598 
599  jjb=jj_begin
600  jje=jj_end
601 
602 
603 c A retravailler eventuellement
604 c division de dQ par la masse pour revenir aux bonnes grandeurs
605  do iq=1,nq
606 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
607  DO l=1,llm
608  dq(:,jjb:jje,l,iq)=dq(:,jjb:jje,l,iq)/masse_cum(:,jjb:jje,l)
609  ENDDO
610 !$OMP ENDDO NOWAIT
611  enddo
612 
613 c=====================================================================
614 c Transport méridien
615 c=====================================================================
616 
617 c cumul zonal des masses des mailles
618 c ----------------------------------
619  jjb=jj_begin
620  jje=jj_end
621  if (pole_sud) jje=jj_end-1
622 
623 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
624  DO l=1,llm
625  zv(jjb:jje,l)=0.
626  zmasse(jjb:jje,l)=0.
627  ENDDO
628 !$OMP ENDDO NOWAIT
629 
630  call register_hallo(masse_cum,ip1jmp1,llm,1,1,1,1,req)
631  do iq=1,nq
632  call register_hallo(q_cum(1,1,1,iq),ip1jmp1,llm,0,1,1,0,req)
633  enddo
634 
635  call sendrequest(req)
636 !$OMP BARRIER
637  call waitrequest(req)
638 c$OMP BARRIER
639 
640  call massbar_p(masse_cum,massebx,masseby)
641 
642  jjb=jj_begin
643  jje=jj_end
644  if (pole_sud) jje=jj_end-1
645 
646 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
647  do l=1,llm
648  do j=jjb,jje
649  do i=1,iim
650  zmasse(j,l)=zmasse(j,l)+masseby(i,j,l)
651  zv(j,l)=zv(j,l)+flux_v_cum(i,j,l)
652  enddo
653  zfactv(j,l)=cv(1,j)/zmasse(j,l)
654  enddo
655  enddo
656 !$OMP ENDDO
657 
658 c print*,'3OK'
659 c --------------------------------------------------------------
660 c calcul de la moyenne zonale du transport :
661 c ------------------------------------------
662 c
663 c --
664 c TOT : la circulation totale [ vq ]
665 c
666 c - -
667 c MMC : mean meridional circulation [ v ] [ q ]
668 c
669 c ---- -- - -
670 c TRS : transitoires [ v'q'] = [ vq ] - [ v q ]
671 c
672 c - * - * - - - -
673 c STT : stationaires [ v q ] = [ v q ] - [ v ] [ q ]
674 c
675 c - -
676 c on utilise aussi l'intermediaire TMP : [ v q ]
677 c
678 c la variable zfactv transforme un transport meridien cumule
679 c en kg/s * unte-du-champ-transporte en m/s * unite-du-champ-transporte
680 c
681 c --------------------------------------------------------------
682 
683 
684 c ----------------------------------------
685 c Transport dans le plan latitude-altitude
686 c ----------------------------------------
687 
688  jjb=jj_begin
689  jje=jj_end
690  if (pole_sud) jje=jj_end-1
691 
692  zvq=0.
693  psiq=0.
694  do iq=1,nq
695 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
696  do l=1,llm
697  zvqtmp(:,l)=0.
698  do j=jjb,jje
699 c print*,'j,l,iQ=',j,l,iQ
700 c Calcul des moyennes zonales du transort total et de zvQtmp
701  do i=1,iim
702  zvq(j,l,itot,iq)=zvq(j,l,itot,iq)
703  s +flux_vq_cum(i,j,l,iq)
704  zqy= 0.5*(q_cum(i,j,l,iq)*masse_cum(i,j,l)+
705  s q_cum(i,j+1,l,iq)*masse_cum(i,j+1,l))
706  zvqtmp(j,l)=zvqtmp(j,l)+flux_v_cum(i,j,l)*zqy
707  s /(0.5*(masse_cum(i,j,l)+masse_cum(i,j+1,l)))
708  zvq(j,l,iave,iq)=zvq(j,l,iave,iq)+zqy
709  enddo
710 c print*,'aOK'
711 c Decomposition
712  zvq(j,l,iave,iq)=zvq(j,l,iave,iq)/zmasse(j,l)
713  zvq(j,l,itot,iq)=zvq(j,l,itot,iq)*zfactv(j,l)
714  zvqtmp(j,l)=zvqtmp(j,l)*zfactv(j,l)
715  zvq(j,l,immc,iq)=zv(j,l)*zvq(j,l,iave,iq)*zfactv(j,l)
716  zvq(j,l,itrs,iq)=zvq(j,l,itot,iq)-zvqtmp(j,l)
717  zvq(j,l,istn,iq)=zvqtmp(j,l)-zvq(j,l,immc,iq)
718  enddo
719  enddo
720 !$OMP ENDDO NOWAIT
721 c fonction de courant meridienne pour la quantite Q
722 !$OMP BARRIER
723 !$OMP MASTER
724  do l=llm,1,-1
725  do j=jjb,jje
726  psiq(j,l,iq)=psiq(j,l+1,iq)+zvq(j,l,itot,iq)
727  enddo
728  enddo
729 !$OMP END MASTER
730 !$OMP BARRIER
731  enddo ! of do iQ=1,nQ
732 
733 c fonction de courant pour la circulation meridienne moyenne
734 !$OMP BARRIER
735 !$OMP MASTER
736  psi(jjb:jje,:)=0.
737  do l=llm,1,-1
738  do j=jjb,jje
739  psi(j,l)=psi(j,l+1)+zv(j,l)
740  zv(j,l)=zv(j,l)*zfactv(j,l)
741  enddo
742  enddo
743 !$OMP END MASTER
744 !$OMP BARRIER
745 
746 c print*,'4OK'
747 c sorties proprement dites
748 !$OMP MASTER
749  if (i_sortie.eq.1) then
750  jjb=jj_begin
751  jje=jj_end
752  jjn=jj_nb
753  if (pole_sud) jje=jj_end-1
754  if (pole_sud) jjn=jj_nb-1
755 
756  do iq=1,nq
757  do itr=1,ntr
758  call histwrite(fileid,znom(itr,iq),itau,
759  s zvq(jjb:jje,:,itr,iq)
760  s ,jjn*llm,ndex3d)
761  enddo
762  call histwrite(fileid,'psi'//nom(iq),
763  s itau,psiq(jjb:jje,1:llm,iq)
764  s ,jjn*llm,ndex3d)
765  enddo
766  call histwrite(fileid,'masse',itau,zmasse(jjb:jje,1:llm)
767  s ,jjn*llm,ndex3d)
768  call histwrite(fileid,'v',itau,zv(jjb:jje,1:llm)
769  s ,jjn*llm,ndex3d)
770  psi(jjb:jje,:)=psi(jjb:jje,:)*1.e-9
771  call histwrite(fileid,'psi',itau,psi(jjb:jje,1:llm),
772  s jjn*llm,ndex3d)
773 
774  endif
775 
776 
777 c -----------------
778 c Moyenne verticale
779 c -----------------
780 
781  zamasse(jjb:jje)=0.
782  do l=1,llm
783  zamasse(jjb:jje)=zamasse(jjb:jje)+zmasse(jjb:jje,l)
784  enddo
785 
786  zavq(jjb:jje,:,:)=0.
787  do iq=1,nq
788  do itr=2,ntr
789  do l=1,llm
790  zavq(jjb:jje,itr,iq)=zavq(jjb:jje,itr,iq)
791  s +zvq(jjb:jje,l,itr,iq)
792  s *zmasse(jjb:jje,l)
793  enddo
794  zavq(jjb:jje,itr,iq)=zavq(jjb:jje,itr,iq)/zamasse(jjb:jje)
795  call histwrite(fileid,'a'//znom(itr,iq),itau,
796  s zavq(jjb:jje,itr,iq),jjn*llm,ndex3d)
797  enddo
798  enddo
799 !$OMP END MASTER
800 !$OMP BARRIER
801 c on doit pouvoir tracer systematiquement la fonction de courant.
802 
803 c=====================================================================
804 c/////////////////////////////////////////////////////////////////////
805  icum=0 !///////////////////////////////////////
806  endif ! icum.eq.ncum !///////////////////////////////////////
807 c/////////////////////////////////////////////////////////////////////
808 c=====================================================================
809  return
810  end
itau_dyn
!$Id && itau_dyn
Definition: temps.h:15
ip1jmp1
!$Header llmm1 INTEGER ip1jmp1
Definition: paramet.h:14
ymds2ju
!$Id zjulian!correction pour l heure initiale!jyg!jyg CALL ymds2ju(annee_ref, 1, day_ref, hour, zjulian)!jyg CALL histbeg_phy("histrac"
mod_hallo::register_hallo
subroutine register_hallo(Field, ij, ll, RUp, Rdown, SUp, SDown, a_request)
Definition: mod_hallo.F90:875
parallel_lmdz::mpi_rank
integer, save mpi_rank
Definition: parallel_lmdz.F90:18
constang
!$Header!CDK comgeom COMMON comgeom constang
Definition: comgeom.h:25
parallel_lmdz::jj_end
integer, save jj_end
Definition: parallel_lmdz.F90:20
parallel_lmdz::mpi_size
integer, save mpi_size
Definition: parallel_lmdz.F90:17
parallel_lmdz::jj_begin
integer, save jj_begin
Definition: parallel_lmdz.F90:19
parallel_lmdz::pole_sud
logical, save pole_sud
Definition: parallel_lmdz.F90:25
convflu_p
subroutine convflu_p(xflu, yflu, nbniv, convfl)
Definition: convflu_p.F:2
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
pi
!$Id mode_top_bound COMMON comconstr && pi
Definition: comconst.h:7
misc_mod
Definition: misc_mod.F90:1
presnivs
!$Id presnivs(llm)
ip1jm
!$Header llmm1 INTEGER ip1jm
Definition: paramet.h:14
write_field_p
Definition: write_field_p.F90:1
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
enercin_p
subroutine enercin_p(vcov, ucov, vcont, ucont, ecin)
Definition: enercin_p.F:2
histvert
!$Id zjulian!correction pour l heure initiale!jyg!jyg CALL nid_tra CALL histvert(nid_tra,"presnivs","Vertical levels","Pa", klev, presnivs, nvert,"down") zsto
massbar_p
subroutine massbar_p(masse, massebx, masseby)
Definition: massbar_p.F:2
day_ref
!$Id day_ref
Definition: temps.h:15
parallel_lmdz
Definition: parallel_lmdz.F90:4
jjp1
!$Header jjp1
Definition: paramet.h:14
cpp
!$Id mode_top_bound COMMON comconstr cpp
Definition: comconst.h:7
prt_level
!FH On elimine toutes les clefs physiques dans la dynamique prt_level
Definition: write_paramLMDZ_dyn.h:9
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
rlatv
!$Header!CDK comgeom COMMON comgeom rlatv
Definition: comgeom.h:25
mod_hallo::sendrequest
subroutine sendrequest(a_Request)
Definition: mod_hallo.F90:1072
parallel_lmdz::jj_nb
integer, save jj_nb
Definition: parallel_lmdz.F90:21
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
cu
!$Id!Parameters for parameters that control the rate of approach!to quasi equilibrium noff nlm real tlcrit real entp real sigd real coeffs real dtmax real cu real betad real damp real delta COMMON cvparam nlm tlcrit sigd coeffs cu
Definition: cvparam.h:12
bilan_dyn_p
subroutine bilan_dyn_p(ntrac, dt_app, dt_cum, ps, masse, pk, flux_u, flux_v, teta, phi, ucov, vcov, trac)
Definition: bilan_dyn_p.F:6
covcont_p
subroutine covcont_p(klevel, ucov, vcov, ucont, vcont)
Definition: covcont_p.F:2
vitvert_p
subroutine vitvert_p(convm, w)
Definition: vitvert_p.F:2
iim
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
misc_mod::adjust
logical, save adjust
Definition: misc_mod.F90:3
cv
!$Header!CDK comgeom COMMON comgeom cv
Definition: comgeom.h:25
mod_hallo::request
Definition: mod_hallo.F90:38
histbeg
c c zjulian c cym CALL iim cym klev iim cym jjmp1 cym On stoke le fichier bilKP instantanne s jmax_ins print On stoke le fichier bilKP instantanne s s cym cym nid_bilKPins ENDIF c cIM BEG c cIM cf AM BEG region cym CALL histbeg("histbilKP_ins", iim, zx_lon(:, 1), cym.jjmp1, zx_lat(1,:), cym.imin_ins, imax_ins-imin_ins+1, cym.jmin_ins, jmax_ins-jmin_ins+1, cym.itau_phy, zjulian, dtime, cym.nhori, nid_bilKPins) CALL histbeg_phy("histbilKP_ins"
convmas_p
subroutine convmas_p(pbaru, pbarv, convm)
Definition: convmas_p.F:2
mod_hallo
Definition: mod_hallo.F90:1
mod_hallo::waitrequest
subroutine waitrequest(a_Request)
Definition: mod_hallo.F90:1196
annee_ref
!$Id annee_ref
Definition: temps.h:15
lunout
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7