Context Navigation

leapfrog_loc.f90 @ 5444

Last change on this file since 5444 was 5324, checked in by abarral, 6 weeks ago
[WIP] Remove uses of DEBUGIO cpp key (deprecated)
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: 53.1 KB

Line
1	SUBROUTINE leapfrog_loc(ucov0,vcov0,teta0,ps0, &
2	masse0,phis0,q0,time_0)
3
4	USE iniprint_mod_h
5	USE comgeom_mod_h
6	USE comdissnew_mod_h
7	USE misc_mod
8	USE parallel_lmdz
9	USE times
10	USE mod_hallo
11	USE Bands
12	USE Write_Field
13	USE Write_Field_p
14	USE vampir
15	USE timer_filtre, ONLY : print_filtre_timer
16	USE infotrac
17	USE guide_loc_mod, ONLY : guide_main
18	USE getparam
19	USE control_mod
20	USE mod_filtreg_p
21	USE write_field_loc
22	USE allocate_field_mod
23	USE call_dissip_mod, ONLY : call_dissip
24	USE call_calfis_mod, ONLY : call_calfis
25	USE leapfrog_mod, ONLY : ucov,vcov,teta,ps,masse,phis,q,dq &
26	,ucovm1,vcovm1,tetam1,massem1,psm1,p,pks,pk,pkf,flxw &
27	,pbaru,pbarv,du,dv,dteta,phi,dp,w &
28	,leapfrog_allocate,leapfrog_switch_caldyn,leapfrog_switch_dissip
29
30	use exner_hyb_loc_m, only: exner_hyb_loc
31	use exner_milieu_loc_m, only: exner_milieu_loc
32	USE comconst_mod, ONLY: cpp, dtvr, ihf
33	USE comvert_mod, ONLY: ap, bp, pressure_exner
34	USE logic_mod, ONLY: iflag_phys,ok_guide,forward,leapf,apphys, &
35	statcl,conser,apdiss,purmats,ok_strato
36	USE temps_mod, ONLY: itaufin,jD_ref,jH_ref,day_ini, &
37	day_ref,start_time,dt
38	USE mod_xios_dyn3dmem, ONLY : dyn3d_ctx_handle
39	USE lmdz_xios, ONLY: xios_update_calendar, &
40	xios_set_current_context, &
41	using_xios
42	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS
43	USE lmdz_reprobus_wrappers, ONLY: finalize_reprobus
44	USE strings_mod, ONLY: int2str
45
46	USE dimensions_mod, ONLY: iim, jjm, llm, ndm
47	USE paramet_mod_h
48	USE academic_mod_h, ONLY: tetarappel, knewt_t, knewt_g, clat4
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	REAL,INTENT(IN) :: time_0 ! not used
82
83	! dynamical variables:
84	REAL,INTENT(IN) :: ucov0(ijb_u:ije_u,llm) ! zonal covariant wind
85	REAL,INTENT(IN) :: vcov0(ijb_v:ije_v,llm) ! meridional covariant wind
86	REAL,INTENT(IN) :: teta0(ijb_u:ije_u,llm) ! potential temperature
87	REAL,INTENT(IN) :: q0(ijb_u:ije_u,llm,nqtot) ! advected tracers
88	REAL,INTENT(IN) :: ps0(ijb_u:ije_u) ! surface pressure (Pa)
89	REAL,INTENT(IN) :: masse0(ijb_u:ije_u,llm) ! air mass
90	REAL,INTENT(IN) :: phis0(ijb_u:ije_u) ! geopotentiat at the surface
91
92	real :: zqmin,zqmax
93
94	! REAL,SAVE,ALLOCATABLE :: p (:,: ) ! pression aux interfac.des couches
95	! REAL,SAVE,ALLOCATABLE :: pks(:) ! exner au sol
96	! REAL,SAVE,ALLOCATABLE :: pk(:,:) ! exner au milieu des couches
97	! REAL,SAVE,ALLOCATABLE :: pkf(:,:) ! exner filt.au milieu des couches
98	! REAL,SAVE,ALLOCATABLE :: phi(:,:) ! geopotentiel
99	! REAL,SAVE,ALLOCATABLE :: w(:,:) ! vitesse verticale
100
101	! variables dynamiques intermediaire pour le transport
102	! REAL,SAVE,ALLOCATABLE :: pbaru(:,:),pbarv(:,:) !flux de masse
103
104	! variables dynamiques au pas -1
105	! REAL,SAVE,ALLOCATABLE :: vcovm1(:,:),ucovm1(:,:)
106	! REAL,SAVE,ALLOCATABLE :: tetam1(:,:),psm1(:)
107	! REAL,SAVE,ALLOCATABLE :: massem1(:,:)
108
109	! tendances dynamiques
110	! REAL,SAVE,ALLOCATABLE :: dv(:,:),du(:,:)
111	! REAL,SAVE,ALLOCATABLE :: dteta(:,:),dp(:)
112	! REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq
113
114	! tendances de la dissipation
115	! REAL,SAVE,ALLOCATABLE :: dvdis(:,:),dudis(:,:)
116	! REAL,SAVE,ALLOCATABLE :: dtetadis(:,:)
117
118	! tendances physiques
119	REAL,SAVE,ALLOCATABLE :: dvfi(:,:),dufi(:,:)
120	REAL,SAVE,ALLOCATABLE :: dtetafi(:,:)
121	REAL,SAVE,ALLOCATABLE :: dpfi(:)
122	REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi
123
124	! variables pour le fichier histoire
125	REAL :: dtav ! intervalle de temps elementaire
126
127	REAL :: tppn(iim),tpps(iim),tpn,tps
128	!
129	INTEGER :: itau,itaufinp1,iav
130	! INTEGER iday ! jour julien
131	REAL :: time
132
133	REAL :: SSUM
134	! REAL,SAVE,ALLOCATABLE :: finvmaold(:,:)
135
136	!ym LOGICAL lafin
137	LOGICAL :: lafin
138	INTEGER :: ij,iq,l
139	INTEGER :: ik
140
141	real :: time_step, t_wrt, t_ops
142
143	! jD_cur: jour julien courant
144	! jH_cur: heure julienne courante
145	REAL :: jD_cur, jH_cur
146	INTEGER :: an, mois, jour
147	REAL :: secondes
148
149	logical :: physic
150	LOGICAL :: first,callinigrads
151
152	data callinigrads/.true./
153	character(len=10) :: string10
154
155	! REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale
156
157	!+jld variables test conservation energie
158	! REAL,SAVE,ALLOCATABLE :: ecin(:,:),ecin0(:,:)
159	! Tendance de la temp. potentiel d (theta)/ d t due a la
160	! tansformation d'energie cinetique en energie thermique
161	! cree par la dissipation
162	! REAL,SAVE,ALLOCATABLE :: dtetaecdt(:,:)
163	! REAL,SAVE,ALLOCATABLE :: vcont(:,:),ucont(:,:)
164	! REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
165	REAL :: d_h_vcol, d_qt, d_qw, d_ql, d_ec
166	CHARACTER(len=15) :: ztit
167	!! INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.
168	! SAVE ip_ebil_dyn
169	! DATA ip_ebil_dyn/0/
170	!-jld
171
172	character(len=80) :: dynhist_file, dynhistave_file
173	character(len=*),parameter :: modname="leapfrog_loc"
174	character(len=80) :: abort_message
175
176
177	logical,PARAMETER :: dissip_conservative=.TRUE.
178
179	INTEGER :: testita
180	PARAMETER (testita = 9)
181
182	logical , parameter :: flag_verif = .false.
183
184	! declaration liees au parallelisme
185	INTEGER :: ierr
186	LOGICAL :: FirstCaldyn
187	LOGICAL :: FirstPhysic
188	INTEGER :: ijb,ije,j,i
189	type(Request) :: TestRequest
190	type(Request) :: Request_Dissip
191	type(Request) :: Request_physic
192
193	INTEGER :: true_itau
194	INTEGER :: iapptrac
195	INTEGER :: AdjustCount
196	! INTEGER :: var_time
197	LOGICAL :: ok_start_timer=.FALSE.
198	LOGICAL, SAVE :: firstcall=.TRUE.
199	TYPE(distrib),SAVE :: new_dist
200
201	call check_isotopes(q0,ijb_u,ije_u,'leapfrog204: debut')
202
203	!$OMP MASTER
204	ItCount=0
205	!$OMP END MASTER
206	true_itau=0
207	FirstCaldyn=.TRUE.
208	FirstPhysic=.TRUE.
209	iapptrac=0
210	AdjustCount = 0
211	lafin=.false.
212
213	if (nday>=0) then
214	itaufin = nday*day_step
215	else
216	itaufin = -nday
217	endif
218
219	itaufinp1 = itaufin +1
220
221	call check_isotopes(q0,ijb_u,ije_u,'leapfrog 226')
222
223	itau = 0
224	physic=.true.
225	if (iflag_phys==0.or.iflag_phys==2) physic=.false.
226	CALL init_nan
227	CALL leapfrog_allocate
228	ucov=ucov0
229	vcov=vcov0
230	teta=teta0
231	ps=ps0
232	masse=masse0
233	phis=phis0
234	q=q0
235
236	call check_isotopes(q,ijb_u,ije_u,'leapfrog 239')
237
238	! iday = day_ini+itau/day_step
239	! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
240	! IF(time.GT.1.) THEN
241	! time = time-1.
242	! iday = iday+1
243	! ENDIF
244
245	! Allocate variables depending on dynamic variable nqtot
246	!$OMP MASTER
247	if (firstcall) then
248	!
249	! ALLOCATE(p(ijb_u:ije_u,llmp1))
250	! ALLOCATE(pks(ijb_u:ije_u))
251	! ALLOCATE(pk(ijb_u:ije_u,llm))
252	! ALLOCATE(pkf(ijb_u:ije_u,llm))
253	! ALLOCATE(phi(ijb_u:ije_u,llm))
254	! ALLOCATE(w(ijb_u:ije_u,llm))
255	! ALLOCATE(pbaru(ip1jmp1,llm),pbarv(ip1jm,llm))
256	! ALLOCATE(vcovm1(ijb_v:ije_v,llm),ucovm1(ijb_u:ije_u,llm))
257	! ALLOCATE(tetam1(ijb_u:ije_u,llm),psm1(ijb_u:ije_u))
258	! ALLOCATE(massem1(ijb_u:ije_u,llm))
259	! ALLOCATE(dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm))
260	! ALLOCATE(dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u))
261	! ALLOCATE(dvdis(ijb_v:ije_v,llm),dudis(ijb_u:ije_u,llm))
262	! ALLOCATE(dtetadis(ijb_u:ije_u,llm))
263	ALLOCATE(dvfi(ijb_v:ije_v,llm),dufi(ijb_u:ije_u,llm))
264	ALLOCATE(dtetafi(ijb_u:ije_u,llm))
265	ALLOCATE(dpfi(ijb_u:ije_u))
266	! ALLOCATE(dq(ijb_u:ije_u,llm,nqtot))
267	ALLOCATE(dqfi(ijb_u:ije_u,llm,nqtot))
268	! ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
269	! ALLOCATE(finvmaold(ijb_u:ije_u,llm))
270	! ALLOCATE(flxw(ijb_u:ije_u,llm))
271	! ALLOCATE(ecin(ijb_u:ije_u,llm),ecin0(ijb_u:ije_u,llm))
272	! ALLOCATE(dtetaecdt(ijb_u:ije_u,llm))
273	! ALLOCATE(vcont(ijb_v:ije_v,llm),ucont(ijb_u:ije_u,llm))
274	! ALLOCATE(vnat(ijb_v:ije_v,llm),unat(ijb_u:ije_u,llm))
275	endif
276	!$OMP END MASTER
277	!$OMP BARRIER
278
279	! CALL dynredem1_loc("restart.nc",0.0,
280	! & vcov,ucov,teta,q,masse,ps)
281
282
283	!-----------------------------------------------------------------------
284	! On initialise la pression et la fonction d'Exner :
285	! --------------------------------------------------
286
287	!$OMP MASTER
288	dq(:,:,:)=0.
289	CALL pression ( ijnb_u, ap, bp, ps, p )
290	!$OMP END MASTER
291	if (pressure_exner) then
292	CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf)
293	else
294	CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf )
295	endif
296	!-----------------------------------------------------------------------
297	! Debut de l'integration temporelle:
298	! ----------------------------------
299	! et du parallelisme !!
300
301	1 CONTINUE ! Matsuno Forward step begins here
302
303	! date: (NB: date remains unchanged for Backward step)
304	! -----
305
306	jD_cur = jD_ref + day_ini - day_ref + &
307	(itau+1)/day_step
308	jH_cur = jH_ref + start_time + &
309	mod(itau+1,day_step)/float(day_step)
310	if (jH_cur > 1.0 ) then
311	jD_cur = jD_cur +1.
312	jH_cur = jH_cur -1.
313	endif
314
315	call check_isotopes(q,ijb_u,ije_u,'leapfrog 321')
316
317	if (ok_guide) then
318	call guide_main(itau,ucov,vcov,teta,q,masse,ps)
319	!$OMP BARRIER
320	endif
321
322
323
324	!
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
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
394	call check_isotopes(q,ijb_u,ije_u,'leapfrog 400')
395
396	2 CONTINUE ! Matsuno backward or leapfrog step begins here
397
398
399	call check_isotopes(q,ijb_u,ije_u,'leapfrog 402')
400
401	!$OMP MASTER
402	ItCount=ItCount+1
403	if (MOD(ItCount,1)==1) then
404	debug=.true.
405	else
406	debug=.false.
407	endif
408	!$OMP END MASTER
409	!-----------------------------------------------------------------------
410
411	! date: (NB: only leapfrog step requires recomputing date)
412	! -----
413
414	IF (leapf) THEN
415	jD_cur = jD_ref + day_ini - day_ref + &
416	(itau+1)/day_step
417	jH_cur = jH_ref + start_time + &
418	mod(itau+1,day_step)/float(day_step)
419	if (jH_cur > 1.0 ) then
420	jD_cur = jD_cur +1.
421	jH_cur = jH_cur -1.
422	endif
423	ENDIF
424
425	! gestion des appels de la physique et des dissipations:
426	! ------------------------------------------------------
427	!
428	! ... P.Le Van ( 6/02/95 ) ....
429
430	apphys = .FALSE.
431	statcl = .FALSE.
432	conser = .FALSE.
433	apdiss = .FALSE.
434
435	IF( purmats ) THEN
436	! ! Purely Matsuno time stepping
437	IF( MOD(itau,iconser) .EQ.0.AND. forward ) conser = .TRUE.
438	IF( MOD(itau,dissip_period ).EQ.0.AND..NOT.forward ) &
439	apdiss = .TRUE.
440	IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward &
441	.and. physic ) apphys = .TRUE.
442	ELSE
443	! ! Leapfrog/Matsuno time stepping
444	IF( MOD(itau ,iconser) .EQ. 0 ) conser = .TRUE.
445	IF( MOD(itau+1,dissip_period).EQ.0 .AND. .NOT. forward ) &
446	apdiss = .TRUE.
447	IF( MOD(itau+1,iphysiq).EQ.0.AND.physic) apphys=.TRUE.
448	END IF
449
450	! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
451	! supress dissipation step
452	if (llm.eq.1) then
453	apdiss=.false.
454	endif
455
456	!ym ---> Pour le moment
457	!ym apphys = .FALSE.
458	statcl = .FALSE.
459	! conser = .FALSE. ! ie: no output of control variables to stdout in //
460
461	if (firstCaldyn) then
462	!$OMP MASTER
463	call Set_Distrib(distrib_caldyn)
464	!$OMP END MASTER
465	!$OMP BARRIER
466	firstCaldyn=.FALSE.
467	!ym call InitTime
468	!$OMP MASTER
469	call Init_timer
470	!$OMP END MASTER
471	endif
472
473	!$OMP MASTER
474	IF (ok_start_timer) THEN
475	CALL InitTime
476	ok_start_timer=.FALSE.
477	ENDIF
478	!$OMP END MASTER
479
480
481	call check_isotopes(q,ijb_u,ije_u,'leapfrog 471')
482
483	!ym PAS D'AJUSTEMENT POUR LE MOMENT
484	if (Adjust) then
485	AdjustCount=AdjustCount+1
486	! if (iapptrac==iapp_tracvl .and. (forward.OR. leapf)
487	! & .and. itau/iphysiq>2 .and. Adjustcount>30) then
488	if (Adjustcount>1) then
489	AdjustCount=0
490	!$OMP MASTER
491	call allgather_timer_average
492
493	if (prt_level > 9) then
494
495	print ,'********************************'
496	print ,'*** TIMER CALDYN ****'
497	do i=0,mpi_size-1
498	print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i), &
499	' : temps moyen :', &
500	timer_average(jj_nb_caldyn(i),timer_caldyn,i), &
501	'+-',timer_delta(jj_nb_caldyn(i),timer_caldyn,i)
502	enddo
503
504	print ,'********************************'
505	print ,'*** TIMER VANLEER ****'
506	do i=0,mpi_size-1
507	print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i), &
508	' : temps moyen :', &
509	timer_average(jj_nb_vanleer(i),timer_vanleer,i), &
510	'+-',timer_delta(jj_nb_vanleer(i),timer_vanleer,i)
511	enddo
512
513	print ,'********************************'
514	print ,'*** TIMER DISSIP ****'
515	do i=0,mpi_size-1
516	print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i), &
517	' : temps moyen :', &
518	timer_average(jj_nb_dissip(i),timer_dissip,i), &
519	'+-',timer_delta(jj_nb_dissip(i),timer_dissip,i)
520	enddo
521
522	! if (mpi_rank==0) call WriteBands
523
524	endif
525
526	call AdjustBands_caldyn(new_dist)
527	!$OMP END MASTER
528	!$OMP BARRIER
529	CALL leapfrog_switch_caldyn(new_dist)
530	!$OMP BARRIER
531
532
533	!$OMP MASTER
534	distrib_caldyn=new_dist
535	CALL set_distrib(distrib_caldyn)
536	!$OMP END MASTER
537	!$OMP BARRIER
538	! call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm,
539	! & jj_Nb_caldyn,0,0,TestRequest)
540	! call Register_SwapFieldHallo(ucovm1,ucovm1,ip1jmp1,llm,
541	! & jj_Nb_caldyn,0,0,TestRequest)
542	! call Register_SwapFieldHallo(vcov,vcov,ip1jm,llm,
543	! & jj_Nb_caldyn,0,0,TestRequest)
544	! call Register_SwapFieldHallo(vcovm1,vcovm1,ip1jm,llm,
545	! & jj_Nb_caldyn,0,0,TestRequest)
546	! call Register_SwapFieldHallo(teta,teta,ip1jmp1,llm,
547	! & jj_Nb_caldyn,0,0,TestRequest)
548	! call Register_SwapFieldHallo(tetam1,tetam1,ip1jmp1,llm,
549	! & jj_Nb_caldyn,0,0,TestRequest)
550	! call Register_SwapFieldHallo(masse,masse,ip1jmp1,llm,
551	! & jj_Nb_caldyn,0,0,TestRequest)
552	! call Register_SwapFieldHallo(massem1,massem1,ip1jmp1,llm,
553	! & jj_Nb_caldyn,0,0,TestRequest)
554	! call Register_SwapFieldHallo(ps,ps,ip1jmp1,1,
555	! & jj_Nb_caldyn,0,0,TestRequest)
556	! call Register_SwapFieldHallo(psm1,psm1,ip1jmp1,1,
557	! & jj_Nb_caldyn,0,0,TestRequest)
558	! call Register_SwapFieldHallo(pkf,pkf,ip1jmp1,llm,
559	! & jj_Nb_caldyn,0,0,TestRequest)
560	! call Register_SwapFieldHallo(pk,pk,ip1jmp1,llm,
561	! & jj_Nb_caldyn,0,0,TestRequest)
562	! call Register_SwapFieldHallo(pks,pks,ip1jmp1,1,
563	! & jj_Nb_caldyn,0,0,TestRequest)
564	! call Register_SwapFieldHallo(phis,phis,ip1jmp1,1,
565	! & jj_Nb_caldyn,0,0,TestRequest)
566	! call Register_SwapFieldHallo(phi,phi,ip1jmp1,llm,
567	! & jj_Nb_caldyn,0,0,TestRequest)
568	! call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,
569	! & jj_Nb_caldyn,0,0,TestRequest)
570	!
571	! do j=1,nqtot
572	! call Register_SwapFieldHallo(q(:,:,j),q(:,:,j),ip1jmp1,llm,
573	! & jj_nb_caldyn,0,0,TestRequest)
574	! enddo
575	!
576	! call Set_Distrib(distrib_caldyn)
577	! call SendRequest(TestRequest)
578	! call WaitRequest(TestRequest)
579
580	!$OMP MASTER
581	call AdjustBands_dissip(new_dist)
582	!$OMP END MASTER
583	!$OMP BARRIER
584	CALL leapfrog_switch_dissip(new_dist)
585	!$OMP BARRIER
586	!$OMP MASTER
587	distrib_dissip=new_dist
588	!$OMP END MASTER
589	!$OMP BARRIER
590	! call AdjustBands_physic
591
592	!$OMP MASTER
593	if (mpi_rank==0) call WriteBands
594	!$OMP END MASTER
595
596
597	endif
598	endif
599
600
601	call check_isotopes(q,ijb_u,ije_u,'leapfrog 589')
602
603	!-----------------------------------------------------------------------
604	! calcul des tendances dynamiques:
605	! --------------------------------
606	!$OMP BARRIER
607	!$OMP MASTER
608	call VTb(VThallo)
609	!$OMP END MASTER
610
611	call Register_Hallo_u(ucov,llm,1,1,1,1,TestRequest)
612	call Register_Hallo_v(vcov,llm,1,1,1,1,TestRequest)
613	call Register_Hallo_u(teta,llm,1,1,1,1,TestRequest)
614	call Register_Hallo_u(ps,1,1,2,2,1,TestRequest)
615	call Register_Hallo_u(pkf,llm,1,1,1,1,TestRequest)
616	call Register_Hallo_u(pk,llm,1,1,1,1,TestRequest)
617	call Register_Hallo_u(pks,1,1,1,1,1,TestRequest)
618	call Register_Hallo_u(p,llmp1,1,1,1,1,TestRequest)
619
620	! do j=1,nqtot
621	! call Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1,
622	! * TestRequest)
623	! enddo
624
625	call SendRequest(TestRequest)
626	!$OMP BARRIER
627	call WaitRequest(TestRequest)
628
629	!$OMP MASTER
630	call VTe(VThallo)
631	!$OMP END MASTER
632	!$OMP BARRIER
633
634	if (debug) then
635	call WriteField_u('ucov',ucov)
636	call WriteField_v('vcov',vcov)
637	call WriteField_u('teta',teta)
638	call WriteField_u('ps',ps)
639	call WriteField_u('masse',masse)
640	call WriteField_u('pk',pk)
641	call WriteField_u('pks',pks)
642	call WriteField_u('pkf',pkf)
643	call WriteField_u('phis',phis)
644	do iq=1,nqtot
645	call WriteField_u('q'//trim(int2str(iq)), &
646	q(:,:,iq))
647	enddo
648	endif
649
650
651	True_itau=True_itau+1
652
653	!$OMP MASTER
654	IF (prt_level>9) THEN
655	WRITE(lunout,*)"leapfrog_p: Iteration No",True_itau
656	ENDIF
657
658
659	call start_timer(timer_caldyn)
660
661	! ! compute geopotential phi()
662	CALL geopot_loc ( ip1jmp1, teta , pk , pks, phis , phi )
663
664	call check_isotopes(q,ijb_u,ije_u,'leapfrog 651')
665
666	call VTb(VTcaldyn)
667	!$OMP END MASTER
668	! var_time=time+iday-day_ini
669
670	!$OMP BARRIER
671	! CALL FTRACE_REGION_BEGIN("caldyn")
672	time = jD_cur + jH_cur
673
674	CALL caldyn_loc &
675	( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , &
676	phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time )
677
678	! CALL FTRACE_REGION_END("caldyn")
679
680	!$OMP MASTER
681	if (mpi_rank==0.AND.conser) THEN
682	WRITE(lunout,*) 'leapfrog_loc, Time step: ',itau,' Day:',time
683	ENDIF
684	call VTe(VTcaldyn)
685	!$OMP END MASTER
686
687	!-----------------------------------------------------------------------
688	! calcul des tendances advection des traceurs (dont l'humidite)
689	! -------------------------------------------------------------
690
691	call check_isotopes(q,ijb_u,ije_u, &
692	'leapfrog 686: avant caladvtrac')
693
694	IF( forward.OR. leapf ) THEN
695	! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step
696	! !write(,) 'leapfrog 679: avant CALL caladvtrac_loc'
697	CALL caladvtrac_loc(q,pbaru,pbarv, &
698	p, masse, dq, teta, &
699	flxw,pk, iapptrac)
700
701	! call creation of mass flux
702	IF (offline .AND. .NOT. adjust) THEN
703	CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi)
704	ENDIF
705
706	! !write(,) 'leapfrog 719'
707	call check_isotopes(q,ijb_u,ije_u, &
708	'leapfrog 698: apres caladvtrac')
709
710	! do j=1,nqtot
711	! call WriteField_u('qadv'//trim(int2str(j)),q(:,:,j))
712	! enddo
713
714	! Ehouarn: Storage of mass flux for off-line tracers... not implemented...
715
716	ENDIF ! of IF( forward.OR. leapf )
717
718
719	!-----------------------------------------------------------------------
720	! integrations dynamique et traceurs:
721	! ----------------------------------
722
723	!$OMP MASTER
724	call VTb(VTintegre)
725	!$OMP END MASTER
726	!$OMP BARRIER
727	! CALL FTRACE_REGION_BEGIN("integrd")
728
729	! !write(,) 'leapfrog 720'
730	call check_isotopes(q,ijb_u,ije_u,'leapfrog 756')
731
732	! ! CRisi: pourquoi aller jusqu'à 2 et non pas jusqu'à nqtot??
733	CALL integrd_loc ( nqtot,vcovm1,ucovm1,tetam1,psm1,massem1 , &
734	dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis)
735	! $ finvmaold )
736
737	! !write(,) 'leapfrog 724'
738	call check_isotopes(q,ijb_u,ije_u,'leapfrog 762')
739
740	! CALL FTRACE_REGION_END("integrd")
741	!$OMP BARRIER
742
743	call check_isotopes(q,ijb_u,ije_u,'leapfrog 775')
744
745	! do j=1,nqtot
746	! call WriteField_p('q'//trim(int2str(j)),
747	! . reshape(q(:,:,j),(/iip1,jmp1,llm/)))
748	! call WriteField_p('dq'//trim(int2str(j)),
749	! . reshape(dq(:,:,j),(/iip1,jmp1,llm/)))
750	! enddo
751
752
753	!$OMP MASTER
754	call VTe(VTintegre)
755	!$OMP END MASTER
756	! .P.Le Van (26/04/94 ajout de finvpold dans l'appel d'integrd)
757	!
758	!-----------------------------------------------------------------------
759	! calcul des tendances physiques:
760	! -------------------------------
761	! ######## P.Le Van ( Modif le 6/02/95 ) ###########
762	!
763	IF( purmats ) THEN
764	IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE.
765	ELSE
766	IF( itau+1.EQ. itaufin ) lafin = .TRUE.
767	ENDIF
768
769	!c$OMP END PARALLEL
770
771	!
772	!
773	IF( apphys ) THEN
774
775	CALL call_calfis(itau,lafin,ucov,vcov,teta,masse,ps, &
776	phis,q,flxw)
777	! #ifdef DEBUG_IO
778	! call WriteField_u('ucovfi',ucov)
779	! call WriteField_v('vcovfi',vcov)
780	! call WriteField_u('tetafi',teta)
781	! call WriteField_u('pfi',p)
782	! call WriteField_u('pkfi',pk)
783	! do j=1,nqtot
784	! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
785	! enddo
786	! #endif
787	! c
788	! c ....... Ajout P.Le Van ( 17/04/96 ) ...........
789	! c
790	! cc$OMP PARALLEL DEFAULT(SHARED)
791	! cc$OMP+ PRIVATE(rdaym_ini,rdayvrai,ijb,ije)
792
793	! c$OMP MASTER
794	! call suspend_timer(timer_caldyn)
795
796	! write(lunout,*)
797	! & 'leapfrog_p: Entree dans la physique : Iteration No ',true_itau
798	! c$OMP END MASTER
799
800	! CALL pression_loc ( ip1jmp1, ap, bp, ps, p )
801
802	! c$OMP BARRIER
803	! CALL exner_hyb_loc( ip1jmp1, ps, p,pks, pk, pkf )
804	! c$OMP BARRIER
805	! jD_cur = jD_ref + day_ini - day_ref
806	! $ + int (itau * dtvr / daysec)
807	! jH_cur = jH_ref + &
808	! & (itau * dtvr / daysec - int(itau * dtvr / daysec))
809	! ! call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
810
811	! c rajout debug
812	! c lafin = .true.
813
814
815	! c Inbterface avec les routines de phylmd (phymars ... )
816	! c -----------------------------------------------------
817
818	! c+jld
819
820	! c Diagnostique de conservation de l'energie : initialisation
821	!
822	! c-jld
823	! c$OMP BARRIER
824	! c$OMP MASTER
825	! call VTb(VThallo)
826	! c$OMP END MASTER
827
828	! #ifdef DEBUG_IO
829	! call WriteField_u('ucovfi',ucov)
830	! call WriteField_v('vcovfi',vcov)
831	! call WriteField_u('tetafi',teta)
832	! call WriteField_u('pfi',p)
833	! call WriteField_u('pkfi',pk)
834	! #endif
835	! call SetTag(Request_physic,800)
836	!
837	! call Register_SwapField_u(ucov,ucov,distrib_physic,
838	! * Request_physic,up=2,down=2)
839	!
840	! call Register_SwapField_v(vcov,vcov,distrib_physic,
841	! * Request_physic,up=2,down=2)
842
843	! call Register_SwapField_u(teta,teta,distrib_physic,
844	! * Request_physic,up=2,down=2)
845	!
846	! call Register_SwapField_u(masse,masse,distrib_physic,
847	! * Request_physic,up=1,down=2)
848
849	! call Register_SwapField_u(p,p,distrib_physic,
850	! * Request_physic,up=2,down=2)
851	!
852	! call Register_SwapField_u(pk,pk,distrib_physic,
853	! * Request_physic,up=2,down=2)
854	!
855	! call Register_SwapField_u(phis,phis,distrib_physic,
856	! * Request_physic,up=2,down=2)
857	!
858	! call Register_SwapField_u(phi,phi,distrib_physic,
859	! * Request_physic,up=2,down=2)
860	!
861	! call Register_SwapField_u(w,w,distrib_physic,
862	! * Request_physic,up=2,down=2)
863	!
864	! call Register_SwapField_u(q,q,distrib_physic,
865	! * Request_physic,up=2,down=2)
866
867	! call Register_SwapField_u(flxw,flxw,distrib_physic,
868	! * Request_physic,up=2,down=2)
869	!
870	! call SendRequest(Request_Physic)
871	! c$OMP BARRIER
872	! call WaitRequest(Request_Physic)
873
874	! c$OMP BARRIER
875	! c$OMP MASTER
876	! call Set_Distrib(distrib_Physic)
877	! call VTe(VThallo)
878	!
879	! call VTb(VTphysiq)
880	! c$OMP END MASTER
881	! c$OMP BARRIER
882
883	! #ifdef DEBUG_IO
884	! call WriteField_u('ucovfi',ucov)
885	! call WriteField_v('vcovfi',vcov)
886	! call WriteField_u('tetafi',teta)
887	! call WriteField_u('pfi',p)
888	! call WriteField_u('pkfi',pk)
889	! do j=1,nqtot
890	! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
891	! enddo
892	! #endif
893	! STOP
894	! c$OMP BARRIER
895	! ! CALL FTRACE_REGION_BEGIN("calfis")
896	! CALL calfis_loc(lafin ,jD_cur, jH_cur,
897	! $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
898	! $ du,dv,dteta,dq,
899	! $ flxw,
900	! $ dufi,dvfi,dtetafi,dqfi,dpfi )
901	! ! CALL FTRACE_REGION_END("calfis")
902	! ! ijb=ij_begin
903	! ! ije=ij_end
904	! ! if ( .not. pole_nord) then
905	! !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
906	! ! DO l=1,llm
907	! ! dufi_tmp(1:iip1,l) = dufi(ijb:ijb+iim,l)
908	! ! dvfi_tmp(1:iip1,l) = dvfi(ijb:ijb+iim,l)
909	! ! dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l)
910	! ! dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:)
911	! ! ENDDO
912	! !c$OMP END DO NOWAIT
913	! !
914	! !c$OMP MASTER
915	! ! dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim)
916	! !c$OMP END MASTER
917	! ! endif ! of if ( .not. pole_nord)
918
919	! !c$OMP BARRIER
920	! !c$OMP MASTER
921	! ! call Set_Distrib(distrib_physic_bis)
922
923	! ! call VTb(VThallo)
924	! !c$OMP END MASTER
925	! !c$OMP BARRIER
926	! !
927	! ! call Register_Hallo_u(dufi,llm,
928	! ! * 1,0,0,1,Request_physic)
929	! !
930	! ! call Register_Hallo_v(dvfi,llm,
931	! ! * 1,0,0,1,Request_physic)
932	! !
933	! ! call Register_Hallo_u(dtetafi,llm,
934	! ! * 1,0,0,1,Request_physic)
935	! !
936	! ! call Register_Hallo_u(dpfi,1,
937	! ! * 1,0,0,1,Request_physic)
938	! !
939	! ! do j=1,nqtot
940	! ! call Register_Hallo_u(dqfi(ijb_u,1,j),llm,
941	! ! * 1,0,0,1,Request_physic)
942	! ! enddo
943	! !
944	! ! call SendRequest(Request_Physic)
945	! !c$OMP BARRIER
946	! ! call WaitRequest(Request_Physic)
947	! !
948	! !c$OMP BARRIER
949	! !c$OMP MASTER
950	! ! call VTe(VThallo)
951	! !
952	! ! call set_Distrib(distrib_Physic)
953	! !c$OMP END MASTER
954	! !c$OMP BARRIER
955	! ! ijb=ij_begin
956	! ! if (.not. pole_nord) then
957	! !
958	! !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
959	! ! DO l=1,llm
960	! ! dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
961	! ! dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
962	! ! dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)
963	! ! & +dtetafi_tmp(1:iip1,l)
964	! ! dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:)
965	! ! & + dqfi_tmp(1:iip1,l,:)
966	! ! ENDDO
967	! !c$OMP END DO NOWAIT
968	! !
969	! !c$OMP MASTER
970	! ! dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
971	! !c$OMP END MASTER
972	! !
973	! ! endif ! of if (.not. pole_nord)
974
975	! #ifdef DEBUG_IO
976	! call WriteField_u('dufi',dufi)
977	! call WriteField_v('dvfi',dvfi)
978	! call WriteField_u('dtetafi',dtetafi)
979	! call WriteField_u('dpfi',dpfi)
980	! do j=1,nqtot
981	! call WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j))
982	! enddo
983	! #endif
984
985	! c$OMP BARRIER
986
987	! c ajout des tendances physiques:
988	! c ------------------------------
989	! #ifdef DEBUG_IO
990	! call WriteField_u('ucovfi',ucov)
991	! call WriteField_v('vcovfi',vcov)
992	! call WriteField_u('tetafi',teta)
993	! call WriteField_u('psfi',ps)
994	! do j=1,nqtot
995	! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
996	! enddo
997	! #endif
998
999	! IF (ok_strato) THEN
1000	! CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
1001	! ENDIF
1002
1003	! #ifdef DEBUG_IO
1004	! call WriteField_u('ucovfi',ucov)
1005	! call WriteField_v('vcovfi',vcov)
1006	! call WriteField_u('tetafi',teta)
1007	! call WriteField_u('psfi',ps)
1008	! do j=1,nqtot
1009	! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
1010	! enddo
1011	! #endif
1012
1013	! CALL addfi_loc( dtphys, leapf, forward ,
1014	! $ ucov, vcov, teta , q ,ps ,
1015	! $ dufi, dvfi, dtetafi , dqfi ,dpfi )
1016
1017	! #ifdef DEBUG_IO
1018	! call WriteField_u('ucovfi',ucov)
1019	! call WriteField_v('vcovfi',vcov)
1020	! call WriteField_u('tetafi',teta)
1021	! call WriteField_u('psfi',ps)
1022	! do j=1,nqtot
1023	! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
1024	! enddo
1025	! #endif
1026
1027	! c$OMP BARRIER
1028	! c$OMP MASTER
1029	! call VTe(VTphysiq)
1030
1031	! call VTb(VThallo)
1032	! c$OMP END MASTER
1033
1034	! call SetTag(Request_physic,800)
1035	! call Register_SwapField_u(ucov,ucov,
1036	! * distrib_caldyn,Request_physic)
1037	!
1038	! call Register_SwapField_v(vcov,vcov,
1039	! * distrib_caldyn,Request_physic)
1040	!
1041	! call Register_SwapField_u(teta,teta,
1042	! * distrib_caldyn,Request_physic)
1043	!
1044	! call Register_SwapField_u(masse,masse,
1045	! * distrib_caldyn,Request_physic)
1046
1047	! call Register_SwapField_u(p,p,
1048	! * distrib_caldyn,Request_physic)
1049	!
1050	! call Register_SwapField_u(pk,pk,
1051	! * distrib_caldyn,Request_physic)
1052	!
1053	! call Register_SwapField_u(phis,phis,
1054	! * distrib_caldyn,Request_physic)
1055	!
1056	! call Register_SwapField_u(phi,phi,
1057	! * distrib_caldyn,Request_physic)
1058	!
1059	! call Register_SwapField_u(w,w,
1060	! * distrib_caldyn,Request_physic)
1061
1062	! call Register_SwapField_u(q,q,
1063	! * distrib_caldyn,Request_physic)
1064	!
1065	! call SendRequest(Request_Physic)
1066	! c$OMP BARRIER
1067	! call WaitRequest(Request_Physic)
1068
1069	! c$OMP BARRIER
1070	! c$OMP MASTER
1071	! call VTe(VThallo)
1072	! call set_distrib(distrib_caldyn)
1073	! c$OMP END MASTER
1074	! c$OMP BARRIER
1075	! c
1076	! c Diagnostique de conservation de l'energie : difference
1077	! IF (ip_ebil_dyn.ge.1 ) THEN
1078	! ztit='bil phys'
1079	! CALL diagedyn(ztit,2,1,1,dtphys
1080	! e , ucov , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
1081	! ENDIF
1082
1083	! #ifdef DEBUG_IO
1084	! call WriteField_u('ucovfi',ucov)
1085	! call WriteField_v('vcovfi',vcov)
1086	! call WriteField_u('tetafi',teta)
1087	! call WriteField_u('psfi',ps)
1088	! do j=1,nqtot
1089	! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
1090	! enddo
1091	! #endif
1092
1093
1094	! c-jld
1095	!$OMP MASTER
1096	if (FirstPhysic) then
1097	ok_start_timer=.TRUE.
1098	FirstPhysic=.false.
1099	endif
1100	!$OMP END MASTER
1101	ENDIF ! of IF( apphys )
1102
1103	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1132')
1104	! !write(,) 'leapfrog 1134: iflag_phys=',iflag_phys
1105
1106	IF(iflag_phys.EQ.2) THEN ! "Newtonian" case
1107	!$OMP MASTER
1108	if (FirstPhysic) then
1109	ok_start_timer=.TRUE.
1110	FirstPhysic=.false.
1111	endif
1112	!$OMP END MASTER
1113
1114
1115	! Calcul academique de la physique = Rappel Newtonien + fritcion
1116	! --------------------------------------------------------------
1117	!ym teta(:,:)=teta(:,:)
1118	!ym s -iphysiqdtvr(teta(:,:)-tetarappel(:,:))/taurappel
1119	ijb=ij_begin
1120	ije=ij_end
1121	!LF teta(ijb:ije,:)=teta(ijb:ije,:)
1122	!LF s -iphysiqdtvr(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel
1123	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1124	do l=1,llm
1125	teta(ijb:ije,l)=teta(ijb:ije,l) -dtvr* &
1126	(teta(ijb:ije,l)-tetarappel(ijb:ije,l))* &
1127	(knewt_g+knewt_t(l)*clat4(ijb:ije))
1128	enddo
1129	!$OMP END DO
1130
1131	!$OMP MASTER
1132	if (planet_type.eq."giant") then
1133	! ! add an intrinsic heat flux at the base of the atmosphere
1134	teta(ijb:ije,1) = teta(ijb:ije,1) &
1135	+ dtvr * aire(ijb:ije) * ihf / cpp / masse(ijb:ije,1)
1136	endif
1137	!$OMP END MASTER
1138	!$OMP BARRIER
1139
1140
1141	call Register_Hallo_u(ucov,llm,0,1,1,0,Request_Physic)
1142	call Register_Hallo_v(vcov,llm,1,1,1,1,Request_Physic)
1143	call SendRequest(Request_Physic)
1144	!$OMP BARRIER
1145	call WaitRequest(Request_Physic)
1146	!$OMP BARRIER
1147	call friction_loc(ucov,vcov,dtvr)
1148	!$OMP BARRIER
1149
1150	! ! Sponge layer (if any)
1151	IF (ok_strato) THEN
1152	CALL top_bound_loc(vcov,ucov,teta,masse,dtvr)
1153	!$OMP BARRIER
1154	ENDIF ! of IF (ok_strato)
1155	ENDIF ! of IF(iflag_phys.EQ.2)
1156
1157
1158	CALL pression_loc ( ip1jmp1, ap, bp, ps, p )
1159	!$OMP BARRIER
1160	if (pressure_exner) then
1161	CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf )
1162	else
1163	CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf )
1164	endif
1165	!$OMP BARRIER
1166	CALL massdair_loc(p,masse)
1167	!$OMP BARRIER
1168
1169	!c$OMP END PARALLEL
1170	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1196')
1171
1172	!-----------------------------------------------------------------------
1173	! dissipation horizontale et verticale des petites echelles:
1174	! ----------------------------------------------------------
1175	! !write(,) 'leapfrog 1163: apdiss=',apdiss
1176	IF(apdiss) THEN
1177
1178	CALL call_dissip(ucov,vcov,teta,p,pk,ps)
1179	!cc$OMP PARALLEL DEFAULT(SHARED)
1180	!cc$OMP+ PRIVATE(ijb,ije,tppn,tpn,tpps,tps)
1181	!c$OMP MASTER
1182	! call suspend_timer(timer_caldyn)
1183	!
1184	!c print*,'Entree dans la dissipation : Iteration No ',true_itau
1185	!c calcul de l'energie cinetique avant dissipation
1186	!c print *,'Passage dans la dissipation'
1187
1188	! call VTb(VThallo)
1189	!c$OMP END MASTER
1190
1191	!c$OMP BARRIER
1192
1193	! call Register_SwapField_u(ucov,ucov,distrib_dissip,
1194	! * Request_dissip,up=1,down=1)
1195
1196	! call Register_SwapField_v(vcov,vcov,distrib_dissip,
1197	! * Request_dissip,up=1,down=1)
1198
1199	! call Register_SwapField_u(teta,teta,distrib_dissip,
1200	! * Request_dissip)
1201
1202	! call Register_SwapField_u(p,p,distrib_dissip,
1203	! * Request_dissip)
1204
1205	! call Register_SwapField_u(pk,pk,distrib_dissip,
1206	! * Request_dissip)
1207
1208	! call SendRequest(Request_dissip)
1209	!c$OMP BARRIER
1210	! call WaitRequest(Request_dissip)
1211
1212	!c$OMP BARRIER
1213	!c$OMP MASTER
1214	! call set_distrib(distrib_dissip)
1215	! call VTe(VThallo)
1216	! call VTb(VTdissipation)
1217	! call start_timer(timer_dissip)
1218	!c$OMP END MASTER
1219	!c$OMP BARRIER
1220
1221	! call covcont_loc(llm,ucov,vcov,ucont,vcont)
1222	! call enercin_loc(vcov,ucov,vcont,ucont,ecin0)
1223
1224	!c dissipation
1225
1226	!! CALL FTRACE_REGION_BEGIN("dissip")
1227	! CALL dissip_loc(vcov,ucov,teta,p,dvdis,dudis,dtetadis)
1228
1229	!#ifdef DEBUG_IO
1230	! call WriteField_u('dudis',dudis)
1231	! call WriteField_v('dvdis',dvdis)
1232	! call WriteField_u('dtetadis',dtetadis)
1233	!#endif
1234	!
1235	!! CALL FTRACE_REGION_END("dissip")
1236	!
1237	! ijb=ij_begin
1238	! ije=ij_end
1239	!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1240	! DO l=1,llm
1241	! ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l)
1242	! ENDDO
1243	!c$OMP END DO NOWAIT
1244	! if (pole_sud) ije=ije-iip1
1245	!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1246	! DO l=1,llm
1247	! vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l)
1248	! ENDDO
1249	!c$OMP END DO NOWAIT
1250
1251	!c teta=teta+dtetadis
1252
1253
1254	!c------------------------------------------------------------------------
1255	! if (dissip_conservative) then
1256	!C On rajoute la tendance due a la transform. Ec -> E therm. cree
1257	!C lors de la dissipation
1258	!c$OMP BARRIER
1259	!c$OMP MASTER
1260	! call suspend_timer(timer_dissip)
1261	! call VTb(VThallo)
1262	!c$OMP END MASTER
1263	! call Register_Hallo_u(ucov,llm,1,1,1,1,Request_Dissip)
1264	! call Register_Hallo_v(vcov,llm,1,1,1,1,Request_Dissip)
1265	! call SendRequest(Request_Dissip)
1266	!c$OMP BARRIER
1267	! call WaitRequest(Request_Dissip)
1268	!c$OMP MASTER
1269	! call VTe(VThallo)
1270	! call resume_timer(timer_dissip)
1271	!c$OMP END MASTER
1272	!c$OMP BARRIER
1273	! call covcont_loc(llm,ucov,vcov,ucont,vcont)
1274	! call enercin_loc(vcov,ucov,vcont,ucont,ecin)
1275	!
1276	! ijb=ij_begin
1277	! ije=ij_end
1278	!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1279	! do l=1,llm
1280	! do ij=ijb,ije
1281	! dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l)
1282	! dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l)
1283	! enddo
1284	! enddo
1285	!c$OMP END DO NOWAIT
1286	! endif
1287
1288	! ijb=ij_begin
1289	! ije=ij_end
1290	!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1291	! do l=1,llm
1292	! do ij=ijb,ije
1293	! teta(ij,l)=teta(ij,l)+dtetadis(ij,l)
1294	! enddo
1295	! enddo
1296	!c$OMP END DO NOWAIT
1297	!c------------------------------------------------------------------------
1298
1299
1300	!c ....... P. Le Van ( ajout le 17/04/96 ) ...........
1301	!c ... Calcul de la valeur moyenne, unique de h aux poles .....
1302	!c
1303
1304	! ijb=ij_begin
1305	! ije=ij_end
1306	!
1307	! if (pole_nord) then
1308	!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1309	! DO l = 1, llm
1310	! DO ij = 1,iim
1311	! tppn(ij) = aire( ij ) * teta( ij ,l)
1312	! ENDDO
1313	! tpn = SSUM(iim,tppn,1)/apoln
1314
1315	! DO ij = 1, iip1
1316	! teta( ij ,l) = tpn
1317	! ENDDO
1318	! ENDDO
1319	!c$OMP END DO NOWAIT
1320
1321	!c$OMP MASTER
1322	! DO ij = 1,iim
1323	! tppn(ij) = aire( ij ) * ps ( ij )
1324	! ENDDO
1325	! tpn = SSUM(iim,tppn,1)/apoln
1326	!
1327	! DO ij = 1, iip1
1328	! ps( ij ) = tpn
1329	! ENDDO
1330	!c$OMP END MASTER
1331	! endif
1332	!
1333	! if (pole_sud) then
1334	!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
1335	! DO l = 1, llm
1336	! DO ij = 1,iim
1337	! tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
1338	! ENDDO
1339	! tps = SSUM(iim,tpps,1)/apols
1340
1341	! DO ij = 1, iip1
1342	! teta(ij+ip1jm,l) = tps
1343	! ENDDO
1344	! ENDDO
1345	!c$OMP END DO NOWAIT
1346
1347	!c$OMP MASTER
1348	! DO ij = 1,iim
1349	! tpps(ij) = aire(ij+ip1jm) * ps (ij+ip1jm)
1350	! ENDDO
1351	! tps = SSUM(iim,tpps,1)/apols
1352	!
1353	! DO ij = 1, iip1
1354	! ps(ij+ip1jm) = tps
1355	! ENDDO
1356	!c$OMP END MASTER
1357	! endif
1358
1359
1360	!c$OMP BARRIER
1361	!c$OMP MASTER
1362	! call VTe(VTdissipation)
1363
1364	! call stop_timer(timer_dissip)
1365	!
1366	! call VTb(VThallo)
1367	!c$OMP END MASTER
1368	! call Register_SwapField_u(ucov,ucov,distrib_caldyn,
1369	! * Request_dissip)
1370
1371	! call Register_SwapField_v(vcov,vcov,distrib_caldyn,
1372	! * Request_dissip)
1373
1374	! call Register_SwapField_u(teta,teta,distrib_caldyn,
1375	! * Request_dissip)
1376
1377	! call Register_SwapField_u(p,p,distrib_caldyn,
1378	! * Request_dissip)
1379
1380	! call Register_SwapField_u(pk,pk,distrib_caldyn,
1381	! * Request_dissip)
1382
1383	! call SendRequest(Request_dissip)
1384	!c$OMP BARRIER
1385	! call WaitRequest(Request_dissip)
1386
1387	!c$OMP BARRIER
1388	!c$OMP MASTER
1389	! call set_distrib(distrib_caldyn)
1390	! call VTe(VThallo)
1391	! call resume_timer(timer_caldyn)
1392	!c print *,'fin dissipation'
1393	!c$OMP END MASTER
1394	!c$OMP BARRIER
1395	END IF ! of IF(apdiss)
1396
1397	!c$OMP END PARALLEL
1398
1399	! ajout debug
1400	! IF( lafin ) then
1401	! abort_message = 'Simulation finished'
1402	! call abort_gcm(modname,abort_message,0)
1403	! ENDIF
1404
1405	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1430')
1406
1407	! ********************************************************************
1408	! ********************************************************************
1409	! .... fin de l'integration dynamique et physique pour le pas itau ..
1410	! ********************************************************************
1411	! ********************************************************************
1412
1413	! preparation du pas d'integration suivant ......
1414	!ym call WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
1415	!ym call WriteField('vcov',reshape(vcov,(/iip1,jjm,llm/)))
1416	!$OMP MASTER
1417	call stop_timer(timer_caldyn)
1418	!$OMP END MASTER
1419	IF (itau==itaumax) then
1420	!$OMP MASTER
1421	call allgather_timer_average
1422	call barrier
1423	if (mpi_rank==0) then
1424
1425	print ,'********************************'
1426	print ,'*** TIMER CALDYN ****'
1427	do i=0,mpi_size-1
1428	print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i), &
1429	' : temps moyen :', &
1430	timer_average(jj_nb_caldyn(i),timer_caldyn,i)
1431	enddo
1432
1433	print ,'********************************'
1434	print ,'*** TIMER VANLEER ****'
1435	do i=0,mpi_size-1
1436	print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i), &
1437	' : temps moyen :', &
1438	timer_average(jj_nb_vanleer(i),timer_vanleer,i)
1439	enddo
1440
1441	print ,'********************************'
1442	print ,'*** TIMER DISSIP ****'
1443	do i=0,mpi_size-1
1444	print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i), &
1445	' : temps moyen :', &
1446	timer_average(jj_nb_dissip(i),timer_dissip,i)
1447	enddo
1448
1449	print ,'********************************'
1450	print ,'*** TIMER PHYSIC ****'
1451	do i=0,mpi_size-1
1452	print *,'proc',i,' : Nb Bandes :',jj_nb_physic(i), &
1453	' : temps moyen :', &
1454	timer_average(jj_nb_physic(i),timer_physic,i)
1455	enddo
1456
1457	endif
1458	CALL barrier
1459	print ,'Taille du Buffer MPI (REAL8)',MaxBufferSize
1460	print ,'Taille du Buffer MPI utilise (REAL8)',MaxBufferSize_Used
1461	print *, 'Temps total ecoule sur la parallelisation :',DiffTime()
1462	print *, 'Temps CPU ecoule sur la parallelisation :',DiffCpuTime()
1463	CALL print_filtre_timer
1464	!$OMP END MASTER
1465	CALL dynredem1_loc("restart.nc",0.0, &
1466	vcov,ucov,teta,q,masse,ps)
1467	!$OMP MASTER
1468	call fin_getparam
1469	!$OMP END MASTER
1470
1471	if (ok_guide) then
1472	! ! set ok_guide to false to avoid extra output
1473	! ! in following forward step
1474	ok_guide=.false.
1475	endif
1476
1477	IF (CPPKEY_INCA) THEN
1478	IF (ANY(type_trac == ['inca','inco'])) THEN
1479	CALL finalize_inca
1480	! switching back to LMDZDYN context
1481	!$OMP MASTER
1482	IF (ok_dyn_xios) THEN
1483	CALL xios_set_current_context(dyn3d_ctx_handle)
1484	ENDIF
1485	!$OMP END MASTER
1486	ENDIF
1487	END IF
1488	IF (CPPKEY_REPROBUS) THEN
1489	if (type_trac == 'repr') CALL finalize_reprobus
1490	END IF
1491
1492	!$OMP MASTER
1493	call finalize_parallel
1494	!$OMP END MASTER
1495	!$OMP BARRIER
1496	RETURN
1497	ENDIF
1498
1499	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1509')
1500
1501	IF ( .NOT.purmats ) THEN
1502	! ........................................................
1503	! .............. schema matsuno + leapfrog ..............
1504	! ........................................................
1505
1506	IF(forward.OR. leapf) THEN
1507	itau= itau + 1
1508	! iday= day_ini+itau/day_step
1509	! time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
1510	! IF(time.GT.1.) THEN
1511	! time = time-1.
1512	! iday = iday+1
1513	! ENDIF
1514	ENDIF
1515
1516
1517	IF( itau.EQ. itaufinp1 ) then
1518
1519	if (flag_verif) then
1520	write(79,*) 'ucov',ucov
1521	write(80,*) 'vcov',vcov
1522	write(81,*) 'teta',teta
1523	write(82,*) 'ps',ps
1524	write(83,*) 'q',q
1525	WRITE(85,*) 'q1 = ',q(:,:,1)
1526	WRITE(86,*) 'q3 = ',q(:,:,3)
1527	endif
1528
1529
1530	!$OMP MASTER
1531	call fin_getparam
1532	!$OMP END MASTER
1533
1534	IF (CPPKEY_INCA) THEN
1535	IF (ANY(type_trac == ['inca','inco'])) THEN
1536	CALL finalize_inca
1537	! switching back to LMDZDYN context
1538	!$OMP MASTER
1539	IF (ok_dyn_xios) THEN
1540	CALL xios_set_current_context(dyn3d_ctx_handle)
1541	ENDIF
1542	!$OMP END MASTER
1543	ENDIF
1544	END IF
1545	IF (CPPKEY_REPROBUS) THEN
1546	if (type_trac == 'repr') CALL finalize_reprobus
1547	END IF
1548
1549	!$OMP MASTER
1550	call finalize_parallel
1551	!$OMP END MASTER
1552	abort_message = 'Simulation finished'
1553	call abort_gcm(modname,abort_message,0)
1554	RETURN
1555	ENDIF
1556	!-----------------------------------------------------------------------
1557	! ecriture du fichier histoire moyenne:
1558	! -------------------------------------
1559
1560	IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
1561	!$OMP BARRIER
1562	IF(itau.EQ.itaufin) THEN
1563	iav=1
1564	ELSE
1565	iav=0
1566	ENDIF
1567
1568	! ! Ehouarn: re-compute geopotential for outputs
1569	!$OMP BARRIER
1570	!$OMP MASTER
1571	CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
1572	!$OMP END MASTER
1573	!$OMP BARRIER
1574
1575	IF (ok_dynzon) THEN
1576
1577	CALL bilan_dyn_loc(2,dtvriperiod,dtvrday_step*periodav, &
1578	ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
1579
1580	ENDIF !ok_dynzon
1581
1582	IF (ok_dyn_ave) THEN
1583	CALL writedynav_loc(itau,vcov, &
1584	ucov,teta,pk,phi,q,masse,ps,phis)
1585	ENDIF
1586
1587
1588
1589	ENDIF
1590
1591	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1584')
1592
1593	!-----------------------------------------------------------------------
1594	! ecriture de la bande histoire:
1595	! ------------------------------
1596
1597	IF( MOD(itau,iecri).EQ.0) THEN
1598	! ! Ehouarn: output only during LF or Backward Matsuno
1599	if (leapf.or.(.not.leapf.and.(.not.forward))) then
1600
1601	!$OMP BARRIER
1602	!$OMP MASTER
1603	CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
1604	!$OMP END MASTER
1605	!$OMP BARRIER
1606
1607	if (ok_dyn_ins) then
1608	CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
1609	masse,ps,phis)
1610	endif
1611
1612
1613	IF (ok_dyn_xios) THEN
1614	!$OMP MASTER
1615	CALL xios_update_calendar(itau)
1616	!$OMP END MASTER
1617	!$OMP BARRIER
1618	CALL writedyn_xios(vcov, &
1619	ucov,teta,pk,phi,q,masse,ps,phis)
1620	ENDIF
1621
1622	endif ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
1623
1624
1625	ENDIF ! of IF(MOD(itau,iecri).EQ.0)
1626
1627	IF(itau.EQ.itaufin) THEN
1628
1629	!$OMP BARRIER
1630
1631	! if (planet_type.eq."earth") then
1632	! Write an Earth-format restart file
1633	CALL dynredem1_loc("restart.nc",0.0, &
1634	vcov,ucov,teta,q,masse,ps)
1635	! endif ! of if (planet_type.eq."earth")
1636	if (ok_guide) then
1637	! ! set ok_guide to false to avoid extra output
1638	! ! in following forward step
1639	ok_guide=.false.
1640	endif
1641
1642	! CLOSE(99)
1643	ENDIF ! of IF (itau.EQ.itaufin)
1644
1645	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1624')
1646
1647	!-----------------------------------------------------------------------
1648	! gestion de l'integration temporelle:
1649	! ------------------------------------
1650
1651	IF( MOD(itau,iperiod).EQ.0 ) THEN
1652	GO TO 1
1653	ELSE IF ( MOD(itau-1,iperiod).EQ. 0 ) THEN
1654
1655	IF( forward ) THEN
1656	! fin du pas forward et debut du pas backward
1657
1658	forward = .FALSE.
1659	leapf = .FALSE.
1660	GO TO 2
1661
1662	ELSE
1663	! fin du pas backward et debut du premier pas leapfrog
1664
1665	leapf = .TRUE.
1666	dt = 2.*dtvr
1667	GO TO 2
1668	END IF
1669	ELSE
1670
1671	! ...... pas leapfrog .....
1672
1673	leapf = .TRUE.
1674	dt = 2.*dtvr
1675	GO TO 2
1676	END IF ! of IF (MOD(itau,iperiod).EQ.0)
1677	! ! ELSEIF (MOD(itau-1,iperiod).EQ.0)
1678
1679
1680	ELSE ! of IF (.not.purmats)
1681
1682
1683	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1664')
1684
1685	! ........................................................
1686	! .............. schema matsuno ...............
1687	! ........................................................
1688	IF( forward ) THEN
1689
1690	itau = itau + 1
1691	! iday = day_ini+itau/day_step
1692	! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
1693	!
1694	! IF(time.GT.1.) THEN
1695	! time = time-1.
1696	! iday = iday+1
1697	! ENDIF
1698
1699	forward = .FALSE.
1700	IF( itau.EQ. itaufinp1 ) then
1701	!$OMP MASTER
1702	call fin_getparam
1703	!$OMP END MASTER
1704
1705	IF (CPPKEY_INCA) THEN
1706	IF (ANY(type_trac == ['inca','inco'])) THEN
1707	CALL finalize_inca
1708	! switching back to LMDZDYN context
1709	!$OMP MASTER
1710	IF (ok_dyn_xios) THEN
1711	CALL xios_set_current_context(dyn3d_ctx_handle)
1712	ENDIF
1713	!$OMP END MASTER
1714	ENDIF
1715
1716	END IF
1717	IF (CPPKEY_REPROBUS) THEN
1718	if (type_trac == 'repr') CALL finalize_reprobus
1719	END IF
1720
1721	!$OMP MASTER
1722	call finalize_parallel
1723	!$OMP END MASTER
1724	abort_message = 'Simulation finished'
1725	call abort_gcm(modname,abort_message,0)
1726	RETURN
1727	ENDIF
1728	GO TO 2
1729
1730	ELSE ! of IF(forward) i.e. backward step
1731
1732
1733	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1698')
1734
1735	IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
1736	IF(itau.EQ.itaufin) THEN
1737	iav=1
1738	ELSE
1739	iav=0
1740	ENDIF
1741
1742	! ! Ehouarn: re-compute geopotential for outputs
1743	!$OMP BARRIER
1744	!$OMP MASTER
1745	CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
1746	!$OMP END MASTER
1747	!$OMP BARRIER
1748
1749	IF (ok_dynzon) THEN
1750	CALL bilan_dyn_loc(2,dtvriperiod,dtvrday_step*periodav, &
1751	ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
1752	ENDIF
1753
1754	IF (ok_dyn_ave) THEN
1755	CALL writedynav_loc(itau,vcov, &
1756	ucov,teta,pk,phi,q,masse,ps,phis)
1757	ENDIF
1758
1759
1760
1761	ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
1762
1763
1764	IF(MOD(itau,iecri ).EQ.0) THEN
1765
1766	!$OMP BARRIER
1767	!$OMP MASTER
1768	CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
1769	!$OMP END MASTER
1770	!$OMP BARRIER
1771
1772
1773	if (ok_dyn_ins) then
1774	CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, &
1775	masse,ps,phis)
1776	endif ! of if (ok_dyn_ins)
1777
1778
1779	IF (ok_dyn_xios) THEN
1780	!$OMP MASTER
1781	CALL xios_update_calendar(itau)
1782	!$OMP END MASTER
1783	!$OMP BARRIER
1784	CALL writedyn_xios(vcov, &
1785	ucov,teta,pk,phi,q,masse,ps,phis)
1786	ENDIF
1787
1788	ENDIF ! of IF(MOD(itau,iecri).EQ.0)
1789
1790
1791	IF(itau.EQ.itaufin) THEN
1792	! if (planet_type.eq."earth") then
1793	CALL dynredem1_loc("restart.nc",0.0, &
1794	vcov,ucov,teta,q,masse,ps)
1795	! endif ! of if (planet_type.eq."earth")
1796	if (ok_guide) then
1797	! ! set ok_guide to false to avoid extra output
1798	! ! in following forward step
1799	ok_guide=.false.
1800	endif
1801
1802	ENDIF ! of IF(itau.EQ.itaufin)
1803
1804	forward = .TRUE.
1805	GO TO 1
1806
1807	ENDIF ! of IF (forward)
1808
1809
1810	call check_isotopes(q,ijb_u,ije_u,'leapfrog 1750')
1811
1812	END IF ! of IF(.not.purmats)
1813	!$OMP MASTER
1814	call fin_getparam
1815	!$OMP END MASTER
1816
1817	IF (CPPKEY_INCA) THEN
1818	IF (ANY(type_trac == ['inca','inco'])) THEN
1819	CALL finalize_inca
1820	! switching back to LMDZDYN context
1821	!$OMP MASTER
1822	IF (ok_dyn_xios) THEN
1823	CALL xios_set_current_context(dyn3d_ctx_handle)
1824	ENDIF
1825	!$OMP END MASTER
1826	ENDIF
1827
1828	END IF
1829	IF (CPPKEY_REPROBUS) THEN
1830	if (type_trac == 'repr') CALL finalize_reprobus
1831	END IF
1832
1833	!$OMP MASTER
1834	call finalize_parallel
1835	!$OMP END MASTER
1836	abort_message = 'Simulation finished'
1837	call abort_gcm(modname,abort_message,0)
1838	RETURN
1839	END SUBROUTINE leapfrog_loc

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

Download in other formats:

Original Format