Context Navigation

infotrac.F90 @ 2173

Last change on this file since 2173 was 2171, checked in by acozic, 10 years ago
There are some commits that we must not do just before holiday .... so be back to rev 2168
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.0 KB

Line
1	! $Id$
2	!
3	MODULE infotrac
4
5	! nqtot : total number of tracers and higher order of moment, water vapor and liquid included
6	INTEGER, SAVE :: nqtot
7	!CR: on ajoute le nombre de traceurs de l eau
8	INTEGER, SAVE :: nqo
9
10	! nbtr : number of tracers not including higher order of moment or water vapor or liquid
11	! number of tracers used in the physics
12	INTEGER, SAVE :: nbtr
13
14	! Name variables
15	CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
16	CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
17
18	! iadv : index of trasport schema for each tracer
19	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iadv
20
21	! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the
22	! dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code.
23	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: niadv ! equivalent dyn / physique
24
25	! conv_flg(it)=0 : convection desactivated for tracer number it
26	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg
27	! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it
28	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg
29
30	CHARACTER(len=4),SAVE :: type_trac
31
32	CONTAINS
33
34	SUBROUTINE infotrac_init
35	USE control_mod
36	#ifdef REPROBUS
37	USE CHEM_REP, ONLY : Init_chem_rep_trac
38	#endif
39	IMPLICIT NONE
40	!=======================================================================
41	!
42	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
43	! -------
44	! Modif special traceur F.Forget 05/94
45	! Modif M-A Filiberti 02/02 lecture de traceur.def
46	!
47	! Objet:
48	! ------
49	! GCM LMD nouvelle grille
50	!
51	!=======================================================================
52	! ... modification de l'integration de q ( 26/04/94 ) ....
53	!-----------------------------------------------------------------------
54	! Declarations
55
56	INCLUDE "dimensions.h"
57	INCLUDE "iniprint.h"
58
59	! Local variables
60	INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv ! index of horizontal trasport schema
61	INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv ! index of vertical trasport schema
62
63	CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0 ! tracer short name
64	CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: tracnam ! name from INCA
65	CHARACTER(len=3), DIMENSION(30) :: descrq
66	CHARACTER(len=1), DIMENSION(3) :: txts
67	CHARACTER(len=2), DIMENSION(9) :: txtp
68	CHARACTER(len=23) :: str1,str2
69
70	INTEGER :: nqtrue ! number of tracers read from tracer.def, without higer order of moment
71	INTEGER :: iq, new_iq, iiq, jq, ierr
72
73	character(len=*),parameter :: modname="infotrac_init"
74	!-----------------------------------------------------------------------
75	! Initialization :
76	!
77	txts=(/'x','y','z'/)
78	txtp=(/'x ','y ','z ','xx','xy','xz','yy','yz','zz'/)
79
80	descrq(14)='VLH'
81	descrq(10)='VL1'
82	descrq(11)='VLP'
83	descrq(12)='FH1'
84	descrq(13)='FH2'
85	descrq(16)='PPM'
86	descrq(17)='PPS'
87	descrq(18)='PPP'
88	descrq(20)='SLP'
89	descrq(30)='PRA'
90
91
92	! Coherence test between parameter type_trac, config_inca and preprocessing keys
93	IF (type_trac=='inca') THEN
94	WRITE(lunout,*) 'You have choosen to couple with INCA chemestry model : type_trac=', &
95	type_trac,' config_inca=',config_inca
96	IF (config_inca/='aero' .AND. config_inca/='chem') THEN
97	WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
98	CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
99	END IF
100	#ifndef INCA
101	WRITE(lunout,*) 'To run this option you must add cpp key INCA and compile with INCA code'
102	CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1)
103	#endif
104	ELSE IF (type_trac=='repr') THEN
105	WRITE(lunout,*) 'You have choosen to couple with REPROBUS chemestry model : type_trac=', type_trac
106	#ifndef REPROBUS
107	WRITE(lunout,*) 'To run this option you must add cpp key REPROBUS and compile with REPRPBUS code'
108	CALL abort_gcm('infotrac_init','You must compile with cpp key REPROBUS',1)
109	#endif
110	ELSE IF (type_trac == 'lmdz') THEN
111	WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac
112	ELSE
113	WRITE(lunout,*) 'type_trac=',type_trac,' not possible. Model stops'
114	CALL abort_gcm('infotrac_init','bad parameter',1)
115	END IF
116
117
118	! Test if config_inca is other then none for run without INCA
119	IF (type_trac/='inca' .AND. config_inca/='none') THEN
120	WRITE(lunout,*) 'config_inca will now be changed to none as you do not couple with INCA model'
121	config_inca='none'
122	END IF
123
124
125	!-----------------------------------------------------------------------
126	!
127	! 1) Get the true number of tracers + water vapor/liquid
128	! Here true tracers (nqtrue) means declared tracers (only first order)
129	!
130	!-----------------------------------------------------------------------
131	IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
132	OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
133	IF(ierr.EQ.0) THEN
134	WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
135	READ(90,*) nqtrue
136	ELSE
137	WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
138	WRITE(lunout,*) trim(modname),': WARNING using defaut values'
139	if (planet_type=='earth') then
140	nqtrue=4 ! Default value for Earth
141	else
142	nqtrue=1 ! Default value for other planets
143	endif
144	END IF
145	if ( planet_type=='earth') then
146	! For Earth, water vapour & liquid tracers are not in the physics
147	nbtr=nqtrue-2
148	else
149	! Other planets (for now); we have the same number of tracers
150	! in the dynamics than in the physics
151	nbtr=nqtrue
152	endif
153	ELSE ! type_trac=inca
154	! nbtr has been read from INCA by init_const_lmdz() in gcm.F
155	nqtrue=nbtr+2
156	END IF
157
158	IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
159	WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
160	CALL abort_gcm('infotrac_init','Not enough tracers',1)
161	END IF
162
163	! Transfert number of tracers to Reprobus
164	IF (type_trac == 'repr') THEN
165	#ifdef REPROBUS
166	CALL Init_chem_rep_trac(nbtr)
167	#endif
168	END IF
169
170	!
171	! Allocate variables depending on nqtrue and nbtr
172	!
173	ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
174	ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), tracnam(nbtr))
175	conv_flg(:) = 1 ! convection activated for all tracers
176	pbl_flg(:) = 1 ! boundary layer activated for all tracers
177
178	!-----------------------------------------------------------------------
179	! 2) Choix des schemas d'advection pour l'eau et les traceurs
180	!
181	! iadv = 1 schema transport type "humidite specifique LMD"
182	! iadv = 2 schema amont
183	! iadv = 14 schema Van-leer + humidite specifique
184	! Modif F.Codron
185	! iadv = 10 schema Van-leer (retenu pour l'eau vapeur et liquide)
186	! iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone) pour vadv
187	! iadv = 12 schema Frederic Hourdin I
188	! iadv = 13 schema Frederic Hourdin II
189	! iadv = 16 schema PPM Monotone(Collela & Woodward 1984)
190	! iadv = 17 schema PPM Semi Monotone (overshoots autorisés)
191	! iadv = 18 schema PPM Positif Defini (overshoots undershoots autorisés)
192	! iadv = 20 schema Slopes
193	! iadv = 30 schema Prather
194	!
195	! Dans le tableau q(ij,l,iq) : iq = 1 pour l'eau vapeur
196	! iq = 2 pour l'eau liquide
197	! Et eventuellement iq = 3,nqtot pour les autres traceurs
198	!
199	! iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq.
200	!------------------------------------------------------------------------
201	!
202	! Get choice of advection schema from file tracer.def or from INCA
203	!---------------------------------------------------------------------
204	IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
205	IF(ierr.EQ.0) THEN
206	! Continue to read tracer.def
207	DO iq=1,nqtrue
208	READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
209	END DO
210	CLOSE(90)
211	ELSE ! Without tracer.def, set default values
212	if (planet_type=="earth") then
213	! for Earth, default is to have 4 tracers
214	hadv(1) = 14
215	vadv(1) = 14
216	tnom_0(1) = 'H2Ov'
217	hadv(2) = 10
218	vadv(2) = 10
219	tnom_0(2) = 'H2Ol'
220	hadv(3) = 10
221	vadv(3) = 10
222	tnom_0(3) = 'RN'
223	hadv(4) = 10
224	vadv(4) = 10
225	tnom_0(4) = 'PB'
226	else ! default for other planets
227	hadv(1) = 10
228	vadv(1) = 10
229	tnom_0(1) = 'dummy'
230	endif ! of if (planet_type=="earth")
231	END IF
232
233	!CR: nombre de traceurs de l eau
234	if (tnom_0(3) == 'H2Oi') then
235	nqo=3
236	else
237	nqo=2
238	endif
239
240	WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
241	WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
242	DO iq=1,nqtrue
243	WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
244	END DO
245
246	ELSE ! type_trac=inca : config_inca='aero' ou 'chem'
247	! le module de chimie fournit les noms des traceurs
248	! et les schemas d'advection associes.
249
250	#ifdef INCA
251	CALL init_transport( &
252	hadv, &
253	vadv, &
254	conv_flg, &
255	pbl_flg, &
256	tracnam)
257	#endif
258	tnom_0(1)='H2Ov'
259	tnom_0(2)='H2Ol'
260
261	DO iq =3,nqtrue
262	tnom_0(iq)=tracnam(iq-2)
263	END DO
264	nqo = 2
265
266	END IF ! type_trac
267
268	!-----------------------------------------------------------------------
269	!
270	! 3) Verify if advection schema 20 or 30 choosen
271	! Calculate total number of tracers needed: nqtot
272	! Allocate variables depending on total number of tracers
273	!-----------------------------------------------------------------------
274	new_iq=0
275	DO iq=1,nqtrue
276	! Add tracers for certain advection schema
277	IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN
278	new_iq=new_iq+1 ! no tracers added
279	ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN
280	new_iq=new_iq+4 ! 3 tracers added
281	ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN
282	new_iq=new_iq+10 ! 9 tracers added
283	ELSE
284	WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
285	CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
286	END IF
287	END DO
288
289	IF (new_iq /= nqtrue) THEN
290	! The choice of advection schema imposes more tracers
291	! Assigne total number of tracers
292	nqtot = new_iq
293
294	WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
295	WRITE(lunout,*) 'makes it necessary to add tracers'
296	WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
297	WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
298
299	ELSE
300	! The true number of tracers is also the total number
301	nqtot = nqtrue
302	END IF
303
304	!
305	! Allocate variables with total number of tracers, nqtot
306	!
307	ALLOCATE(tname(nqtot), ttext(nqtot))
308	ALLOCATE(iadv(nqtot), niadv(nqtot))
309
310	!-----------------------------------------------------------------------
311	!
312	! 4) Determine iadv, long and short name
313	!
314	!-----------------------------------------------------------------------
315	new_iq=0
316	DO iq=1,nqtrue
317	new_iq=new_iq+1
318
319	! Verify choice of advection schema
320	IF (hadv(iq)==vadv(iq)) THEN
321	iadv(new_iq)=hadv(iq)
322	ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
323	iadv(new_iq)=11
324	ELSE
325	WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
326
327	CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
328	END IF
329
330	str1=tnom_0(iq)
331	tname(new_iq)= tnom_0(iq)
332	IF (iadv(new_iq)==0) THEN
333	ttext(new_iq)=trim(str1)
334	ELSE
335	ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
336	END IF
337
338	! schemas tenant compte des moments d'ordre superieur
339	str2=ttext(new_iq)
340	IF (iadv(new_iq)==20) THEN
341	DO jq=1,3
342	new_iq=new_iq+1
343	iadv(new_iq)=-20
344	ttext(new_iq)=trim(str2)//txts(jq)
345	tname(new_iq)=trim(str1)//txts(jq)
346	END DO
347	ELSE IF (iadv(new_iq)==30) THEN
348	DO jq=1,9
349	new_iq=new_iq+1
350	iadv(new_iq)=-30
351	ttext(new_iq)=trim(str2)//txtp(jq)
352	tname(new_iq)=trim(str1)//txtp(jq)
353	END DO
354	END IF
355	END DO
356
357	!
358	! Find vector keeping the correspodence between true and total tracers
359	!
360	niadv(:)=0
361	iiq=0
362	DO iq=1,nqtot
363	IF(iadv(iq).GE.0) THEN
364	! True tracer
365	iiq=iiq+1
366	niadv(iiq)=iq
367	ENDIF
368	END DO
369
370
371	WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
372	WRITE(lunout,*) trim(modname),': iadv niadv tname ttext :'
373	DO iq=1,nqtot
374	WRITE(lunout,*) iadv(iq),niadv(iq),&
375	' ',trim(tname(iq)),' ',trim(ttext(iq))
376	END DO
377
378	!
379	! Test for advection schema.
380	! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) .
381	!
382	DO iq=1,nqtot
383	IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
384	WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
385	CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
386	ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
387	WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
388	CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
389	END IF
390	END DO
391
392	!-----------------------------------------------------------------------
393	! Finalize :
394	!
395	DEALLOCATE(tnom_0, hadv, vadv)
396	DEALLOCATE(tracnam)
397
398	END SUBROUTINE infotrac_init
399
400	END MODULE infotrac

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

Download in other formats:

Original Format