LMDZ
leapfrog_loc.F
Go to the documentation of this file.
1 !
2 ! $Id$
3 !
4 c
5 c
6 #define DEBUG_IO
7 #undef DEBUG_IO
8 
9 
10  SUBROUTINE leapfrog_loc(ucov0,vcov0,teta0,ps0,
11  & masse0,phis0,q0,time_0)
12 
13  USE misc_mod
14  USE parallel_lmdz
15  USE times
16  USE mod_hallo
17  USE bands
18  USE write_field
19  USE write_field_p
20  USE vampir
21  USE timer_filtre, ONLY : print_filtre_timer
22  USE infotrac
23  USE guide_loc_mod, ONLY : guide_main
24  USE getparam
25  USE control_mod
26  USE mod_filtreg_p
27  USE write_field_loc
28  USE allocate_field_mod
29  USE call_dissip_mod, ONLY : call_dissip
30  USE call_calfis_mod, ONLY : call_calfis
31  USE leapfrog_mod
32  use exner_hyb_loc_m, only: exner_hyb_loc
33  use exner_milieu_loc_m, only: exner_milieu_loc
34  IMPLICIT NONE
35 
36 c ...... Version du 10/01/98 ..........
37 
38 c avec coordonnees verticales hybrides
39 c avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
40 
41 c=======================================================================
42 c
43 c Auteur: P. Le Van /L. Fairhead/F.Hourdin
44 c -------
45 c
46 c Objet:
47 c ------
48 c
49 c GCM LMD nouvelle grille
50 c
51 c=======================================================================
52 c
53 c ... Dans inigeom , nouveaux calculs pour les elongations cu , cv
54 c et possibilite d'appeler une fonction f(y) a derivee tangente
55 c hyperbolique a la place de la fonction a derivee sinusoidale.
56 
57 c ... Possibilite de choisir le shema pour l'advection de
58 c q , en modifiant iadv dans traceur.def (10/02) .
59 c
60 c Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
61 c Pour Van-Leer iadv=10
62 c
63 c-----------------------------------------------------------------------
64 c Declarations:
65 c -------------
66 
67 #include "dimensions.h"
68 #include "paramet.h"
69 #include "comconst.h"
70 #include "comdissnew.h"
71 #include "comvert.h"
72 #include "comgeom.h"
73 #include "logic.h"
74 #include "temps.h"
75 #include "ener.h"
76 #include "description.h"
77 #include "serre.h"
78 !#include "com_io_dyn.h"
79 #include "iniprint.h"
80 #include "academic.h"
81 ! include "mpif.h"
82 
83  REAL,INTENT(IN) :: time_0 ! not used
84 
85 c dynamical variables:
86  REAL,INTENT(IN) :: ucov0(ijb_u:ije_u,llm) ! zonal covariant wind
87  REAL,INTENT(IN) :: vcov0(ijb_v:ije_v,llm) ! meridional covariant wind
88  REAL,INTENT(IN) :: teta0(ijb_u:ije_u,llm) ! potential temperature
89  REAL,INTENT(IN) :: q0(ijb_u:ije_u,llm,nqtot) ! advected tracers
90  REAL,INTENT(IN) :: ps0(ijb_u:ije_u) ! surface pressure (Pa)
91  REAL,INTENT(IN) :: masse0(ijb_u:ije_u,llm) ! air mass
92  REAL,INTENT(IN) :: phis0(ijb_u:ije_u) ! geopotentiat at the surface
93 
94  real zqmin,zqmax
95 
96 ! REAL,SAVE,ALLOCATABLE :: p (:,: ) ! pression aux interfac.des couches
97 ! REAL,SAVE,ALLOCATABLE :: pks(:) ! exner au sol
98 ! REAL,SAVE,ALLOCATABLE :: pk(:,:) ! exner au milieu des couches
99 ! REAL,SAVE,ALLOCATABLE :: pkf(:,:) ! exner filt.au milieu des couches
100 ! REAL,SAVE,ALLOCATABLE :: phi(:,:) ! geopotentiel
101 ! REAL,SAVE,ALLOCATABLE :: w(:,:) ! vitesse verticale
102 
103 c variables dynamiques intermediaire pour le transport
104 ! REAL,SAVE,ALLOCATABLE :: pbaru(:,:),pbarv(:,:) !flux de masse
105 
106 c variables dynamiques au pas -1
107 ! REAL,SAVE,ALLOCATABLE :: vcovm1(:,:),ucovm1(:,:)
108 ! REAL,SAVE,ALLOCATABLE :: tetam1(:,:),psm1(:)
109 ! REAL,SAVE,ALLOCATABLE :: massem1(:,:)
110 
111 c tendances dynamiques
112 ! REAL,SAVE,ALLOCATABLE :: dv(:,:),du(:,:)
113 ! REAL,SAVE,ALLOCATABLE :: dteta(:,:),dp(:)
114 ! REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq
115 
116 c tendances de la dissipation
117 ! REAL,SAVE,ALLOCATABLE :: dvdis(:,:),dudis(:,:)
118 ! REAL,SAVE,ALLOCATABLE :: dtetadis(:,:)
119 
120 c tendances physiques
121  REAL,SAVE,ALLOCATABLE :: dvfi(:,:),dufi(:,:)
122  REAL,SAVE,ALLOCATABLE :: dtetafi(:,:)
123  REAL,SAVE,ALLOCATABLE :: dpfi(:)
124  REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi
125 
126 c variables pour le fichier histoire
127  REAL dtav ! intervalle de temps elementaire
128 
129  REAL tppn(iim),tpps(iim),tpn,tps
130 c
131  INTEGER itau,itaufinp1,iav
132 ! INTEGER iday ! jour julien
133  REAL time
134 
135  REAL SSUM
136 ! REAL,SAVE,ALLOCATABLE :: finvmaold(:,:)
137 
138 cym LOGICAL lafin
139  LOGICAL :: lafin
140  INTEGER ij,iq,l
141  INTEGER ik
142 
143  real time_step, t_wrt, t_ops
144 
145 ! jD_cur: jour julien courant
146 ! jH_cur: heure julienne courante
147  REAL :: jD_cur, jH_cur
148  INTEGER :: an, mois, jour
149  REAL :: secondes
150 
151  logical :: physic
152  LOGICAL first,callinigrads
153 
154  data callinigrads/.true./
155  character*10 string10
156 
157 ! REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale
158 
159 c+jld variables test conservation energie
160 ! REAL,SAVE,ALLOCATABLE :: ecin(:,:),ecin0(:,:)
161 C Tendance de la temp. potentiel d (theta)/ d t due a la
162 C tansformation d'energie cinetique en energie thermique
163 C cree par la dissipation
164 ! REAL,SAVE,ALLOCATABLE :: dtetaecdt(:,:)
165 ! REAL,SAVE,ALLOCATABLE :: vcont(:,:),ucont(:,:)
166 ! REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
167  REAL d_h_vcol, d_qt, d_qw, d_ql, d_ec
168  CHARACTER*15 ztit
169 !! INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.
170 ! SAVE ip_ebil_dyn
171 ! DATA ip_ebil_dyn/0/
172 c-jld
173 
174  character*80 dynhist_file, dynhistave_file
175  character(len=*),parameter :: modname="leapfrog_loc"
176  character*80 abort_message
177 
178 
179  logical,PARAMETER :: dissip_conservative=.true.
180 
181  INTEGER testita
182  parameter(testita = 9)
183 
184  logical , parameter :: flag_verif = .false.
185 
186 c declaration liees au parallelisme
187  INTEGER :: ierr
188  LOGICAL :: FirstCaldyn
189  LOGICAL :: FirstPhysic
190  INTEGER :: ijb,ije,j,i
191  type(request) :: TestRequest
192  type(request) :: Request_Dissip
193  type(request) :: Request_physic
194 
195  INTEGER :: true_itau
196  INTEGER :: iapptrac
197  INTEGER :: AdjustCount
198 ! INTEGER :: var_time
199  LOGICAL :: ok_start_timer=.false.
200  LOGICAL, SAVE :: firstcall=.true.
201  TYPE(distrib),SAVE :: new_dist
202 
203  if (ok_iso_verif) then
204  call check_isotopes(q0,ijb_u,ije_u,'leapfrog204: debut')
205  endif !if (ok_iso_verif) then
206 
207 c$OMP MASTER
208  itcount=0
209 c$OMP END MASTER
210  true_itau=0
211  firstcaldyn=.true.
212  firstphysic=.true.
213  iapptrac=0
214  adjustcount = 0
215  lafin=.false.
216 
217  if (nday>=0) then
218  itaufin = nday*day_step
219  else
220  itaufin = -nday
221  endif
222 
223  itaufinp1 = itaufin +1
224 
225  if (ok_iso_verif) then
226  call check_isotopes(q0,ijb_u,ije_u,'leapfrog 226')
227  endif !if (ok_iso_verif) then
228 
229  itau = 0
230  physic=.true.
231  if (iflag_phys==0.or.iflag_phys==2) physic=.false.
232  CALL init_nan
233  CALL leapfrog_allocate
234  ucov=ucov0
235  vcov=vcov0
236  teta=teta0
237  ps=ps0
238  masse=masse0
239  phis=phis0
240  q=q0
241 
242  if (ok_iso_verif) then
243  call check_isotopes(q,ijb_u,ije_u,'leapfrog 239')
244  endif !if (ok_iso_verif) then
245 
246 ! iday = day_ini+itau/day_step
247 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
248 ! IF(time.GT.1.) THEN
249 ! time = time-1.
250 ! iday = iday+1
251 ! ENDIF
252 
253 c Allocate variables depending on dynamic variable nqtot
254 !$OMP MASTER
255  if (firstcall) then
256 !
257 ! ALLOCATE(p(ijb_u:ije_u,llmp1))
258 ! ALLOCATE(pks(ijb_u:ije_u))
259 ! ALLOCATE(pk(ijb_u:ije_u,llm))
260 ! ALLOCATE(pkf(ijb_u:ije_u,llm))
261 ! ALLOCATE(phi(ijb_u:ije_u,llm))
262 ! ALLOCATE(w(ijb_u:ije_u,llm))
263 ! ALLOCATE(pbaru(ip1jmp1,llm),pbarv(ip1jm,llm))
264 ! ALLOCATE(vcovm1(ijb_v:ije_v,llm),ucovm1(ijb_u:ije_u,llm))
265 ! ALLOCATE(tetam1(ijb_u:ije_u,llm),psm1(ijb_u:ije_u))
266 ! ALLOCATE(massem1(ijb_u:ije_u,llm))
267 ! ALLOCATE(dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm))
268 ! ALLOCATE(dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u))
269 ! ALLOCATE(dvdis(ijb_v:ije_v,llm),dudis(ijb_u:ije_u,llm))
270 ! ALLOCATE(dtetadis(ijb_u:ije_u,llm))
271  ALLOCATE(dvfi(ijb_v:ije_v,llm),dufi(ijb_u:ije_u,llm))
272  ALLOCATE(dtetafi(ijb_u:ije_u,llm))
273  ALLOCATE(dpfi(ijb_u:ije_u))
274 ! ALLOCATE(dq(ijb_u:ije_u,llm,nqtot))
275  ALLOCATE(dqfi(ijb_u:ije_u,llm,nqtot))
276 ! ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
277 ! ALLOCATE(finvmaold(ijb_u:ije_u,llm))
278 ! ALLOCATE(flxw(ijb_u:ije_u,llm))
279 ! ALLOCATE(ecin(ijb_u:ije_u,llm),ecin0(ijb_u:ije_u,llm))
280 ! ALLOCATE(dtetaecdt(ijb_u:ije_u,llm))
281 ! ALLOCATE(vcont(ijb_v:ije_v,llm),ucont(ijb_u:ije_u,llm))
282 ! ALLOCATE(vnat(ijb_v:ije_v,llm),unat(ijb_u:ije_u,llm))
283  endif
284 !$OMP END MASTER
285 !$OMP BARRIER
286 
287 ! CALL dynredem1_loc("restart.nc",0.0,
288 ! & vcov,ucov,teta,q,masse,ps)
289 
290 
291 c-----------------------------------------------------------------------
292 c On initialise la pression et la fonction d'Exner :
293 c --------------------------------------------------
294 
295 c$OMP MASTER
296  dq(:,:,:)=0.
297  CALL pression ( ijnb_u, ap, bp, ps, p )
298 c$OMP END MASTER
299  if (pressure_exner) then
300  CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf)
301  else
302  CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf )
303  endif
304 c-----------------------------------------------------------------------
305 c Debut de l'integration temporelle:
306 c ----------------------------------
307 c et du parallelisme !!
308 
309  1 CONTINUE ! Matsuno Forward step begins here
310 
311 c date: (NB: date remains unchanged for Backward step)
312 c -----
313 
314  jd_cur = jd_ref + day_ini - day_ref + &
315  & (itau+1)/day_step
316  jh_cur = jh_ref + start_time + &
317  & mod(itau+1,day_step)/float(day_step)
318  if (jh_cur > 1.0 ) then
319  jd_cur = jd_cur +1.
320  jh_cur = jh_cur -1.
321  endif
322 
323  if (ok_iso_verif) then
324  call check_isotopes(q,ijb_u,ije_u,'leapfrog 321')
325  endif !if (ok_iso_verif) then
326 
327 #ifdef CPP_IOIPSL
328  if (ok_guide) then
329  call guide_main(itau,ucov,vcov,teta,q,masse,ps)
330 !$OMP BARRIER
331  endif
332 #endif
333 
334 
335 c
336 c IF( MOD( itau, 10* day_step ).EQ.0 ) THEN
337 c CALL test_period ( ucov,vcov,teta,q,p,phis )
338 c PRINT *,' ---- Test_period apres continue OK ! -----', itau
339 c ENDIF
340 c
341 cym CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
342 cym CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
343 cym CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 )
344 cym CALL SCOPY( ijp1llm,masse, 1, massem1, 1 )
345 cym CALL SCOPY( ip1jmp1, ps , 1, psm1 , 1 )
346 
347  if (firstcaldyn) then
348 c$OMP MASTER
349  ucovm1=ucov
350  vcovm1=vcov
351  tetam1= teta
352  massem1= masse
353  psm1= ps
354 
355 ! Ehouarn: finvmaold is actually not used
356 ! finvmaold = masse
357 c$OMP END MASTER
358 c$OMP BARRIER
359 ! CALL filtreg_p ( finvmaold ,jjb_u,jje_u,jjb_u,jje_u,jjp1, llm,
360 ! & -2,2, .TRUE., 1 )
361  else
362 ! Save fields obtained at previous time step as '...m1'
363  ijb=ij_begin
364  ije=ij_end
365 
366 c$OMP MASTER
367  psm1(ijb:ije) = ps(ijb:ije)
368 c$OMP END MASTER
369 
370 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
371  DO l=1,llm
372  ije=ij_end
373  ucovm1(ijb:ije,l) = ucov(ijb:ije,l)
374  tetam1(ijb:ije,l) = teta(ijb:ije,l)
375  massem1(ijb:ije,l) = masse(ijb:ije,l)
376 ! finvmaold(ijb:ije,l)=masse(ijb:ije,l)
377 
378  if (pole_sud) ije=ij_end-iip1
379  vcovm1(ijb:ije,l) = vcov(ijb:ije,l)
380 
381 
382  ENDDO
383 c$OMP ENDDO
384 
385 
386 ! Ehouarn: finvmaold not used
387 ! CALL filtreg_p(finvmaold ,jjb_u,jje_u,jj_begin,jj_end,jjp1,
388 ! . llm, -2,2, .TRUE., 1 )
389 
390  endif ! of if (FirstCaldyn)
391 
392  forward = .true.
393  leapf = .false.
394  dt = dtvr
395 
396 c ... P.Le Van .26/04/94 ....
397 
398 cym CALL SCOPY ( ijp1llm, masse, 1, finvmaold, 1 )
399 cym CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
400 
401 cym ne sert a rien
402 cym call minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
403 
404 
405  if (ok_iso_verif) then
406  call check_isotopes(q,ijb_u,ije_u,'leapfrog 400')
407  endif !if (ok_iso_verif) then
408 
409  2 CONTINUE ! Matsuno backward or leapfrog step begins here
410 
411 
412  if (ok_iso_verif) then
413  call check_isotopes(q,ijb_u,ije_u,'leapfrog 402')
414  endif !if (ok_iso_verif) then
415 
416 c$OMP MASTER
417  itcount=itcount+1
418  if (mod(itcount,1)==1) then
419  debug=.true.
420  else
421  debug=.false.
422  endif
423 c$OMP END MASTER
424 c-----------------------------------------------------------------------
425 
426 c date: (NB: only leapfrog step requires recomputing date)
427 c -----
428 
429  IF (leapf) THEN
430  jd_cur = jd_ref + day_ini - day_ref +
431  & (itau+1)/day_step
432  jh_cur = jh_ref + start_time +
433  & mod(itau+1,day_step)/float(day_step)
434  if (jh_cur > 1.0 ) then
435  jd_cur = jd_cur +1.
436  jh_cur = jh_cur -1.
437  endif
438  ENDIF
439 
440 c gestion des appels de la physique et des dissipations:
441 c ------------------------------------------------------
442 c
443 c ... P.Le Van ( 6/02/95 ) ....
444 
445  apphys = .false.
446  statcl = .false.
447  conser = .false.
448  apdiss = .false.
449 
450  IF( purmats ) THEN
451  ! Purely Matsuno time stepping
452  IF( mod(itau,iconser) .EQ.0.AND. forward ) conser = .true.
453  IF( mod(itau,dissip_period ).EQ.0.AND..NOT.forward )
454  s apdiss = .true.
455  IF( mod(itau,iphysiq ).EQ.0.AND..NOT.forward
456  s .and. physic ) apphys = .true.
457  ELSE
458  ! Leapfrog/Matsuno time stepping
459  IF( mod(itau ,iconser) .EQ. 0 ) conser = .true.
460  IF( mod(itau+1,dissip_period).EQ.0 .AND. .NOT. forward )
461  s apdiss = .true.
462  IF( mod(itau+1,iphysiq).EQ.0.AND.physic) apphys=.true.
463  END IF
464 
465 ! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
466 ! supress dissipation step
467  if (llm.eq.1) then
468  apdiss=.false.
469  endif
470 
471 cym ---> Pour le moment
472 cym apphys = .FALSE.
473  statcl = .false.
474  conser = .false. ! ie: no output of control variables to stdout in //
475 
476  if (firstcaldyn) then
477 c$OMP MASTER
478  call set_distrib(distrib_caldyn)
479 c$OMP END MASTER
480 c$OMP BARRIER
481  firstcaldyn=.false.
482 cym call InitTime
483 c$OMP MASTER
484  call init_timer
485 c$OMP END MASTER
486  endif
487 
488 c$OMP MASTER
489  IF (ok_start_timer) THEN
490  CALL inittime
491  ok_start_timer=.false.
492  ENDIF
493 c$OMP END MASTER
494 
495 
496  if (ok_iso_verif) then
497  call check_isotopes(q,ijb_u,ije_u,'leapfrog 471')
498  endif !if (ok_iso_verif) then
499 
500 !ym PAS D'AJUSTEMENT POUR LE MOMENT
501  if (adjust) then
502  adjustcount=adjustcount+1
503 ! if (iapptrac==iapp_tracvl .and. (forward. OR . leapf)
504 ! & .and. itau/iphysiq>2 .and. Adjustcount>30) then
505  if (adjustcount>1) then
506  adjustcount=0
507 c$OMP MASTER
508  call allgather_timer_average
509 
510  if (prt_level > 9) then
511 
512  print *,'*********************************'
513  print *,'****** TIMER CALDYN ******'
514  do i=0,mpi_size-1
515  print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i),
516  & ' : temps moyen :',
517  & timer_average(jj_nb_caldyn(i),timer_caldyn,i),
518  & '+-',timer_delta(jj_nb_caldyn(i),timer_caldyn,i)
519  enddo
520 
521  print *,'*********************************'
522  print *,'****** TIMER VANLEER ******'
523  do i=0,mpi_size-1
524  print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i),
525  & ' : temps moyen :',
526  & timer_average(jj_nb_vanleer(i),timer_vanleer,i),
527  & '+-',timer_delta(jj_nb_vanleer(i),timer_vanleer,i)
528  enddo
529 
530  print *,'*********************************'
531  print *,'****** TIMER DISSIP ******'
532  do i=0,mpi_size-1
533  print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i),
534  & ' : temps moyen :',
535  & timer_average(jj_nb_dissip(i),timer_dissip,i),
536  & '+-',timer_delta(jj_nb_dissip(i),timer_dissip,i)
537  enddo
538 
539 ! if (mpi_rank==0) call WriteBands
540 
541  endif
542 
543  call adjustbands_caldyn(new_dist)
544 !$OMP END MASTER
545 !$OMP BARRIER
546  CALL leapfrog_switch_caldyn(new_dist)
547 !$OMP BARRIER
548 
549 
550 !$OMP MASTER
551  distrib_caldyn=new_dist
552  CALL set_distrib(distrib_caldyn)
553 !$OMP END MASTER
554 !$OMP BARRIER
555 ! call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm,
556 ! & jj_Nb_caldyn,0,0,TestRequest)
557 ! call Register_SwapFieldHallo(ucovm1,ucovm1,ip1jmp1,llm,
558 ! & jj_Nb_caldyn,0,0,TestRequest)
559 ! call Register_SwapFieldHallo(vcov,vcov,ip1jm,llm,
560 ! & jj_Nb_caldyn,0,0,TestRequest)
561 ! call Register_SwapFieldHallo(vcovm1,vcovm1,ip1jm,llm,
562 ! & jj_Nb_caldyn,0,0,TestRequest)
563 ! call Register_SwapFieldHallo(teta,teta,ip1jmp1,llm,
564 ! & jj_Nb_caldyn,0,0,TestRequest)
565 ! call Register_SwapFieldHallo(tetam1,tetam1,ip1jmp1,llm,
566 ! & jj_Nb_caldyn,0,0,TestRequest)
567 ! call Register_SwapFieldHallo(masse,masse,ip1jmp1,llm,
568 ! & jj_Nb_caldyn,0,0,TestRequest)
569 ! call Register_SwapFieldHallo(massem1,massem1,ip1jmp1,llm,
570 ! & jj_Nb_caldyn,0,0,TestRequest)
571 ! call Register_SwapFieldHallo(ps,ps,ip1jmp1,1,
572 ! & jj_Nb_caldyn,0,0,TestRequest)
573 ! call Register_SwapFieldHallo(psm1,psm1,ip1jmp1,1,
574 ! & jj_Nb_caldyn,0,0,TestRequest)
575 ! call Register_SwapFieldHallo(pkf,pkf,ip1jmp1,llm,
576 ! & jj_Nb_caldyn,0,0,TestRequest)
577 ! call Register_SwapFieldHallo(pk,pk,ip1jmp1,llm,
578 ! & jj_Nb_caldyn,0,0,TestRequest)
579 ! call Register_SwapFieldHallo(pks,pks,ip1jmp1,1,
580 ! & jj_Nb_caldyn,0,0,TestRequest)
581 ! call Register_SwapFieldHallo(phis,phis,ip1jmp1,1,
582 ! & jj_Nb_caldyn,0,0,TestRequest)
583 ! call Register_SwapFieldHallo(phi,phi,ip1jmp1,llm,
584 ! & jj_Nb_caldyn,0,0,TestRequest)
585 ! call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,
586 ! & jj_Nb_caldyn,0,0,TestRequest)
587 !
588 ! do j=1,nqtot
589 ! call Register_SwapFieldHallo(q(:,:,j),q(:,:,j),ip1jmp1,llm,
590 ! & jj_nb_caldyn,0,0,TestRequest)
591 ! enddo
592 !
593 ! call Set_Distrib(distrib_caldyn)
594 ! call SendRequest(TestRequest)
595 ! call WaitRequest(TestRequest)
596 
597 !$OMP MASTER
598  call adjustbands_dissip(new_dist)
599 !$OMP END MASTER
600 !$OMP BARRIER
601  CALL leapfrog_switch_dissip(new_dist)
602 !$OMP BARRIER
603 !$OMP MASTER
604  distrib_dissip=new_dist
605 !$OMP END MASTER
606 !$OMP BARRIER
607 ! call AdjustBands_physic
608 
609 c$OMP MASTER
610  if (mpi_rank==0) call writebands
611 c$OMP END MASTER
612 
613 
614  endif
615  endif
616 
617 
618  if (ok_iso_verif) then
619  call check_isotopes(q,ijb_u,ije_u,'leapfrog 589')
620  endif !if (ok_iso_verif) then
621 
622 c-----------------------------------------------------------------------
623 c calcul des tendances dynamiques:
624 c --------------------------------
625 c$OMP BARRIER
626 c$OMP MASTER
627  call vtb(vthallo)
628 c$OMP END MASTER
629 
630  call register_hallo_u(ucov,llm,1,1,1,1,testrequest)
631  call register_hallo_v(vcov,llm,1,1,1,1,testrequest)
632  call register_hallo_u(teta,llm,1,1,1,1,testrequest)
633  call register_hallo_u(ps,1,1,2,2,1,testrequest)
634  call register_hallo_u(pkf,llm,1,1,1,1,testrequest)
635  call register_hallo_u(pk,llm,1,1,1,1,testrequest)
636  call register_hallo_u(pks,1,1,1,1,1,testrequest)
637  call register_hallo_u(p,llmp1,1,1,1,1,testrequest)
638 
639 c do j=1,nqtot
640 c call Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1,
641 c * TestRequest)
642 c enddo
643 
644  call sendrequest(testrequest)
645 c$OMP BARRIER
646  call waitrequest(testrequest)
647 
648 c$OMP MASTER
649  call vte(vthallo)
650 c$OMP END MASTER
651 c$OMP BARRIER
652 
653  if (debug) then
654  call writefield_u('ucov',ucov)
655  call writefield_v('vcov',vcov)
656  call writefield_u('teta',teta)
657  call writefield_u('ps',ps)
658  call writefield_u('masse',masse)
659  call writefield_u('pk',pk)
660  call writefield_u('pks',pks)
661  call writefield_u('pkf',pkf)
662  call writefield_u('phis',phis)
663  do j=1,nqtot
664  call writefield_u('q'//trim(int2str(j)),
665  . q(:,:,j))
666  enddo
667  endif
668 
669 
670  true_itau=true_itau+1
671 
672 c$OMP MASTER
673  IF (prt_level>9) THEN
674  WRITE(lunout,*)"leapfrog_p: Iteration No",true_itau
675  ENDIF
676 
677 
678  call start_timer(timer_caldyn)
679 
680  ! compute geopotential phi()
681  CALL geopot_loc ( ip1jmp1, teta , pk , pks, phis , phi )
682 
683  if (ok_iso_verif) then
684  call check_isotopes(q,ijb_u,ije_u,'leapfrog 651')
685  endif !if (ok_iso_verif) then
686 
687  call vtb(vtcaldyn)
688 c$OMP END MASTER
689 ! var_time=time+iday-day_ini
690 
691 c$OMP BARRIER
692 ! CALL FTRACE_REGION_BEGIN("caldyn")
693  time = jd_cur + jh_cur
694 
695  CALL caldyn_loc
696  $ ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
697  $ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time )
698 
699 ! CALL FTRACE_REGION_END("caldyn")
700 
701 c$OMP MASTER
702  call vte(vtcaldyn)
703 c$OMP END MASTER
704 
705 #ifdef DEBUG_IO
706  call writefield_u('du',du)
707  call writefield_v('dv',dv)
708  call writefield_u('dteta',dteta)
709  call writefield_u('dp',dp)
710  call writefield_u('w',w)
711  call writefield_u('pbaru',pbaru)
712  call writefield_v('pbarv',pbarv)
713  call writefield_u('p',p)
714  call writefield_u('masse',masse)
715  call writefield_u('pk',pk)
716 #endif
717 c-----------------------------------------------------------------------
718 c calcul des tendances advection des traceurs (dont l'humidite)
719 c -------------------------------------------------------------
720 
721  if (ok_iso_verif) then
722  call check_isotopes(q,ijb_u,ije_u,
723  & 'leapfrog 686: avant caladvtrac')
724  endif !if (ok_iso_verif) then
725 
726  IF( forward. or . leapf ) THEN
727 ! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step
728  !write(*,*) 'leapfrog 679: avant CALL caladvtrac_loc'
729  CALL caladvtrac_loc(q,pbaru,pbarv,
730  * p, masse, dq, teta,
731  . flxw,pk, iapptrac)
732 
733  !write(*,*) 'leapfrog 719'
734  if (ok_iso_verif) then
735  call check_isotopes(q,ijb_u,ije_u,
736  & 'leapfrog 698: apres caladvtrac')
737  endif !if (ok_iso_verif) then
738 
739 ! do j=1,nqtot
740 ! call WriteField_u('qadv'//trim(int2str(j)),q(:,:,j))
741 ! enddo
742 
743 ! Ehouarn: Storage of mass flux for off-line tracers... not implemented...
744 
745  ENDIF ! of IF( forward. OR . leapf )
746 
747 
748 c-----------------------------------------------------------------------
749 c integrations dynamique et traceurs:
750 c ----------------------------------
751 
752 c$OMP MASTER
753  call vtb(vtintegre)
754 c$OMP END MASTER
755 #ifdef DEBUG_IO
756  if (true_itau>20) then
757  call writefield_u('ucovm1',ucovm1)
758  call writefield_v('vcovm1',vcovm1)
759  call writefield_u('tetam1',tetam1)
760  call writefield_u('psm1',psm1)
761  call writefield_u('ucov_int',ucov)
762  call writefield_v('vcov_int',vcov)
763  call writefield_u('teta_int',teta)
764  call writefield_u('ps_int',ps)
765  endif
766 #endif
767 c$OMP BARRIER
768 ! CALL FTRACE_REGION_BEGIN("integrd")
769 
770  !write(*,*) 'leapfrog 720'
771  if (ok_iso_verif) then
772  call check_isotopes(q,ijb_u,ije_u,'leapfrog 756')
773  endif !if (ok_iso_verif) then
774 
775  ! CRisi: pourquoi aller jusqu'à 2 et non pas jusqu'à nqtot??
776  CALL integrd_loc ( nqtot,vcovm1,ucovm1,tetam1,psm1,massem1 ,
777  $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis)
778 ! $ finvmaold )
779 
780  !write(*,*) 'leapfrog 724'
781  if (ok_iso_verif) then
782  call check_isotopes(q,ijb_u,ije_u,'leapfrog 762')
783  endif !if (ok_iso_verif) then
784 
785 ! CALL FTRACE_REGION_END("integrd")
786 c$OMP BARRIER
787 #ifdef DEBUG_IO
788  call writefield_u('ucovm1',ucovm1)
789  call writefield_v('vcovm1',vcovm1)
790  call writefield_u('tetam1',tetam1)
791  call writefield_u('psm1',psm1)
792  call writefield_u('ucov_int',ucov)
793  call writefield_v('vcov_int',vcov)
794  call writefield_u('teta_int',teta)
795  call writefield_u('ps_int',ps)
796 #endif
797 
798  if (ok_iso_verif) then
799  call check_isotopes(q,ijb_u,ije_u,'leapfrog 775')
800  endif !if (ok_iso_verif) then
801 
802 c do j=1,nqtot
803 c call WriteField_p('q'//trim(int2str(j)),
804 c . reshape(q(:,:,j),(/iip1,jmp1,llm/)))
805 c call WriteField_p('dq'//trim(int2str(j)),
806 c . reshape(dq(:,:,j),(/iip1,jmp1,llm/)))
807 c enddo
808 
809 
810 c$OMP MASTER
811  call vte(vtintegre)
812 c$OMP END MASTER
813 c .P.Le Van (26/04/94 ajout de finvpold dans l'appel d'integrd)
814 c
815 c-----------------------------------------------------------------------
816 c calcul des tendances physiques:
817 c -------------------------------
818 c ######## P.Le Van ( Modif le 6/02/95 ) ###########
819 c
820  IF( purmats ) THEN
821  IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .true.
822  ELSE
823  IF( itau+1. eq. itaufin ) lafin = .true.
824  ENDIF
825 
826 cc$OMP END PARALLEL
827 
828 c
829 c
830  IF( apphys ) THEN
831 
832  CALL call_calfis(itau,lafin,ucov,vcov,teta,masse,ps,
833  & phis,q,flxw)
834 ! #ifdef DEBUG_IO
835 ! call WriteField_u('ucovfi',ucov)
836 ! call WriteField_v('vcovfi',vcov)
837 ! call WriteField_u('tetafi',teta)
838 ! call WriteField_u('pfi',p)
839 ! call WriteField_u('pkfi',pk)
840 ! do j=1,nqtot
841 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
842 ! enddo
843 ! #endif
844 ! c
845 ! c ....... Ajout P.Le Van ( 17/04/96 ) ...........
846 ! c
847 ! cc$OMP PARALLEL DEFAULT(SHARED)
848 ! cc$OMP+ PRIVATE(rdaym_ini,rdayvrai,ijb,ije)
849 
850 ! c$OMP MASTER
851 ! call suspend_timer(timer_caldyn)
852 
853 ! write(lunout,*)
854 ! & 'leapfrog_p: Entree dans la physique : Iteration No ',true_itau
855 ! c$OMP END MASTER
856 
857 ! CALL pression_loc ( ip1jmp1, ap, bp, ps, p )
858 
859 ! c$OMP BARRIER
860 ! CALL exner_hyb_loc( ip1jmp1, ps, p,pks, pk, pkf )
861 ! c$OMP BARRIER
862 ! jD_cur = jD_ref + day_ini - day_ref
863 ! $ + int (itau * dtvr / daysec)
864 ! jH_cur = jH_ref + &
865 ! & (itau * dtvr / daysec - int(itau * dtvr / daysec))
866 ! ! call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
867 
868 ! c rajout debug
869 ! c lafin = .true.
870 
871 
872 ! c Inbterface avec les routines de phylmd (phymars ... )
873 ! c -----------------------------------------------------
874 
875 ! c+jld
876 
877 ! c Diagnostique de conservation de l'energie : initialisation
878 !
879 ! c-jld
880 ! c$OMP BARRIER
881 ! c$OMP MASTER
882 ! call VTb(VThallo)
883 ! c$OMP END MASTER
884 
885 ! #ifdef DEBUG_IO
886 ! call WriteField_u('ucovfi',ucov)
887 ! call WriteField_v('vcovfi',vcov)
888 ! call WriteField_u('tetafi',teta)
889 ! call WriteField_u('pfi',p)
890 ! call WriteField_u('pkfi',pk)
891 ! #endif
892 ! call SetTag(Request_physic,800)
893 !
894 ! call Register_SwapField_u(ucov,ucov,distrib_physic,
895 ! * Request_physic,up=2,down=2)
896 !
897 ! call Register_SwapField_v(vcov,vcov,distrib_physic,
898 ! * Request_physic,up=2,down=2)
899 
900 ! call Register_SwapField_u(teta,teta,distrib_physic,
901 ! * Request_physic,up=2,down=2)
902 !
903 ! call Register_SwapField_u(masse,masse,distrib_physic,
904 ! * Request_physic,up=1,down=2)
905 
906 ! call Register_SwapField_u(p,p,distrib_physic,
907 ! * Request_physic,up=2,down=2)
908 !
909 ! call Register_SwapField_u(pk,pk,distrib_physic,
910 ! * Request_physic,up=2,down=2)
911 !
912 ! call Register_SwapField_u(phis,phis,distrib_physic,
913 ! * Request_physic,up=2,down=2)
914 !
915 ! call Register_SwapField_u(phi,phi,distrib_physic,
916 ! * Request_physic,up=2,down=2)
917 !
918 ! call Register_SwapField_u(w,w,distrib_physic,
919 ! * Request_physic,up=2,down=2)
920 !
921 ! call Register_SwapField_u(q,q,distrib_physic,
922 ! * Request_physic,up=2,down=2)
923 
924 ! call Register_SwapField_u(flxw,flxw,distrib_physic,
925 ! * Request_physic,up=2,down=2)
926 !
927 ! call SendRequest(Request_Physic)
928 ! c$OMP BARRIER
929 ! call WaitRequest(Request_Physic)
930 
931 ! c$OMP BARRIER
932 ! c$OMP MASTER
933 ! call Set_Distrib(distrib_Physic)
934 ! call VTe(VThallo)
935 !
936 ! call VTb(VTphysiq)
937 ! c$OMP END MASTER
938 ! c$OMP BARRIER
939 
940 ! #ifdef DEBUG_IO
941 ! call WriteField_u('ucovfi',ucov)
942 ! call WriteField_v('vcovfi',vcov)
943 ! call WriteField_u('tetafi',teta)
944 ! call WriteField_u('pfi',p)
945 ! call WriteField_u('pkfi',pk)
946 ! do j=1,nqtot
947 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
948 ! enddo
949 ! #endif
950 ! STOP
951 ! c$OMP BARRIER
952 ! ! CALL FTRACE_REGION_BEGIN("calfis")
953 ! CALL calfis_loc(lafin ,jD_cur, jH_cur,
954 ! $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
955 ! $ du,dv,dteta,dq,
956 ! $ flxw,
957 ! $ dufi,dvfi,dtetafi,dqfi,dpfi )
958 ! ! CALL FTRACE_REGION_END("calfis")
959 ! ! ijb=ij_begin
960 ! ! ije=ij_end
961 ! ! if ( .not. pole_nord) then
962 ! !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
963 ! ! DO l=1,llm
964 ! ! dufi_tmp(1:iip1,l) = dufi(ijb:ijb+iim,l)
965 ! ! dvfi_tmp(1:iip1,l) = dvfi(ijb:ijb+iim,l)
966 ! ! dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l)
967 ! ! dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:)
968 ! ! ENDDO
969 ! !c$OMP END DO NOWAIT
970 ! !
971 ! !c$OMP MASTER
972 ! ! dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim)
973 ! !c$OMP END MASTER
974 ! ! endif ! of if ( .not. pole_nord)
975 
976 ! !c$OMP BARRIER
977 ! !c$OMP MASTER
978 ! ! call Set_Distrib(distrib_physic_bis)
979 
980 ! ! call VTb(VThallo)
981 ! !c$OMP END MASTER
982 ! !c$OMP BARRIER
983 ! !
984 ! ! call Register_Hallo_u(dufi,llm,
985 ! ! * 1,0,0,1,Request_physic)
986 ! !
987 ! ! call Register_Hallo_v(dvfi,llm,
988 ! ! * 1,0,0,1,Request_physic)
989 ! !
990 ! ! call Register_Hallo_u(dtetafi,llm,
991 ! ! * 1,0,0,1,Request_physic)
992 ! !
993 ! ! call Register_Hallo_u(dpfi,1,
994 ! ! * 1,0,0,1,Request_physic)
995 ! !
996 ! ! do j=1,nqtot
997 ! ! call Register_Hallo_u(dqfi(ijb_u,1,j),llm,
998 ! ! * 1,0,0,1,Request_physic)
999 ! ! enddo
1000 ! !
1001 ! ! call SendRequest(Request_Physic)
1002 ! !c$OMP BARRIER
1003 ! ! call WaitRequest(Request_Physic)
1004 ! !
1005 ! !c$OMP BARRIER
1006 ! !c$OMP MASTER
1007 ! ! call VTe(VThallo)
1008 ! !
1009 ! ! call set_Distrib(distrib_Physic)
1010 ! !c$OMP END MASTER
1011 ! !c$OMP BARRIER
1012 ! ! ijb=ij_begin
1013 ! ! if (.not. pole_nord) then
1014 ! !
1015 ! !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1016 ! ! DO l=1,llm
1017 ! ! dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
1018 ! ! dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
1019 ! ! dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)
1020 ! ! & +dtetafi_tmp(1:iip1,l)
1021 ! ! dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:)
1022 ! ! & + dqfi_tmp(1:iip1,l,:)
1023 ! ! ENDDO
1024 ! !c$OMP END DO NOWAIT
1025 ! !
1026 ! !c$OMP MASTER
1027 ! ! dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
1028 ! !c$OMP END MASTER
1029 ! !
1030 ! ! endif ! of if (.not. pole_nord)
1031 
1032 ! #ifdef DEBUG_IO
1033 ! call WriteField_u('dufi',dufi)
1034 ! call WriteField_v('dvfi',dvfi)
1035 ! call WriteField_u('dtetafi',dtetafi)
1036 ! call WriteField_u('dpfi',dpfi)
1037 ! do j=1,nqtot
1038 ! call WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j))
1039 ! enddo
1040 ! #endif
1041 
1042 ! c$OMP BARRIER
1043 
1044 ! c ajout des tendances physiques:
1045 ! c ------------------------------
1046 ! #ifdef DEBUG_IO
1047 ! call WriteField_u('ucovfi',ucov)
1048 ! call WriteField_v('vcovfi',vcov)
1049 ! call WriteField_u('tetafi',teta)
1050 ! call WriteField_u('psfi',ps)
1051 ! do j=1,nqtot
1052 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
1053 ! enddo
1054 ! #endif
1055 
1056 ! IF (ok_strato) THEN
1057 ! CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
1058 ! ENDIF
1059 
1060 ! #ifdef DEBUG_IO
1061 ! call WriteField_u('ucovfi',ucov)
1062 ! call WriteField_v('vcovfi',vcov)
1063 ! call WriteField_u('tetafi',teta)
1064 ! call WriteField_u('psfi',ps)
1065 ! do j=1,nqtot
1066 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
1067 ! enddo
1068 ! #endif
1069 
1070 ! CALL addfi_loc( dtphys, leapf, forward ,
1071 ! $ ucov, vcov, teta , q ,ps ,
1072 ! $ dufi, dvfi, dtetafi , dqfi ,dpfi )
1073 
1074 ! #ifdef DEBUG_IO
1075 ! call WriteField_u('ucovfi',ucov)
1076 ! call WriteField_v('vcovfi',vcov)
1077 ! call WriteField_u('tetafi',teta)
1078 ! call WriteField_u('psfi',ps)
1079 ! do j=1,nqtot
1080 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
1081 ! enddo
1082 ! #endif
1083 
1084 ! c$OMP BARRIER
1085 ! c$OMP MASTER
1086 ! call VTe(VTphysiq)
1087 
1088 ! call VTb(VThallo)
1089 ! c$OMP END MASTER
1090 
1091 ! call SetTag(Request_physic,800)
1092 ! call Register_SwapField_u(ucov,ucov,
1093 ! * distrib_caldyn,Request_physic)
1094 !
1095 ! call Register_SwapField_v(vcov,vcov,
1096 ! * distrib_caldyn,Request_physic)
1097 !
1098 ! call Register_SwapField_u(teta,teta,
1099 ! * distrib_caldyn,Request_physic)
1100 !
1101 ! call Register_SwapField_u(masse,masse,
1102 ! * distrib_caldyn,Request_physic)
1103 
1104 ! call Register_SwapField_u(p,p,
1105 ! * distrib_caldyn,Request_physic)
1106 !
1107 ! call Register_SwapField_u(pk,pk,
1108 ! * distrib_caldyn,Request_physic)
1109 !
1110 ! call Register_SwapField_u(phis,phis,
1111 ! * distrib_caldyn,Request_physic)
1112 !
1113 ! call Register_SwapField_u(phi,phi,
1114 ! * distrib_caldyn,Request_physic)
1115 !
1116 ! call Register_SwapField_u(w,w,
1117 ! * distrib_caldyn,Request_physic)
1118 
1119 ! call Register_SwapField_u(q,q,
1120 ! * distrib_caldyn,Request_physic)
1121 !
1122 ! call SendRequest(Request_Physic)
1123 ! c$OMP BARRIER
1124 ! call WaitRequest(Request_Physic)
1125 
1126 ! c$OMP BARRIER
1127 ! c$OMP MASTER
1128 ! call VTe(VThallo)
1129 ! call set_distrib(distrib_caldyn)
1130 ! c$OMP END MASTER
1131 ! c$OMP BARRIER
1132 ! c
1133 ! c Diagnostique de conservation de l'energie : difference
1134 ! IF (ip_ebil_dyn.ge.1 ) THEN
1135 ! ztit='bil phys'
1136 ! CALL diagedyn(ztit,2,1,1,dtphys
1137 ! e , ucov , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
1138 ! ENDIF
1139 
1140 ! #ifdef DEBUG_IO
1141 ! call WriteField_u('ucovfi',ucov)
1142 ! call WriteField_v('vcovfi',vcov)
1143 ! call WriteField_u('tetafi',teta)
1144 ! call WriteField_u('psfi',ps)
1145 ! do j=1,nqtot
1146 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
1147 ! enddo
1148 ! #endif
1149 
1150 
1151 ! c-jld
1152 c$OMP MASTER
1153  if (firstphysic) then
1154  ok_start_timer=.true.
1155  firstphysic=.false.
1156  endif
1157 c$OMP END MASTER
1158  ENDIF ! of IF( apphys )
1159 
1160  if (ok_iso_verif) then
1161  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1132')
1162  endif !if (ok_iso_verif) then
1163  !write(*,*) 'leapfrog 1134: iflag_phys=',iflag_phys
1164 
1165  IF(iflag_phys.EQ.2) THEN ! "Newtonian" case
1166 c$OMP MASTER
1167  if (firstphysic) then
1168  ok_start_timer=.true.
1169  firstphysic=.false.
1170  endif
1171 c$OMP END MASTER
1172 
1173 
1174 c Calcul academique de la physique = Rappel Newtonien + fritcion
1175 c --------------------------------------------------------------
1176 cym teta(:,:)=teta(:,:)
1177 cym s -iphysiq*dtvr*(teta(:,:)-tetarappel(:,:))/taurappel
1178  ijb=ij_begin
1179  ije=ij_end
1180 !LF teta(ijb:ije,:)=teta(ijb:ije,:)
1181 !LF s -iphysiq*dtvr*(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel
1182 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1183  do l=1,llm
1184  teta(ijb:ije,l)=teta(ijb:ije,l) -dtvr*
1185  & (teta(ijb:ije,l)-tetarappel(ijb:ije,l))*
1186  & (knewt_g+knewt_t(l)*clat4(ijb:ije))
1187  enddo
1188 !$OMP END DO
1189 
1190 !$OMP MASTER
1191  if (planet_type.eq."giant") then
1192  ! add an intrinsic heat flux at the base of the atmosphere
1193  teta(ijb:ije,1) = teta(ijb:ije,1)
1194  & + dtvr * aire(ijb:ije) * ihf / cpp / masse(ijb:ije,1)
1195  endif
1196 !$OMP END MASTER
1197 !$OMP BARRIER
1198 
1199 
1200  call register_hallo_u(ucov,llm,0,1,1,0,request_physic)
1201  call register_hallo_v(vcov,llm,1,1,1,1,request_physic)
1202  call sendrequest(request_physic)
1203 c$OMP BARRIER
1204  call waitrequest(request_physic)
1205 c$OMP BARRIER
1206  call friction_loc(ucov,vcov,dtvr)
1207 !$OMP BARRIER
1208 
1209  ! Sponge layer (if any)
1210  IF (ok_strato) THEN
1211  CALL top_bound_loc(vcov,ucov,teta,masse,dtvr)
1212 !$OMP BARRIER
1213  ENDIF ! of IF (ok_strato)
1214  ENDIF ! of IF(iflag_phys.EQ.2)
1215 
1216 
1217  CALL pression_loc ( ip1jmp1, ap, bp, ps, p )
1218 c$OMP BARRIER
1219  if (pressure_exner) then
1220  CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf )
1221  else
1222  CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf )
1223  endif
1224 c$OMP BARRIER
1225  CALL massdair_loc(p,masse)
1226 c$OMP BARRIER
1227 
1228 cc$OMP END PARALLEL
1229  if (ok_iso_verif) then
1230  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1196')
1231  endif !if (ok_iso_verif) then
1232 
1233 c-----------------------------------------------------------------------
1234 c dissipation horizontale et verticale des petites echelles:
1235 c ----------------------------------------------------------
1236  !write(*,*) 'leapfrog 1163: apdiss=',apdiss
1237  IF(apdiss) THEN
1238 
1239  CALL call_dissip(ucov,vcov,teta,p,pk,ps)
1240 !cc$OMP PARALLEL DEFAULT(SHARED)
1241 !cc$OMP+ PRIVATE(ijb,ije,tppn,tpn,tpps,tps)
1242 !c$OMP MASTER
1243 ! call suspend_timer(timer_caldyn)
1244 !
1245 !c print*,'Entree dans la dissipation : Iteration No ',true_itau
1246 !c calcul de l'energie cinetique avant dissipation
1247 !c print *,'Passage dans la dissipation'
1248 
1249 ! call VTb(VThallo)
1250 !c$OMP END MASTER
1251 
1252 !c$OMP BARRIER
1253 
1254 ! call Register_SwapField_u(ucov,ucov,distrib_dissip,
1255 ! * Request_dissip,up=1,down=1)
1256 
1257 ! call Register_SwapField_v(vcov,vcov,distrib_dissip,
1258 ! * Request_dissip,up=1,down=1)
1259 
1260 ! call Register_SwapField_u(teta,teta,distrib_dissip,
1261 ! * Request_dissip)
1262 
1263 ! call Register_SwapField_u(p,p,distrib_dissip,
1264 ! * Request_dissip)
1265 
1266 ! call Register_SwapField_u(pk,pk,distrib_dissip,
1267 ! * Request_dissip)
1268 
1269 ! call SendRequest(Request_dissip)
1270 !c$OMP BARRIER
1271 ! call WaitRequest(Request_dissip)
1272 
1273 !c$OMP BARRIER
1274 !c$OMP MASTER
1275 ! call set_distrib(distrib_dissip)
1276 ! call VTe(VThallo)
1277 ! call VTb(VTdissipation)
1278 ! call start_timer(timer_dissip)
1279 !c$OMP END MASTER
1280 !c$OMP BARRIER
1281 
1282 ! call covcont_loc(llm,ucov,vcov,ucont,vcont)
1283 ! call enercin_loc(vcov,ucov,vcont,ucont,ecin0)
1284 
1285 !c dissipation
1286 
1287 !! CALL FTRACE_REGION_BEGIN("dissip")
1288 ! CALL dissip_loc(vcov,ucov,teta,p,dvdis,dudis,dtetadis)
1289 
1290 !#ifdef DEBUG_IO
1291 ! call WriteField_u('dudis',dudis)
1292 ! call WriteField_v('dvdis',dvdis)
1293 ! call WriteField_u('dtetadis',dtetadis)
1294 !#endif
1295 !
1296 !! CALL FTRACE_REGION_END("dissip")
1297 !
1298 ! ijb=ij_begin
1299 ! ije=ij_end
1300 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1301 ! DO l=1,llm
1302 ! ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l)
1303 ! ENDDO
1304 !c$OMP END DO NOWAIT
1305 ! if (pole_sud) ije=ije-iip1
1306 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1307 ! DO l=1,llm
1308 ! vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l)
1309 ! ENDDO
1310 !c$OMP END DO NOWAIT
1311 
1312 !c teta=teta+dtetadis
1313 
1314 
1315 !c------------------------------------------------------------------------
1316 ! if (dissip_conservative) then
1317 !C On rajoute la tendance due a la transform. Ec -> E therm. cree
1318 !C lors de la dissipation
1319 !c$OMP BARRIER
1320 !c$OMP MASTER
1321 ! call suspend_timer(timer_dissip)
1322 ! call VTb(VThallo)
1323 !c$OMP END MASTER
1324 ! call Register_Hallo_u(ucov,llm,1,1,1,1,Request_Dissip)
1325 ! call Register_Hallo_v(vcov,llm,1,1,1,1,Request_Dissip)
1326 ! call SendRequest(Request_Dissip)
1327 !c$OMP BARRIER
1328 ! call WaitRequest(Request_Dissip)
1329 !c$OMP MASTER
1330 ! call VTe(VThallo)
1331 ! call resume_timer(timer_dissip)
1332 !c$OMP END MASTER
1333 !c$OMP BARRIER
1334 ! call covcont_loc(llm,ucov,vcov,ucont,vcont)
1335 ! call enercin_loc(vcov,ucov,vcont,ucont,ecin)
1336 !
1337 ! ijb=ij_begin
1338 ! ije=ij_end
1339 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1340 ! do l=1,llm
1341 ! do ij=ijb,ije
1342 ! dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l)
1343 ! dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l)
1344 ! enddo
1345 ! enddo
1346 !c$OMP END DO NOWAIT
1347 ! endif
1348 
1349 ! ijb=ij_begin
1350 ! ije=ij_end
1351 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1352 ! do l=1,llm
1353 ! do ij=ijb,ije
1354 ! teta(ij,l)=teta(ij,l)+dtetadis(ij,l)
1355 ! enddo
1356 ! enddo
1357 !c$OMP END DO NOWAIT
1358 !c------------------------------------------------------------------------
1359 
1360 
1361 !c ....... P. Le Van ( ajout le 17/04/96 ) ...........
1362 !c ... Calcul de la valeur moyenne, unique de h aux poles .....
1363 !c
1364 
1365 ! ijb=ij_begin
1366 ! ije=ij_end
1367 !
1368 ! if (pole_nord) then
1369 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1370 ! DO l = 1, llm
1371 ! DO ij = 1,iim
1372 ! tppn(ij) = aire( ij ) * teta( ij ,l)
1373 ! ENDDO
1374 ! tpn = SSUM(iim,tppn,1)/apoln
1375 
1376 ! DO ij = 1, iip1
1377 ! teta( ij ,l) = tpn
1378 ! ENDDO
1379 ! ENDDO
1380 !c$OMP END DO NOWAIT
1381 
1382 !c$OMP MASTER
1383 ! DO ij = 1,iim
1384 ! tppn(ij) = aire( ij ) * ps ( ij )
1385 ! ENDDO
1386 ! tpn = SSUM(iim,tppn,1)/apoln
1387 !
1388 ! DO ij = 1, iip1
1389 ! ps( ij ) = tpn
1390 ! ENDDO
1391 !c$OMP END MASTER
1392 ! endif
1393 !
1394 ! if (pole_sud) then
1395 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1396 ! DO l = 1, llm
1397 ! DO ij = 1,iim
1398 ! tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
1399 ! ENDDO
1400 ! tps = SSUM(iim,tpps,1)/apols
1401 
1402 ! DO ij = 1, iip1
1403 ! teta(ij+ip1jm,l) = tps
1404 ! ENDDO
1405 ! ENDDO
1406 !c$OMP END DO NOWAIT
1407 
1408 !c$OMP MASTER
1409 ! DO ij = 1,iim
1410 ! tpps(ij) = aire(ij+ip1jm) * ps (ij+ip1jm)
1411 ! ENDDO
1412 ! tps = SSUM(iim,tpps,1)/apols
1413 !
1414 ! DO ij = 1, iip1
1415 ! ps(ij+ip1jm) = tps
1416 ! ENDDO
1417 !c$OMP END MASTER
1418 ! endif
1419 
1420 
1421 !c$OMP BARRIER
1422 !c$OMP MASTER
1423 ! call VTe(VTdissipation)
1424 
1425 ! call stop_timer(timer_dissip)
1426 !
1427 ! call VTb(VThallo)
1428 !c$OMP END MASTER
1429 ! call Register_SwapField_u(ucov,ucov,distrib_caldyn,
1430 ! * Request_dissip)
1431 
1432 ! call Register_SwapField_v(vcov,vcov,distrib_caldyn,
1433 ! * Request_dissip)
1434 
1435 ! call Register_SwapField_u(teta,teta,distrib_caldyn,
1436 ! * Request_dissip)
1437 
1438 ! call Register_SwapField_u(p,p,distrib_caldyn,
1439 ! * Request_dissip)
1440 
1441 ! call Register_SwapField_u(pk,pk,distrib_caldyn,
1442 ! * Request_dissip)
1443 
1444 ! call SendRequest(Request_dissip)
1445 !c$OMP BARRIER
1446 ! call WaitRequest(Request_dissip)
1447 
1448 !c$OMP BARRIER
1449 !c$OMP MASTER
1450 ! call set_distrib(distrib_caldyn)
1451 ! call VTe(VThallo)
1452 ! call resume_timer(timer_caldyn)
1453 !c print *,'fin dissipation'
1454 !c$OMP END MASTER
1455 !c$OMP BARRIER
1456  END IF ! of IF(apdiss)
1457 
1458 cc$OMP END PARALLEL
1459 
1460 c ajout debug
1461 c IF( lafin ) then
1462 c abort_message = 'Simulation finished'
1463 c call abort_gcm(modname,abort_message,0)
1464 c ENDIF
1465 
1466  if (ok_iso_verif) then
1467  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1430')
1468  endif !if (ok_iso_verif) then
1469 
1470 c ********************************************************************
1471 c ********************************************************************
1472 c .... fin de l'integration dynamique et physique pour le pas itau ..
1473 c ********************************************************************
1474 c ********************************************************************
1475 
1476 c preparation du pas d'integration suivant ......
1477 cym call WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
1478 cym call WriteField('vcov',reshape(vcov,(/iip1,jjm,llm/)))
1479 c$OMP MASTER
1480  call stop_timer(timer_caldyn)
1481 c$OMP END MASTER
1482  IF (itau==itaumax) then
1483 c$OMP MASTER
1484  call allgather_timer_average
1485  call barrier
1486  if (mpi_rank==0) then
1487 
1488  print *,'*********************************'
1489  print *,'****** TIMER CALDYN ******'
1490  do i=0,mpi_size-1
1491  print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i),
1492  & ' : temps moyen :',
1493  & timer_average(jj_nb_caldyn(i),timer_caldyn,i)
1494  enddo
1495 
1496  print *,'*********************************'
1497  print *,'****** TIMER VANLEER ******'
1498  do i=0,mpi_size-1
1499  print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i),
1500  & ' : temps moyen :',
1501  & timer_average(jj_nb_vanleer(i),timer_vanleer,i)
1502  enddo
1503 
1504  print *,'*********************************'
1505  print *,'****** TIMER DISSIP ******'
1506  do i=0,mpi_size-1
1507  print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i),
1508  & ' : temps moyen :',
1509  & timer_average(jj_nb_dissip(i),timer_dissip,i)
1510  enddo
1511 
1512  print *,'*********************************'
1513  print *,'****** TIMER PHYSIC ******'
1514  do i=0,mpi_size-1
1515  print *,'proc',i,' : Nb Bandes :',jj_nb_physic(i),
1516  & ' : temps moyen :',
1517  & timer_average(jj_nb_physic(i),timer_physic,i)
1518  enddo
1519 
1520  endif
1521  CALL barrier
1522  print *,'Taille du Buffer MPI (REAL*8)',maxbuffersize
1523  print *,'Taille du Buffer MPI utilise (REAL*8)',maxbuffersize_used
1524  print *, 'Temps total ecoule sur la parallelisation :',difftime()
1525  print *, 'Temps CPU ecoule sur la parallelisation :',diffcputime()
1526  CALL print_filtre_timer
1527 c$OMP END MASTER
1528  CALL dynredem1_loc("restart.nc",0.0,
1529  . vcov,ucov,teta,q,masse,ps)
1530 c$OMP MASTER
1531  call fin_getparam
1532 c$OMP END MASTER
1533 
1534 #ifdef INCA
1535  call finalize_inca
1536 #endif
1537 
1538 c$OMP MASTER
1539  call finalize_parallel
1540 c$OMP END MASTER
1541 c$OMP BARRIER
1542  RETURN
1543  ENDIF
1544 
1545  if (ok_iso_verif) then
1546  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1509')
1547  endif !if (ok_iso_verif) then
1548 
1549  IF ( .NOT.purmats ) THEN
1550 c ........................................................
1551 c .............. schema matsuno + leapfrog ..............
1552 c ........................................................
1553 
1554  IF(forward. or. leapf) THEN
1555  itau= itau + 1
1556 ! iday= day_ini+itau/day_step
1557 ! time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
1558 ! IF(time.GT.1.) THEN
1559 ! time = time-1.
1560 ! iday = iday+1
1561 ! ENDIF
1562  ENDIF
1563 
1564 
1565  IF( itau. eq. itaufinp1 ) then
1566 
1567  if (flag_verif) then
1568  write(79,*) 'ucov',ucov
1569  write(80,*) 'vcov',vcov
1570  write(81,*) 'teta',teta
1571  write(82,*) 'ps',ps
1572  write(83,*) 'q',q
1573  WRITE(85,*) 'q1 = ',q(:,:,1)
1574  WRITE(86,*) 'q3 = ',q(:,:,3)
1575  endif
1576 
1577 
1578 c$OMP MASTER
1579  call fin_getparam
1580 c$OMP END MASTER
1581 
1582 #ifdef INCA
1583  call finalize_inca
1584 #endif
1585 
1586 c$OMP MASTER
1587  call finalize_parallel
1588 c$OMP END MASTER
1589  abort_message = 'Simulation finished'
1590  call abort_gcm(modname,abort_message,0)
1591  RETURN
1592  ENDIF
1593 c-----------------------------------------------------------------------
1594 c ecriture du fichier histoire moyenne:
1595 c -------------------------------------
1596 
1597  IF(mod(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
1598 c$OMP BARRIER
1599  IF(itau.EQ.itaufin) THEN
1600  iav=1
1601  ELSE
1602  iav=0
1603  ENDIF
1604 
1605 #ifdef CPP_IOIPSL
1606  IF (ok_dynzon) THEN
1607 
1608  CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav,
1609  , ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
1610 
1611  ENDIF !ok_dynzon
1612 
1613  IF (ok_dyn_ave) THEN
1614  CALL writedynav_loc(itau,vcov,
1615  & ucov,teta,pk,phi,q,masse,ps,phis)
1616  ENDIF
1617 #endif
1618  ENDIF
1619 
1620  if (ok_iso_verif) then
1621  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1584')
1622  endif !if (ok_iso_verif) then
1623 
1624 c-----------------------------------------------------------------------
1625 c ecriture de la bande histoire:
1626 c ------------------------------
1627 
1628  IF( mod(itau,iecri).EQ.0) THEN
1629  ! Ehouarn: output only during LF or Backward Matsuno
1630  if (leapf.or.(.not.leapf.and.(.not.forward))) then
1631 
1632 c$OMP BARRIER
1633 c$OMP MASTER
1634  CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
1635 c$OMP END MASTER
1636 c$OMP BARRIER
1637 
1638 #ifdef CPP_IOIPSL
1639  if (ok_dyn_ins) then
1640  CALL writehist_loc(itau,vcov,ucov,teta,phi,q,
1641  & masse,ps,phis)
1642  endif
1643 #endif
1644  endif ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
1645  ENDIF ! of IF(MOD(itau,iecri).EQ.0)
1646 
1647  IF(itau.EQ.itaufin) THEN
1648 
1649 c$OMP BARRIER
1650 
1651 ! if (planet_type.eq."earth") then
1652 ! Write an Earth-format restart file
1653  CALL dynredem1_loc("restart.nc",0.0,
1654  & vcov,ucov,teta,q,masse,ps)
1655 ! endif ! of if (planet_type.eq."earth")
1656 
1657 ! CLOSE(99)
1658  ENDIF ! of IF (itau.EQ.itaufin)
1659 
1660  if (ok_iso_verif) then
1661  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1624')
1662  endif !if (ok_iso_verif) then
1663 
1664 c-----------------------------------------------------------------------
1665 c gestion de l'integration temporelle:
1666 c ------------------------------------
1667 
1668  IF( mod(itau,iperiod).EQ.0 ) THEN
1669  GO TO 1
1670  ELSE IF ( mod(itau-1,iperiod). eq. 0 ) THEN
1671 
1672  IF( forward ) THEN
1673 c fin du pas forward et debut du pas backward
1674 
1675  forward = .false.
1676  leapf = .false.
1677  GO TO 2
1678 
1679  ELSE
1680 c fin du pas backward et debut du premier pas leapfrog
1681 
1682  leapf = .true.
1683  dt = 2.*dtvr
1684  GO TO 2
1685  END IF
1686  ELSE
1687 
1688 c ...... pas leapfrog .....
1689 
1690  leapf = .true.
1691  dt = 2.*dtvr
1692  GO TO 2
1693  END IF ! of IF (MOD(itau,iperiod).EQ.0)
1694  ! ELSEIF (MOD(itau-1,iperiod).EQ.0)
1695 
1696 
1697  ELSE ! of IF (.not.purmats)
1698 
1699 
1700  if (ok_iso_verif) then
1701  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1664')
1702  endif !if (ok_iso_verif) then
1703 
1704 c ........................................................
1705 c .............. schema matsuno ...............
1706 c ........................................................
1707  IF( forward ) THEN
1708 
1709  itau = itau + 1
1710 ! iday = day_ini+itau/day_step
1711 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
1712 !
1713 ! IF(time.GT.1.) THEN
1714 ! time = time-1.
1715 ! iday = iday+1
1716 ! ENDIF
1717 
1718  forward = .false.
1719  IF( itau. eq. itaufinp1 ) then
1720 c$OMP MASTER
1721  call fin_getparam
1722 c$OMP END MASTER
1723 
1724 #ifdef INCA
1725  call finalize_inca
1726 #endif
1727 
1728 c$OMP MASTER
1729  call finalize_parallel
1730 c$OMP END MASTER
1731  abort_message = 'Simulation finished'
1732  call abort_gcm(modname,abort_message,0)
1733  RETURN
1734  ENDIF
1735  GO TO 2
1736 
1737  ELSE ! of IF(forward) i.e. backward step
1738 
1739 
1740  if (ok_iso_verif) then
1741  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1698')
1742  endif !if (ok_iso_verif) then
1743 
1744  IF(mod(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
1745  IF(itau.EQ.itaufin) THEN
1746  iav=1
1747  ELSE
1748  iav=0
1749  ENDIF
1750 
1751 #ifdef CPP_IOIPSL
1752  IF (ok_dynzon) THEN
1753  CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav,
1754  , ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
1755  ENDIF
1756 
1757  IF (ok_dyn_ave) THEN
1758  CALL writedynav_loc(itau,vcov,
1759  & ucov,teta,pk,phi,q,masse,ps,phis)
1760  ENDIF
1761 #endif
1762  ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
1763 
1764 
1765  IF(mod(itau,iecri ).EQ.0) THEN
1766 
1767 c$OMP BARRIER
1768 c$OMP MASTER
1769  CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
1770 c$OMP END MASTER
1771 c$OMP BARRIER
1772 
1773 
1774 #ifdef CPP_IOIPSL
1775  if (ok_dyn_ins) then
1776  CALL writehist_loc(itau,vcov,ucov,teta,phi,q,
1777  & masse,ps,phis)
1778  endif ! of if (ok_dyn_ins)
1779 #endif
1780  ENDIF ! of IF(MOD(itau,iecri).EQ.0)
1781 
1782 
1783  IF(itau.EQ.itaufin) THEN
1784 ! if (planet_type.eq."earth") then
1785  CALL dynredem1_loc("restart.nc",0.0,
1786  . vcov,ucov,teta,q,masse,ps)
1787 ! endif ! of if (planet_type.eq."earth")
1788  ENDIF ! of IF(itau.EQ.itaufin)
1789 
1790  forward = .true.
1791  GO TO 1
1792 
1793  ENDIF ! of IF (forward)
1794 
1795 
1796  if (ok_iso_verif) then
1797  call check_isotopes(q,ijb_u,ije_u,'leapfrog 1750')
1798  endif !if (ok_iso_verif) then
1799 
1800  END IF ! of IF(.not.purmats)
1801 c$OMP MASTER
1802  call fin_getparam
1803 c$OMP END MASTER
1804 
1805 #ifdef INCA
1806  call finalize_inca
1807 #endif
1808 
1809 c$OMP MASTER
1810  call finalize_parallel
1811 c$OMP END MASTER
1812  abort_message = 'Simulation finished'
1813  call abort_gcm(modname,abort_message,0)
1814  RETURN
1815  END
leapfrog_mod::q
real, dimension(:,:,:), pointer, save q
Definition: leapfrog_mod.F90:9
write_field_loc
Definition: write_field_loc.F90:1
parallel_lmdz::barrier
subroutine barrier
Definition: parallel_lmdz.F90:496
bands
Definition: bands.F90:4
top_bound_loc
subroutine top_bound_loc(vcov, ucov, teta, masse, dt)
Definition: top_bound_loc.F:5
mod_hallo::maxbuffersize_used
integer, save maxbuffersize_used
Definition: mod_hallo.F90:10
check_isotopes
subroutine check_isotopes(q, ijb, ije, err_msg)
Definition: check_isotopes_loc.F:2
leapfrog_mod::dq
real, dimension(:,:,:), pointer, save dq
Definition: leapfrog_mod.F90:27
ip1jmp1
!$Header llmm1 INTEGER ip1jmp1
Definition: paramet.h:14
exner_milieu_loc_m
Definition: exner_milieu_loc_m.F90:1
call_dissip_mod::call_dissip
subroutine call_dissip(ucov_dyn, vcov_dyn, teta_dyn, p_dyn, pk_dyn, ps_dyn)
Definition: call_dissip_mod.F90:80
times::timer_physic
integer, parameter timer_physic
Definition: times.F90:10
leapfrog_mod::pkf
real, dimension(:,:), pointer, save pkf
Definition: leapfrog_mod.F90:13
bands::jj_nb_caldyn
integer, dimension(:), allocatable jj_nb_caldyn
Definition: bands.F90:10
bands::adjustbands_dissip
subroutine adjustbands_dissip(new_dist)
Definition: bands.F90:313
getparam::fin_getparam
subroutine fin_getparam
Definition: getparam.F90:29
bilan_dyn_loc
subroutine bilan_dyn_loc(ntrac, dt_app, dt_cum, ps, masse, pk, flux_u, flux_v, teta, phi, ucov, vcov, trac)
Definition: bilan_dyn_loc.F:6
leapfrog_mod::pbarv
real, dimension(:,:), pointer, save pbarv
Definition: leapfrog_mod.F90:17
times::init_timer
subroutine init_timer
Definition: times.F90:27
control_mod::ok_dyn_ins
logical, save ok_dyn_ins
Definition: control_mod.F90:36
write_field_loc::writefield_v
Definition: write_field_loc.F90:8
times::stop_timer
subroutine stop_timer(no_timer)
Definition: times.F90:103
leapfrog_mod::dv
real, dimension(:,:), pointer, save dv
Definition: leapfrog_mod.F90:23
exner_milieu_loc_m::exner_milieu_loc
subroutine exner_milieu_loc(ngrid, ps, p, pks, pk, pkf)
Definition: exner_milieu_loc_m.F90:8
bands::distrib_dissip
type(distrib), target, save distrib_dissip
Definition: bands.F90:20
llmp1
!$Header llmp1
Definition: paramet.h:14
bp
!$Id bp(llm+1)
parallel_lmdz::distrib
Definition: parallel_lmdz.F90:51
vampir
Definition: vampir.F90:1
parallel_lmdz::mpi_rank
integer, save mpi_rank
Definition: parallel_lmdz.F90:18
times::difftime
double precision function difftime()
Definition: times.F90:225
bands::writebands
subroutine writebands
Definition: bands.F90:438
leapfrog_loc
subroutine leapfrog_loc(ucov0, vcov0, teta0, ps0, masse0, phis0, q0, time_0)
Definition: leapfrog_loc.F:12
parallel_lmdz::mpi_size
integer, save mpi_size
Definition: parallel_lmdz.F90:17
times::timer_average
real, dimension(:,:,:), allocatable timer_average
Definition: times.F90:19
infotrac::ok_iso_verif
logical, save ok_iso_verif
Definition: infotrac.F90:44
parallel_lmdz::ij_end
integer, save ij_end
Definition: parallel_lmdz.F90:23
parallel_lmdz::pole_sud
logical, save pole_sud
Definition: parallel_lmdz.F90:25
vampir::vtb
subroutine vtb(number)
Definition: vampir.F90:52
knewt_t
!$Id knewt_t
Definition: academic.h:4
dt
!$Id calend INTEGER itaufin INTEGER itau_phy INTEGER day_ref REAL dt
Definition: temps.h:15
massdair_loc
subroutine massdair_loc(p, masse)
Definition: massdair_loc.F:2
control_mod::planet_type
character(len=10), save planet_type
Definition: control_mod.F90:32
abort_gcm
subroutine abort_gcm(modname, message, ierr)
Definition: abort_gcm.F:7
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
vampir::vtintegre
integer, parameter vtintegre
Definition: vampir.F90:4
call_calfis_mod
Definition: call_calfis_mod.F90:2
aire
!$Header!CDK comgeom COMMON comgeom aire
Definition: comgeom.h:25
bands::jj_nb_dissip
integer, dimension(:), allocatable jj_nb_dissip
Definition: bands.F90:13
allocate_field_mod
Definition: allocate_field_mod.F90:1
misc_mod::itcount
integer, save itcount
Definition: misc_mod.F90:4
writehist_loc
subroutine writehist_loc(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
Definition: writehist_loc.F:6
misc_mod
Definition: misc_mod.F90:1
iflag_phys
!$Id ysinus ok_gradsfile hybrid COMMON logici iflag_phys
Definition: logic.h:10
caladvtrac_loc
subroutine caladvtrac_loc(q, pbaru, pbarv, p, masse, dq, teta, flxw, pk, iapptrac)
Definition: caladvtrac_loc.F:9
control_mod::day_step
integer, save day_step
Definition: control_mod.F90:15
knewt_g
!$Id knewt_g
Definition: academic.h:4
times::timer_caldyn
integer, parameter timer_caldyn
Definition: times.F90:7
control_mod::iphysiq
integer, save iphysiq
Definition: control_mod.F90:24
leapfrog_mod::vcov
real, dimension(:,:), pointer, save vcov
Definition: leapfrog_mod.F90:4
guide_loc_mod
Definition: guide_loc_mod.F90:4
exner_hyb_loc_m::exner_hyb_loc
subroutine exner_hyb_loc(ngrid, ps, p, pks, pk, pkf)
Definition: exner_hyb_loc_m.F90:8
infotrac::nqtot
integer, save nqtot
Definition: infotrac.F90:6
times::allgather_timer_average
subroutine allgather_timer_average
Definition: times.F90:173
leapfrog_mod::w
real, dimension(:,:), pointer, save w
Definition: leapfrog_mod.F90:15
ok_strato
!$Id ysinus ok_strato
Definition: logic.h:10
leapfrog_mod::pks
real, dimension(:), pointer, save pks
Definition: leapfrog_mod.F90:11
leapfrog_mod::leapfrog_allocate
subroutine leapfrog_allocate
Definition: leapfrog_mod.F90:38
statcl
!$Id && statcl
Definition: logic.h:10
parallel_lmdz::ijb_v
integer, save ijb_v
Definition: parallel_lmdz.F90:38
leapfrog_mod::p
real, dimension(:,:), pointer, save p
Definition: leapfrog_mod.F90:10
pression
subroutine pression(ngrid, ap, bp, ps, p)
Definition: pression.F90:2
write_field_p
Definition: write_field_p.F90:1
pression_loc
subroutine pression_loc(ngrid, ap, bp, ps, p)
Definition: pression_loc.F:2
conser
!$Id conser
Definition: logic.h:10
leapfrog_mod::leapfrog_switch_caldyn
subroutine leapfrog_switch_caldyn(dist)
Definition: leapfrog_mod.F90:92
day_ini
!$Id && day_ini
Definition: temps.h:15
times::timer_dissip
integer, parameter timer_dissip
Definition: times.F90:9
misc_mod::itaumax
integer, save itaumax
Definition: misc_mod.F90:2
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
mod_hallo::maxbuffersize
integer, save maxbuffersize
Definition: mod_hallo.F90:7
times::timer_delta
real, dimension(:,:,:), allocatable timer_delta
Definition: times.F90:20
parallel_lmdz::finalize_parallel
subroutine finalize_parallel
Definition: parallel_lmdz.F90:389
bands::jj_nb_physic
integer, dimension(:), allocatable jj_nb_physic
Definition: bands.F90:14
leapfrog_mod::teta
real, dimension(:,:), pointer, save teta
Definition: leapfrog_mod.F90:5
ok_guide
!$Id ysinus ok_guide
Definition: logic.h:10
control_mod::dissip_period
integer, save dissip_period
Definition: control_mod.F90:22
leapfrog_mod::flxw
real, dimension(:,:), pointer, save flxw
Definition: leapfrog_mod.F90:29
call_dissip_mod
Definition: call_dissip_mod.F90:1
leapfrog_mod::phi
real, dimension(:,:), pointer, save phi
Definition: leapfrog_mod.F90:14
day_ref
!$Id day_ref
Definition: temps.h:15
dynredem1_loc
subroutine dynredem1_loc(fichnom, time, vcov, ucov, teta, q, masse, ps)
Definition: dynredem_loc.F90:166
writedynav_loc
subroutine writedynav_loc(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
Definition: writedynav_loc.F:6
parallel_lmdz
Definition: parallel_lmdz.F90:4
apdiss
!$Id apdiss
Definition: logic.h:10
cpp
!$Id mode_top_bound COMMON comconstr cpp
Definition: comconst.h:7
times::inittime
subroutine inittime
Definition: times.F90:213
timer_filtre::print_filtre_timer
subroutine, public print_filtre_timer
Definition: timer_filtre.F90:30
times::diffcputime
real function diffcputime()
Definition: times.F90:239
prt_level
!FH On elimine toutes les clefs physiques dans la dynamique prt_level
Definition: write_paramLMDZ_dyn.h:9
leapfrog_mod::phis
real, dimension(:), pointer, save phis
Definition: leapfrog_mod.F90:8
vampir::vtcaldyn
integer, parameter vtcaldyn
Definition: vampir.F90:3
vampir::vthallo
integer, parameter vthallo
Definition: vampir.F90:7
guide_loc_mod::guide_main
subroutine guide_main(itau, ucov, vcov, teta, q, masse, ps)
Definition: guide_loc_mod.F90:343
mod_hallo::register_hallo_u
subroutine register_hallo_u(Field, ll, RUp, Rdown, SUp, SDown, a_request)
Definition: mod_hallo.F90:942
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
times
Definition: times.F90:1
leapfrog_mod::dp
real, dimension(:), pointer, save dp
Definition: leapfrog_mod.F90:26
control_mod::periodav
real, save periodav
Definition: control_mod.F90:12
friction_loc
subroutine friction_loc(ucov, vcov, pdt)
Definition: friction_loc.F:6
leapfrog_mod::pbaru
real, dimension(:,:), pointer, save pbaru
Definition: leapfrog_mod.F90:16
apphys
!$Id apphys
Definition: logic.h:10
parallel_lmdz::set_distrib
subroutine set_distrib(d)
Definition: parallel_lmdz.F90:305
write_field
Definition: write_field.F90:4
mod_hallo::sendrequest
subroutine sendrequest(a_Request)
Definition: mod_hallo.F90:1072
control_mod::iconser
integer, save iconser
Definition: control_mod.F90:20
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
parallel_lmdz::ij_begin
integer, save ij_begin
Definition: parallel_lmdz.F90:22
purmats
!$Id ysinus ok_gradsfile hybrid COMMON logici iflag_trac LOGICAL purmats
Definition: logic.h:10
parallel_lmdz::ije_v
integer, save ije_v
Definition: parallel_lmdz.F90:39
control_mod::ok_dynzon
logical, save ok_dynzon
Definition: control_mod.F90:35
integrd_loc
subroutine integrd_loc(nq, vcovm1, ucovm1, tetam1, psm1, massem1, dv, du, dteta, dq, dp, vcov, ucov, teta, q, ps0, masse, phis)
Definition: integrd_loc.F:7
mod_filtreg_p
Definition: mod_filtreg_p.F:1
leapfrog_mod::tetam1
real, dimension(:,:), pointer, save tetam1
Definition: leapfrog_mod.F90:20
call_calfis_mod::call_calfis
subroutine call_calfis(itau, lafin, ucov_dyn, vcov_dyn, teta_dyn, masse_dyn, ps_dyn, phis_dyn, q_dyn, flxw_dyn)
Definition: call_calfis_mod.F90:72
dtvr
!$Id mode_top_bound COMMON comconstr dtvr
Definition: comconst.h:7
control_mod::iecri
integer, save iecri
Definition: control_mod.F90:21
vampir::vte
subroutine vte(number)
Definition: vampir.F90:69
control_mod::ok_dyn_ave
logical, save ok_dyn_ave
Definition: control_mod.F90:38
leapfrog_mod::psm1
real, dimension(:), pointer, save psm1
Definition: leapfrog_mod.F90:21
forward
!$Id forward
Definition: logic.h:10
leapfrog_mod::ucovm1
real, dimension(:,:), pointer, save ucovm1
Definition: leapfrog_mod.F90:19
leapf
!$Id leapf
Definition: logic.h:10
leapfrog_mod::ucov
real, dimension(:,:), pointer, save ucov
Definition: leapfrog_mod.F90:3
iim
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
times::start_timer
subroutine start_timer(no_timer)
Definition: times.F90:51
control_mod::iperiod
integer, save iperiod
Definition: control_mod.F90:16
caldyn_loc
subroutine caldyn_loc(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, phi, conser, du, dv, dteta, dp, w, pbaru, pbarv, time)
Definition: caldyn_loc.F:10
bands::adjustbands_caldyn
subroutine adjustbands_caldyn(new_dist)
Definition: bands.F90:177
leapfrog_mod::ps
real, dimension(:), pointer, save ps
Definition: leapfrog_mod.F90:6
allocate_field_mod::init_nan
subroutine init_nan
Definition: allocate_field_mod.F90:40
itaufin
!$Id itaufin
Definition: temps.h:15
write_field::int2str
character(len=maxlen) function int2str(int)
Definition: write_field.F90:307
geopot_loc
subroutine geopot_loc(ngrid, teta, pk, pks, phis, phi)
Definition: geopot_loc.F:2
leapfrog_mod::vcovm1
real, dimension(:,:), pointer, save vcovm1
Definition: leapfrog_mod.F90:18
control_mod::nday
integer, save nday
Definition: control_mod.F90:14
misc_mod::adjust
logical, save adjust
Definition: misc_mod.F90:3
parallel_lmdz::ije_u
integer, save ije_u
Definition: parallel_lmdz.F90:35
mod_hallo::request
Definition: mod_hallo.F90:38
leapfrog_mod
Definition: leapfrog_mod.F90:1
timer_filtre
Definition: timer_filtre.F90:1
times::timer_vanleer
integer, parameter timer_vanleer
Definition: times.F90:8
bands::jj_nb_vanleer
integer, dimension(:), allocatable jj_nb_vanleer
Definition: bands.F90:11
leapfrog_mod::dteta
real, dimension(:,:), pointer, save dteta
Definition: leapfrog_mod.F90:25
bands::distrib_caldyn
type(distrib), target, save distrib_caldyn
Definition: bands.F90:17
start_time
!$Id start_time
Definition: temps.h:15
mod_hallo
Definition: mod_hallo.F90:1
exner_hyb_loc_m
Definition: exner_hyb_loc_m.F90:1
mod_hallo::register_hallo_v
subroutine register_hallo_v(Field, ll, RUp, Rdown, SUp, SDown, a_request)
Definition: mod_hallo.F90:1007
write_field_loc::writefield_u
Definition: write_field_loc.F90:4
leapfrog_mod::massem1
real, dimension(:,:), pointer, save massem1
Definition: leapfrog_mod.F90:22
leapfrog_mod::du
real, dimension(:,:), pointer, save du
Definition: leapfrog_mod.F90:24
mod_hallo::waitrequest
subroutine waitrequest(a_Request)
Definition: mod_hallo.F90:1196
leapfrog_mod::masse
real, dimension(:,:), pointer, save masse
Definition: leapfrog_mod.F90:7
control_mod
Definition: control_mod.F90:5
leapfrog_mod::leapfrog_switch_dissip
subroutine leapfrog_switch_dissip(dist)
Definition: leapfrog_mod.F90:139
parallel_lmdz::ijnb_u
integer, save ijnb_u
Definition: parallel_lmdz.F90:36
lunout
!$Header!gestion des impressions de sorties et de d�bogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7
parallel_lmdz::ijb_u
integer, save ijb_u
Definition: parallel_lmdz.F90:34
leapfrog_mod::pk
real, dimension(:,:), pointer, save pk
Definition: leapfrog_mod.F90:12
misc_mod::debug
logical, save debug
Definition: misc_mod.F90:5