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