Context Navigation

leapfrog_loc.F90 @ 5153

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

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

Download in other formats:

Original Format