Context Navigation

vlspltgen_loc.F90 @ 4332

Last change on this file since 4332 was 3852, checked in by dcugnet, 5 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: 14.8 KB

Line
1	SUBROUTINE vlspltgen_loc( q,iadv,pente_max,masse,w,pbaru,pbarv,pdt,p,pk,teta)
2
3	! Auteurs: P.Le Van, F.Hourdin, F.Forget, F.Codron
4	!
5	! ********************************************************************
6	! Shema d'advection " pseudo amont " .
7	! + test sur humidite specifique: Q advecte< Qsat aval
8	! (F. Codron, 10/99)
9	! ********************************************************************
10	! q,pbaru,pbarv,w sont des arguments d'entree pour le s-pg ....
11	!
12	! pente_max facteur de limitation des pentes: 2 en general
13	! 0 pour un schema amont
14	! pbaru,pbarv,w flux de masse en u ,v ,w
15	! pdt pas de temps
16	!
17	! teta temperature potentielle, p pression aux interfaces,
18	! pk exner au milieu des couches necessaire pour calculer Qsat
19	!--------------------------------------------------------------------
20	USE parallel_lmdz
21	USE mod_hallo
22	USE Write_Field_loc
23	USE VAMPIR
24	USE infotrac, ONLY : nqtot, tracers, tra
25	USE vlspltgen_mod
26	USE comconst_mod, ONLY: cpp
27	IMPLICIT NONE
28
29	include "dimensions.h"
30	include "paramet.h"
31
32	!
33	! Arguments:
34	!----------
35	REAL, DIMENSION(ijb_u:ije_u,llm,nqtot), INTENT(INOUT) :: q
36	INTEGER, DIMENSION(nqtot), INTENT(IN) :: iadv
37	REAL, INTENT(IN) :: pdt, pente_max
38	REAL, DIMENSION(ijb_u:ije_u,llm), INTENT(IN) :: pk, pbaru, masse, w, teta
39	REAL, DIMENSION(ijb_v:ije_v,llm), INTENT(IN) :: pbarv
40	REAL, DIMENSION(ijb_u:ije_u,llmp1), INTENT(IN) :: p
41	!
42	! Local
43	!---------
44	INTEGER :: ij, l
45	REAL :: zzpbar, zzw
46	REAL, PARAMETER :: qmin = 0., qmax = 1.e33
47	TYPE(tra), POINTER :: tr
48
49	!--pour rapport de melange saturant--
50	REAL, PARAMETER :: &
51	r2es = 380.11733, &
52	r3les = 17.269, &
53	r3ies = 21.875, &
54	r4les = 35.86, &
55	r4ies = 7.66, &
56	retv = 0.6077667, &
57	rtt = 273.16
58
59	REAL :: play, ptarg, pdelarg, foeew, zdelta, tempe(ijb_u:ije_u)
60	INTEGER :: ijb,ije,iq,iq2,ichld
61	LOGICAL, SAVE :: firstcall=.TRUE.
62	!$OMP THREADPRIVATE(firstcall)
63	TYPE(request), SAVE :: MyRequest1, MyRequest2
64	!$OMP THREADPRIVATE (MyRequest1, MyRequest2)
65
66	! fonction psat(T)
67	FOEEW ( PTARG,PDELARG ) = EXP ( (R3LES(1.-PDELARG)+R3IESPDELARG) * (PTARG-RTT) &
68	/ (PTARG-(R4LES(1.-PDELARG)+R4IESPDELARG)) )
69
70	! Allocate variables depending on dynamic variable nqtot
71	IF(firstcall) THEN
72	firstcall=.FALSE.
73	END IF
74	!-- Calcul de Qsat en chaque point
75	!-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
76	! pour eviter une exponentielle.
77
78	CALL SetTag(MyRequest1,100)
79	CALL SetTag(MyRequest2,101)
80
81	ijb=ij_begin-iip1; IF(pole_nord) ijb=ij_begin
82	ije=ij_end +iip1; IF(pole_sud) ije=ij_end
83
84	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
85	DO l = 1, llm
86	DO ij = ijb, ije
87	tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
88	END DO
89	DO ij = ijb, ije
90	zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
91	play = 0.5*(p(ij,l)+p(ij,l+1))
92	qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
93	qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
94	END DO
95	END DO
96	!$OMP END DO NOWAIT
97	! PRINT*,'Debut vlsplt version debug sans vlyqs'
98
99	zzpbar = 0.5 * pdt
100	zzw = pdt
101
102	ijb=ij_begin; IF(pole_nord) ijb=ijb+iip1
103	ije=ij_end; IF(pole_sud) ije=ije-iip1
104	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
105	DO l=1,llm
106	DO ij = ijb,ije
107	mu(ij,l)=pbaru(ij,l) * zzpbar
108	END DO
109	END DO
110	!$OMP END DO NOWAIT
111
112	ijb=ij_begin-iip1; IF(pole_nord) ijb=ij_begin
113	ije=ij_end; IF(pole_sud) ije=ij_end-iip1
114	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
115	DO l=1,llm
116	DO ij=ijb,ije
117	mv(ij,l)=pbarv(ij,l) * zzpbar
118	END DO
119	END DO
120	!$OMP END DO NOWAIT
121
122	ijb=ij_begin
123	ije=ij_end
124	DO iq=1,nqtot
125	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
126	DO l=1,llm
127	DO ij=ijb,ije
128	mw(ij,l,iq)=w(ij,l) * zzw
129	END DO
130	END DO
131	!$OMP END DO NOWAIT
132	END DO
133
134	DO iq=1,nqtot
135	!$OMP MASTER
136	DO ij=ijb,ije
137	mw(ij,llm+1,iq)=0.
138	END DO
139	!$OMP END MASTER
140	END DO
141
142	! CALL SCOPY(ijp1llm,q,1,zq,1)
143	! CALL SCOPY(ijp1llm,masse,1,zm,1)
144
145	ijb=ij_begin
146	ije=ij_end
147	DO iq=1,nqtot
148	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
149	DO l=1,llm
150	zq(ijb:ije,l,iq)=q(ijb:ije,l,iq)
151	zm(ijb:ije,l,iq)=masse(ijb:ije,l)
152	END DO
153	!$OMP END DO NOWAIT
154	END DO
155
156	#ifdef DEBUG_IO
157	CALL WriteField_u('mu',mu)
158	CALL WriteField_v('mv',mv)
159	CALL WriteField_u('mw',mw)
160	CALL WriteField_u('qsat',qsat)
161	#endif
162
163	! verif temporaire
164	ijb=ij_begin
165	ije=ij_end
166	CALL check_isotopes(zq,ijb,ije,'vlspltgen_loc 191')
167
168	!$OMP BARRIER
169	DO iq=1,nqtot
170	tr => tracers(iq)
171	! CRisi: on ne boucle que sur les parents = ceux qui sont transportes directement par l'air
172	IF(tr%igen /= 1) CYCLE
173	! write(,) 'vlspltgen 192: iq,iadv=',iq,iadv(iq)
174	#ifdef DEBUG_IO
175	CALL WriteField_u('zq',zq(:,:,iq))
176	CALL WriteField_u('zm',zm(:,:,iq))
177	#endif
178	!----------------------------------------------------------------------
179	SELECT CASE(iadv(iq))
180	!----------------------------------------------------------------------
181	CASE(0); CYCLE
182	!----------------------------------------------------------------------
183	CASE(10)
184	#ifdef _ADV_HALO
185	! CRisi: on ajoute les nombres de fils et tableaux des fils
186	! On suppose qu'on ne peut advecter les fils que par le schéma 10.
187	CALL vlx_loc(zq,pente_max,zm,mu,ij_begin,ij_begin+2*iip1-1,iq)
188	CALL vlx_loc(zq,pente_max,zm,mu,ij_end-2*iip1+1,ij_end,iq)
189	#else
190	CALL vlx_loc(zq,pente_max,zm,mu,ij_begin,ij_end,iq)
191	#endif
192	!$OMP MASTER
193	CALL VTb(VTHallo)
194	!$OMP END MASTER
195	CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
196	CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
197	! CRisi
198	DO ichld=1,tr%ndesc
199	iq2=tr%idesc(ichld)
200	CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
201	CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
202	END DO
203	!$OMP MASTER
204	CALL VTe(VTHallo)
205	!$OMP END MASTER
206	!----------------------------------------------------------------------
207	CASE(14)
208	#ifdef _ADV_HALO
209	CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_begin+2*iip1-1,iq)
210	CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_end-2*iip1+1,ij_end,iq)
211	#else
212	CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_end,iq)
213	#endif
214	!$OMP MASTER
215	CALL VTb(VTHallo)
216	!$OMP END MASTER
217	CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest1)
218	CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest1)
219	DO ichld=1,tr%ndesc
220	iq2=tr%idesc(ichld)
221	CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest1)
222	CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest1)
223	END DO
224	!$OMP MASTER
225	CALL VTe(VTHallo)
226	!$OMP END MASTER
227	!----------------------------------------------------------------------
228	CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
229	!----------------------------------------------------------------------
230	END SELECT
231	!----------------------------------------------------------------------
232	END DO
233	!$OMP BARRIER
234
235	!$OMP MASTER
236	CALL VTb(VTHallo)
237	!$OMP END MASTER
238	CALL SendRequest(MyRequest1)
239	!$OMP MASTER
240	CALL VTe(VTHallo)
241	!$OMP END MASTER
242
243	!$OMP BARRIER
244
245	! verif temporaire
246	ijb=ij_begin-2*iip1; IF(pole_nord) ijb=ij_begin
247	ije=ij_end +2*iip1; IF(pole_sud) ije=ij_end
248	CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 280')
249
250	DO iq=1,nqtot
251	tr => tracers(iq)
252	! write(,) 'vlspltgen 279: iq=',iq
253	IF(tr%igen /= 1) CYCLE
254	!----------------------------------------------------------------------
255	SELECT CASE(iadv(iq))
256	!----------------------------------------------------------------------
257	CASE(0); CYCLE
258	!----------------------------------------------------------------------
259	CASE(10)
260	#ifdef _ADV_HALLO
261	CALL vlx_loc(zq,pente_max,zm,mu,ij_begin+2iip1,ij_end-2iip1,iq)
262	#endif
263	!----------------------------------------------------------------------
264	CASE(14)
265	#ifdef _ADV_HALLO
266	CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin+2iip1,ij_end-2iip1,iq)
267	#endif
268	CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
269	!----------------------------------------------------------------------
270	END SELECT
271	!----------------------------------------------------------------------
272	END DO
273	!$OMP BARRIER
274
275	!$OMP MASTER
276	CALL VTb(VTHallo)
277	!$OMP END MASTER
278
279	! CALL WaitRecvRequest(MyRequest1)
280	! CALL WaitSendRequest(MyRequest1)
281	!$OMP BARRIER
282	CALL WaitRequest(MyRequest1)
283
284
285	!$OMP MASTER
286	CALL VTe(VTHallo)
287	!$OMP END MASTER
288	!$OMP BARRIER
289
290	CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 326')
291
292	ijb=ij_begin-2*iip1; IF(pole_nord) ijb=ij_begin
293	ije=ij_end +2*iip1; IF(pole_sud) ije=ij_end
294
295	CALL check_isotopes(zq,ijb,ije,'vlspltgen_loc 336')
296
297	DO iq=1,nqtot
298	tr => tracers(iq)
299	! write(,) 'vlspltgen 321: iq=',iq
300	IF(tr%igen /= 1) CYCLE
301	#ifdef DEBUG_IO
302	CALL WriteField_u('zq',zq(:,:,iq))
303	CALL WriteField_u('zm',zm(:,:,iq))
304	#endif
305	!----------------------------------------------------------------------
306	SELECT CASE(iadv(iq))
307	CASE(0); CYCLE
308	CASE(10); CALL vly_loc(zq,pente_max,zm,mv,iq)
309	CASE(14); CALL vlyqs_loc(zq,pente_max,zm,mv,qsat,iq)
310	CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
311	END SELECT
312	!----------------------------------------------------------------------
313	END DO
314
315	CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 357')
316
317	DO iq=1,nqtot
318	tr => tracers(iq)
319	! write(,) 'vlspltgen 349: iq=',iq
320	IF(tr%igen /= 1) CYCLE
321	#ifdef DEBUG_IO
322	CALL WriteField_u('zq',zq(:,:,iq))
323	CALL WriteField_u('zm',zm(:,:,iq))
324	#endif
325	!----------------------------------------------------------------------
326	SELECT CASE(iadv(iq))
327	!----------------------------------------------------------------------
328	CASE(0); CYCLE
329	!----------------------------------------------------------------------
330	CASE(10,14)
331	!$OMP BARRIER
332	#ifdef _ADV_HALLO
333	CALL vlz_loc(zq,pente_max,zm,mw,ij_begin,ij_begin+2*iip1-1,iq)
334	CALL vlz_loc(zq,pente_max,zm,mw,ij_end-2*iip1+1,ij_end,iq)
335	#else
336	CALL vlz_loc(zq,pente_max,zm,mw,ij_begin,ij_end,iq)
337	#endif
338	!$OMP BARRIER
339	!$OMP MASTER
340	CALL VTb(VTHallo)
341	!$OMP END MASTER
342	CALL Register_Hallo_u(zq(:,:,iq),llm,2,2,2,2,MyRequest2)
343	CALL Register_Hallo_u(zm(:,:,iq),llm,1,1,1,1,MyRequest2)
344	! CRisi
345	DO ichld=1,tr%ndesc
346	iq2=tr%idesc(ichld)
347	CALL Register_Hallo_u(zq(:,:,iq2),llm,2,2,2,2,MyRequest2)
348	CALL Register_Hallo_u(zm(:,:,iq2),llm,1,1,1,1,MyRequest2)
349	END DO
350	!$OMP MASTER
351	CALL VTe(VTHallo)
352	!$OMP END MASTER
353	!$OMP BARRIER
354	!----------------------------------------------------------------------
355	CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
356	!----------------------------------------------------------------------
357	END SELECT
358	!----------------------------------------------------------------------
359	END DO
360	!$OMP BARRIER
361
362
363	!$OMP MASTER
364	CALL VTb(VTHallo)
365	!$OMP END MASTER
366
367	CALL SendRequest(MyRequest2)
368
369	!$OMP MASTER
370	CALL VTe(VTHallo)
371	!$OMP END MASTER
372
373	CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 429')
374
375	!$OMP BARRIER
376	DO iq=1,nqtot
377	tr => tracers(iq)
378	! write(,) 'vlspltgen 409: iq=',iq
379	IF(tr%igen /= 1) CYCLE
380	!----------------------------------------------------------------------
381	SELECT CASE(iadv(iq))
382	!----------------------------------------------------------------------
383	CASE(0); CYCLE
384	!----------------------------------------------------------------------
385	CASE(10,14)
386	!$OMP BARRIER
387	#ifdef _ADV_HALLO
388	CALL vlz_loc(zq,pente_max,zm,mw,ij_begin+2iip1,ij_end-2iip1,iq)
389	#endif
390	!$OMP BARRIER
391	!----------------------------------------------------------------------
392	CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
393	!----------------------------------------------------------------------
394	END SELECT
395	!----------------------------------------------------------------------
396	END DO
397	! write(,) 'vlspltgen_loc 476'
398
399	!$OMP BARRIER
400	! write(,) 'vlspltgen_loc 477'
401	!$OMP MASTER
402	CALL VTb(VTHallo)
403	!$OMP END MASTER
404
405	! CALL WaitRecvRequest(MyRequest2)
406	! CALL WaitSendRequest(MyRequest2)
407	!$OMP BARRIER
408	CALL WaitRequest(MyRequest2)
409
410	!$OMP MASTER
411	CALL VTe(VTHallo)
412	!$OMP END MASTER
413	!$OMP BARRIER
414
415	! write(,) 'vlspltgen_loc 494'
416	CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 461')
417
418	DO iq=1,nqtot
419	tr => tracers(iq)
420	! write(,) 'vlspltgen 449: iq=',iq
421	IF(tr%igen /= 1) CYCLE
422	#ifdef DEBUG_IO
423	CALL WriteField_u('zq',zq(:,:,iq))
424	CALL WriteField_u('zm',zm(:,:,iq))
425	#endif
426	!----------------------------------------------------------------------
427	SELECT CASE(iadv(iq))
428	CASE(0); CYCLE
429	CASE(10); CALL vly_loc(zq,pente_max,zm,mv,iq)
430	CASE(14); CALL vlyqs_loc(zq,pente_max,zm,mv,qsat,iq)
431	CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
432	END SELECT
433	!----------------------------------------------------------------------
434	END DO
435
436	CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 493')
437
438	DO iq=1,nqtot
439	tr => tracers(iq)
440	! write(,) 'vlspltgen 477: iq=',iq
441	IF(tr%igen /= 1) CYCLE
442	#ifdef DEBUG_IO
443	CALL WriteField_u('zq',zq(:,:,iq))
444	CALL WriteField_u('zm',zm(:,:,iq))
445	#endif
446	!----------------------------------------------------------------------
447	SELECT CASE(iadv(iq))
448	CASE(0); CYCLE
449	CASE(10); CALL vlx_loc(zq,pente_max,zm,mu, ij_begin,ij_end,iq)
450	CASE(14); CALL vlxqs_loc(zq,pente_max,zm,mu,qsat,ij_begin,ij_end,iq)
451	CASE DEFAULT; STOP 'vlspltgen_p : schema non parallelise'
452	END SELECT
453	!----------------------------------------------------------------------
454	END DO
455
456	! write(,) 'vlspltgen 550: apres derniere serie de call vlx'
457	CALL check_isotopes(zq,ij_begin,ij_end,'vlspltgen_loc 521')
458
459	ijb=ij_begin
460	ije=ij_end
461	! write(,) 'vlspltgen_loc 557'
462	!$OMP BARRIER
463
464	! write(,) 'vlspltgen_loc 559'
465	DO iq=1,nqtot
466	! write(,) 'vlspltgen_loc 561, iq=',iq
467	#ifdef DEBUG_IO
468	CALL WriteField_u('zq',zq(:,:,iq))
469	CALL WriteField_u('zm',zm(:,:,iq))
470	#endif
471	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
472	DO l=1,llm
473	DO ij=ijb,ije
474	! print *,'zq-->',ij,l,iq,zq(ij,l,iq)
475	! print *,'q-->',ij,l,iq,q(ij,l,iq)
476	q(ij,l,iq)=zq(ij,l,iq)
477	END DO
478	END DO
479	!$OMP END DO NOWAIT
480	! write(,) 'vlspltgen_loc 575'
481
482	!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
483	DO l=1,llm
484	DO ij=ijb,ije-iip1+1,iip1
485	q(ij+iim,l,iq)=q(ij,l,iq)
486	END DO
487	END DO
488	!$OMP END DO NOWAIT
489	! write(,) 'vlspltgen_loc 583'
490	END DO
491
492	CALL check_isotopes(q,ij_begin,ij_end,'vlspltgen_loc 557')
493
494	!$OMP BARRIER
495
496	!!$OMP MASTER
497	! call WaitSendRequest(MyRequest1)
498	! call WaitSendRequest(MyRequest2)
499	!!$OMP END MASTER
500	!!$OMP BARRIER
501
502	! write(,) 'vlspltgen 597: sortie'
503
504	END

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

Download in other formats:

Original Format