Context Navigation

leapfrog_loc.F @ 4148

Last change on this file since 4148 was 4148, checked in by Laurent Fairhead, 2 years ago
Forgot a CPP condition
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:keywords set to `Id`
File size: 56.9 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format