Context Navigation

leapfrog_loc.F @ 1763

Last change on this file since 1763 was 1705, checked in by Ehouarn Millour, 12 years ago

Added arch files for ADA (IDRIS IBMx3750) and made the following code modifications:
phylmd/printflag.F : removed "print" of unset variable (radpas0)
dyn3dmem/integrd_loc.F : removed unecessary "include mpif.h"
dyn3dmem/leapfrog_loc.F : removed unecessary "include mpif.h" and allocate saved variables at first call
dyn3dmem/mod_filtreg_p.F : added matmul() alternatives to call to BLAS routine SGEMM (which was incorectly set as DGEMM; which would fail if running with -r4)
filtrez/filtreg.F: changed calls to DGEMM into calls to SGEMM, so that code works with either -r4 or -r8 (the later being used in conjunction with "BLAS SGEMV=DGEMV SGEMM=DGEMM" preprocessing statements)
EM

File size: 51.7 KB

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

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

Download in other formats:

Original Format