Context Navigation

leapfrog_loc.f90 @ 5301

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

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

Download in other formats:

Original Format