Context Navigation

infotrac.F90 @ 3869

Last change on this file since 3869 was 3869, checked in by Ehouarn Millour, 3 years ago
Minor fix to r3865; initialize nqexcl(=nqtrue) even for regular "type_trac" cases, as it is used later in a print statement which gets caught by compilers in debug mode. 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 Property svn:keywords set to `Id`
File size: 39.9 KB

Line
1	! $Id: infotrac.F90 3869 2021-03-29 09:22:09Z emillour $
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	! CRisi: nb traceurs pères= directement advectés par l'air
15	INTEGER, SAVE :: nqperes
16
17	! ThL: nb traceurs spécifiques à INCA
18	INTEGER, SAVE :: nqINCA
19
20	! Name variables
21	CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
22	CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
23
24	! iadv : index of trasport schema for each tracer
25	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iadv
26
27	! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the
28	! dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code.
29	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: niadv ! equivalent dyn / physique
30
31	! CRisi: tableaux de fils
32	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqfils
33	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations
34	INTEGER, SAVE :: nqdesc_tot
35	INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqfils
36	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iqpere
37	REAL :: qperemin,masseqmin,ratiomin ! MVals et CRisi
38	PARAMETER (qperemin=1e-16,masseqmin=1e-16,ratiomin=1e-16) ! MVals
39
40	! conv_flg(it)=0 : convection desactivated for tracer number it
41	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg
42	! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it
43	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg
44
45	CHARACTER(len=4),SAVE :: type_trac
46	CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
47
48	! CRisi: cas particulier des isotopes
49	LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso
50	INTEGER :: niso_possibles
51	PARAMETER ( niso_possibles=5)
52	REAL, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal
53	LOGICAL, DIMENSION(niso_possibles),SAVE :: use_iso
54	INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqiso ! donne indice iq en fn de (ixt,phase)
55	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
56	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
57	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: zone_num ! donne numéro de la zone de tracage en fn de nqtot
58	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: phase_num ! donne numéro de la zone de tracage en fn de nqtot
59	INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
60	INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: index_trac ! numéro ixt en fn izone, indnum entre 1 et niso
61	INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
62
63	#ifdef CPP_StratAer
64	!--CK/OB for stratospheric aerosols
65	INTEGER, SAVE :: nbtr_bin
66	INTEGER, SAVE :: nbtr_sulgas
67	INTEGER, SAVE :: id_OCS_strat
68	INTEGER, SAVE :: id_SO2_strat
69	INTEGER, SAVE :: id_H2SO4_strat
70	INTEGER, SAVE :: id_BIN01_strat
71	INTEGER, SAVE :: id_TEST_strat
72	#endif
73
74	CONTAINS
75
76	SUBROUTINE infotrac_init
77	USE control_mod, ONLY: planet_type, config_inca
78	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
79	#ifdef REPROBUS
80	USE CHEM_REP, ONLY : Init_chem_rep_trac
81	#endif
82	IMPLICIT NONE
83	!=======================================================================
84	!
85	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
86	! -------
87	! Modif special traceur F.Forget 05/94
88	! Modif M-A Filiberti 02/02 lecture de traceur.def
89	!
90	! Objet:
91	! ------
92	! GCM LMD nouvelle grille
93	!
94	!=======================================================================
95	! ... modification de l'integration de q ( 26/04/94 ) ....
96	!-----------------------------------------------------------------------
97	! Declarations
98
99	INCLUDE "dimensions.h"
100	INCLUDE "iniprint.h"
101
102	! Local variables
103	INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv ! index of horizontal trasport schema
104	INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv ! index of vertical trasport schema
105
106	INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv_inca ! index of horizontal trasport schema
107	INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv_inca ! index of vertical trasport schema
108
109	CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0 ! tracer short name
110	CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi
111	CHARACTER(len=3), DIMENSION(30) :: descrq
112	CHARACTER(len=1), DIMENSION(3) :: txts
113	CHARACTER(len=2), DIMENSION(9) :: txtp
114	CHARACTER(len=23) :: str1,str2
115
116	INTEGER :: nqtrue ! number of tracers read from tracer.def, without higer order of moment
117	INTEGER :: iq, new_iq, iiq, jq, ierr
118	INTEGER :: ifils,ipere,generation ! CRisi
119	LOGICAL :: continu,nouveau_traceurdef
120	INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def
121	CHARACTER(len=15) :: tchaine
122
123	character(len=*),parameter :: modname="infotrac_init"
124
125	INTEGER :: nqexcl ! ThL. Nb de traceurs dans traceur.def. Egal à nqtrue,
126	! sauf pour 'inca' = nqtrue-nbtr, et 'inco' = 4.
127	!-----------------------------------------------------------------------
128	! Initialization :
129	!
130	txts=(/'x','y','z'/)
131	txtp=(/'x ','y ','z ','xx','xy','xz','yy','yz','zz'/)
132
133	descrq(14)='VLH'
134	descrq(10)='VL1'
135	descrq(11)='VLP'
136	descrq(12)='FH1'
137	descrq(13)='FH2'
138	descrq(16)='PPM'
139	descrq(17)='PPS'
140	descrq(18)='PPP'
141	descrq(20)='SLP'
142	descrq(30)='PRA'
143
144
145	! Coherence test between parameter type_trac, config_inca and preprocessing keys
146	IF (type_trac=='inca') THEN
147	WRITE(lunout,*) 'You have chosen to couple with INCA chemistry model : type_trac=', &
148	type_trac,' config_inca=',config_inca
149	IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
150	WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
151	CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
152	END IF
153	#ifndef INCA
154	WRITE(lunout,*) 'To run this option you must add cpp key INCA and compile with INCA code'
155	CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1)
156	#endif
157	ELSE IF (type_trac=='repr') THEN
158	WRITE(lunout,*) 'You have chosen to couple with REPROBUS chemestry model : type_trac=', type_trac
159	#ifndef REPROBUS
160	WRITE(lunout,*) 'To run this option you must add cpp key REPROBUS and compile with REPRPBUS code'
161	CALL abort_gcm('infotrac_init','You must compile with cpp key REPROBUS',1)
162	#endif
163	ELSE IF (type_trac == 'co2i') THEN
164	WRITE(lunout,*) 'You have chosen to run with CO2 cycle: type_trac=', type_trac
165	ELSE IF (type_trac == 'coag') THEN
166	WRITE(lunout,*) 'Tracers are treated for COAGULATION tests : type_trac=', type_trac
167	#ifndef CPP_StratAer
168	WRITE(lunout,*) 'To run this option you must add cpp key StratAer and compile with StratAer code'
169	CALL abort_gcm('infotrac_init','You must compile with cpp key StratAer',1)
170	#endif
171	ELSE IF (type_trac == 'lmdz') THEN
172	WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac
173	ELSE IF (type_trac == 'inco') THEN ! ThL
174	WRITE(lunout,*) 'Using jointly INCA and CO2 cycle: type_trac =', type_trac
175	IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
176	WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
177	CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
178	END IF
179	#ifndef INCA
180	WRITE(lunout,*) 'To run this option you must add cpp key INCA and compilewith INCA code'
181	CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1)
182	#endif
183	ELSE
184	WRITE(lunout,*) 'type_trac=',type_trac,' not possible. Model stops'
185	CALL abort_gcm('infotrac_init','bad parameter',1)
186	END IF
187
188	! Test if config_inca is other then none for run without INCA
189	IF (type_trac/='inca' .AND. type_trac/='inco' .AND. config_inca/='none') THEN
190	WRITE(lunout,*) 'config_inca will now be changed to none as you do not couple with INCA model'
191	config_inca='none'
192	END IF
193
194	!-----------------------------------------------------------------------
195	!
196	! 1) Get the true number of tracers + water vapor/liquid
197	! Here true tracers (nqtrue) means declared tracers (only first order)
198	!
199	!-----------------------------------------------------------------------
200	IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag' .OR. type_trac == 'co2i') THEN
201	OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
202	IF(ierr.EQ.0) THEN
203	WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
204	READ(90,*) nqtrue
205	write(lunout,*) 'nqtrue=',nqtrue
206	ELSE
207	WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
208	WRITE(lunout,*) trim(modname),': WARNING using defaut values'
209	IF (planet_type=='earth') THEN
210	nqtrue=4 ! Default value for Earth
211	ELSE
212	nqtrue=1 ! Default value for other planets
213	ENDIF
214	ENDIF
215	nqexcl=nqtrue
216	!jyg<
217	!! if ( planet_type=='earth') then
218	!! ! For Earth, water vapour & liquid tracers are not in the physics
219	!! nbtr=nqtrue-2
220	!! else
221	!! ! Other planets (for now); we have the same number of tracers
222	!! ! in the dynamics than in the physics
223	!! nbtr=nqtrue
224	!! endif
225	!>jyg
226	ELSE ! type_trac=inca (or inco ThL)
227	!jyg<
228	! The traceur.def file is used to define the number "nqo" of water phases
229	! present in the simulation. Default : nqo = 2.
230	OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
231	IF(ierr.EQ.0) THEN
232	WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
233	READ(90,*) nqo
234	ELSE
235	WRITE(lunout,*) trim(modname),': Using default value for nqo'
236	nqo=2
237	ENDIF
238	IF (nqo /= 2 .AND. nqo /= 3 ) THEN
239	IF (nqo == 4 .AND. type_trac=='inco') THEN ! ThL
240	WRITE(lunout,*) trim(modname),': you are coupling with INCA, and also using CO2i.'
241	nqo = 3 ! A améliorier... je force 3 traceurs eau... ThL
242	WRITE(lunout,*) trim(modname),': nqo = ',nqo
243	ELSE
244	WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowed. Only 2 or 3 water phases allowed'
245	CALL abort_gcm('infotrac_init','Bad number of water phases',1)
246	ENDIF
247	END IF
248	! nbtr has been read from INCA by init_const_lmdz() in gcm.F
249	#ifdef INCA
250	CALL Init_chem_inca_trac(nbtr)
251	#endif
252	IF (type_trac=='inco') THEN ! Add ThL
253	nqexcl = nqo+1 ! Tracers excluding INCA's = water + CO2 in 'inco' case
254	ELSE
255	nqexcl = nqo ! Tracers excluding INCA's = water
256	ENDIF
257	nqtrue = nbtr + nqexcl ! Total nb of tracers = INCA's + traceur.def
258	IF (type_trac=='inco') THEN !
259	nqINCA = nbtr ! nbtr = other tracers than H2O = INCA's + CO2i
260	nbtr = nqINCA + 1 !
261	ELSEIF (type_trac=='inca') THEN !
262	nqINCA = nbtr !
263	ELSE !
264	nqINCA = 0 !
265	ENDIF !
266	WRITE(lunout,*) trim(modname),': nqo = ',nqo
267	WRITE(lunout,*) trim(modname),': nbtr = ',nbtr
268	WRITE(lunout,*) trim(modname),': nqexcl = ',nqexcl
269	WRITE(lunout,*) trim(modname),': nqtrue = ',nqtrue
270	WRITE(lunout,*) trim(modname),': nqINCA = ',nqINCA
271	ALLOCATE(hadv_inca(nqINCA), vadv_inca(nqINCA)) ! ThL
272	ENDIF ! type_trac
273	!>jyg
274
275	IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
276	WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
277	CALL abort_gcm('infotrac_init','Not enough tracers',1)
278	END IF
279
280	!jyg<
281	! Transfert number of tracers to Reprobus
282	!! IF (type_trac == 'repr') THEN
283	!!#ifdef REPROBUS
284	!! CALL Init_chem_rep_trac(nbtr)
285	!!#endif
286	!! END IF
287	!>jyg
288
289	!
290	! Allocate variables depending on nqtrue
291	!
292	ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue),tnom_transp(nqtrue))
293
294	!
295	!jyg<
296	!! ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
297	!! conv_flg(:) = 1 ! convection activated for all tracers
298	!! pbl_flg(:) = 1 ! boundary layer activated for all tracers
299	!>jyg
300
301	!-----------------------------------------------------------------------
302	! 2) Choix des schemas d'advection pour l'eau et les traceurs
303	!
304	! iadv = 1 schema transport type "humidite specifique LMD"
305	! iadv = 2 schema amont
306	! iadv = 14 schema Van-leer + humidite specifique
307	! Modif F.Codron
308	! iadv = 10 schema Van-leer (retenu pour l'eau vapeur et liquide)
309	! iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone) pour vadv
310	! iadv = 12 schema Frederic Hourdin I
311	! iadv = 13 schema Frederic Hourdin II
312	! iadv = 16 schema PPM Monotone(Collela & Woodward 1984)
313	! iadv = 17 schema PPM Semi Monotone (overshoots autorisés)
314	! iadv = 18 schema PPM Positif Defini (overshoots undershoots autorisés)
315	! iadv = 20 schema Slopes
316	! iadv = 30 schema Prather
317	!
318	! Dans le tableau q(ij,l,iq) : iq = 1 pour l'eau vapeur
319	! iq = 2 pour l'eau liquide
320	! Et eventuellement iq = 3,nqtot pour les autres traceurs
321	!
322	! iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq.
323	!------------------------------------------------------------------------
324	!
325	! Get choice of advection schema from file tracer.def or from INCA
326	!---------------------------------------------------------------------
327	IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag' .OR. type_trac == 'co2i') THEN
328	IF(ierr.EQ.0) THEN
329	! Continue to read tracer.def
330	DO iq=1,nqtrue
331
332	write(,) 'infotrac 237: iq=',iq
333	! CRisi: ajout du nom du fluide transporteur
334	! mais rester retro compatible
335	READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine
336	write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq)
337	write(lunout,*) 'tchaine=',trim(tchaine)
338	write(,) 'infotrac 238: IOstatus=',IOstatus
339	if (IOstatus.ne.0) then
340	CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1)
341	endif
342	! Y-a-t-il 1 ou 2 noms de traceurs? -> On regarde s'il y a un
343	! espace ou pas au milieu de la chaine.
344	continu=.true.
345	nouveau_traceurdef=.false.
346	iiq=1
347	do while (continu)
348	if (tchaine(iiq:iiq).eq.' ') then
349	nouveau_traceurdef=.true.
350	continu=.false.
351	else if (iiq.lt.LEN_TRIM(tchaine)) then
352	iiq=iiq+1
353	else
354	continu=.false.
355	endif
356	enddo
357	write(,) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef
358	if (nouveau_traceurdef) then
359	write(lunout,*) 'C''est la nouvelle version de traceur.def'
360	tnom_0(iq)=tchaine(1:iiq-1)
361	tnom_transp(iq)=tchaine(iiq+1:15)
362	else
363	write(lunout,*) 'C''est l''ancienne version de traceur.def'
364	write(lunout,*) 'On suppose que les traceurs sont tous d''air'
365	tnom_0(iq)=tchaine
366	tnom_transp(iq) = 'air'
367	endif
368	write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>'
369	write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
370
371	END DO !DO iq=1,nqtrue
372	CLOSE(90)
373
374	ELSE ! Without tracer.def, set default values
375	if (planet_type=="earth") then
376	! for Earth, default is to have 4 tracers
377	hadv(1) = 14
378	vadv(1) = 14
379	tnom_0(1) = 'H2Ov'
380	tnom_transp(1) = 'air'
381	hadv(2) = 10
382	vadv(2) = 10
383	tnom_0(2) = 'H2Ol'
384	tnom_transp(2) = 'air'
385	hadv(3) = 10
386	vadv(3) = 10
387	tnom_0(3) = 'RN'
388	tnom_transp(3) = 'air'
389	hadv(4) = 10
390	vadv(4) = 10
391	tnom_0(4) = 'PB'
392	tnom_transp(4) = 'air'
393	else ! default for other planets
394	hadv(1) = 10
395	vadv(1) = 10
396	tnom_0(1) = 'dummy'
397	tnom_transp(1) = 'dummy'
398	endif ! of if (planet_type=="earth")
399	END IF
400
401	WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
402	WRITE(lunout,*) trim(modname),': nombre total de traceurs ',nqtrue
403	WRITE(lunout,*) trim(modname),': nombre de traceurs dans traceur.def ',nqexcl
404	DO iq=1,nqtrue
405	WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq),tnom_transp(iq)
406	END DO
407
408	IF ( planet_type=='earth') THEN
409	!CR: nombre de traceurs de l eau
410	IF (tnom_0(3) == 'H2Oi') THEN
411	nqo=3
412	ELSE
413	nqo=2
414	ENDIF
415	! For Earth, water vapour & liquid tracers are not in the physics
416	nbtr=nqtrue-nqo
417	ELSE
418	! Other planets (for now); we have the same number of tracers
419	! in the dynamics than in the physics
420	nbtr=nqtrue
421	ENDIF
422
423	#ifdef CPP_StratAer
424	IF (type_trac == 'coag') THEN
425	nbtr_bin=0
426	nbtr_sulgas=0
427	DO iq=1,nqtrue
428	IF (tnom_0(iq)(1:3)=='BIN') THEN !check if tracer name contains 'BIN'
429	nbtr_bin=nbtr_bin+1
430	ENDIF
431	IF (tnom_0(iq)(1:3)=='GAS') THEN !check if tracer name contains 'GAS'
432	nbtr_sulgas=nbtr_sulgas+1
433	ENDIF
434	ENDDO
435	print*,'nbtr_bin=',nbtr_bin
436	print*,'nbtr_sulgas=',nbtr_sulgas
437	DO iq=1,nqtrue
438	IF (tnom_0(iq)=='GASOCS') THEN
439	id_OCS_strat=iq-nqo
440	ENDIF
441	IF (tnom_0(iq)=='GASSO2') THEN
442	id_SO2_strat=iq-nqo
443	ENDIF
444	IF (tnom_0(iq)=='GASH2SO4') THEN
445	id_H2SO4_strat=iq-nqo
446	ENDIF
447	IF (tnom_0(iq)=='BIN01') THEN
448	id_BIN01_strat=iq-nqo
449	ENDIF
450	IF (tnom_0(iq)=='GASTEST') THEN
451	id_TEST_strat=iq-nqo
452	ENDIF
453	ENDDO
454	print*,'id_OCS_strat =',id_OCS_strat
455	print*,'id_SO2_strat =',id_SO2_strat
456	print*,'id_H2SO4_strat=',id_H2SO4_strat
457	print*,'id_BIN01_strat=',id_BIN01_strat
458	ENDIF
459	#endif
460
461	ENDIF ! (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac = 'coag' .OR. type_trac = 'co2i')
462	!jyg<
463	!
464	! Transfert number of tracers to Reprobus
465	IF (type_trac == 'repr') THEN
466	#ifdef REPROBUS
467	CALL Init_chem_rep_trac(nbtr,nqo,tnom_0)
468	#endif
469	END IF
470	!
471	! Allocate variables depending on nbtr
472	!
473	ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
474	conv_flg(:) = 1 ! convection activated for all tracers
475	pbl_flg(:) = 1 ! boundary layer activated for all tracers
476	!
477	!! ELSE ! type_trac=inca : config_inca='aero' ou 'chem'
478	!
479	IF (type_trac == 'inca') THEN ! config_inca='aero' ou 'chem'
480	!>jyg
481	! le module de chimie fournit les noms des traceurs
482	! et les schemas d'advection associes. excepte pour ceux lus
483	! dans traceur.def
484	IF (ierr .eq. 0) then
485	DO iq=1,nqo
486
487	write(,) 'infotrac 237: iq=',iq
488	! CRisi: ajout du nom du fluide transporteur
489	! mais rester retro compatible
490	READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine
491	write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq)
492	write(lunout,*) 'tchaine=',trim(tchaine)
493	write(,) 'infotrac 238: IOstatus=',IOstatus
494	if (IOstatus.ne.0) then
495	CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1)
496	endif
497	! Y-a-t-il 1 ou 2 noms de traceurs? -> On regarde s'il y a un
498	! espace ou pas au milieu de la chaine.
499	continu=.true.
500	nouveau_traceurdef=.false.
501	iiq=1
502	do while (continu)
503	if (tchaine(iiq:iiq).eq.' ') then
504	nouveau_traceurdef=.true.
505	continu=.false.
506	else if (iiq.lt.LEN_TRIM(tchaine)) then
507	iiq=iiq+1
508	else
509	continu=.false.
510	endif
511	enddo
512	write(,) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef
513	if (nouveau_traceurdef) then
514	write(lunout,*) 'C''est la nouvelle version de traceur.def'
515	tnom_0(iq)=tchaine(1:iiq-1)
516	tnom_transp(iq)=tchaine(iiq+1:15)
517	else
518	write(lunout,*) 'C''est l''ancienne version de traceur.def'
519	write(lunout,*) 'On suppose que les traceurs sont tous d''air'
520	tnom_0(iq)=tchaine
521	tnom_transp(iq) = 'air'
522	endif
523	write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>'
524	write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
525
526	END DO !DO iq=1,nqo
527	CLOSE(90)
528	ELSE !! if traceur.def doesn't exist
529	tnom_0(1)='H2Ov'
530	tnom_transp(1) = 'air'
531	tnom_0(2)='H2Ol'
532	tnom_transp(2) = 'air'
533	hadv(1) = 10
534	hadv(2) = 10
535	vadv(1) = 10
536	vadv(2) = 10
537	ENDIF
538
539	#ifdef INCA
540	CALL init_transport( &
541	hadv_inca, &
542	vadv_inca, &
543	conv_flg, &
544	pbl_flg, &
545	solsym)
546	#endif
547
548
549	!jyg<
550	DO iq = nqo+1, nqtrue
551	hadv(iq) = hadv_inca(iq-nqo)
552	vadv(iq) = vadv_inca(iq-nqo)
553	tnom_0(iq)=solsym(iq-nqo)
554	tnom_transp(iq) = 'air'
555	END DO
556
557	END IF ! (type_trac == 'inca')
558
559	!< add ThL case 'inco'
560	IF (type_trac == 'inco') THEN
561	! le module de chimie fournit les noms des traceurs
562	! et les schemas d'advection associes. excepte pour ceux lus
563	! dans traceur.def
564	IF (ierr .eq. 0) then
565	DO iq=1,nqexcl
566	write(,) 'infotrac 237: iq=',iq
567	! CRisi: ajout du nom du fluide transporteur
568	! mais rester retro compatible
569	READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine
570	write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq)
571	write(lunout,*) 'tchaine=',trim(tchaine)
572	write(,) 'infotrac 238: IOstatus=',IOstatus
573	if (IOstatus.ne.0) then
574	CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1)
575	endif
576	! Y-a-t-il 1 ou 2 noms de traceurs? -> On regarde s'il y a un
577	! espace ou pas au milieu de la chaine.
578	continu=.true.
579	nouveau_traceurdef=.false.
580	iiq=1
581	do while (continu)
582	if (tchaine(iiq:iiq).eq.' ') then
583	nouveau_traceurdef=.true.
584	continu=.false.
585	else if (iiq.lt.LEN_TRIM(tchaine)) then
586	iiq=iiq+1
587	else
588	continu=.false.
589	endif
590	enddo
591	write(,) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef
592	if (nouveau_traceurdef) then
593	write(lunout,*) 'C''est la nouvelle version de traceur.def'
594	tnom_0(iq)=tchaine(1:iiq-1)
595	tnom_transp(iq)=tchaine(iiq+1:15)
596	else
597	write(lunout,*) 'C''est l''ancienne version de traceur.def'
598	write(lunout,*) 'On suppose que les traceurs sont tous d''air'
599	tnom_0(iq)=tchaine
600	tnom_transp(iq) = 'air'
601	endif
602	write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>'
603	write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
604	END DO !DO iq=1,nqexcl
605	CLOSE(90)
606	ELSE !! if traceur.def doesn't exist
607	tnom_0(1)='H2Ov'
608	tnom_transp(1) = 'air'
609	tnom_0(2)='H2Ol'
610	tnom_transp(2) = 'air'
611	hadv(1) = 10
612	hadv(2) = 10
613	vadv(1) = 10
614	vadv(2) = 10
615	ENDIF
616
617	#ifdef INCA
618	CALL init_transport( &
619	hadv_inca, &
620	vadv_inca, &
621	conv_flg, &
622	pbl_flg, &
623	solsym)
624	#endif
625
626	DO iq = nqexcl+1, nqtrue
627	hadv(iq) = hadv_inca(iq-nqexcl) ! mod. Thl : nqexcl was nqo (in order to shift)
628	vadv(iq) = vadv_inca(iq-nqexcl) ! idem
629	tnom_0(iq)=solsym(iq-nqexcl) ! idem
630	tnom_transp(iq) = 'air'
631	END DO
632
633	END IF ! (type_trac == 'inco')
634	!> add ThL case 'inco'
635
636	!-----------------------------------------------------------------------
637	!
638	! 3) Verify if advection schema 20 or 30 choosen
639	! Calculate total number of tracers needed: nqtot
640	! Allocate variables depending on total number of tracers
641	!-----------------------------------------------------------------------
642	new_iq=0
643	DO iq=1,nqtrue
644	! Add tracers for certain advection schema
645	IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN
646	new_iq=new_iq+1 ! no tracers added
647	ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN
648	new_iq=new_iq+4 ! 3 tracers added
649	ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN
650	new_iq=new_iq+10 ! 9 tracers added
651	ELSE
652	WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
653	CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
654	END IF
655	END DO
656
657	IF (new_iq /= nqtrue) THEN
658	! The choice of advection schema imposes more tracers
659	! Assigne total number of tracers
660	nqtot = new_iq
661
662	WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
663	WRITE(lunout,*) 'makes it necessary to add tracers'
664	WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
665	WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
666
667	ELSE
668	! The true number of tracers is also the total number
669	nqtot = nqtrue
670	END IF
671
672	!
673	! Allocate variables with total number of tracers, nqtot
674	!
675	ALLOCATE(tname(nqtot), ttext(nqtot))
676	ALLOCATE(iadv(nqtot), niadv(nqtot))
677
678	!-----------------------------------------------------------------------
679	!
680	! 4) Determine iadv, long and short name
681	!
682	!-----------------------------------------------------------------------
683	new_iq=0
684	DO iq=1,nqtrue
685	new_iq=new_iq+1
686
687	! Verify choice of advection schema
688	IF (hadv(iq)==vadv(iq)) THEN
689	iadv(new_iq)=hadv(iq)
690	ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
691	iadv(new_iq)=11
692	ELSE
693	WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
694
695	CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
696	END IF
697
698	str1=tnom_0(iq)
699	tname(new_iq)= tnom_0(iq)
700	IF (iadv(new_iq)==0) THEN
701	ttext(new_iq)=trim(str1)
702	ELSE
703	ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
704	END IF
705
706	! schemas tenant compte des moments d'ordre superieur
707	str2=ttext(new_iq)
708	IF (iadv(new_iq)==20) THEN
709	DO jq=1,3
710	new_iq=new_iq+1
711	iadv(new_iq)=-20
712	ttext(new_iq)=trim(str2)//txts(jq)
713	tname(new_iq)=trim(str1)//txts(jq)
714	END DO
715	ELSE IF (iadv(new_iq)==30) THEN
716	DO jq=1,9
717	new_iq=new_iq+1
718	iadv(new_iq)=-30
719	ttext(new_iq)=trim(str2)//txtp(jq)
720	tname(new_iq)=trim(str1)//txtp(jq)
721	END DO
722	END IF
723	END DO
724
725	!
726	! Find vector keeping the correspodence between true and total tracers
727	!
728	niadv(:)=0
729	iiq=0
730	DO iq=1,nqtot
731	IF(iadv(iq).GE.0) THEN
732	! True tracer
733	iiq=iiq+1
734	niadv(iiq)=iq
735	ENDIF
736	END DO
737
738
739	WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
740	WRITE(lunout,*) trim(modname),': iadv niadv tname ttext :'
741	DO iq=1,nqtot
742	WRITE(lunout,*) iadv(iq),niadv(iq),&
743	' ',trim(tname(iq)),' ',trim(ttext(iq))
744	END DO
745
746	!
747	! Test for advection schema.
748	! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) .
749	!
750	DO iq=1,nqtot
751	IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
752	WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
753	CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
754	ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
755	WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
756	CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
757	END IF
758	END DO
759
760
761	! CRisi: quels sont les traceurs fils et les traceurs pères.
762	! initialiser tous les tableaux d'indices liés aux traceurs familiaux
763	! + vérifier que tous les pères sont écrits en premières positions
764	ALLOCATE(nqfils(nqtot),nqdesc(nqtot))
765	ALLOCATE(iqfils(nqtot,nqtot))
766	ALLOCATE(iqpere(nqtot))
767	nqperes=0
768	nqfils(:)=0
769	nqdesc(:)=0
770	iqfils(:,:)=0
771	iqpere(:)=0
772	nqdesc_tot=0
773	DO iq=1,nqtot
774	if (tnom_transp(iq) == 'air') then
775	! ceci est un traceur père
776	WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere'
777	nqperes=nqperes+1
778	iqpere(iq)=0
779	else !if (tnom_transp(iq) == 'air') then
780	! ceci est un fils. Qui est son père?
781	WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils'
782	continu=.true.
783	ipere=1
784	do while (continu)
785	if (tnom_transp(iq) == tnom_0(ipere)) then
786	! Son père est ipere
787	WRITE(lunout,*) 'Le traceur',iq,'appele ', &
788	& trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere))
789	nqfils(ipere)=nqfils(ipere)+1
790	iqfils(nqfils(ipere),ipere)=iq
791	iqpere(iq)=ipere
792	continu=.false.
793	else !if (tnom_transp(iq) == tnom_0(ipere)) then
794	ipere=ipere+1
795	if (ipere.gt.nqtot) then
796	WRITE(lunout,*) 'Le traceur',iq,'appele ', &
797	& trim(tnom_0(iq)),', est orphelin.'
798	CALL abort_gcm('infotrac_init','Un traceur est orphelin',1)
799	endif !if (ipere.gt.nqtot) then
800	endif !if (tnom_transp(iq) == tnom_0(ipere)) then
801	enddo !do while (continu)
802	endif !if (tnom_transp(iq) == 'air') then
803	enddo !DO iq=1,nqtot
804	WRITE(lunout,*) 'infotrac: nqperes=',nqperes
805	WRITE(lunout,*) 'nqfils=',nqfils
806	WRITE(lunout,*) 'iqpere=',iqpere
807	WRITE(lunout,*) 'iqfils=',iqfils
808
809	! Calculer le nombre de descendants à partir de iqfils et de nbfils
810	DO iq=1,nqtot
811	generation=0
812	continu=.true.
813	ifils=iq
814	do while (continu)
815	ipere=iqpere(ifils)
816	if (ipere.gt.0) then
817	nqdesc(ipere)=nqdesc(ipere)+1
818	nqdesc_tot=nqdesc_tot+1
819	iqfils(nqdesc(ipere),ipere)=iq
820	ifils=ipere
821	generation=generation+1
822	else !if (ipere.gt.0) then
823	continu=.false.
824	endif !if (ipere.gt.0) then
825	enddo !do while (continu)
826	WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)),' est un traceur de generation: ',generation
827	enddo !DO iq=1,nqtot
828	WRITE(lunout,*) 'infotrac: nqdesc=',nqdesc
829	WRITE(lunout,*) 'iqfils=',iqfils
830	WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot
831
832	! Interdire autres schémas que 10 pour les traceurs fils, et autres schémas
833	! que 10 et 14 si des pères ont des fils
834	do iq=1,nqtot
835	if (iqpere(iq).gt.0) then
836	! ce traceur a un père qui n'est pas l'air
837	! Seul le schéma 10 est autorisé
838	if (iadv(iq)/=10) then
839	WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons'
840	CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1)
841	endif
842	! Le traceur père ne peut être advecté que par schéma 10 ou 14:
843	IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
844	WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers'
845	CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1)
846	endif !IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
847	endif !if (iqpere(iq).gt.0) the
848	enddo !do iq=1,nqtot
849
850	WRITE(lunout,*) 'infotrac init fin'
851
852	! detecter quels sont les traceurs isotopiques parmi des traceurs
853	call infotrac_isoinit(tnom_0,nqtrue)
854
855	!-----------------------------------------------------------------------
856	! Finalize :
857	!
858	DEALLOCATE(tnom_0, hadv, vadv,tnom_transp)
859
860
861	END SUBROUTINE infotrac_init
862
863	SUBROUTINE infotrac_isoinit(tnom_0,nqtrue)
864
865	#ifdef CPP_IOIPSL
866	use IOIPSL
867	#else
868	! if not using IOIPSL, we still need to use (a local version of) getin
869	use ioipsl_getincom
870	#endif
871	implicit none
872
873	! inputs
874	INTEGER nqtrue
875	CHARACTER(len=15) tnom_0(nqtrue)
876
877	! locals
878	CHARACTER(len=3), DIMENSION(niso_possibles) :: tnom_iso
879	INTEGER, ALLOCATABLE,DIMENSION(:,:) :: nb_iso,nb_traciso
880	INTEGER, ALLOCATABLE,DIMENSION(:) :: nb_isoind
881	INTEGER :: ntraceurs_zone_prec,iq,phase,ixt,iiso,izone
882	CHARACTER(len=19) :: tnom_trac
883	INCLUDE "iniprint.h"
884
885	tnom_iso=(/'eau','HDO','O18','O17','HTO'/)
886
887	ALLOCATE(nb_iso(niso_possibles,nqo))
888	ALLOCATE(nb_isoind(nqo))
889	ALLOCATE(nb_traciso(niso_possibles,nqo))
890	ALLOCATE(iso_num(nqtot))
891	ALLOCATE(iso_indnum(nqtot))
892	ALLOCATE(zone_num(nqtot))
893	ALLOCATE(phase_num(nqtot))
894
895	iso_num(:)=0
896	iso_indnum(:)=0
897	zone_num(:)=0
898	phase_num(:)=0
899	indnum_fn_num(:)=0
900	use_iso(:)=.false.
901	nb_iso(:,:)=0
902	nb_isoind(:)=0
903	nb_traciso(:,:)=0
904	niso=0
905	ntraceurs_zone=0
906	ntraceurs_zone_prec=0
907	ntraciso=0
908
909	do iq=nqo+1,nqtot
910	! write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq)
911	do phase=1,nqo
912	do ixt= 1,niso_possibles
913	tnom_trac=trim(tnom_0(phase))//'_'
914	tnom_trac=trim(tnom_trac)//trim(tnom_iso(ixt))
915	! write(,) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac
916	IF (tnom_0(iq) == tnom_trac) then
917	! write(lunout,*) 'Ce traceur est un isotope'
918	nb_iso(ixt,phase)=nb_iso(ixt,phase)+1
919	nb_isoind(phase)=nb_isoind(phase)+1
920	iso_num(iq)=ixt
921	iso_indnum(iq)=nb_isoind(phase)
922	indnum_fn_num(ixt)=iso_indnum(iq)
923	phase_num(iq)=phase
924	! write(lunout,*) 'iso_num(iq)=',iso_num(iq)
925	! write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq)
926	! write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt)
927	! write(lunout,*) 'phase_num(iq)=',phase_num(iq)
928	goto 20
929	else if (iqpere(iq).gt.0) then
930	if (tnom_0(iqpere(iq)) == tnom_trac) then
931	! write(lunout,*) 'Ce traceur est le fils d''un isotope'
932	! c'est un traceur d'isotope
933	nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1
934	iso_num(iq)=ixt
935	iso_indnum(iq)=indnum_fn_num(ixt)
936	zone_num(iq)=nb_traciso(ixt,phase)
937	phase_num(iq)=phase
938	! write(lunout,*) 'iso_num(iq)=',iso_num(iq)
939	! write(lunout,*) 'phase_num(iq)=',phase_num(iq)
940	! write(lunout,*) 'zone_num(iq)=',zone_num(iq)
941	goto 20
942	endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
943	endif !IF (tnom_0(iq) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then
944	enddo !do ixt= niso_possibles
945	enddo !do phase=1,nqo
946	20 continue
947	enddo !do iq=1,nqtot
948
949	! write(lunout,*) 'iso_num=',iso_num
950	! write(lunout,*) 'iso_indnum=',iso_indnum
951	! write(lunout,*) 'zone_num=',zone_num
952	! write(lunout,*) 'phase_num=',phase_num
953	! write(lunout,*) 'indnum_fn_num=',indnum_fn_num
954
955	do ixt= 1,niso_possibles
956
957	if (nb_iso(ixt,1).eq.1) then
958	! on vérifie que toutes les phases ont le même nombre de
959	! traceurs
960	do phase=2,nqo
961	if (nb_iso(ixt,phase).ne.nb_iso(ixt,1)) then
962	! write(lunout,*) 'ixt,phase,nb_iso=',ixt,phase,nb_iso(ixt,phase)
963	CALL abort_gcm('infotrac_init','Phases must have same number of isotopes',1)
964	endif
965	enddo !do phase=2,nqo
966
967	niso=niso+1
968	use_iso(ixt)=.true.
969	ntraceurs_zone=nb_traciso(ixt,1)
970
971	! on vérifie que toutes les phases ont le même nombre de
972	! traceurs
973	do phase=2,nqo
974	if (nb_traciso(ixt,phase).ne.ntraceurs_zone) then
975	write(lunout,*) 'ixt,phase,nb_traciso=',ixt,phase,nb_traciso(ixt,phase)
976	write(lunout,*) 'ntraceurs_zone=',ntraceurs_zone
977	CALL abort_gcm('infotrac_init','Phases must have same number of tracers',1)
978	endif
979	enddo !do phase=2,nqo
980	! on vérifie que tous les isotopes ont le même nombre de
981	! traceurs
982	if (ntraceurs_zone_prec.gt.0) then
983	if (ntraceurs_zone.eq.ntraceurs_zone_prec) then
984	ntraceurs_zone_prec=ntraceurs_zone
985	else !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then
986	write(,) 'ntraceurs_zone_prec,ntraceurs_zone=',ntraceurs_zone_prec,ntraceurs_zone
987	CALL abort_gcm('infotrac_init', &
988	&'Isotope tracers are not well defined in traceur.def',1)
989	endif !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then
990	endif !if (ntraceurs_zone_prec.gt.0) then
991
992	else if (nb_iso(ixt,1).ne.0) then
993	WRITE(lunout,*) 'nqo,ixt=',nqo,ixt
994	WRITE(lunout,*) 'nb_iso(ixt,1)=',nb_iso(ixt,1)
995	CALL abort_gcm('infotrac_init','Isotopes are not well defined in traceur.def',1)
996	endif !if (nb_iso(ixt,1).eq.1) then
997	enddo ! do ixt= niso_possibles
998
999	! dimensions isotopique:
1000	ntraciso=niso*(ntraceurs_zone+1)
1001	! WRITE(lunout,*) 'niso=',niso
1002	! WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso
1003
1004	! flags isotopiques:
1005	if (niso.gt.0) then
1006	ok_isotopes=.true.
1007	else
1008	ok_isotopes=.false.
1009	endif
1010	! WRITE(lunout,*) 'ok_isotopes=',ok_isotopes
1011
1012	if (ok_isotopes) then
1013	ok_iso_verif=.false.
1014	call getin('ok_iso_verif',ok_iso_verif)
1015	ok_init_iso=.false.
1016	call getin('ok_init_iso',ok_init_iso)
1017	tnat=(/1.0,155.76e-6,2005.2e-6,0.004/100.,0.0/)
1018	alpha_ideal=(/1.0,1.01,1.006,1.003,1.0/)
1019	endif !if (ok_isotopes) then
1020	! WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif
1021	! WRITE(lunout,*) 'ok_init_iso=',ok_init_iso
1022
1023	if (ntraceurs_zone.gt.0) then
1024	ok_isotrac=.true.
1025	else
1026	ok_isotrac=.false.
1027	endif
1028	! WRITE(lunout,*) 'ok_isotrac=',ok_isotrac
1029
1030	! remplissage du tableau iqiso(ntraciso,phase)
1031	ALLOCATE(iqiso(ntraciso,nqo))
1032	iqiso(:,:)=0
1033	do iq=1,nqtot
1034	if (iso_num(iq).gt.0) then
1035	ixt=iso_indnum(iq)+zone_num(iq)*niso
1036	iqiso(ixt,phase_num(iq))=iq
1037	endif
1038	enddo
1039	! WRITE(lunout,*) 'iqiso=',iqiso
1040
1041	! replissage du tableau index_trac(ntraceurs_zone,niso)
1042	ALLOCATE(index_trac(ntraceurs_zone,niso))
1043	if (ok_isotrac) then
1044	do iiso=1,niso
1045	do izone=1,ntraceurs_zone
1046	index_trac(izone,iiso)=iiso+izone*niso
1047	enddo
1048	enddo
1049	else !if (ok_isotrac) then
1050	index_trac(:,:)=0.0
1051	endif !if (ok_isotrac) then
1052	! write(lunout,*) 'index_trac=',index_trac
1053
1054	! Finalize :
1055	DEALLOCATE(nb_iso)
1056
1057	END SUBROUTINE infotrac_isoinit
1058
1059	END MODULE infotrac

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

Download in other formats:

Original Format