Context Navigation

leapfrog_loc.F @ 2598

Last change on this file since 2598 was 2598, checked in by Ehouarn Millour, 8 years ago
Cleanup in the dynamics: turn serre.h into module serre_mod.F90 EM
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
File size: 55.8 KB

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

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

Download in other formats:

Original Format