Context Navigation

leapfrog_p.F @ 1119

Last change on this file since 1119 was 1000, checked in by Laurent Fairhead, 16 years ago

Modifs sur le parallelisme: masquage dans la physique
Inclusion strato
mise en coherence etat0
le mode offline fonctionne maintenant en parallele,
les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
L'OPENMP fonctionne maintenant sans la parallelisation MPI.

YM
LF

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 45.5 KB

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

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

Download in other formats:

Original Format