Context Navigation

leapfrog_loc.F @ 1649

Last change on this file since 1649 was 1632, checked in by Laurent Fairhead, 13 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 49.3 KB

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

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

Download in other formats:

Original Format