Context Navigation

leapfrog_loc.f90 @ 5411

Last change on this file since 5411 was 5195, checked in by abarral, 3 months ago
Correct r5192, some lmdz_description cases were missing
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: 38.4 KB

Line
1	! $Id: leapfrog_loc.f90 5195 2024-09-16 13:18:00Z evignon $
2
3	SUBROUTINE leapfrog_loc(ucov0, vcov0, teta0, ps0, &
4	masse0, phis0, q0, time_0)
5
6	USE misc_mod
7	USE parallel_lmdz
8	USE times
9	USE mod_hallo
10	USE Bands
11	USE lmdz_strings, ONLY: int2str
12	USE Write_Field_p
13	USE lmdz_vampir
14	USE lmdz_timer_filtre, ONLY: print_filtre_timer
15	USE lmdz_infotrac
16	USE guide_loc_mod, ONLY: guide_main
17	USE getparam
18	USE control_mod
19	USE lmdz_filtreg_p
20	USE write_field_loc
21	USE allocate_field_mod
22	USE call_dissip_mod, ONLY: call_dissip
23	USE lmdz_call_calfis, ONLY: call_calfis
24	USE leapfrog_mod, ONLY: ucov, vcov, teta, ps, masse, phis, q, dq &
25	, ucovm1, vcovm1, tetam1, massem1, psm1, p, pks, pk, pkf, flxw &
26	, pbaru, pbarv, du, dv, dteta, phi, dp, w &
27	, leapfrog_allocate, leapfrog_switch_caldyn, leapfrog_switch_dissip
28
29	USE exner_hyb_loc_m, ONLY: exner_hyb_loc
30	USE exner_milieu_loc_m, ONLY: exner_milieu_loc
31	USE comconst_mod, ONLY: cpp, dtvr, ihf
32	USE comvert_mod, ONLY: ap, bp, pressure_exner
33	USE logic_mod, ONLY: iflag_phys, ok_guide, forward, leapf, apphys, &
34	statcl, conser, apdiss, purmats, ok_strato
35	USE temps_mod, ONLY: itaufin, jD_ref, jH_ref, day_ini, &
36	day_ref, start_time, dt
37	USE mod_xios_dyn3dmem, ONLY: dyn3d_ctx_handle
38	USE lmdz_xios, ONLY: xios_update_calendar, &
39	xios_set_current_context, &
40	using_xios
41	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO, CPPKEY_REPROBUS
42	USE lmdz_iniprint, ONLY: lunout, prt_level
43	USE lmdz_academic, ONLY: tetarappel, knewt_t, kfrict, knewt_g, clat4
44	USE lmdz_comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, &
45	tetagrot, tetatemp, coefdis, vert_prof_dissip
46	USE lmdz_comgeom
47
48	USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
49	USE lmdz_paramet
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	REAL, INTENT(IN) :: time_0 ! not used
84
85	! dynamical variables:
86	REAL, INTENT(IN) :: ucov0(ijb_u:ije_u, llm) ! zonal covariant wind
87	REAL, INTENT(IN) :: vcov0(ijb_v:ije_v, llm) ! meridional covariant wind
88	REAL, INTENT(IN) :: teta0(ijb_u:ije_u, llm) ! potential temperature
89	REAL, INTENT(IN) :: q0(ijb_u:ije_u, llm, nqtot) ! advected tracers
90	REAL, INTENT(IN) :: ps0(ijb_u:ije_u) ! surface pressure (Pa)
91	REAL, INTENT(IN) :: masse0(ijb_u:ije_u, llm) ! air mass
92	REAL, INTENT(IN) :: phis0(ijb_u:ije_u) ! geopotentiat at the surface
93
94	REAL :: zqmin, zqmax
95
96	! REAL,SAVE,ALLOCATABLE :: p (:,: ) ! pression aux interfac.des couches
97	! REAL,SAVE,ALLOCATABLE :: pks(:) ! exner au sol
98	! REAL,SAVE,ALLOCATABLE :: pk(:,:) ! exner au milieu des couches
99	! REAL,SAVE,ALLOCATABLE :: pkf(:,:) ! exner filt.au milieu des couches
100	! REAL,SAVE,ALLOCATABLE :: phi(:,:) ! geopotentiel
101	! REAL,SAVE,ALLOCATABLE :: w(:,:) ! vitesse verticale
102
103	! variables dynamiques intermediaire pour le transport
104	! REAL,SAVE,ALLOCATABLE :: pbaru(:,:),pbarv(:,:) !flux de masse
105
106	! variables dynamiques au pas -1
107	! REAL,SAVE,ALLOCATABLE :: vcovm1(:,:),ucovm1(:,:)
108	! REAL,SAVE,ALLOCATABLE :: tetam1(:,:),psm1(:)
109	! REAL,SAVE,ALLOCATABLE :: massem1(:,:)
110
111	! tendances dynamiques
112	! REAL,SAVE,ALLOCATABLE :: dv(:,:),du(:,:)
113	! REAL,SAVE,ALLOCATABLE :: dteta(:,:),dp(:)
114	! REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq
115
116	! tendances de la dissipation
117	! REAL,SAVE,ALLOCATABLE :: dvdis(:,:),dudis(:,:)
118	! REAL,SAVE,ALLOCATABLE :: dtetadis(:,:)
119
120	! tendances physiques
121	REAL, SAVE, ALLOCATABLE :: dvfi(:, :), dufi(:, :)
122	REAL, SAVE, ALLOCATABLE :: dtetafi(:, :)
123	REAL, SAVE, ALLOCATABLE :: dpfi(:)
124	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: dqfi
125
126	! variables pour le fichier histoire
127	REAL :: dtav ! intervalle de temps elementaire
128
129	REAL :: tppn(iim), tpps(iim), tpn, tps
130
131	INTEGER :: itau, itaufinp1, iav
132	! INTEGER iday ! jour julien
133	REAL :: time
134
135	! REAL,SAVE,ALLOCATABLE :: finvmaold(:,:)
136
137	!ym LOGICAL lafin
138	LOGICAL :: lafin
139	INTEGER :: ij, iq, l
140	INTEGER :: ik
141
142	REAL :: time_step, t_wrt, t_ops
143
144	! jD_cur: jour julien courant
145	! jH_cur: heure julienne courante
146	REAL :: jD_cur, jH_cur
147	INTEGER :: an, mois, jour
148	REAL :: secondes
149
150	LOGICAL :: physic
151	LOGICAL :: first, callinigrads
152
153	data callinigrads/.TRUE./
154	CHARACTER(LEN = 10) :: string10
155
156	! REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale
157
158	!+jld variables test conservation energie
159	! REAL,SAVE,ALLOCATABLE :: ecin(:,:),ecin0(:,:)
160	! Tendance de la temp. potentiel d (theta)/ d t due a la
161	! tansformation d'energie cinetique en energie thermique
162	! cree par la dissipation
163	! REAL,SAVE,ALLOCATABLE :: dtetaecdt(:,:)
164	! REAL,SAVE,ALLOCATABLE :: vcont(:,:),ucont(:,:)
165	! REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
166	REAL :: d_h_vcol, d_qt, d_qw, d_ql, d_ec
167	CHARACTER(len = 15) :: ztit
168	!! INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.
169	! SAVE ip_ebil_dyn
170	! DATA ip_ebil_dyn/0/
171	!-jld
172
173	CHARACTER(LEN = 80) :: dynhist_file, dynhistave_file
174	CHARACTER(LEN = *), parameter :: modname = "leapfrog_loc"
175	CHARACTER(LEN = 80) :: abort_message
176
177	logical, PARAMETER :: dissip_conservative = .TRUE.
178
179	INTEGER :: testita
180	PARAMETER (testita = 9)
181
182	logical, parameter :: flag_verif = .FALSE.
183
184	! declaration liees au parallelisme
185	INTEGER :: ierr
186	LOGICAL :: FirstCaldyn
187	LOGICAL :: FirstPhysic
188	INTEGER :: ijb, ije, j, i
189	type(Request) :: TestRequest
190	type(Request) :: Request_Dissip
191	type(Request) :: Request_physic
192
193	INTEGER :: true_itau
194	INTEGER :: iapptrac
195	INTEGER :: AdjustCount
196	! INTEGER :: var_time
197	LOGICAL :: ok_start_timer = .FALSE.
198	LOGICAL, SAVE :: firstcall = .TRUE.
199	TYPE(distrib), SAVE :: new_dist
200
201	CALL check_isotopes(q0, ijb_u, ije_u, 'leapfrog204: debut')
202
203	!$OMP MASTER
204	ItCount = 0
205	!$OMP END MASTER
206	true_itau = 0
207	FirstCaldyn = .TRUE.
208	FirstPhysic = .TRUE.
209	iapptrac = 0
210	AdjustCount = 0
211	lafin = .FALSE.
212
213	IF (nday>=0) THEN
214	itaufin = nday * day_step
215	else
216	itaufin = -nday
217	ENDIF
218
219	itaufinp1 = itaufin + 1
220
221	CALL check_isotopes(q0, ijb_u, ije_u, 'leapfrog 226')
222
223	itau = 0
224	physic = .TRUE.
225	IF (iflag_phys==0.OR.iflag_phys==2) physic = .FALSE.
226	CALL init_nan
227	CALL leapfrog_allocate
228	ucov = ucov0
229	vcov = vcov0
230	teta = teta0
231	ps = ps0
232	masse = masse0
233	phis = phis0
234	q = q0
235
236	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 239')
237
238	! iday = day_ini+itau/day_step
239	! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
240	! IF(time.GT.1.) THEN
241	! time = time-1.
242	! iday = iday+1
243	! ENDIF
244
245	! Allocate variables depending on dynamic variable nqtot
246	!$OMP MASTER
247	IF (firstcall) THEN
248	! ALLOCATE(p(ijb_u:ije_u,llmp1))
249	! ALLOCATE(pks(ijb_u:ije_u))
250	! ALLOCATE(pk(ijb_u:ije_u,llm))
251	! ALLOCATE(pkf(ijb_u:ije_u,llm))
252	! ALLOCATE(phi(ijb_u:ije_u,llm))
253	! ALLOCATE(w(ijb_u:ije_u,llm))
254	! ALLOCATE(pbaru(ip1jmp1,llm),pbarv(ip1jm,llm))
255	! ALLOCATE(vcovm1(ijb_v:ije_v,llm),ucovm1(ijb_u:ije_u,llm))
256	! ALLOCATE(tetam1(ijb_u:ije_u,llm),psm1(ijb_u:ije_u))
257	! ALLOCATE(massem1(ijb_u:ije_u,llm))
258	! ALLOCATE(dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm))
259	! ALLOCATE(dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u))
260	! ALLOCATE(dvdis(ijb_v:ije_v,llm),dudis(ijb_u:ije_u,llm))
261	! ALLOCATE(dtetadis(ijb_u:ije_u,llm))
262	ALLOCATE(dvfi(ijb_v:ije_v, llm), dufi(ijb_u:ije_u, llm))
263	ALLOCATE(dtetafi(ijb_u:ije_u, llm))
264	ALLOCATE(dpfi(ijb_u:ije_u))
265	! ALLOCATE(dq(ijb_u:ije_u,llm,nqtot))
266	ALLOCATE(dqfi(ijb_u:ije_u, llm, nqtot))
267	! ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
268	! ALLOCATE(finvmaold(ijb_u:ije_u,llm))
269	! ALLOCATE(flxw(ijb_u:ije_u,llm))
270	! ALLOCATE(ecin(ijb_u:ije_u,llm),ecin0(ijb_u:ije_u,llm))
271	! ALLOCATE(dtetaecdt(ijb_u:ije_u,llm))
272	! ALLOCATE(vcont(ijb_v:ije_v,llm),ucont(ijb_u:ije_u,llm))
273	! ALLOCATE(vnat(ijb_v:ije_v,llm),unat(ijb_u:ije_u,llm))
274	ENDIF
275	!$OMP END MASTER
276	!$OMP BARRIER
277
278	! CALL dynredem1_loc("restart.nc",0.0,
279	! & vcov,ucov,teta,q,masse,ps)
280
281
282	!-----------------------------------------------------------------------
283	! On initialise la pression et la fonction d'Exner :
284	! --------------------------------------------------
285
286	!$OMP MASTER
287	dq(:, :, :) = 0.
288	CALL pression (ijnb_u, ap, bp, ps, p)
289	!$OMP END MASTER
290	IF (pressure_exner) THEN
291	CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
292	else
293	CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk, pkf)
294	ENDIF
295	!-----------------------------------------------------------------------
296	! Debut de l'integration temporelle:
297	! ----------------------------------
298	! et du parallelisme !!
299
300	1 CONTINUE ! Matsuno Forward step begins here
301
302	! date: (NB: date remains unchanged for Backward step)
303	! -----
304
305	jD_cur = jD_ref + day_ini - day_ref + &
306	(itau + 1) / day_step
307	jH_cur = jH_ref + start_time + &
308	mod(itau + 1, day_step) / float(day_step)
309	IF (jH_cur > 1.0) THEN
310	jD_cur = jD_cur + 1.
311	jH_cur = jH_cur - 1.
312	ENDIF
313
314	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 321')
315
316	IF (ok_guide) THEN
317	CALL guide_main(itau, ucov, vcov, teta, q, masse, ps)
318	!$OMP BARRIER
319	ENDIF
320
321
322
323	! IF( MOD( itau, 10* day_step ).EQ.0 ) THEN
324	! CALL test_period ( ucov,vcov,teta,q,p,phis )
325	! PRINT *,' ---- Test_period apres continue OK ! -----', itau
326	! ENDIF
327
328	!ym CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
329	!ym CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
330	!ym CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 )
331	!ym CALL SCOPY( ijp1llm,masse, 1, massem1, 1 )
332	!ym CALL SCOPY( ip1jmp1, ps , 1, psm1 , 1 )
333
334	IF (FirstCaldyn) THEN
335	!$OMP MASTER
336	ucovm1 = ucov
337	vcovm1 = vcov
338	tetam1 = teta
339	massem1 = masse
340	psm1 = ps
341
342	! Ehouarn: finvmaold is actually not used
343	! finvmaold = masse
344	!$OMP END MASTER
345	!$OMP BARRIER
346	! CALL filtreg_p ( finvmaold ,jjb_u,jje_u,jjb_u,jje_u,jjp1, llm,
347	! & -2,2, .TRUE., 1 )
348	else
349	! Save fields obtained at previous time step as '...m1'
350	ijb = ij_begin
351	ije = ij_end
352
353	!$OMP MASTER
354	psm1 (ijb:ije) = ps (ijb:ije)
355	!$OMP END MASTER
356
357	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
358	DO l = 1, llm
359	ije = ij_end
360	ucovm1 (ijb:ije, l) = ucov (ijb:ije, l)
361	tetam1 (ijb:ije, l) = teta (ijb:ije, l)
362	massem1 (ijb:ije, l) = masse (ijb:ije, l)
363	! finvmaold(ijb:ije,l)=masse(ijb:ije,l)
364
365	IF (pole_sud) ije = ij_end - iip1
366	vcovm1(ijb:ije, l) = vcov (ijb:ije, l)
367
368	ENDDO
369	!$OMP ENDDO
370
371
372	! Ehouarn: finvmaold not used
373	! CALL filtreg_p(finvmaold ,jjb_u,jje_u,jj_begin,jj_end,jjp1,
374	! . llm, -2,2, .TRUE., 1 )
375
376	ENDIF ! of if (FirstCaldyn)
377
378	forward = .TRUE.
379	leapf = .FALSE.
380	dt = dtvr
381
382	! ... P.Le Van .26/04/94 ....
383
384	!ym CALL SCOPY ( ijp1llm, masse, 1, finvmaold, 1 )
385	!ym CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
386
387	!ym ne sert a rien
388	!ym CALL minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
389
390	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 400')
391
392	2 CONTINUE ! Matsuno backward or leapfrog step begins here
393
394	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 402')
395
396	!$OMP MASTER
397	ItCount = ItCount + 1
398	IF (MOD(ItCount, 1)==1) THEN
399	debug = .TRUE.
400	else
401	debug = .FALSE.
402	ENDIF
403	!$OMP END MASTER
404	!-----------------------------------------------------------------------
405
406	! date: (NB: only leapfrog step requires recomputing date)
407	! -----
408
409	IF (leapf) THEN
410	jD_cur = jD_ref + day_ini - day_ref + &
411	(itau + 1) / day_step
412	jH_cur = jH_ref + start_time + &
413	mod(itau + 1, day_step) / float(day_step)
414	IF (jH_cur > 1.0) THEN
415	jD_cur = jD_cur + 1.
416	jH_cur = jH_cur - 1.
417	endif
418	ENDIF
419
420	! gestion des appels de la physique et des dissipations:
421	! ------------------------------------------------------
422
423	! ... P.Le Van ( 6/02/95 ) ....
424
425	apphys = .FALSE.
426	statcl = .FALSE.
427	conser = .FALSE.
428	apdiss = .FALSE.
429
430	IF(purmats) THEN
431	! Purely Matsuno time stepping
432	IF(MOD(itau, iconser) ==0.AND. forward) conser = .TRUE.
433	IF(MOD(itau, dissip_period)==0.AND..NOT.forward) &
434	apdiss = .TRUE.
435	IF(MOD(itau, iphysiq)==0.AND..NOT.forward &
436	.AND. physic) apphys = .TRUE.
437	ELSE
438	! Leapfrog/Matsuno time stepping
439	IF(MOD(itau, iconser) == 0) conser = .TRUE.
440	IF(MOD(itau + 1, dissip_period)==0 .AND. .NOT. forward) &
441	apdiss = .TRUE.
442	IF(MOD(itau + 1, iphysiq)==0.AND.physic) apphys = .TRUE.
443	END IF
444
445	! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
446	! supress dissipation step
447	IF (llm==1) THEN
448	apdiss = .FALSE.
449	ENDIF
450
451	!ym ---> Pour le moment
452	!ym apphys = .FALSE.
453	statcl = .FALSE.
454	! conser = .FALSE. ! ie: no output of control variables to stdout in //
455
456	IF (firstCaldyn) THEN
457	!$OMP MASTER
458	CALL Set_Distrib(distrib_caldyn)
459	!$OMP END MASTER
460	!$OMP BARRIER
461	firstCaldyn = .FALSE.
462	!ym CALL InitTime
463	!$OMP MASTER
464	CALL Init_timer
465	!$OMP END MASTER
466	ENDIF
467
468	!$OMP MASTER
469	IF (ok_start_timer) THEN
470	CALL InitTime
471	ok_start_timer = .FALSE.
472	ENDIF
473	!$OMP END MASTER
474
475	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 471')
476
477	!ym PAS D'AJUSTEMENT POUR LE MOMENT
478	IF (Adjust) THEN
479	AdjustCount = AdjustCount + 1
480	! if (iapptrac==iapp_tracvl .AND. (forward .OR. leapf)
481	! & .AND. itau/iphysiq>2 .AND. Adjustcount>30) THEN
482	IF (Adjustcount>1) THEN
483	AdjustCount = 0
484	!$OMP MASTER
485	CALL allgather_timer_average
486
487	IF (prt_level > 9) THEN
488	PRINT , '********************************'
489	PRINT , '*** TIMER CALDYN ****'
490	DO i = 0, mpi_size - 1
491	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_caldyn(i), &
492	' : temps moyen :', &
493	timer_average(jj_nb_caldyn(i), timer_caldyn, i), &
494	'+-', timer_delta(jj_nb_caldyn(i), timer_caldyn, i)
495	enddo
496
497	PRINT , '********************************'
498	PRINT , '*** TIMER VANLEER ****'
499	DO i = 0, mpi_size - 1
500	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_vanleer(i), &
501	' : temps moyen :', &
502	timer_average(jj_nb_vanleer(i), timer_vanleer, i), &
503	'+-', timer_delta(jj_nb_vanleer(i), timer_vanleer, i)
504	enddo
505
506	PRINT , '********************************'
507	PRINT , '*** TIMER DISSIP ****'
508	DO i = 0, mpi_size - 1
509	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_dissip(i), &
510	' : temps moyen :', &
511	timer_average(jj_nb_dissip(i), timer_dissip, i), &
512	'+-', timer_delta(jj_nb_dissip(i), timer_dissip, i)
513	enddo
514
515	! if (mpi_rank==0) CALL WriteBands
516
517	endif
518
519	CALL AdjustBands_caldyn(new_dist)
520	!$OMP END MASTER
521	!$OMP BARRIER
522	CALL leapfrog_switch_caldyn(new_dist)
523	!$OMP BARRIER
524
525
526	!$OMP MASTER
527	distrib_caldyn = new_dist
528	CALL set_distrib(distrib_caldyn)
529	!$OMP END MASTER
530	!$OMP BARRIER
531	! CALL Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm,
532	! & jj_Nb_caldyn,0,0,TestRequest)
533	! CALL Register_SwapFieldHallo(ucovm1,ucovm1,ip1jmp1,llm,
534	! & jj_Nb_caldyn,0,0,TestRequest)
535	! CALL Register_SwapFieldHallo(vcov,vcov,ip1jm,llm,
536	! & jj_Nb_caldyn,0,0,TestRequest)
537	! CALL Register_SwapFieldHallo(vcovm1,vcovm1,ip1jm,llm,
538	! & jj_Nb_caldyn,0,0,TestRequest)
539	! CALL Register_SwapFieldHallo(teta,teta,ip1jmp1,llm,
540	! & jj_Nb_caldyn,0,0,TestRequest)
541	! CALL Register_SwapFieldHallo(tetam1,tetam1,ip1jmp1,llm,
542	! & jj_Nb_caldyn,0,0,TestRequest)
543	! CALL Register_SwapFieldHallo(masse,masse,ip1jmp1,llm,
544	! & jj_Nb_caldyn,0,0,TestRequest)
545	! CALL Register_SwapFieldHallo(massem1,massem1,ip1jmp1,llm,
546	! & jj_Nb_caldyn,0,0,TestRequest)
547	! CALL Register_SwapFieldHallo(ps,ps,ip1jmp1,1,
548	! & jj_Nb_caldyn,0,0,TestRequest)
549	! CALL Register_SwapFieldHallo(psm1,psm1,ip1jmp1,1,
550	! & jj_Nb_caldyn,0,0,TestRequest)
551	! CALL Register_SwapFieldHallo(pkf,pkf,ip1jmp1,llm,
552	! & jj_Nb_caldyn,0,0,TestRequest)
553	! CALL Register_SwapFieldHallo(pk,pk,ip1jmp1,llm,
554	! & jj_Nb_caldyn,0,0,TestRequest)
555	! CALL Register_SwapFieldHallo(pks,pks,ip1jmp1,1,
556	! & jj_Nb_caldyn,0,0,TestRequest)
557	! CALL Register_SwapFieldHallo(phis,phis,ip1jmp1,1,
558	! & jj_Nb_caldyn,0,0,TestRequest)
559	! CALL Register_SwapFieldHallo(phi,phi,ip1jmp1,llm,
560	! & jj_Nb_caldyn,0,0,TestRequest)
561	! CALL Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,
562	! & jj_Nb_caldyn,0,0,TestRequest)
563
564	! do j=1,nqtot
565	! CALL Register_SwapFieldHallo(q(:,:,j),q(:,:,j),ip1jmp1,llm,
566	! & jj_nb_caldyn,0,0,TestRequest)
567	! enddo
568
569	! CALL Set_Distrib(distrib_caldyn)
570	! CALL SendRequest(TestRequest)
571	! CALL WaitRequest(TestRequest)
572
573	!$OMP MASTER
574	CALL AdjustBands_dissip(new_dist)
575	!$OMP END MASTER
576	!$OMP BARRIER
577	CALL leapfrog_switch_dissip(new_dist)
578	!$OMP BARRIER
579	!$OMP MASTER
580	distrib_dissip = new_dist
581	!$OMP END MASTER
582	!$OMP BARRIER
583	! CALL AdjustBands_physic
584
585	!$OMP MASTER
586	IF (mpi_rank==0) CALL WriteBands
587	!$OMP END MASTER
588
589	endif
590	ENDIF
591
592	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 589')
593
594	!-----------------------------------------------------------------------
595	! calcul des tendances dynamiques:
596	! --------------------------------
597	!$OMP BARRIER
598	!$OMP MASTER
599	CALL VTb(VThallo)
600	!$OMP END MASTER
601
602	CALL Register_Hallo_u(ucov, llm, 1, 1, 1, 1, TestRequest)
603	CALL Register_Hallo_v(vcov, llm, 1, 1, 1, 1, TestRequest)
604	CALL Register_Hallo_u(teta, llm, 1, 1, 1, 1, TestRequest)
605	CALL Register_Hallo_u(ps, 1, 1, 2, 2, 1, TestRequest)
606	CALL Register_Hallo_u(pkf, llm, 1, 1, 1, 1, TestRequest)
607	CALL Register_Hallo_u(pk, llm, 1, 1, 1, 1, TestRequest)
608	CALL Register_Hallo_u(pks, 1, 1, 1, 1, 1, TestRequest)
609	CALL Register_Hallo_u(p, llmp1, 1, 1, 1, 1, TestRequest)
610
611	! do j=1,nqtot
612	! CALL Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1,
613	! * TestRequest)
614	! enddo
615
616	CALL SendRequest(TestRequest)
617	!$OMP BARRIER
618	CALL WaitRequest(TestRequest)
619
620	!$OMP MASTER
621	CALL VTe(VThallo)
622	!$OMP END MASTER
623	!$OMP BARRIER
624
625	IF (debug) THEN
626	CALL WriteField_u('ucov', ucov)
627	CALL WriteField_v('vcov', vcov)
628	CALL WriteField_u('teta', teta)
629	CALL WriteField_u('ps', ps)
630	CALL WriteField_u('masse', masse)
631	CALL WriteField_u('pk', pk)
632	CALL WriteField_u('pks', pks)
633	CALL WriteField_u('pkf', pkf)
634	CALL WriteField_u('phis', phis)
635	DO iq = 1, nqtot
636	CALL WriteField_u('q' // trim(int2str(iq)), &
637	q(:, :, iq))
638	enddo
639	ENDIF
640
641	True_itau = True_itau + 1
642
643	!$OMP MASTER
644	IF (prt_level>9) THEN
645	WRITE(lunout, *)"leapfrog_p: Iteration No", True_itau
646	ENDIF
647
648	CALL start_timer(timer_caldyn)
649
650	! compute geopotential phi()
651	CALL geopot_loc (ip1jmp1, teta, pk, pks, phis, phi)
652
653	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 651')
654
655	CALL VTb(VTcaldyn)
656	!$OMP END MASTER
657	! var_time=time+iday-day_ini
658
659	!$OMP BARRIER
660	! CALL FTRACE_REGION_BEGIN("caldyn")
661	time = jD_cur + jH_cur
662
663	CALL caldyn_loc &
664	(itau, ucov, vcov, teta, ps, masse, pk, pkf, phis, &
665	phi, conser, du, dv, dteta, dp, w, pbaru, pbarv, time)
666
667	! CALL FTRACE_REGION_END("caldyn")
668
669	!$OMP MASTER
670	IF (mpi_rank==0.AND.conser) THEN
671	WRITE(lunout, *) 'leapfrog_loc, Time step: ', itau, ' Day:', time
672	ENDIF
673	CALL VTe(VTcaldyn)
674	!$OMP END MASTER
675
676	IF (CPPKEY_DEBUGIO) THEN
677	CALL WriteField_u('du', du)
678	CALL WriteField_v('dv', dv)
679	CALL WriteField_u('dteta', dteta)
680	CALL WriteField_u('dp', dp)
681	CALL WriteField_u('w', w)
682	CALL WriteField_u('pbaru', pbaru)
683	CALL WriteField_v('pbarv', pbarv)
684	CALL WriteField_u('p', p)
685	CALL WriteField_u('masse', masse)
686	CALL WriteField_u('pk', pk)
687	END IF
688	!-----------------------------------------------------------------------
689	! calcul des tendances advection des traceurs (dont l'humidite)
690	! -------------------------------------------------------------
691
692	CALL check_isotopes(q, ijb_u, ije_u, &
693	'leapfrog 686: avant caladvtrac')
694
695	IF(forward .OR. leapf) THEN
696	! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step
697	!WRITE(,) 'leapfrog 679: avant CALL caladvtrac_loc'
698	CALL caladvtrac_loc(q, pbaru, pbarv, &
699	p, masse, dq, teta, &
700	flxw, pk, iapptrac)
701
702	! CALL creation of mass flux
703	IF (offline .AND. .NOT. adjust) THEN
704	CALL fluxstokenc_p(pbaru, pbarv, masse, teta, phi)
705	ENDIF
706
707	!WRITE(,) 'leapfrog 719'
708	CALL check_isotopes(q, ijb_u, ije_u, &
709	'leapfrog 698: apres caladvtrac')
710
711	! do j=1,nqtot
712	! CALL WriteField_u('qadv'//trim(int2str(j)),q(:,:,j))
713	! enddo
714
715	! Ehouarn: Storage of mass flux for off-line tracers... not implemented...
716
717	ENDIF ! of IF( forward .OR. leapf )
718
719
720	!-----------------------------------------------------------------------
721	! integrations dynamique et traceurs:
722	! ----------------------------------
723
724	!$OMP MASTER
725	CALL VTb(VTintegre)
726	!$OMP END MASTER
727	IF (CPPKEY_DEBUGIO) THEN
728	IF (true_itau>20) THEN
729	CALL WriteField_u('ucovm1', ucovm1)
730	CALL WriteField_v('vcovm1', vcovm1)
731	CALL WriteField_u('tetam1', tetam1)
732	CALL WriteField_u('psm1', psm1)
733	CALL WriteField_u('ucov_int', ucov)
734	CALL WriteField_v('vcov_int', vcov)
735	CALL WriteField_u('teta_int', teta)
736	CALL WriteField_u('ps_int', ps)
737	endif
738	END IF
739	!$OMP BARRIER
740	! CALL FTRACE_REGION_BEGIN("integrd")
741
742	!WRITE(,) 'leapfrog 720'
743	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 756')
744
745	! CRisi: pourquoi aller jusqu'à 2 et non pas jusqu'à nqtot??
746	CALL integrd_loc (nqtot, vcovm1, ucovm1, tetam1, psm1, massem1, &
747	dv, du, dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis)
748	! $ finvmaold )
749
750	! !WRITE(,) 'leapfrog 724'
751	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 762')
752
753	! CALL FTRACE_REGION_END("integrd")
754	!$OMP BARRIER
755	IF (CPPKEY_DEBUGIO) THEN
756	CALL WriteField_u('ucovm1', ucovm1)
757	CALL WriteField_v('vcovm1', vcovm1)
758	CALL WriteField_u('tetam1', tetam1)
759	CALL WriteField_u('psm1', psm1)
760	CALL WriteField_u('ucov_int', ucov)
761	CALL WriteField_v('vcov_int', vcov)
762	CALL WriteField_u('teta_int', teta)
763	CALL WriteField_u('ps_int', ps)
764	END IF
765
766	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 775')
767
768	! do j=1,nqtot
769	! CALL WriteField_p('q'//trim(int2str(j)),
770	! . reshape(q(:,:,j),(/iip1,jmp1,llm/)))
771	! CALL WriteField_p('dq'//trim(int2str(j)),
772	! . reshape(dq(:,:,j),(/iip1,jmp1,llm/)))
773	! enddo
774
775
776	!$OMP MASTER
777	CALL VTe(VTintegre)
778	!$OMP END MASTER
779	! .P.Le Van (26/04/94 ajout de finvpold dans l'appel d'integrd)
780
781	!-----------------------------------------------------------------------
782	! calcul des tendances physiques:
783	! -------------------------------
784	! ######## P.Le Van ( Modif le 6/02/95 ) ###########
785
786	IF(purmats) THEN
787	IF(itau==itaufin.AND..NOT.forward) lafin = .TRUE.
788	ELSE
789	IF(itau + 1 == itaufin) lafin = .TRUE.
790	ENDIF
791
792	!c$OMP END PARALLEL
793
794	IF(apphys) THEN
795
796	CALL call_calfis(itau, lafin, ucov, vcov, teta, masse, ps, phis, q, flxw)
797
798	! c-jld
799	!$OMP MASTER
800	IF (FirstPhysic) THEN
801	ok_start_timer = .TRUE.
802	FirstPhysic = .FALSE.
803	endif
804	!$OMP END MASTER
805	ENDIF ! of IF( apphys )
806
807	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1132')
808	!WRITE(,) 'leapfrog 1134: iflag_phys=',iflag_phys
809
810	IF(iflag_phys==2) THEN ! "Newtonian" case
811	!$OMP MASTER
812	IF (FirstPhysic) THEN
813	ok_start_timer = .TRUE.
814	FirstPhysic = .FALSE.
815	endif
816	!$OMP END MASTER
817
818
819	! Calcul academique de la physique = Rappel Newtonien + fritcion
820	! --------------------------------------------------------------
821	!ym teta(:,:)=teta(:,:)
822	!ym s -iphysiqdtvr(teta(:,:)-tetarappel(:,:))/taurappel
823	ijb = ij_begin
824	ije = ij_end
825	!LF teta(ijb:ije,:)=teta(ijb:ije,:)
826	!LF s -iphysiqdtvr(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel
827	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
828	DO l = 1, llm
829	teta(ijb:ije, l) = teta(ijb:ije, l) - dtvr * &
830	(teta(ijb:ije, l) - tetarappel(ijb:ije, l)) * &
831	(knewt_g + knewt_t(l) * clat4(ijb:ije))
832	enddo
833	!$OMP END DO
834
835	!$OMP MASTER
836	IF (planet_type=="giant") THEN
837	! add an intrinsic heat flux at the base of the atmosphere
838	teta(ijb:ije, 1) = teta(ijb:ije, 1) &
839	+ dtvr * aire(ijb:ije) * ihf / cpp / masse(ijb:ije, 1)
840	endif
841	!$OMP END MASTER
842	!$OMP BARRIER
843
844	CALL Register_Hallo_u(ucov, llm, 0, 1, 1, 0, Request_Physic)
845	CALL Register_Hallo_v(vcov, llm, 1, 1, 1, 1, Request_Physic)
846	CALL SendRequest(Request_Physic)
847	!$OMP BARRIER
848	CALL WaitRequest(Request_Physic)
849	!$OMP BARRIER
850	CALL friction_loc(ucov, vcov, dtvr)
851	!$OMP BARRIER
852
853	! Sponge layer (if any)
854	IF (ok_strato) THEN
855	CALL top_bound_loc(vcov, ucov, teta, masse, dtvr)
856	!$OMP BARRIER
857	ENDIF ! of IF (ok_strato)
858	ENDIF ! of IF(iflag_phys.EQ.2)
859
860	CALL pression_loc (ip1jmp1, ap, bp, ps, p)
861	!$OMP BARRIER
862	IF (pressure_exner) THEN
863	CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
864	else
865	CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk, pkf)
866	ENDIF
867	!$OMP BARRIER
868	CALL massdair_loc(p, masse)
869	!$OMP BARRIER
870
871	!c$OMP END PARALLEL
872	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1196')
873
874	!-----------------------------------------------------------------------
875	! dissipation horizontale et verticale des petites echelles:
876	! ----------------------------------------------------------
877	IF(apdiss) THEN
878	CALL call_dissip(ucov, vcov, teta, p, pk, ps)
879	END IF
880
881	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1430')
882
883	! ********************************************************************
884	! .... fin de l'integration dynamique et physique pour le pas itau ..
885	! ********************************************************************
886
887	! preparation du pas d'integration suivant ......
888	!$OMP MASTER
889	CALL stop_timer(timer_caldyn)
890	!$OMP END MASTER
891	IF (itau==itaumax) THEN
892	!$OMP MASTER
893	CALL allgather_timer_average
894	CALL barrier
895	IF (mpi_rank==0) THEN
896	PRINT , '********************************'
897	PRINT , '*** TIMER CALDYN ****'
898	DO i = 0, mpi_size - 1
899	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_caldyn(i), &
900	' : temps moyen :', &
901	timer_average(jj_nb_caldyn(i), timer_caldyn, i)
902	enddo
903
904	PRINT , '********************************'
905	PRINT , '*** TIMER VANLEER ****'
906	DO i = 0, mpi_size - 1
907	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_vanleer(i), &
908	' : temps moyen :', &
909	timer_average(jj_nb_vanleer(i), timer_vanleer, i)
910	enddo
911
912	PRINT , '********************************'
913	PRINT , '*** TIMER DISSIP ****'
914	DO i = 0, mpi_size - 1
915	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_dissip(i), &
916	' : temps moyen :', &
917	timer_average(jj_nb_dissip(i), timer_dissip, i)
918	enddo
919
920	PRINT , '********************************'
921	PRINT , '*** TIMER PHYSIC ****'
922	DO i = 0, mpi_size - 1
923	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_physic(i), &
924	' : temps moyen :', &
925	timer_average(jj_nb_physic(i), timer_physic, i)
926	enddo
927
928	endif
929	CALL barrier
930	PRINT , 'Taille du Buffer MPI (REAL8)', MaxBufferSize
931	PRINT , 'Taille du Buffer MPI utilise (REAL8)', MaxBufferSize_Used
932	PRINT *, 'Temps total ecoule sur la parallelisation :', DiffTime()
933	PRINT *, 'Temps CPU ecoule sur la parallelisation :', DiffCpuTime()
934	CALL print_filtre_timer
935	!$OMP END MASTER
936	CALL dynredem1_loc("restart.nc", 0.0, &
937	vcov, ucov, teta, q, masse, ps)
938	!$OMP MASTER
939	CALL fin_getparam
940	!$OMP END MASTER
941
942	IF (ok_guide) THEN
943	! set ok_guide to false to avoid extra output
944	! in following forward step
945	ok_guide = .FALSE.
946	endif
947
948	IF (ANY(type_trac == ['inca', 'inco'])) THEN
949	CALL finalize_inca
950	! switching back to LMDZDYN context
951	!$OMP MASTER
952	IF (ok_dyn_xios) THEN
953	CALL xios_set_current_context(dyn3d_ctx_handle)
954	ENDIF
955	!$OMP END MASTER
956	ENDIF
957	IF (CPPKEY_REPROBUS) THEN
958	IF (type_trac == 'repr') CALL finalize_reprobus
959	END IF
960
961	!$OMP MASTER
962	CALL finalize_parallel
963	!$OMP END MASTER
964	!$OMP BARRIER
965	RETURN
966	ENDIF
967
968	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1509')
969
970	IF (.NOT.purmats) THEN
971	! ........................................................
972	! .............. schema matsuno + leapfrog ..............
973	! ........................................................
974
975	IF(forward .OR. leapf) THEN
976	itau = itau + 1
977	! iday= day_ini+itau/day_step
978	! time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
979	! IF(time.GT.1.) THEN
980	! time = time-1.
981	! iday = iday+1
982	! ENDIF
983	ENDIF
984
985	IF(itau == itaufinp1) THEN
986	IF (flag_verif) THEN
987	WRITE(79, *) 'ucov', ucov
988	WRITE(80, *) 'vcov', vcov
989	WRITE(81, *) 'teta', teta
990	WRITE(82, *) 'ps', ps
991	WRITE(83, *) 'q', q
992	WRITE(85, *) 'q1 = ', q(:, :, 1)
993	WRITE(86, *) 'q3 = ', q(:, :, 3)
994	endif
995
996
997	!$OMP MASTER
998	CALL fin_getparam
999	!$OMP END MASTER
1000
1001	IF (ANY(type_trac == ['inca', 'inco'])) THEN
1002	CALL finalize_inca
1003	! switching back to LMDZDYN context
1004	!$OMP MASTER
1005	IF (ok_dyn_xios) THEN
1006	CALL xios_set_current_context(dyn3d_ctx_handle)
1007	ENDIF
1008	!$OMP END MASTER
1009	ENDIF
1010	IF (CPPKEY_REPROBUS) THEN
1011	IF (type_trac == 'repr') CALL finalize_reprobus
1012	END IF
1013
1014	!$OMP MASTER
1015	CALL finalize_parallel
1016	!$OMP END MASTER
1017	abort_message = 'Simulation finished'
1018	CALL abort_gcm(modname, abort_message, 0)
1019	RETURN
1020	ENDIF
1021	!-----------------------------------------------------------------------
1022	! ecriture du fichier histoire moyenne:
1023	! -------------------------------------
1024
1025	IF(MOD(itau, iperiod)==0 .OR. itau==itaufin) THEN
1026	!$OMP BARRIER
1027	IF(itau==itaufin) THEN
1028	iav = 1
1029	ELSE
1030	iav = 0
1031	ENDIF
1032
1033	! Ehouarn: re-compute geopotential for outputs
1034	!$OMP BARRIER
1035	!$OMP MASTER
1036	CALL geopot_loc(ip1jmp1, teta, pk, pks, phis, phi)
1037	!$OMP END MASTER
1038	!$OMP BARRIER
1039
1040	IF (ok_dynzon) THEN
1041
1042	CALL bilan_dyn_loc(2, dtvr * iperiod, dtvr * day_step * periodav, &
1043	ps, masse, pk, pbaru, pbarv, teta, phi, ucov, vcov, q)
1044
1045	ENDIF !ok_dynzon
1046
1047	IF (ok_dyn_ave) THEN
1048	CALL writedynav_loc(itau, vcov, &
1049	ucov, teta, pk, phi, q, masse, ps, phis)
1050	ENDIF
1051
1052	ENDIF
1053
1054	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1584')
1055
1056	!-----------------------------------------------------------------------
1057	! ecriture de la bande histoire:
1058	! ------------------------------
1059
1060	IF(MOD(itau, iecri)==0) THEN
1061	! Ehouarn: output only during LF or Backward Matsuno
1062	IF (leapf.OR.(.NOT.leapf.AND.(.NOT.forward))) THEN
1063	!$OMP BARRIER
1064	!$OMP MASTER
1065	CALL geopot_loc(ip1jmp1, teta, pk, pks, phis, phi)
1066	!$OMP END MASTER
1067	!$OMP BARRIER
1068
1069	IF (ok_dyn_ins) THEN
1070	CALL writehist_loc(itau, vcov, ucov, teta, pk, phi, q, &
1071	masse, ps, phis)
1072	endif
1073
1074	IF (ok_dyn_xios) THEN
1075	!$OMP MASTER
1076	CALL xios_update_calendar(itau)
1077	!$OMP END MASTER
1078	!$OMP BARRIER
1079	CALL writedyn_xios(vcov, &
1080	ucov, teta, pk, phi, q, masse, ps, phis)
1081	ENDIF
1082
1083	endif ! of if (leapf.OR.(.NOT.leapf.AND.(.NOT.forward)))
1084
1085	ENDIF ! of IF(MOD(itau,iecri).EQ.0)
1086
1087	IF(itau==itaufin) THEN
1088
1089	!$OMP BARRIER
1090
1091	! if (planet_type.EQ."earth") THEN
1092	! Write an Earth-format restart file
1093	CALL dynredem1_loc("restart.nc", 0.0, &
1094	vcov, ucov, teta, q, masse, ps)
1095	! END IF ! of if (planet_type.EQ."earth")
1096	IF (ok_guide) THEN
1097	! set ok_guide to false to avoid extra output
1098	! in following forward step
1099	ok_guide = .FALSE.
1100	endif
1101
1102	! CLOSE(99)
1103	ENDIF ! of IF (itau.EQ.itaufin)
1104
1105	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1624')
1106
1107	!-----------------------------------------------------------------------
1108	! gestion de l'integration temporelle:
1109	! ------------------------------------
1110
1111	IF(MOD(itau, iperiod)==0) THEN
1112	GO TO 1
1113	ELSE IF (MOD(itau - 1, iperiod) == 0) THEN
1114
1115	IF(forward) THEN
1116	! fin du pas forward et debut du pas backward
1117
1118	forward = .FALSE.
1119	leapf = .FALSE.
1120	GO TO 2
1121
1122	ELSE
1123	! fin du pas backward et debut du premier pas leapfrog
1124
1125	leapf = .TRUE.
1126	dt = 2. * dtvr
1127	GO TO 2
1128	END IF
1129	ELSE
1130
1131	! ...... pas leapfrog .....
1132
1133	leapf = .TRUE.
1134	dt = 2. * dtvr
1135	GO TO 2
1136	END IF ! of IF (MOD(itau,iperiod).EQ.0)
1137	! ELSEIF (MOD(itau-1,iperiod).EQ.0)
1138
1139	ELSE ! of IF (.NOT.purmats)
1140
1141	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1664')
1142
1143	! ........................................................
1144	! .............. schema matsuno ...............
1145	! ........................................................
1146	IF(forward) THEN
1147
1148	itau = itau + 1
1149	! iday = day_ini+itau/day_step
1150	! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
1151
1152	! IF(time.GT.1.) THEN
1153	! time = time-1.
1154	! iday = iday+1
1155	! ENDIF
1156
1157	forward = .FALSE.
1158	IF(itau == itaufinp1) THEN
1159	!$OMP MASTER
1160	CALL fin_getparam
1161	!$OMP END MASTER
1162
1163	IF (ANY(type_trac == ['inca', 'inco'])) THEN
1164	CALL finalize_inca
1165	! switching back to LMDZDYN context
1166	!$OMP MASTER
1167	IF (ok_dyn_xios) THEN
1168	CALL xios_set_current_context(dyn3d_ctx_handle)
1169	ENDIF
1170	!$OMP END MASTER
1171	ENDIF
1172	IF (CPPKEY_REPROBUS) THEN
1173	IF (type_trac == 'repr') CALL finalize_reprobus
1174	END IF
1175
1176	!$OMP MASTER
1177	CALL finalize_parallel
1178	!$OMP END MASTER
1179	abort_message = 'Simulation finished'
1180	CALL abort_gcm(modname, abort_message, 0)
1181	RETURN
1182	ENDIF
1183	GO TO 2
1184
1185	ELSE ! of IF(forward) i.e. backward step
1186
1187	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1698')
1188
1189	IF(MOD(itau, iperiod)==0 .OR. itau==itaufin) THEN
1190	IF(itau==itaufin) THEN
1191	iav = 1
1192	ELSE
1193	iav = 0
1194	ENDIF
1195
1196	! Ehouarn: re-compute geopotential for outputs
1197	!$OMP BARRIER
1198	!$OMP MASTER
1199	CALL geopot_loc(ip1jmp1, teta, pk, pks, phis, phi)
1200	!$OMP END MASTER
1201	!$OMP BARRIER
1202
1203	IF (ok_dynzon) THEN
1204	CALL bilan_dyn_loc(2, dtvr * iperiod, dtvr * day_step * periodav, &
1205	ps, masse, pk, pbaru, pbarv, teta, phi, ucov, vcov, q)
1206	ENDIF
1207
1208	IF (ok_dyn_ave) THEN
1209	CALL writedynav_loc(itau, vcov, &
1210	ucov, teta, pk, phi, q, masse, ps, phis)
1211	ENDIF
1212
1213	ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
1214
1215	IF(MOD(itau, iecri)==0) THEN
1216
1217	!$OMP BARRIER
1218	!$OMP MASTER
1219	CALL geopot_loc(ip1jmp1, teta, pk, pks, phis, phi)
1220	!$OMP END MASTER
1221	!$OMP BARRIER
1222
1223	IF (ok_dyn_ins) THEN
1224	CALL writehist_loc(itau, vcov, ucov, teta, pk, phi, q, &
1225	masse, ps, phis)
1226	endif ! of if (ok_dyn_ins)
1227
1228	IF (ok_dyn_xios) THEN
1229	!$OMP MASTER
1230	CALL xios_update_calendar(itau)
1231	!$OMP END MASTER
1232	!$OMP BARRIER
1233	CALL writedyn_xios(vcov, &
1234	ucov, teta, pk, phi, q, masse, ps, phis)
1235	ENDIF
1236
1237	ENDIF ! of IF(MOD(itau,iecri).EQ.0)
1238
1239	IF(itau==itaufin) THEN
1240	! if (planet_type.EQ."earth") THEN
1241	CALL dynredem1_loc("restart.nc", 0.0, &
1242	vcov, ucov, teta, q, masse, ps)
1243	! END IF ! of if (planet_type.EQ."earth")
1244	IF (ok_guide) THEN
1245	! set ok_guide to false to avoid extra output
1246	! in following forward step
1247	ok_guide = .FALSE.
1248	endif
1249
1250	ENDIF ! of IF(itau.EQ.itaufin)
1251
1252	forward = .TRUE.
1253	GO TO 1
1254
1255	ENDIF ! of IF (forward)
1256
1257	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1750')
1258
1259	END IF ! of IF(.NOT.purmats)
1260	!$OMP MASTER
1261	CALL fin_getparam
1262	!$OMP END MASTER
1263
1264	IF (ANY(type_trac == ['inca', 'inco'])) THEN
1265	CALL finalize_inca
1266	! switching back to LMDZDYN context
1267	!$OMP MASTER
1268	IF (ok_dyn_xios) THEN
1269	CALL xios_set_current_context(dyn3d_ctx_handle)
1270	ENDIF
1271	!$OMP END MASTER
1272	ENDIF
1273	IF (CPPKEY_REPROBUS) THEN
1274	IF (type_trac == 'repr') CALL finalize_reprobus
1275	END IF
1276
1277	!$OMP MASTER
1278	CALL finalize_parallel
1279	!$OMP END MASTER
1280	abort_message = 'Simulation finished'
1281	CALL abort_gcm(modname, abort_message, 0)
1282
1283	END SUBROUTINE leapfrog_loc

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

Download in other formats:

Original Format