Context Navigation

advtrac_loc.F @ 3961

Last change on this file since 3961 was 3852, checked in by dcugnet, 4 years ago

Extension of the tracers management.

The tracers files can be:

1) "traceur.def": old format, with:

the number of tracers on the first line
one line for each tracer: <tracer name> <hadv> <vadv> [<parent name>]

2) "tracer.def": new format with one section each model component.
3) "tracer_<name>.def": new format with a single section.

The formats 2 and 3 reading is driven by the "type_trac" key, which can be a

coma-separated list of components.

Format 2: read the sections from the "tracer.def" file.
format 3: read one section each "tracer_<section name>.def" file.
the first line of a section is "&<section name>
the other lines start with a tracer name followed by <key>=<val> pairs.
the "default" tracer name is reserved ; the other tracers of the section inherit its <key>=<val>, except for the keys that are redefined locally.

This format helps keeping the tracers files compact, thanks to the "default"
special tracer and the three levels of factorization:

on the tracers names: a tracer name can be a coma-separated list of tracers => all the tracers of the list have the same <key>=<val> properties
on the parents names: the value of the "parent" property can be a coma-separated list of tracers => only possible for geographic tagging tracers
on the phases: the property "phases" is [g](l][s] (gas/liquid/solid)

Read information is stored in the vector "tracers(:)", of derived type "tra".

"isotopes_params.def" is a similar file, with one section each isotopes family.
It contains a database of isotopes properties ; if there are second generation
tracers (isotopes), the corresponding sections are read.

Read information is stored in the vector "isotopes(:)", of derived type "iso".

The "getKey" function helps to get the values of the parameters stored in
"tracers" or "isotopes".

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: 13.0 KB

Line
1	!
2	! $Id$
3	!
4	c
5	c
6	#define DEBUG_IO
7	#undef DEBUG_IO
8	SUBROUTINE advtrac_loc(pbarug,pbarvg ,wg,
9	* p, massem,q,teta,
10	* pk )
11
12	c Auteur : F. Hourdin
13	c
14	c Modif. P. Le Van (20/12/97)
15	c F. Codron (10/99)
16	c D. Le Croller (07/2001)
17	c M.A Filiberti (04/2002)
18	c
19	USE parallel_lmdz
20	USE Write_Field_loc
21	USE Write_Field
22	USE Bands
23	USE mod_hallo
24	USE Vampir
25	USE times
26	USE infotrac, ONLY: nqtot, tracers
27	USE control_mod, ONLY: iapp_tracvl, day_step, planet_type
28	USE advtrac_mod, ONLY: finmasse
29	USE comconst_mod, ONLY: dtvr
30	IMPLICIT NONE
31	c
32	include "dimensions.h"
33	include "paramet.h"
34	include "comdissip.h"
35	include "comgeom2.h"
36	include "description.h"
37
38	c-------------------------------------------------------------------
39	c Arguments
40	c-------------------------------------------------------------------
41	c Ajout PPM
42	c--------------------------------------------------------
43	REAL massebx(ijb_u:ije_u,llm),masseby(ijb_v:ije_v,llm)
44	c--------------------------------------------------------
45	INTEGER iapptrac
46	REAL pbarug(ijb_u:ije_u,llm),pbarvg(ijb_v:ije_v,llm)
47	REAL wg(ijb_u:ije_u,llm)
48	REAL q(ijb_u:ije_u,llm,nqtot),massem(ijb_u:ije_u,llm)
49	REAL p( ijb_u:ije_u,llmp1 ),teta(ijb_u:ije_u,llm)
50	REAL pk(ijb_u:ije_u,llm)
51
52	c-------------------------------------------------------------
53	c Variables locales
54	c-------------------------------------------------------------
55
56	REAL zdp(ijb_u:ije_u)
57	REAL (kind=kind(1.d0)) :: t_initial, t_final, tps_cpu
58	INTEGER,SAVE :: iadvtr=0
59	c$OMP THREADPRIVATE(iadvtr)
60	INTEGER ij,l,iq,iiq
61	REAL zdpmin, zdpmax
62	INTEGER, POINTER :: iadv(:)
63	c----------------------------------------------------------
64	c Rajouts pour PPM
65	c----------------------------------------------------------
66	INTEGER indice,n
67	REAL dtbon ! Pas de temps adaptatif pour que CFL<1
68	REAL CFLmaxz,aaa,bbb ! CFL maximum
69	REAL psppm(iim,jjb_u:jje_u) ! pression au sol
70	REAL unatppm(iim,jjb_u:jje_u,llm),vnatppm(iim,jjb_u:jje_u,llm)
71	REAL qppm(iim*jjnb_u,llm,nqtot)
72	REAL fluxwppm(iim,jjb_u:jje_u,llm)
73	REAL apppm(llmp1), bpppm(llmp1)
74	LOGICAL dum,fill
75	DATA fill/.true./
76	DATA dum/.true./
77	integer ijb,ije,ijbu,ijbv,ijeu,ijev,j
78	type(Request),SAVE :: testRequest
79	!$OMP THREADPRIVATE(testRequest)
80
81	iadv => tracers(:)%iadv
82
83	c test sur l''eventuelle creation de valeurs negatives de la masse
84	ijb=ij_begin
85	ije=ij_end
86	if (pole_nord) ijb=ij_begin+iip1
87	if (pole_sud) ije=ij_end-iip1
88
89	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
90	DO l=1,llm-1
91	DO ij = ijb+1,ije
92	zdp(ij) = pbarug(ij-1,l) - pbarug(ij,l)
93	s - pbarvg(ij-iip1,l) + pbarvg(ij,l)
94	s + wg(ij,l+1) - wg(ij,l)
95	ENDDO
96
97	c CALL SCOPY( jjm -1 ,zdp(iip1+iip1),iip1,zdp(iip2),iip1 )
98	c ym ---> pourquoi jjm-1 et non jjm ? a cause du pole ?
99
100	do ij=ijb,ije-iip1+1,iip1
101	zdp(ij)=zdp(ij+iip1-1)
102	enddo
103
104	DO ij = ijb,ije
105	zdp(ij)= zdp(ij)*dtvr/ massem(ij,l)
106	ENDDO
107
108
109	c CALL minmax ( ip1jm-iip1, zdp(iip2), zdpmin,zdpmax )
110	c ym ---> eventuellement a revoir
111	CALL minmax ( ije-ijb+1, zdp(ijb), zdpmin,zdpmax )
112
113	IF(MAX(ABS(zdpmin),ABS(zdpmax)).GT.0.5) THEN
114	PRINT*,'WARNING DP/P l=',l,' MIN:',zdpmin,
115	s ' MAX:', zdpmax
116	ENDIF
117
118	ENDDO
119	c$OMP END DO NOWAIT
120
121	c-------------------------------------------------------------------
122	c Advection proprement dite (Modification Le Croller (07/2001)
123	c-------------------------------------------------------------------
124
125	c----------------------------------------------------
126	c Calcul des moyennes basées sur la masse
127	c----------------------------------------------------
128
129	cym ----> Normalement, inutile pour les schémas classiques
130	cym ----> Revérifier lors de la parallélisation des autres schemas
131
132	cym call massbar_p(massem,massebx,masseby)
133
134	#ifdef DEBUG_IO
135	CALL WriteField_u('massem',massem)
136	CALL WriteField_u('wg',wg)
137	CALL WriteField_u('pbarug',pbarug)
138	CALL WriteField_v('pbarvg',pbarvg)
139	CALL WriteField_u('p_tmp',p)
140	CALL WriteField_u('pk_tmp',pk)
141	CALL WriteField_u('teta_tmp',teta)
142	do j=1,nqtot
143	call WriteField_u('q_adv'//trim(int2str(j)),
144	. q(:,:,j))
145	enddo
146	#endif
147
148	!
149	! call Register_Hallo_v(pbarvg,llm,1,1,1,1,TestRequest)
150	!
151	! call SendRequest(TestRequest)
152	!c$OMP BARRIER
153	! call WaitRequest(TestRequest)
154	c$OMP BARRIER
155
156	!write(,) 'advtrac 157: appel de vlspltgen_loc'
157	call vlspltgen_loc( q,iadv, 2., massem, wg ,
158	* pbarug,pbarvg,dtvr,p,
159	* pk,teta )
160
161	!write(,) 'advtrac 162: apres appel vlspltgen_loc'
162
163	call check_isotopes(q,ijb_u,ije_u,'advtrac 162')
164
165	#ifdef DEBUG_IO
166	do j=1,nqtot
167	call WriteField_u('q_adv'//trim(int2str(j)),
168	. q(:,:,j))
169	enddo
170	#endif
171
172	GOTO 1234
173	c-----------------------------------------------------------
174	c Appel des sous programmes d'advection
175	c-----------------------------------------------------------
176	do iq=1,nqtot
177	c call clock(t_initial)
178	if(iadv(iq) == 0) cycle
179	c ----------------------------------------------------------------
180	c Schema de Van Leer I MUSCL
181	c ----------------------------------------------------------------
182	if(iadv(iq).eq.10) THEN
183
184	!LF call vlsplt_p(q(1,1,iq),2.,massem,wg,pbarug,pbarvg,dtvr)
185
186	c ----------------------------------------------------------------
187	c Schema "pseudo amont" + test sur humidite specifique
188	C pour la vapeur d'eau. F. Codron
189	c ----------------------------------------------------------------
190	else if(iadv(iq).eq.14) then
191	c
192	cym stop 'advtrac : appel à vlspltqs :schema non parallelise'
193	!LF CALL vlspltqs_p( q(1,1,1), 2., massem, wg ,
194	!LF * pbarug,pbarvg,dtvr,p,pk,teta )
195	c ----------------------------------------------------------------
196	c Schema de Frederic Hourdin
197	c ----------------------------------------------------------------
198	else if(iadv(iq).eq.12) then
199	stop 'advtrac : schema non parallelise'
200	c Pas de temps adaptatif
201	call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
202	if (n.GT.1) then
203	write(,) 'WARNING horizontal dt=',dtbon,'dtvr=',
204	s dtvr,'n=',n
205	endif
206	do indice=1,n
207	call advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,1)
208	end do
209	else if(iadv(iq).eq.13) then
210	stop 'advtrac : schema non parallelise'
211	c Pas de temps adaptatif
212	call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
213	if (n.GT.1) then
214	write(,) 'WARNING horizontal dt=',dtbon,'dtvr=',
215	s dtvr,'n=',n
216	endif
217	do indice=1,n
218	call advn(q(1,1,iq),massem,wg,pbarug,pbarvg,dtbon,2)
219	end do
220	c ----------------------------------------------------------------
221	c Schema de pente SLOPES
222	c ----------------------------------------------------------------
223	else if (iadv(iq).eq.20) then
224	stop 'advtrac : schema non parallelise'
225
226	call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0)
227
228	c ----------------------------------------------------------------
229	c Schema de Prather
230	c ----------------------------------------------------------------
231	else if (iadv(iq).eq.30) then
232	stop 'advtrac : schema non parallelise'
233	c Pas de temps adaptatif
234	call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
235	if (n.GT.1) then
236	write(,) 'WARNING horizontal dt=',dtbon,'dtvr=',
237	s dtvr,'n=',n
238	endif
239	call prather(q(1,1,iq),wg,massem,pbarug,pbarvg,
240	s n,dtbon)
241	c ----------------------------------------------------------------
242	c Schemas PPM Lin et Rood
243	c ----------------------------------------------------------------
244	else if (iadv(iq).eq.11.OR.(iadv(iq).GE.16.AND.
245	s iadv(iq).LE.18)) then
246
247	stop 'advtrac : schema non parallelise'
248
249	c Test sur le flux horizontal
250	c Pas de temps adaptatif
251	call adaptdt(iadv(iq),dtbon,n,pbarug,massem)
252	if (n.GT.1) then
253	write(,) 'WARNING horizontal dt=',dtbon,'dtvr=',
254	s dtvr,'n=',n
255	endif
256	c Test sur le flux vertical
257	CFLmaxz=0.
258	do l=2,llm
259	do ij=iip2,ip1jm
260	aaa=wg(ij,l)*dtvr/massem(ij,l)
261	CFLmaxz=max(CFLmaxz,aaa)
262	bbb=-wg(ij,l)*dtvr/massem(ij,l-1)
263	CFLmaxz=max(CFLmaxz,bbb)
264	enddo
265	enddo
266	if (CFLmaxz.GE.1) then
267	write(,) 'WARNING vertical','CFLmaxz=', CFLmaxz
268	endif
269
270	c-----------------------------------------------------------
271	c Ss-prg interface LMDZ.4->PPM3d
272	c-----------------------------------------------------------
273
274	call interpre(q(1,1,iq),qppm(1,1,iq),wg,fluxwppm,massem,
275	s apppm,bpppm,massebx,masseby,pbarug,pbarvg,
276	s unatppm,vnatppm,psppm)
277
278	do indice=1,n
279	c---------------------------------------------------------------------
280	c VL (version PPM) horiz. et PPM vert.
281	c---------------------------------------------------------------------
282	if (iadv(iq).eq.11) then
283	c Ss-prg PPM3d de Lin
284	call ppm3d(1,qppm(1,1,iq),
285	s psppm,psppm,
286	s unatppm,vnatppm,fluxwppm,dtbon,2,2,2,1,
287	s iim,jjp1,2,llm,apppm,bpppm,0.01,6400000,
288	s fill,dum,220.)
289
290	c----------------------------------------------------------------------
291	c Monotonic PPM
292	c----------------------------------------------------------------------
293	else if (iadv(iq).eq.16) then
294	c Ss-prg PPM3d de Lin
295	call ppm3d(1,qppm(1,1,iq),
296	s psppm,psppm,
297	s unatppm,vnatppm,fluxwppm,dtbon,3,3,3,1,
298	s iim,jjp1,2,llm,apppm,bpppm,0.01,6400000,
299	s fill,dum,220.)
300	c---------------------------------------------------------------------
301
302	c---------------------------------------------------------------------
303	c Semi Monotonic PPM
304	c---------------------------------------------------------------------
305	else if (iadv(iq).eq.17) then
306	c Ss-prg PPM3d de Lin
307	call ppm3d(1,qppm(1,1,iq),
308	s psppm,psppm,
309	s unatppm,vnatppm,fluxwppm,dtbon,4,4,4,1,
310	s iim,jjp1,2,llm,apppm,bpppm,0.01,6400000,
311	s fill,dum,220.)
312	c---------------------------------------------------------------------
313
314	c---------------------------------------------------------------------
315	c Positive Definite PPM
316	c---------------------------------------------------------------------
317	else if (iadv(iq).eq.18) then
318	c Ss-prg PPM3d de Lin
319	call ppm3d(1,qppm(1,1,iq),
320	s psppm,psppm,
321	s unatppm,vnatppm,fluxwppm,dtbon,5,5,5,1,
322	s iim,jjp1,2,llm,apppm,bpppm,0.01,6400000,
323	s fill,dum,220.)
324	c---------------------------------------------------------------------
325	endif
326	enddo
327	c-----------------------------------------------------------------
328	c Ss-prg interface PPM3d-LMDZ.4
329	c-----------------------------------------------------------------
330	call interpost(q(1,1,iq),qppm(1,1,iq))
331	endif
332	c----------------------------------------------------------------------
333
334	c-----------------------------------------------------------------
335	c On impose une seule valeur du traceur au pôle Sud j=jjm+1=jjp1
336	c et Nord j=1
337	c-----------------------------------------------------------------
338
339	c call traceurpole(q(1,1,iq),massem)
340
341	c calcul du temps cpu pour un schema donne
342
343
344	end DO
345
346	1234 CONTINUE
347	c$OMP BARRIER
348
349	if (planet_type=="earth") then
350
351	ijb=ij_begin
352	ije=ij_end
353
354	c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
355	DO l = 1, llm
356	DO ij = ijb, ije
357	finmasse(ij,l) = p(ij,l) - p(ij,l+1)
358	ENDDO
359	ENDDO
360	c$OMP END DO
361
362	! CRisi: on passe nqtot et non nq
363	CALL qminimum_loc( q, nqtot, finmasse )
364
365	endif ! of if (planet_type=="earth")
366
367	RETURN
368	END
369

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

Download in other formats:

Original Format