source: LMDZ5/trunk/libf/leapfrog_loc.F @ 1630

Last change on this file since 1630 was 1630, checked in by Laurent Fairhead, 12 years ago

Importation initiale du répertoire dyn3dmem


Initial import of dyn3dmem directory

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