Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

leapfrog_loc.F90

Last change on this file was 5251, checked in by abarral, 63 minutes ago
Wrap uses of cpp key INCA Add INCA wrapper
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: 54.0 KB

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

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

Download in other formats:

Original Format