Context Navigation

leapfrog_loc.F @ 1682

Last change on this file since 1682 was 1682, checked in by Laurent Fairhead, 12 years ago

Désactivation des sorties debug
Problème de double déclaration de variables de contrôle

Turning off debugging outputs
Problem with double declaration of some control variables

File size: 51.6 KB

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

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

Download in other formats:

Original Format