source: LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.f90 @ 5285

Last change on this file since 5285 was 5285, checked in by abarral, 13 months ago

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