Context Navigation

leapfrog_loc.F @ 3681

Last change on this file since 3681 was 2641, checked in by Laurent Fairhead, 8 years ago
Merged trunk changes r2593:2640 into testing branch
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.1 KB

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

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

Download in other formats:

Original Format