Context Navigation

leapfrog_loc.F90 @ 5172

Last change on this file since 5172 was 5160, checked in by abarral, 5 months ago
Put .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 5160 2024-08-03 12:56:58Z 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	USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
50	USE lmdz_paramet
51	IMPLICIT NONE
52
53	! ...... Version du 10/01/98 ..........
54
55	! avec coordonnees verticales hybrides
56	! avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
57
58	!=======================================================================
59
60	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
61	! -------
62
63	! Objet:
64	! ------
65
66	! GCM LMD nouvelle grille
67
68	!=======================================================================
69
70	! ... Dans inigeom , nouveaux calculs pour les elongations cu , cv
71	! et possibilite d'appeler une fonction f(y) a derivee tangente
72	! hyperbolique a la place de la fonction a derivee sinusoidale.
73
74	! ... Possibilite de choisir le shema pour l'advection de
75	! q , en modifiant iadv dans traceur.def (10/02) .
76
77	! Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
78	! Pour Van-Leer iadv=10
79
80	!-----------------------------------------------------------------------
81	! Declarations:
82	! -------------
83
84
85
86
87	REAL, INTENT(IN) :: time_0 ! not used
88
89	! dynamical variables:
90	REAL, INTENT(IN) :: ucov0(ijb_u:ije_u, llm) ! zonal covariant wind
91	REAL, INTENT(IN) :: vcov0(ijb_v:ije_v, llm) ! meridional covariant wind
92	REAL, INTENT(IN) :: teta0(ijb_u:ije_u, llm) ! potential temperature
93	REAL, INTENT(IN) :: q0(ijb_u:ije_u, llm, nqtot) ! advected tracers
94	REAL, INTENT(IN) :: ps0(ijb_u:ije_u) ! surface pressure (Pa)
95	REAL, INTENT(IN) :: masse0(ijb_u:ije_u, llm) ! air mass
96	REAL, INTENT(IN) :: phis0(ijb_u:ije_u) ! geopotentiat at the surface
97
98	REAL :: zqmin, zqmax
99
100	! REAL,SAVE,ALLOCATABLE :: p (:,: ) ! pression aux interfac.des couches
101	! REAL,SAVE,ALLOCATABLE :: pks(:) ! exner au sol
102	! REAL,SAVE,ALLOCATABLE :: pk(:,:) ! exner au milieu des couches
103	! REAL,SAVE,ALLOCATABLE :: pkf(:,:) ! exner filt.au milieu des couches
104	! REAL,SAVE,ALLOCATABLE :: phi(:,:) ! geopotentiel
105	! REAL,SAVE,ALLOCATABLE :: w(:,:) ! vitesse verticale
106
107	! variables dynamiques intermediaire pour le transport
108	! REAL,SAVE,ALLOCATABLE :: pbaru(:,:),pbarv(:,:) !flux de masse
109
110	! variables dynamiques au pas -1
111	! REAL,SAVE,ALLOCATABLE :: vcovm1(:,:),ucovm1(:,:)
112	! REAL,SAVE,ALLOCATABLE :: tetam1(:,:),psm1(:)
113	! REAL,SAVE,ALLOCATABLE :: massem1(:,:)
114
115	! tendances dynamiques
116	! REAL,SAVE,ALLOCATABLE :: dv(:,:),du(:,:)
117	! REAL,SAVE,ALLOCATABLE :: dteta(:,:),dp(:)
118	! REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq
119
120	! tendances de la dissipation
121	! REAL,SAVE,ALLOCATABLE :: dvdis(:,:),dudis(:,:)
122	! REAL,SAVE,ALLOCATABLE :: dtetadis(:,:)
123
124	! tendances physiques
125	REAL, SAVE, ALLOCATABLE :: dvfi(:, :), dufi(:, :)
126	REAL, SAVE, ALLOCATABLE :: dtetafi(:, :)
127	REAL, SAVE, ALLOCATABLE :: dpfi(:)
128	REAL, DIMENSION(:, :, :), ALLOCATABLE, SAVE :: dqfi
129
130	! variables pour le fichier histoire
131	REAL :: dtav ! intervalle de temps elementaire
132
133	REAL :: tppn(iim), tpps(iim), tpn, tps
134
135	INTEGER :: itau, itaufinp1, iav
136	! INTEGER iday ! jour julien
137	REAL :: time
138
139	! REAL,SAVE,ALLOCATABLE :: finvmaold(:,:)
140
141	!ym LOGICAL lafin
142	LOGICAL :: lafin
143	INTEGER :: ij, iq, l
144	INTEGER :: ik
145
146	REAL :: time_step, t_wrt, t_ops
147
148	! jD_cur: jour julien courant
149	! jH_cur: heure julienne courante
150	REAL :: jD_cur, jH_cur
151	INTEGER :: an, mois, jour
152	REAL :: secondes
153
154	LOGICAL :: physic
155	LOGICAL :: first, callinigrads
156
157	data callinigrads/.TRUE./
158	CHARACTER(LEN = 10) :: string10
159
160	! REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale
161
162	!+jld variables test conservation energie
163	! REAL,SAVE,ALLOCATABLE :: ecin(:,:),ecin0(:,:)
164	! Tendance de la temp. potentiel d (theta)/ d t due a la
165	! tansformation d'energie cinetique en energie thermique
166	! cree par la dissipation
167	! REAL,SAVE,ALLOCATABLE :: dtetaecdt(:,:)
168	! REAL,SAVE,ALLOCATABLE :: vcont(:,:),ucont(:,:)
169	! REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
170	REAL :: d_h_vcol, d_qt, d_qw, d_ql, d_ec
171	CHARACTER(len = 15) :: ztit
172	!! INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.
173	! SAVE ip_ebil_dyn
174	! DATA ip_ebil_dyn/0/
175	!-jld
176
177	CHARACTER(LEN = 80) :: dynhist_file, dynhistave_file
178	CHARACTER(LEN = *), parameter :: modname = "leapfrog_loc"
179	CHARACTER(LEN = 80) :: abort_message
180
181	logical, PARAMETER :: dissip_conservative = .TRUE.
182
183	INTEGER :: testita
184	PARAMETER (testita = 9)
185
186	logical, parameter :: flag_verif = .FALSE.
187
188	! declaration liees au parallelisme
189	INTEGER :: ierr
190	LOGICAL :: FirstCaldyn
191	LOGICAL :: FirstPhysic
192	INTEGER :: ijb, ije, j, i
193	type(Request) :: TestRequest
194	type(Request) :: Request_Dissip
195	type(Request) :: Request_physic
196
197	INTEGER :: true_itau
198	INTEGER :: iapptrac
199	INTEGER :: AdjustCount
200	! INTEGER :: var_time
201	LOGICAL :: ok_start_timer = .FALSE.
202	LOGICAL, SAVE :: firstcall = .TRUE.
203	TYPE(distrib), SAVE :: new_dist
204
205	CALL check_isotopes(q0, ijb_u, ije_u, 'leapfrog204: debut')
206
207	!$OMP MASTER
208	ItCount = 0
209	!$OMP END MASTER
210	true_itau = 0
211	FirstCaldyn = .TRUE.
212	FirstPhysic = .TRUE.
213	iapptrac = 0
214	AdjustCount = 0
215	lafin = .FALSE.
216
217	IF (nday>=0) THEN
218	itaufin = nday * day_step
219	else
220	itaufin = -nday
221	ENDIF
222
223	itaufinp1 = itaufin + 1
224
225	CALL check_isotopes(q0, ijb_u, ije_u, 'leapfrog 226')
226
227	itau = 0
228	physic = .TRUE.
229	IF (iflag_phys==0.OR.iflag_phys==2) physic = .FALSE.
230	CALL init_nan
231	CALL leapfrog_allocate
232	ucov = ucov0
233	vcov = vcov0
234	teta = teta0
235	ps = ps0
236	masse = masse0
237	phis = phis0
238	q = q0
239
240	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 239')
241
242	! iday = day_ini+itau/day_step
243	! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
244	! IF(time.GT.1.) THEN
245	! time = time-1.
246	! iday = iday+1
247	! ENDIF
248
249	! Allocate variables depending on dynamic variable nqtot
250	!$OMP MASTER
251	IF (firstcall) THEN
252	! ALLOCATE(p(ijb_u:ije_u,llmp1))
253	! ALLOCATE(pks(ijb_u:ije_u))
254	! ALLOCATE(pk(ijb_u:ije_u,llm))
255	! ALLOCATE(pkf(ijb_u:ije_u,llm))
256	! ALLOCATE(phi(ijb_u:ije_u,llm))
257	! ALLOCATE(w(ijb_u:ije_u,llm))
258	! ALLOCATE(pbaru(ip1jmp1,llm),pbarv(ip1jm,llm))
259	! ALLOCATE(vcovm1(ijb_v:ije_v,llm),ucovm1(ijb_u:ije_u,llm))
260	! ALLOCATE(tetam1(ijb_u:ije_u,llm),psm1(ijb_u:ije_u))
261	! ALLOCATE(massem1(ijb_u:ije_u,llm))
262	! ALLOCATE(dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm))
263	! ALLOCATE(dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u))
264	! ALLOCATE(dvdis(ijb_v:ije_v,llm),dudis(ijb_u:ije_u,llm))
265	! ALLOCATE(dtetadis(ijb_u:ije_u,llm))
266	ALLOCATE(dvfi(ijb_v:ije_v, llm), dufi(ijb_u:ije_u, llm))
267	ALLOCATE(dtetafi(ijb_u:ije_u, llm))
268	ALLOCATE(dpfi(ijb_u:ije_u))
269	! ALLOCATE(dq(ijb_u:ije_u,llm,nqtot))
270	ALLOCATE(dqfi(ijb_u:ije_u, llm, nqtot))
271	! ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
272	! ALLOCATE(finvmaold(ijb_u:ije_u,llm))
273	! ALLOCATE(flxw(ijb_u:ije_u,llm))
274	! ALLOCATE(ecin(ijb_u:ije_u,llm),ecin0(ijb_u:ije_u,llm))
275	! ALLOCATE(dtetaecdt(ijb_u:ije_u,llm))
276	! ALLOCATE(vcont(ijb_v:ije_v,llm),ucont(ijb_u:ije_u,llm))
277	! ALLOCATE(vnat(ijb_v:ije_v,llm),unat(ijb_u:ije_u,llm))
278	ENDIF
279	!$OMP END MASTER
280	!$OMP BARRIER
281
282	! CALL dynredem1_loc("restart.nc",0.0,
283	! & vcov,ucov,teta,q,masse,ps)
284
285
286	!-----------------------------------------------------------------------
287	! On initialise la pression et la fonction d'Exner :
288	! --------------------------------------------------
289
290	!$OMP MASTER
291	dq(:, :, :) = 0.
292	CALL pression (ijnb_u, ap, bp, ps, p)
293	!$OMP END MASTER
294	IF (pressure_exner) THEN
295	CALL exner_hyb_loc(ijnb_u, ps, p, pks, pk, pkf)
296	else
297	CALL exner_milieu_loc(ijnb_u, ps, p, pks, pk, pkf)
298	ENDIF
299	!-----------------------------------------------------------------------
300	! Debut de l'integration temporelle:
301	! ----------------------------------
302	! et du parallelisme !!
303
304	1 CONTINUE ! Matsuno Forward step begins here
305
306	! date: (NB: date remains unchanged for Backward step)
307	! -----
308
309	jD_cur = jD_ref + day_ini - day_ref + &
310	(itau + 1) / day_step
311	jH_cur = jH_ref + start_time + &
312	mod(itau + 1, day_step) / float(day_step)
313	IF (jH_cur > 1.0) THEN
314	jD_cur = jD_cur + 1.
315	jH_cur = jH_cur - 1.
316	ENDIF
317
318	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 321')
319
320	IF (ok_guide) THEN
321	CALL guide_main(itau,ucov,vcov,teta,q,masse,ps)
322	!$OMP BARRIER
323	ENDIF
324
325
326
327	! IF( MOD( itau, 10* day_step ).EQ.0 ) THEN
328	! CALL test_period ( ucov,vcov,teta,q,p,phis )
329	! PRINT *,' ---- Test_period apres continue OK ! -----', itau
330	! ENDIF
331
332	!ym CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
333	!ym CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
334	!ym CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 )
335	!ym CALL SCOPY( ijp1llm,masse, 1, massem1, 1 )
336	!ym CALL SCOPY( ip1jmp1, ps , 1, psm1 , 1 )
337
338	IF (FirstCaldyn) THEN
339	!$OMP MASTER
340	ucovm1 = ucov
341	vcovm1 = vcov
342	tetam1 = teta
343	massem1 = masse
344	psm1 = ps
345
346	! Ehouarn: finvmaold is actually not used
347	! finvmaold = masse
348	!$OMP END MASTER
349	!$OMP BARRIER
350	! CALL filtreg_p ( finvmaold ,jjb_u,jje_u,jjb_u,jje_u,jjp1, llm,
351	! & -2,2, .TRUE., 1 )
352	else
353	! Save fields obtained at previous time step as '...m1'
354	ijb = ij_begin
355	ije = ij_end
356
357	!$OMP MASTER
358	psm1 (ijb:ije) = ps (ijb:ije)
359	!$OMP END MASTER
360
361	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
362	DO l = 1, llm
363	ije = ij_end
364	ucovm1 (ijb:ije, l) = ucov (ijb:ije, l)
365	tetam1 (ijb:ije, l) = teta (ijb:ije, l)
366	massem1 (ijb:ije, l) = masse (ijb:ije, l)
367	! finvmaold(ijb:ije,l)=masse(ijb:ije,l)
368
369	IF (pole_sud) ije = ij_end - iip1
370	vcovm1(ijb:ije, l) = vcov (ijb:ije, l)
371
372	ENDDO
373	!$OMP ENDDO
374
375
376	! Ehouarn: finvmaold not used
377	! CALL filtreg_p(finvmaold ,jjb_u,jje_u,jj_begin,jj_end,jjp1,
378	! . llm, -2,2, .TRUE., 1 )
379
380	ENDIF ! of if (FirstCaldyn)
381
382	forward = .TRUE.
383	leapf = .FALSE.
384	dt = dtvr
385
386	! ... P.Le Van .26/04/94 ....
387
388	!ym CALL SCOPY ( ijp1llm, masse, 1, finvmaold, 1 )
389	!ym CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
390
391	!ym ne sert a rien
392	!ym CALL minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
393
394	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 400')
395
396	2 CONTINUE ! Matsuno backward or leapfrog step begins here
397
398	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 402')
399
400	!$OMP MASTER
401	ItCount = ItCount + 1
402	IF (MOD(ItCount, 1)==1) THEN
403	debug = .TRUE.
404	else
405	debug = .FALSE.
406	ENDIF
407	!$OMP END MASTER
408	!-----------------------------------------------------------------------
409
410	! date: (NB: only leapfrog step requires recomputing date)
411	! -----
412
413	IF (leapf) THEN
414	jD_cur = jD_ref + day_ini - day_ref + &
415	(itau + 1) / day_step
416	jH_cur = jH_ref + start_time + &
417	mod(itau + 1, day_step) / float(day_step)
418	IF (jH_cur > 1.0) THEN
419	jD_cur = jD_cur + 1.
420	jH_cur = jH_cur - 1.
421	endif
422	ENDIF
423
424	! gestion des appels de la physique et des dissipations:
425	! ------------------------------------------------------
426
427	! ... P.Le Van ( 6/02/95 ) ....
428
429	apphys = .FALSE.
430	statcl = .FALSE.
431	conser = .FALSE.
432	apdiss = .FALSE.
433
434	IF(purmats) THEN
435	! Purely Matsuno time stepping
436	IF(MOD(itau, iconser) ==0.AND. forward) conser = .TRUE.
437	IF(MOD(itau, dissip_period)==0.AND..NOT.forward) &
438	apdiss = .TRUE.
439	IF(MOD(itau, iphysiq)==0.AND..NOT.forward &
440	.AND. physic) apphys = .TRUE.
441	ELSE
442	! Leapfrog/Matsuno time stepping
443	IF(MOD(itau, iconser) == 0) conser = .TRUE.
444	IF(MOD(itau + 1, dissip_period)==0 .AND. .NOT. forward) &
445	apdiss = .TRUE.
446	IF(MOD(itau + 1, iphysiq)==0.AND.physic) apphys = .TRUE.
447	END IF
448
449	! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
450	! supress dissipation step
451	IF (llm==1) THEN
452	apdiss = .FALSE.
453	ENDIF
454
455	!ym ---> Pour le moment
456	!ym apphys = .FALSE.
457	statcl = .FALSE.
458	! conser = .FALSE. ! ie: no output of control variables to stdout in //
459
460	IF (firstCaldyn) THEN
461	!$OMP MASTER
462	CALL Set_Distrib(distrib_caldyn)
463	!$OMP END MASTER
464	!$OMP BARRIER
465	firstCaldyn = .FALSE.
466	!ym CALL InitTime
467	!$OMP MASTER
468	CALL Init_timer
469	!$OMP END MASTER
470	ENDIF
471
472	!$OMP MASTER
473	IF (ok_start_timer) THEN
474	CALL InitTime
475	ok_start_timer = .FALSE.
476	ENDIF
477	!$OMP END MASTER
478
479	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 471')
480
481	!ym PAS D'AJUSTEMENT POUR LE MOMENT
482	IF (Adjust) THEN
483	AdjustCount = AdjustCount + 1
484	! if (iapptrac==iapp_tracvl .AND. (forward .OR. leapf)
485	! & .AND. itau/iphysiq>2 .AND. Adjustcount>30) THEN
486	IF (Adjustcount>1) THEN
487	AdjustCount = 0
488	!$OMP MASTER
489	CALL allgather_timer_average
490
491	IF (prt_level > 9) THEN
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	PRINT , '********************************'
903	PRINT , '*** TIMER CALDYN ****'
904	DO i = 0, mpi_size - 1
905	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_caldyn(i), &
906	' : temps moyen :', &
907	timer_average(jj_nb_caldyn(i), timer_caldyn, i)
908	enddo
909
910	PRINT , '********************************'
911	PRINT , '*** TIMER VANLEER ****'
912	DO i = 0, mpi_size - 1
913	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_vanleer(i), &
914	' : temps moyen :', &
915	timer_average(jj_nb_vanleer(i), timer_vanleer, i)
916	enddo
917
918	PRINT , '********************************'
919	PRINT , '*** TIMER DISSIP ****'
920	DO i = 0, mpi_size - 1
921	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_dissip(i), &
922	' : temps moyen :', &
923	timer_average(jj_nb_dissip(i), timer_dissip, i)
924	enddo
925
926	PRINT , '********************************'
927	PRINT , '*** TIMER PHYSIC ****'
928	DO i = 0, mpi_size - 1
929	PRINT *, 'proc', i, ' : Nb Bandes :', jj_nb_physic(i), &
930	' : temps moyen :', &
931	timer_average(jj_nb_physic(i), timer_physic, i)
932	enddo
933
934	endif
935	CALL barrier
936	PRINT , 'Taille du Buffer MPI (REAL8)', MaxBufferSize
937	PRINT , 'Taille du Buffer MPI utilise (REAL8)', MaxBufferSize_Used
938	PRINT *, 'Temps total ecoule sur la parallelisation :', DiffTime()
939	PRINT *, 'Temps CPU ecoule sur la parallelisation :', DiffCpuTime()
940	CALL print_filtre_timer
941	!$OMP END MASTER
942	CALL dynredem1_loc("restart.nc", 0.0, &
943	vcov, ucov, teta, q, masse, ps)
944	!$OMP MASTER
945	CALL fin_getparam
946	!$OMP END MASTER
947
948	IF (ok_guide) THEN
949	! set ok_guide to false to avoid extra output
950	! in following forward step
951	ok_guide = .FALSE.
952	endif
953
954	IF (ANY(type_trac == ['inca', 'inco'])) THEN
955	CALL finalize_inca
956	! switching back to LMDZDYN context
957	!$OMP MASTER
958	IF (ok_dyn_xios) THEN
959	CALL xios_set_current_context(dyn3d_ctx_handle)
960	ENDIF
961	!$OMP END MASTER
962	ENDIF
963	#ifdef REPROBUS
964	IF (type_trac == 'repr') CALL finalize_reprobus
965	#endif
966
967	!$OMP MASTER
968	CALL finalize_parallel
969	!$OMP END MASTER
970	!$OMP BARRIER
971	RETURN
972	ENDIF
973
974	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1509')
975
976	IF (.NOT.purmats) THEN
977	! ........................................................
978	! .............. schema matsuno + leapfrog ..............
979	! ........................................................
980
981	IF(forward .OR. leapf) THEN
982	itau = itau + 1
983	! iday= day_ini+itau/day_step
984	! time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
985	! IF(time.GT.1.) THEN
986	! time = time-1.
987	! iday = iday+1
988	! ENDIF
989	ENDIF
990
991	IF(itau == itaufinp1) THEN
992	IF (flag_verif) THEN
993	WRITE(79, *) 'ucov', ucov
994	WRITE(80, *) 'vcov', vcov
995	WRITE(81, *) 'teta', teta
996	WRITE(82, *) 'ps', ps
997	WRITE(83, *) 'q', q
998	WRITE(85, *) 'q1 = ', q(:, :, 1)
999	WRITE(86, *) 'q3 = ', q(:, :, 3)
1000	endif
1001
1002
1003	!$OMP MASTER
1004	CALL fin_getparam
1005	!$OMP END MASTER
1006
1007	IF (ANY(type_trac == ['inca', 'inco'])) THEN
1008	CALL finalize_inca
1009	! switching back to LMDZDYN context
1010	!$OMP MASTER
1011	IF (ok_dyn_xios) THEN
1012	CALL xios_set_current_context(dyn3d_ctx_handle)
1013	ENDIF
1014	!$OMP END MASTER
1015	ENDIF
1016	#ifdef REPROBUS
1017	IF (type_trac == 'repr') CALL finalize_reprobus
1018	#endif
1019
1020	!$OMP MASTER
1021	CALL finalize_parallel
1022	!$OMP END MASTER
1023	abort_message = 'Simulation finished'
1024	CALL abort_gcm(modname, abort_message, 0)
1025	RETURN
1026	ENDIF
1027	!-----------------------------------------------------------------------
1028	! ecriture du fichier histoire moyenne:
1029	! -------------------------------------
1030
1031	IF(MOD(itau, iperiod)==0 .OR. itau==itaufin) THEN
1032	!$OMP BARRIER
1033	IF(itau==itaufin) THEN
1034	iav = 1
1035	ELSE
1036	iav = 0
1037	ENDIF
1038
1039	! Ehouarn: re-compute geopotential for outputs
1040	!$OMP BARRIER
1041	!$OMP MASTER
1042	CALL geopot_loc(ip1jmp1, teta, pk, pks, phis, phi)
1043	!$OMP END MASTER
1044	!$OMP BARRIER
1045
1046	IF (ok_dynzon) THEN
1047
1048	CALL bilan_dyn_loc(2,dtvriperiod,dtvrday_step*periodav, &
1049	ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
1050
1051	ENDIF !ok_dynzon
1052
1053	IF (ok_dyn_ave) THEN
1054	CALL writedynav_loc(itau,vcov, &
1055	ucov,teta,pk,phi,q,masse,ps,phis)
1056	ENDIF
1057
1058	ENDIF
1059
1060	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1584')
1061
1062	!-----------------------------------------------------------------------
1063	! ecriture de la bande histoire:
1064	! ------------------------------
1065
1066	IF(MOD(itau, iecri)==0) THEN
1067	! Ehouarn: output only during LF or Backward Matsuno
1068	IF (leapf.OR.(.NOT.leapf.AND.(.NOT.forward))) THEN
1069	!$OMP BARRIER
1070	!$OMP MASTER
1071	CALL geopot_loc(ip1jmp1, teta, pk, pks, phis, phi)
1072	!$OMP END MASTER
1073	!$OMP BARRIER
1074
1075	IF (ok_dyn_ins) THEN
1076	CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
1077	masse,ps,phis)
1078	endif
1079
1080	IF (ok_dyn_xios) THEN
1081	!$OMP MASTER
1082	CALL xios_update_calendar(itau)
1083	!$OMP END MASTER
1084	!$OMP BARRIER
1085	CALL writedyn_xios(vcov, &
1086	ucov, teta, pk, phi, q, masse, ps, phis)
1087	ENDIF
1088
1089	endif ! of if (leapf.OR.(.NOT.leapf.AND.(.NOT.forward)))
1090
1091	ENDIF ! of IF(MOD(itau,iecri).EQ.0)
1092
1093	IF(itau==itaufin) THEN
1094
1095	!$OMP BARRIER
1096
1097	! if (planet_type.EQ."earth") THEN
1098	! Write an Earth-format restart file
1099	CALL dynredem1_loc("restart.nc", 0.0, &
1100	vcov, ucov, teta, q, masse, ps)
1101	! END IF ! of if (planet_type.EQ."earth")
1102	IF (ok_guide) THEN
1103	! set ok_guide to false to avoid extra output
1104	! in following forward step
1105	ok_guide = .FALSE.
1106	endif
1107
1108	! CLOSE(99)
1109	ENDIF ! of IF (itau.EQ.itaufin)
1110
1111	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1624')
1112
1113	!-----------------------------------------------------------------------
1114	! gestion de l'integration temporelle:
1115	! ------------------------------------
1116
1117	IF(MOD(itau, iperiod)==0) THEN
1118	GO TO 1
1119	ELSE IF (MOD(itau - 1, iperiod) == 0) THEN
1120
1121	IF(forward) THEN
1122	! fin du pas forward et debut du pas backward
1123
1124	forward = .FALSE.
1125	leapf = .FALSE.
1126	GO TO 2
1127
1128	ELSE
1129	! fin du pas backward et debut du premier pas leapfrog
1130
1131	leapf = .TRUE.
1132	dt = 2. * dtvr
1133	GO TO 2
1134	END IF
1135	ELSE
1136
1137	! ...... pas leapfrog .....
1138
1139	leapf = .TRUE.
1140	dt = 2. * dtvr
1141	GO TO 2
1142	END IF ! of IF (MOD(itau,iperiod).EQ.0)
1143	! ELSEIF (MOD(itau-1,iperiod).EQ.0)
1144
1145	ELSE ! of IF (.NOT.purmats)
1146
1147	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1664')
1148
1149	! ........................................................
1150	! .............. schema matsuno ...............
1151	! ........................................................
1152	IF(forward) THEN
1153
1154	itau = itau + 1
1155	! iday = day_ini+itau/day_step
1156	! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
1157
1158	! IF(time.GT.1.) THEN
1159	! time = time-1.
1160	! iday = iday+1
1161	! ENDIF
1162
1163	forward = .FALSE.
1164	IF(itau == itaufinp1) THEN
1165	!$OMP MASTER
1166	CALL fin_getparam
1167	!$OMP END MASTER
1168
1169	IF (ANY(type_trac == ['inca', 'inco'])) THEN
1170	CALL finalize_inca
1171	! switching back to LMDZDYN context
1172	!$OMP MASTER
1173	IF (ok_dyn_xios) THEN
1174	CALL xios_set_current_context(dyn3d_ctx_handle)
1175	ENDIF
1176	!$OMP END MASTER
1177	ENDIF
1178	#ifdef REPROBUS
1179	IF (type_trac == 'repr') CALL finalize_reprobus
1180	#endif
1181
1182	!$OMP MASTER
1183	CALL finalize_parallel
1184	!$OMP END MASTER
1185	abort_message = 'Simulation finished'
1186	CALL abort_gcm(modname, abort_message, 0)
1187	RETURN
1188	ENDIF
1189	GO TO 2
1190
1191	ELSE ! of IF(forward) i.e. backward step
1192
1193	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1698')
1194
1195	IF(MOD(itau, iperiod)==0 .OR. itau==itaufin) THEN
1196	IF(itau==itaufin) THEN
1197	iav = 1
1198	ELSE
1199	iav = 0
1200	ENDIF
1201
1202	! Ehouarn: re-compute geopotential for outputs
1203	!$OMP BARRIER
1204	!$OMP MASTER
1205	CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
1206	!$OMP END MASTER
1207	!$OMP BARRIER
1208
1209	IF (ok_dynzon) THEN
1210	CALL bilan_dyn_loc(2,dtvriperiod,dtvrday_step*periodav, &
1211	ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
1212	ENDIF
1213
1214	IF (ok_dyn_ave) THEN
1215	CALL writedynav_loc(itau,vcov, &
1216	ucov,teta,pk,phi,q,masse,ps,phis)
1217	ENDIF
1218
1219	ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
1220
1221	IF(MOD(itau, iecri)==0) THEN
1222
1223	!$OMP BARRIER
1224	!$OMP MASTER
1225	CALL geopot_loc(ip1jmp1, teta, pk, pks, phis, phi)
1226	!$OMP END MASTER
1227	!$OMP BARRIER
1228
1229
1230	IF (ok_dyn_ins) THEN
1231	CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
1232	masse,ps,phis)
1233	endif ! of if (ok_dyn_ins)
1234
1235	IF (ok_dyn_xios) THEN
1236	!$OMP MASTER
1237	CALL xios_update_calendar(itau)
1238	!$OMP END MASTER
1239	!$OMP BARRIER
1240	CALL writedyn_xios(vcov, &
1241	ucov, teta, pk, phi, q, masse, ps, phis)
1242	ENDIF
1243
1244	ENDIF ! of IF(MOD(itau,iecri).EQ.0)
1245
1246	IF(itau==itaufin) THEN
1247	! if (planet_type.EQ."earth") THEN
1248	CALL dynredem1_loc("restart.nc", 0.0, &
1249	vcov, ucov, teta, q, masse, ps)
1250	! END IF ! of if (planet_type.EQ."earth")
1251	IF (ok_guide) THEN
1252	! set ok_guide to false to avoid extra output
1253	! in following forward step
1254	ok_guide = .FALSE.
1255	endif
1256
1257	ENDIF ! of IF(itau.EQ.itaufin)
1258
1259	forward = .TRUE.
1260	GO TO 1
1261
1262	ENDIF ! of IF (forward)
1263
1264	CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 1750')
1265
1266	END IF ! of IF(.NOT.purmats)
1267	!$OMP MASTER
1268	CALL fin_getparam
1269	!$OMP END MASTER
1270
1271	IF (ANY(type_trac == ['inca', 'inco'])) THEN
1272	CALL finalize_inca
1273	! switching back to LMDZDYN context
1274	!$OMP MASTER
1275	IF (ok_dyn_xios) THEN
1276	CALL xios_set_current_context(dyn3d_ctx_handle)
1277	ENDIF
1278	!$OMP END MASTER
1279	ENDIF
1280	#ifdef REPROBUS
1281	IF (type_trac == 'repr') CALL finalize_reprobus
1282	#endif
1283
1284	!$OMP MASTER
1285	CALL finalize_parallel
1286	!$OMP END MASTER
1287	abort_message = 'Simulation finished'
1288	CALL abort_gcm(modname, abort_message, 0)
1289
1290	END SUBROUTINE leapfrog_loc

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

Download in other formats:

Original Format