Context Navigation

infotrac.F90 @ 2118

Last change on this file since 2118 was 2086, checked in by fhourdin, 10 years ago
nclusion de la thermodynamique de la glace Ice thermodynamics (Catherine Rio)
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.9 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
265	END IF ! type_trac
266
267	!-----------------------------------------------------------------------
268	!
269	! 3) Verify if advection schema 20 or 30 choosen
270	! Calculate total number of tracers needed: nqtot
271	! Allocate variables depending on total number of tracers
272	!-----------------------------------------------------------------------
273	new_iq=0
274	DO iq=1,nqtrue
275	! Add tracers for certain advection schema
276	IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN
277	new_iq=new_iq+1 ! no tracers added
278	ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN
279	new_iq=new_iq+4 ! 3 tracers added
280	ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN
281	new_iq=new_iq+10 ! 9 tracers added
282	ELSE
283	WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
284	CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
285	END IF
286	END DO
287
288	IF (new_iq /= nqtrue) THEN
289	! The choice of advection schema imposes more tracers
290	! Assigne total number of tracers
291	nqtot = new_iq
292
293	WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
294	WRITE(lunout,*) 'makes it necessary to add tracers'
295	WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
296	WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
297
298	ELSE
299	! The true number of tracers is also the total number
300	nqtot = nqtrue
301	END IF
302
303	!
304	! Allocate variables with total number of tracers, nqtot
305	!
306	ALLOCATE(tname(nqtot), ttext(nqtot))
307	ALLOCATE(iadv(nqtot), niadv(nqtot))
308
309	!-----------------------------------------------------------------------
310	!
311	! 4) Determine iadv, long and short name
312	!
313	!-----------------------------------------------------------------------
314	new_iq=0
315	DO iq=1,nqtrue
316	new_iq=new_iq+1
317
318	! Verify choice of advection schema
319	IF (hadv(iq)==vadv(iq)) THEN
320	iadv(new_iq)=hadv(iq)
321	ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
322	iadv(new_iq)=11
323	ELSE
324	WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
325
326	CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
327	END IF
328
329	str1=tnom_0(iq)
330	tname(new_iq)= tnom_0(iq)
331	IF (iadv(new_iq)==0) THEN
332	ttext(new_iq)=trim(str1)
333	ELSE
334	ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
335	END IF
336
337	! schemas tenant compte des moments d'ordre superieur
338	str2=ttext(new_iq)
339	IF (iadv(new_iq)==20) THEN
340	DO jq=1,3
341	new_iq=new_iq+1
342	iadv(new_iq)=-20
343	ttext(new_iq)=trim(str2)//txts(jq)
344	tname(new_iq)=trim(str1)//txts(jq)
345	END DO
346	ELSE IF (iadv(new_iq)==30) THEN
347	DO jq=1,9
348	new_iq=new_iq+1
349	iadv(new_iq)=-30
350	ttext(new_iq)=trim(str2)//txtp(jq)
351	tname(new_iq)=trim(str1)//txtp(jq)
352	END DO
353	END IF
354	END DO
355
356	!
357	! Find vector keeping the correspodence between true and total tracers
358	!
359	niadv(:)=0
360	iiq=0
361	DO iq=1,nqtot
362	IF(iadv(iq).GE.0) THEN
363	! True tracer
364	iiq=iiq+1
365	niadv(iiq)=iq
366	ENDIF
367	END DO
368
369
370	WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
371	WRITE(lunout,*) trim(modname),': iadv niadv tname ttext :'
372	DO iq=1,nqtot
373	WRITE(lunout,*) iadv(iq),niadv(iq),&
374	' ',trim(tname(iq)),' ',trim(ttext(iq))
375	END DO
376
377	!
378	! Test for advection schema.
379	! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) .
380	!
381	DO iq=1,nqtot
382	IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
383	WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
384	CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
385	ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
386	WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
387	CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
388	END IF
389	END DO
390
391	!-----------------------------------------------------------------------
392	! Finalize :
393	!
394	DEALLOCATE(tnom_0, hadv, vadv)
395	DEALLOCATE(tracnam)
396
397	END SUBROUTINE infotrac_init
398
399	END MODULE infotrac

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

Download in other formats:

Original Format