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

Last change on this file since 5280 was 5280, checked in by abarral, 3 days ago

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