Context Navigation

leapfrog_p.F @ 2021

Last change on this file since 2021 was 2021, checked in by lguez, 10 years ago

Removed unused variables pks, pk, pkf from main program unit gcm.

Encapsulated procedures exner_hyb, exner_hyb_p, exner_hyb_loc,
exner_milieu, exner_milieu_p and exner_milieu_loc into
modules. (Compulsory to allow optional arguments.)

In the procedures exner_hyb, exner_hyb_p, exner_hyb_loc, donwgraded
arguments alpha and beta to local variables. In exner_milieu,
exner_milieu_p and exner_milieu_loc, removed beta altogether. In the
six procedures exner_*, made pkf an optional argument. Made some
cosmetic modifications in order to keep the six procedures exner_* as
close as possible.

In the six procedures exner_*, removed the averaging of pks at the
poles: this is not useful because ps is already the same at all
longitudes at the poles. This modification changes the results of the
program. Motivation: had to do this for exner_hyb because we call it
from test_disvert with a few surface pressure values.

In all the procedures calling exner_*, removed the variables alpha and
beta. Also removed variables alpha and beta from module leapfrog_mod
and from module call_calfis_mod.

Removed actual argument pkf in call to exner_hyb* and exner_milieu*
from guide_interp, guide_main, iniacademic and iniacademic_loc (pkf
was not used in those procedures).

Argument workvar of startget_dyn is used only if varname is tpot or

When varname is tpot or q, the actual argument associated to

workvar in etat0_netcdf is not y. So y in etat0_netcdf is a
place-holder, never used. So we remove optional argument y in the
calls to exner_hyb and exner_milieu from etat0_netcdf.

Created procedure test_disvert, called only by etat0_netcdf. This
procedure tests the order of pressure values at half-levels and full
levels.

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 55.6 KB

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

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

Download in other formats:

Original Format