Context Navigation

leapfrog_loc.F90 @ 5103

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

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

Download in other formats:

Original Format