Context Navigation

leapfrog_loc.F @ 4146

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

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

Download in other formats:

Original Format