Context Navigation

leapfrog_loc.F90 @ 5127

Last change on this file since 5127 was 5123, checked in by abarral, 12 months ago
Correct various minor mistakes from previous commits
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.2 KB

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

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

Download in other formats:

Original Format