Context Navigation

leapfrog_loc.F @ 4143

Last change on this file since 4143 was 4143, checked in by dcugnet, 2 years ago
Some variables are renamed or replaced by direct equivalents: iso_indnum -> tracers(:)%iso_iName niso_possibles -> niso iqiso -> iqIsoPha ; index_trac -> itZonIso ok_iso_verif -> isoCheck ntraceurs_zone -> nzone ; ntraciso -> ntiso qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times. Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18). The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).
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
File size: 56.2 KB

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

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

Download in other formats:

Original Format