Context Navigation

leapfrog_loc.F @ 4379

Last change on this file since 4379 was 4187, checked in by acozic, 2 years ago
Add a syntax correction in leapfrog_loc for compilation with inca / add a condition on inca in phys_output_write to be use without inca
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: 56.8 KB

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

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

Download in other formats:

Original Format