Context Navigation

leapfrog_loc.F @ 1630

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

Importation initiale du rÃ©pertoire dyn3dmem

Initial import of dyn3dmem directory

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