Context Navigation

leapfrog_loc.F @ 5220

Last change on this file since 5220 was 5084, checked in by Laurent Fairhead, 12 months ago
Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks AB, LF
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: 57.6 KB

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

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

Download in other formats:

Original Format