Context Navigation

leapfrog_p.F @ 1118

Last change on this file since 1118 was 1114, checked in by jghattas, 17 years ago

Creation du module infotrac:

contient les variables de advtrac.h
contient la subroutine iniadvtrac renommer en infotrac_init
le nombre des traceurs est lu dans tracer.def en dynamique (ou par default ou recu par INCA)
ce module est utilise dans la dynamique et la physique
contient aussi la variable nbtr qui avant etait stockee dans dimphy

Le fichier advtrac.h n'existe plus.
La compilation ne prend plus en compte le nombre de traceur.

/JG

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

File size: 45.9 KB

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

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

Download in other formats:

Original Format