Context Navigation

infotrac.F90 @ 4105

Last change on this file since 4105 was 4082, checked in by Ehouarn Millour, 2 years ago
Bug fix in infotrac (introduced in r4063), nbtr and related arrays were not properly initialized. Tests notheless show there is still an issue between serial and parallel handling of (non-water) tracers that needs be fixed. 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: 51.4 KB

Rev	Line
[4064]	1	!$Id: infotrac.F90 4082 2022-02-28 08:37:41Z jyg $
[1279]	2	!
[1114]	3	MODULE infotrac
	4
[4068]	5	USE strings_mod, ONLY: msg, find, strIdx, strFind, strParse, dispTable, int2str, reduceExpr, &
	6	cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile
[4063]	7	USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, addPhase, phases_sep, nphases, ancestor, &
	8	isot_type, readIsotopesFile, delPhase, old_phases, getKey_init, tran0, &
[4067]	9	keys_type, initIsotopes, indexUpdate, known_phases, getKey, setGeneration, &
	10	new2oldPhase
[4046]	11
[4063]	12	IMPLICIT NONE
[1114]	13
[4063]	14	PRIVATE
[1114]	15
[4063]	16	!=== FOR TRACERS:
	17	PUBLIC :: infotrac_init !--- Initialization of the tracers
	18	PUBLIC :: tracers, type_trac !--- Full tracers database, tracers type keyword
	19	PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions
	20	PUBLIC :: solsym, conv_flg, pbl_flg !--- Tracers names + convection & boundary layer activation keys
[3923]	21
[4063]	22	!=== FOR ISOTOPES: General
	23	PUBLIC :: isotopes, nbIso !--- Derived type, full isotopes families database + nb of families
	24	PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index
	25	PUBLIC :: min_qParent, min_qMass, min_ratio !--- Min. values for various isotopic quantities
	26	!=== FOR ISOTOPES: Specific to water
	27	PUBLIC :: iH2O, tnat, alpha_ideal !--- H2O isotopes index, natural abundance, fractionning coeff.
	28	!=== FOR ISOTOPES: Depending on the selected isotopes family
	29	PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey)
	30	PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases
	31	PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number
	32	PUBLIC :: iZonIso, iTraPha !--- 2D index tables to get "iq" index
	33	PUBLIC :: isoCheck !--- Run isotopes checking routines
	34	!=== FOR BOTH TRACERS AND ISOTOPES
	35	PUBLIC :: getKey !--- Get a key from "tracers" or "isotope"
[3870]	36
[4063]	37	PUBLIC :: ntraciso, ntraceurs_zone, iqiso
	38	PUBLIC :: ok_isotopes, ok_iso_verif, ok_isotrac, ok_init_iso, use_iso
	39	PUBLIC :: index_trac, iso_indnum, indnum_fn_num, niso_possibles
	40	PUBLIC :: qperemin, masseqmin, ratiomin
[1114]	41
[4063]	42	INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
[2270]	43
[4063]	44	!=== CONVENTIONS FOR TRACERS NUMBERS:
	45	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
	46	! \| water in different \| water tagging \| water isotopes \| other tracers \| additional tracers moments \|
	47	! \| phases: H2O_[gls] \| isotopes \| \| \| for higher order schemes \|
	48	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
	49	! \| \| \| \| \| \|
	50	! \|<-- nqo -->\|<-- nqoniso nzone -->\|<-- nqo*niso -->\|<-- nbtr -->\|<-- (nmom) -->\|
	51	! \| \| \| \|
	52	! \| \|<-- nqoniso(nzone+1) = nqo*ntiso -->\|<-- nqtottr = nbtr + nmom -->\|
	53	! \| = nqtot - nqo*(ntiso+1) \|
	54	! \| \|
	55	! \|<-- nqtrue = nbtr + nqo*(ntiso+1) -->\| \|
	56	! \| \|
	57	! \|<-- nqtot = nqtrue + nmom -->\|
	58	! \| \|
	59	! \|-----------------------------------------------------------------------------------------------------------\|
	60	! NOTES FOR THIS TABLE:
	61	! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
	62	! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
	63	! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
	64	! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
	65	!
	66	!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
	67	! Each entry is accessible using "%" sign.
	68	! \|-------------+------------------------------------------------------+-------------+------------------------+
	69	! \| entry \| Meaning \| Former name \| Possible values \|
	70	! \|-------------+------------------------------------------------------+-------------+------------------------+
	71	! \| name \| Name (short) \| tname \| \|
	72	! \| gen0Name \| Name of the 1st generation ancestor \| / \| \|
	73	! \| parent \| Name of the parent \| / \| \|
	74	! \| longName \| Long name (with adv. scheme suffix) for outputs \| ttext \| \|
	75	! \| type \| Type (so far: tracer or tag) \| / \| tracer,tag \|
	76	! \| phase \| Phases list ("g"as / "l"iquid / "s"olid) \| / \| [g][l][s] \|
	77	! \| component \| Name(s) of the merged/cumulated section(s) \| / \| coma-separated names \|
	78	! \| iadv \| Advection scheme number \| iadv \| 1-20,30 exc. 3-9,15,19 \|
	79	! \| iGeneration \| Generation (>=1) \| / \| \|
[4071]	80	! \| isAdvected \| advected tracers flag (.TRUE. if iadv >= 0) \| / \| nqtrue .TRUE. values \|
	81	! \| isInPhysics \| tracers not extracted from the main table in physics \| / \| nqtottr .TRUE. values \|
[4063]	82	! \| iqParent \| Index of the parent tracer \| iqpere \| 1:nqtot \|
	83	! \| iqDescen \| Indexes of the childs (all generations) \| iqfils \| 1:nqtot \|
	84	! \| nqDescen \| Number of the descendants (all generations) \| nqdesc \| 1:nqtot \|
	85	! \| nqChilds \| Number of childs (1st generation only) \| nqfils \| 1:nqtot \|
	86	! \| iso_iGroup \| Isotopes group index in isotopes(:) \| / \| 1:nbIso \|
	87	! \| iso_iName \| Isotope name index in isotopes(iso_iGroup)%trac(:) \| iso_indnum \| 1:niso \|
	88	! \| iso_iZone \| Isotope zone index in isotopes(iso_iGroup)%zone(:) \| zone_num \| 1:nzone \|
	89	! \| iso_iPhas \| Isotope phase index in isotopes(iso_iGroup)%phas(:) \| phase_num \| 1:nphas \|
	90	! \| keys \| key/val pairs accessible with "getKey" routine \| / \| \|
	91	! +-------------+------------------------------------------------------+-------------+------------------------+
	92	!
	93	!=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
	94	! Each entry is accessible using "%" sign.
	95	! \|-----------------+--------------------------------------------------+----------------+-----------------+
	96	! \| entry \| length \| Meaning \| Former name \| Possible values \|
	97	! \|-----------------+--------------------------------------------------+----------------+-----------------+
	98	! \| parent \| Parent tracer (isotopes family name) \| \| \|
	99	! \| keys \| niso \| Isotopes keys/values pairs list + number \| \| \|
	100	! \| trac \| ntiso \| Isotopes + tagging tracers list + number \| \| \|
	101	! \| zone \| nzone \| Geographic tagging zones list + number \| \| \|
	102	! \| phase \| nphas \| Phases list + number \| \| [g][l][s], 1:3 \|
	103	! \| niso \| Number of isotopes, excluding tagging tracers \| \| \|
	104	! \| ntiso \| Number of isotopes, including tagging tracers \| ntraciso \| \|
	105	! \| nzone \| Number of geographic tagging zones \| ntraceurs_zone \| \|
	106	! \| nphas \| Number of phases \| \| \|
	107	! \| iTraPha \| Index in "trac(1:niso)" = f(name(1:ntiso)),phas) \| iqiso \| 1:niso \|
	108	! \| iZonIso \| Index in "trac(1:ntiso)" = f(zone, name(1:niso)) \| index_trac \| 1:nzone \|
	109	! \|-----------------+--------------------------------------------------+----------------+-----------------+
[1114]	110
[4063]	111	REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi
[3870]	112
[4063]	113	!=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
	114	INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O)
	115	nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O)
	116	nqo, & !--- Number of water phases
	117	nbIso, & !--- Number of available isotopes family
	118	nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?)
	119	nqCO2 !--- Number of tracers of CO2 (ThL)
	120	CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type
	121
	122	!=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
	123	TYPE(trac_type), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR
	124	TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR
	125
	126	!=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
	127	TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
	128	INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family
	129	LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines
	130	TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
	131	CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
	132	isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY
	133	isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY
	134	INTEGER, TARGET, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
	135	nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
	136	INTEGER, SAVE, POINTER :: iZonIso(:,:) !--- INDEX IN "isoTrac" AS f(tagging zone, isotope)
	137	INTEGER, SAVE, POINTER :: iTraPha(:,:) !--- INDEX IN "isoTrac" AS f(isotopic tracer, phase)
	138	INTEGER, ALLOCATABLE, SAVE :: index_trac(:,:) ! numero ixt en fn izone, indnum entre 1 et niso
	139	INTEGER, ALLOCATABLE, SAVE :: iqiso(:,:) ! donne indice iq en fn de (ixt,phase)
	140
	141	!--- Aliases for older names
	142	INTEGER, POINTER, SAVE :: ntraciso, ntraceurs_zone
[4064]	143	REAL, SAVE :: qperemin, masseqmin, ratiomin
[4063]	144
[2690]	145	! CRisi: cas particulier des isotopes
[4063]	146	INTEGER, PARAMETER :: niso_possibles = 5
	147	LOGICAL, SAVE :: ok_isotopes, ok_iso_verif, ok_isotrac, ok_init_iso
	148	LOGICAL, SAVE, ALLOCATABLE :: use_iso(:)
	149	INTEGER, SAVE, ALLOCATABLE :: iso_indnum(:) !--- Gives 1<=idx<=niso_possibles as function(1<=iq <=nqtot)
	150	INTEGER, SAVE, ALLOCATABLE :: indnum_fn_num(:) !--- Gives 1<=idx<=niso as function(1<=idx<=niso_possibles)
[2690]	151
[4063]	152	!=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA
	153	REAL, SAVE, ALLOCATABLE :: tnat(:), & !--- Natural relative abundance of water isotope (niso)
	154	alpha_ideal(:) !--- Ideal fractionning coefficient (for initial state) (niso)
	155	INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr)
	156	pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr)
	157	CHARACTER(LEN=8), SAVE, ALLOCATABLE :: solsym(:) !--- Names from INCA (nbtr)
	158	LOGICAL, PARAMETER :: lOldCode = .TRUE.
	159
[1114]	160	CONTAINS
	161
[4063]	162	SUBROUTINE infotrac_init
	163	USE control_mod, ONLY: planet_type, config_inca
[1565]	164	#ifdef REPROBUS
[4063]	165	USE CHEM_REP, ONLY: Init_chem_rep_trac
[1565]	166	#endif
[4063]	167	IMPLICIT NONE
	168	!==============================================================================================================================
[1114]	169	!
	170	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
	171	! -------
	172	!
[4063]	173	! Modifications:
	174	! --------------
	175	! 05/94: F.Forget Modif special traceur
	176	! 02/02: M-A Filiberti Lecture de traceur.def
	177	! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types tr et iso)
	178	!
[1114]	179	! Objet:
	180	! ------
	181	! GCM LMD nouvelle grille
	182	!
[4063]	183	!==============================================================================================================================
[1114]	184	! ... modification de l'integration de q ( 26/04/94 ) ....
[4063]	185	!------------------------------------------------------------------------------------------------------------------------------
	186	! Declarations:
	187	INCLUDE "dimensions.h"
	188	INCLUDE "iniprint.h"
[1114]	189
[4063]	190	!------------------------------------------------------------------------------------------------------------------------------
[1114]	191	! Local variables
[4064]	192	INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number
	193	#ifdef INCA
	194	INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
	195	vad (:), vadv_inca(:), pbl_flg_inca(:)
[4063]	196	CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA
[4064]	197	INTEGER :: nqINCA
	198	#endif
[4063]	199	CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather)
	200	CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags
[4064]	201	CHARACTER(LEN=maxlen) :: msg1 !--- String for messages
[4063]	202	CHARACTER(LEN=maxlen), ALLOCATABLE :: str(:) !--- Temporary storage
	203	INTEGER :: fType !--- Tracers description file type ; 0: none
	204	!--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
	205	INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments)
	206	INTEGER :: iad !--- Advection scheme number
[4073]	207	INTEGER :: ic, ip, np, iq, jq, it, nt, im, nm, ix, iz, nz, k !--- Indexes and temporary variables
[4063]	208	LOGICAL :: lerr, ll
	209	CHARACTER(LEN=1) :: p
	210	TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
[4064]	211	TYPE(trac_type), POINTER :: t1, t(:)
[4063]	212	TYPE(isot_type), POINTER :: iso
[1114]	213
[4063]	214	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnom_0(:), tnom_transp(:) !--- Tracer short name + transporting fluid name
	215	CHARACTER(LEN=maxlen) :: tchaine
[4064]	216	INTEGER :: ierr
[4063]	217	LOGICAL :: lINCA
[2566]	218
[4063]	219	CHARACTER(LEN=*), PARAMETER :: modname="infotrac_init"
	220	!------------------------------------------------------------------------------------------------------------------------------
	221	! Initialization :
	222	!------------------------------------------------------------------------------------------------------------------------------
	223	suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
	224	descrq( 1: 2) = ['LMV','BAK']
	225	descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP']
	226	descrq(30) = 'PRA'
	227
[4067]	228	CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
[4063]	229	IF(lOldCode) THEN
	230	str = [type_trac]; nt = 1
	231	ELSE
	232	IF(strParse(type_trac, ',', str, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1)
	233	END IF
[3870]	234
[4063]	235	!---------------------------------------------------------------------------------------------------------------------------
	236	DO it = 1, nt !--- nt>1=> "type_trac": coma-separated keywords list
	237	!---------------------------------------------------------------------------------------------------------------------------
	238	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
	239	msg1 = 'For type_trac = "'//TRIM(str(it))//'":'
	240	SELECT CASE(type_trac)
	241	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca, modname)
	242	CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
	243	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname)
	244	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname)
	245	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
	246	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname)
	247	CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(str(it))//' not possible yet.',1)
	248	END SELECT
[1454]	249
[4063]	250	!--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca"
	251	IF(ANY(['inca', 'inco'] == str(it)) .AND. ALL(['aero', 'aeNP', 'chem'] /= config_inca)) &
	252	CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1)
[3865]	253
[4063]	254	!--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
	255	SELECT CASE(str(it))
	256	CASE('inca','inco')
[1569]	257	#ifndef INCA
[4063]	258	CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
[1569]	259	#endif
[4063]	260	CASE('repr')
[1569]	261	#ifndef REPROBUS
[4063]	262	CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
[1569]	263	#endif
[4063]	264	CASE('coag')
[2690]	265	#ifndef CPP_StratAer
[4063]	266	CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
[2690]	267	#endif
[4063]	268	END SELECT
[1279]	269
[4063]	270	!--- DISABLE "config_inca" OPTION FOR A RUN WITHOUT "INCA" IF IT DIFFERS FROM "none"
	271	IF(fmsg('Setting config_inca="none" as you do not couple with INCA model', &
	272	modname, ALL(['inca', 'inco'] /= str(it)) .AND. config_inca /= 'none')) config_inca = 'none'
[1563]	273
[4063]	274	!---------------------------------------------------------------------------------------------------------------------------
	275	END DO
	276	!---------------------------------------------------------------------------------------------------------------------------
	277
	278	nqCO2 = 0; IF(ANY(str == 'inco')) nqCO2 = 1
	279
	280	!==============================================================================================================================
	281	! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
	282	!==============================================================================================================================
	283
	284	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	285	IF(lOldCode) THEN
	286	!------------------------------------------------------------------------------------------------------------------------------
	287	!--- Determine nqtrue and (INCA only) nqo, nbtr
	288	OPEN(90, FILE='traceur.def', FORM='formatted', STATUS='old', IOSTAT=ierr)
	289	IF(ierr /= 0) CALL abort_gcm(modname, 'file "traceur.def" not found !', 1)
	290	CALL msg('File "traceur.def" successfully opened.', modname)
	291	lINCA = ANY(['inca','inco'] == type_trac)
	292
	293	IF(lINCA) THEN
[2372]	294	#ifdef INCA
[4063]	295	READ(90,*) nqo
	296	IF(nqCO2==1 .AND. nqo==4) nqo = 3
	297	CALL Init_chem_inca_trac(nqINCA)
	298	nbtr = nqINCA + nqCO2
	299	nqtrue = nbtr + nqo
[4073]	300	IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
[4063]	301	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
	302	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
	303	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
	304	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname)
	305	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
	306	ALLOCATE(hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
	307	ALLOCATE(vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
	308	CALL init_transport(hadv_inca, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
	309	! DC passive CO2 tracer is at position 1: H2O was removed ; nqCO2/=0 in "inco" case only
[4082]	310	ALLOCATE(conv_flg(nbtr),pbl_flg(nbtr),solsym(nbtr))
[4063]	311	conv_flg = [( 1, ic=1, nqCO2),conv_flg_inca]
	312	pbl_flg = [( 1, ic=1, nqCO2), pbl_flg_inca]
[4073]	313	solsym = [('CO2 ', ic=1, nqCO2), solsym_inca]
[4077]	314	DEALLOCATE(conv_flg_inca, pbl_flg_inca)
[3870]	315	#endif
[4063]	316	ELSE
	317	READ(90,*) nqtrue
	318	END IF
[1114]	319
[4063]	320	IF (planet_type=="earth" .AND. nqtrue < 2) &
	321	CALL abort_gcm('infotrac_init', 'Not enough tracers: nqtrue='//TRIM(int2str(nqtrue))//', 2 tracers is the minimum', 1)
[2566]	322
[4063]	323	!--- Allocate variables depending on nqtrue
	324	ALLOCATE(hadv(nqtrue), vadv(nqtrue), tnom_0(nqtrue), tnom_transp(nqtrue), tracers(nqtrue))
[1114]	325
[4063]	326	!--- Continue to read tracer.def
	327	it = 0
	328	DO iq = 1, nqtrue
	329	#ifdef INCA
	330	IF(iq > nqo+nqCO2) THEN
	331	it = it+1
	332	hadv (iq) = hadv_inca (it)
	333	vadv (iq) = vadv_inca (it)
	334	tnom_0(iq) = solsym_inca(it)
	335	tnom_transp(iq) = 'air'
	336	CYCLE
	337	END IF
	338	#endif
	339	CALL msg('237: iq='//TRIM(int2str(iq)), modname)
	340	READ(90,'(I2,X,I2,X,A)',IOSTAT=ierr) hadv(iq),vadv(iq),tchaine
[4071]	341	WRITE(msg1,'("hadv(",i0,"), vadv(",i0,") = ",i0,", ",i0)')iq, iq, hadv(iq), vadv(iq)
	342	CALL msg(TRIM(msg1), modname)
[4063]	343	CALL msg('tchaine = "'//TRIM(tchaine)//'"', modname)
	344	CALL msg('infotrac 238: IOstatus='//TRIM(int2str(ierr)), modname)
	345	IF(ierr/=0) CALL abort_gcm('infotrac_init', 'Pb dans la lecture de traceur.def', 1)
	346	jq = INDEX(tchaine(1:LEN_TRIM(tchaine)),' ')
	347	CALL msg("Ancienne version de traceur.def: traceurs d'air uniquement", modname, iq==1 .AND. jq==0)
	348	CALL msg("Nouvelle version de traceur.def", modname, iq==1 .AND. jq/=0)
	349	IF(jq /= 0) THEN !--- Space in the string chain => new format
	350	tnom_0 (iq) = tchaine(1:jq-1)
	351	tnom_transp(iq) = tchaine(jq+1:)
	352	ELSE
	353	tnom_0 (iq) = tchaine
	354	tnom_transp(iq) = 'air'
	355	END IF
	356	CALL msg( 'tnom_0(iq)=<'//TRIM(tnom_0(iq)) //'>', modname)
	357	CALL msg('tnom_transp(iq)=<'//TRIM(tnom_transp(iq))//'>', modname)
	358	END DO
[4078]	359	#ifdef INCA
[4077]	360	DEALLOCATE(solsym_inca)
[4078]	361	#endif
[3945]	362
[4063]	363	CLOSE(90)
[2270]	364
[4063]	365	#ifndef INCA
	366	CALL msg('Valeur de traceur.def :', modname)
	367	CALL msg('nombre total de traceurs '//TRIM(int2str(nqtrue)), modname)
	368	DO iq = 1, nqtrue
	369	CALL msg(strStack([int2str(hadv(iq)), int2str(vadv(iq)), tnom_0(iq), tnom_transp(iq)]), modname)
	370	END DO
	371	IF(planet_type /= 'earth') nqo = 0 !--- Same number of tracers in dynamics and physics
	372	IF(planet_type == 'earth') nqo = COUNT(delPhase(tnom_0) == 'H2O') !--- for all planets except for Earth
	373	nbtr = nqtrue - nqo
[4082]	374	ALLOCATE(conv_flg(nbtr),pbl_flg(nbtr),solsym(nbtr))
	375	conv_flg(1:nbtr) = 1 !--- Convection activated for all tracers
	376	pbl_flg(1:nbtr) = 1 !--- Boundary layer activated for all tracers
[4063]	377	#endif
[2270]	378
[4063]	379	!--- SET FIELDS %name, %parent, %phase, %component
	380	tracers(:)%name = tnom_0
	381	tracers(:)%parent = tnom_transp
	382	tracers(:)%phase = 'g'
	383	tracers(:)%component = type_trac
[4077]	384
	385
[4067]	386	DO iq = 1, nqtrue
[4077]	387	ip = strIdx([(addPhase('H2O',old_phases(ix:ix),''), ix=1, nphases)], strHead(tracers(iq)%name,'_',.TRUE.))
[4067]	388	IF(ip == 0) CYCLE
	389	tracers(iq)%phase = known_phases(ip:ip)
[4077]	390	tracers(iq)%component = 'lmdz'
[4063]	391	END DO
	392	IF(lINCA) tracers(1+nqo:nqCO2+nqo)%component = 'co2i'
	393	CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name
	394	! manque "type"
[1114]	395
[4063]	396	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	397	ELSE
	398	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	399	IF(readTracersFiles(type_trac, fType, tracers)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
	400	IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
	401	!---------------------------------------------------------------------------------------------------------------------------
	402	IF(fType == 1) THEN !=== FOUND AN OLD STYLE "traceur.def"
	403	!---------------------------------------------------------------------------------------------------------------------------
	404	#ifdef INCA
	405	nqo = SIZE(tracers)
	406	IF(nqCO2==1 .AND. nqo==4) nqo = 3 !--- Force nqo to 3 (ThL)
	407	CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA
	408	nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac
	409	nqtrue = nbtr + nqo !--- Total number of "true" tracers
[4073]	410	IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
[4063]	411	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
	412	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
	413	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
	414	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname)
	415	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
	416	ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
	417	ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
	418	CALL init_transport(hadv_inca, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
	419	! DC passive CO2 tracer is at position 1: H2O was removed ; nqCO2/=0 in "inco" case only
[4082]	420
[4073]	421	conv_flg = [( 1 , k=1, nqCO2), conv_flg_inca]
	422	pbl_flg = [( 1 , k=1, nqCO2), pbl_flg_inca]
	423	solsym = [('CO2 ', k=1, nqCO2), solsym_inca]
[4063]	424	DEALLOCATE(conv_flg_inca, pbl_flg_inca, solsym_inca)
	425	ALLOCATE(ttr(nqtrue))
	426	ttr(1:nqo+nqCO2) = tracers
	427	ttr(1 : nqo )%component = 'lmdz'
	428	ttr(1+nqo:nqCO2+nqo )%component = 'co2i'
	429	ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
	430	ttr(1+nqo :nqtrue)%name = solsym
	431	ttr(1+nqo+nqCO2:nqtrue)%parent = tran0
	432	ttr(1+nqo+nqCO2:nqtrue)%phase = 'g'
	433	lerr = getKey('hadv', had, ky=ttr(:)%keys); hadv(:) = [had, hadv_inca]
	434	lerr = getKey('vadv', vad, ky=ttr(:)%keys); vadv(:) = [vad, vadv_inca]
	435	DEALLOCATE(had, hadv_inca, vad, vadv_inca)
	436	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
	437	CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name
	438	#else
	439	nqo = COUNT(delPhase(tracers(:)%name) == 'H2O') !--- Number of water phases
	440	nqtrue = SIZE(tracers) !--- Total number of "true" tracers
	441	nbtr = nqtrue - nqo !--- Number of tracers passed to phytrac
	442	lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
	443	lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
[4082]	444	ALLOCATE(solsym(nbtr))
	445	conv_flg(1:nbtr)=1 !--- Convection activated for all tracers
	446	pbl_flg(1:nbtr)=1 !--- Boundary layer activated for all tracers
[4063]	447	#endif
	448	!---------------------------------------------------------------------------------------------------------------------------
	449	ELSE !=== FOUND NEW STYLE TRACERS CONFIGURATION FILE(S)
	450	!---------------------------------------------------------------------------------------------------------------------------
	451	nqo = COUNT(delPhase(tracers(:)%name) == 'H2O') !--- Number of water phases
	452	nqtrue = SIZE(tracers) !--- Total number of "true" tracers
	453	nbtr = nqtrue - nqo !--- Number of tracers passed to phytrac
	454	lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
	455	lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
	456	ALLOCATE(solsym(nbtr))
[4082]	457	conv_flg(1:nbtr)=1 !--- Convection activated for all tracers
	458	pbl_flg(1:nbtr)=1 !--- Boundary layer activated for all tracers
[4063]	459	!---------------------------------------------------------------------------------------------------------------------------
	460	END IF
	461	!---------------------------------------------------------------------------------------------------------------------------
	462	END IF
	463	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[2262]	464
[4063]	465	CALL getKey_init(tracers)
[2566]	466
[4063]	467	!--- Transfert the number of tracers to Reprobus
[3945]	468	#ifdef REPROBUS
[4063]	469	CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
[3945]	470	#endif
[4063]	471
	472	!==============================================================================================================================
	473	! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
	474	!==============================================================================================================================
	475	DO iq = 1, nqtrue
	476	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
	477	WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
	478	CALL abort_gcm(modname, TRIM(msg1), 1)
	479	END DO
	480	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
	481	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
	482	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
	483
	484	!--- More tracers due to the choice of advection scheme => assign total number of tracers
	485	IF( nqtot /= nqtrue ) THEN
	486	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
	487	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
	488	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
	489	END IF
	490	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
	491	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
	492	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
	493	CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname)
	494
	495	!==============================================================================================================================
	496	! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected.
	497	! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV
	498	! iadv = 2 backward (for H2O liquid) BAK
	499	! iadv = 14 Van-Leer + specific humidity, modified by Francis Codron VLH
	500	! iadv = 10 Van-Leer (chosen for vapour and liquid water) VL1
	501	! iadv = 11 Van-Leer for hadv and PPM version (Monotonic) for vadv VLP
	502	! iadv = 12 Frederic Hourdin I FH1
	503	! iadv = 13 Frederic Hourdin II FH2
	504	! iadv = 16 Monotonic PPM (Collela & Woodward 1984) PPM
	505	! iadv = 17 Semi-monotonic PPM (overshoots allowed) PPS
	506	! iadv = 18 Definite positive PPM (overshoots and undershoots allowed) PPP
	507	! iadv = 20 Slopes SLP
	508	! iadv = 30 Prather PRA
[3945]	509	!
[4063]	510	! In array q(ij,l,iq) : iq = 1/2[/3] for vapour/liquid[/ice] water
	511	! And optionaly: iq = 3[4],nqtot for other tracers
	512	!==============================================================================================================================
	513	ALLOCATE(ttr(nqtot))
	514	jq = nqtrue+1; tracers(:)%iadv = -1
	515	DO iq = 1, nqtrue
	516	t1 => tracers(iq)
[3945]	517
[4063]	518	!--- VERIFY THE CHOICE OF ADVECTION SCHEME
	519	iad = -1
	520	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
	521	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
	522	WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
	523	IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
[3945]	524
[4071]	525	!--- SET FIELDS %longName, %iadv, %isAdvected, %isInPhysics
[4063]	526	t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
	527	t1%iadv = iad
[4071]	528	t1%isAdvected = iad >= 0
[4077]	529	t1%isInPhysics= .not. (delPhase(t1%gen0Name) == 'H2O' .and. t1%component=='lmdz') !=== TO BE COMPLETED WITH OTHER EXCEPTIONS: CO2i, SURSATURATED CLOUDS...
[4063]	530	ttr(iq) = t1
[3945]	531
[4063]	532	!--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
	533	nm = 0
	534	IF(iad == 20) nm = 3 !--- 2nd order scheme
	535	IF(iad == 30) nm = 9 !--- 3rd order scheme
[4064]	536	IF(nm == 0) CYCLE !--- No higher moments
[4063]	537	ttr(jq+1:jq+nm) = t1
	538	ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
	539	ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ]
	540	ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
	541	ttr(jq+1:jq+nm)%iadv = [(-iad, im=1, nm) ]
	542	ttr(jq+1:jq+nm)%isAdvected = [(.FALSE., im=1, nm) ]
	543	jq = jq + nm
	544	END DO
	545	DEALLOCATE(hadv, vadv)
	546	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
[3945]	547
[4063]	548	!--- SET FIELDS %iqParent, %nqChilds, %iGeneration, %iqDescen, %nqDescen
	549	CALL indexUpdate(tracers)
[1114]	550
[4063]	551	CALL msg('Information stored in infotrac :', modname)
	552	CALL msg('iadv name long_name :', modname)
[1114]	553
[4063]	554	!=== TEST ADVECTION SCHEME
	555	DO iq=1,nqtot ; t1 => tracers(iq); iad = t1%iadv
[1114]	556
[4063]	557	!--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers)
	558	IF(ALL([10,14,0] /= iad)) &
	559	CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1)
[1114]	560
[4063]	561	!--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1)
	562	IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) &
	563	CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1)
[1114]	564
[4063]	565	!--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1)
	566	IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',&
	567	modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10
[1454]	568
[4063]	569	!--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14
	570	ll = t1%name /= addPhase('H2O','g'); IF(lOldCode) ll = t1%name /= 'H2Ov'
	571	IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', &
	572	modname, iad == 14 .AND. ll)) t1%iadv = 10
	573	END DO
[1114]	574
[4063]	575	IF(lOldCode) THEN
[1114]	576
[4063]	577	CALL infotrac_setHeredity !--- SET FIELDS %iqParent, %nqChilds, %iGeneration, %gen0Name, %iqDescen, %nqDescen
[4064]	578	CALL infotrac_isoinit !--- SET FIELDS %type, %iso_iName, %iso_iZone, %iso_iPhase
[4063]	579	CALL getKey_init(tracers, isotopes)
	580	IF(isoSelect('H2O')) RETURN !--- Select water isotopes ; finished if no water isotopes
	581	iH2O = ixIso !--- Keep track of water family index
[3945]	582
[4063]	583	!--- Remove the isotopic tracers from the tracers list passed to phytrac
	584	nbtr = nbtr -nqo* ntiso !--- ISOTOPIC TAGGING TRACERS ARE NOT PASSED TO THE PHYSICS
	585	nqtottr = nqtot-nqo*(1+ntiso) !--- NO H2O-FAMILY TRACER IS PASSED TO THE PHYSICS
	586	CALL msg('702: nbtr, ntiso='//strStack(int2str([nbtr, ntiso])), modname)
	587	CALL msg('704: nqtottr, nqtot, nqo = '//strStack(int2str([nqtottr, nqtot, nqo])), modname)
	588	! Rq: nqtottr n'est pas forcement egal a nbtr dans le cas ou nmom/=0
[4077]	589	IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers(:)%name) == 'H2O' .AND. tracers(:)%component=='lmdz') /= nqtottr) &
[4063]	590	CALL abort_gcm('infotrac_init', 'pb dans le calcul de nqtottr', 1)
[1114]	591
[4063]	592	!--- Finalize :
[4064]	593	DEALLOCATE(tnom_0, tnom_transp)
[1279]	594
[4063]	595	ELSE
[2270]	596
[4063]	597	CALL initIsotopes(tracers, isotopes)
	598	nbIso = SIZE(isotopes); IF(nbIso==0) RETURN !--- No isotopes: finished.
[2270]	599
[4063]	600	!=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE SPECIFIC TO WATER ISOTOPES
	601	! DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat, alpha_ideal)
	602	CALL getKey_init(tracers, isotopes)
	603	IF(isoSelect('H2O')) RETURN !--- Select water isotopes ; finished if no water isotopes
	604	iH2O = ixIso !--- Keep track of water family index
	605	IF(getKey('tnat' , tnat, isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "tnat"', 1)
	606	IF(getKey('alpha', alpha_ideal, isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "alpha_ideal"', 1)
[4050]	607
[4063]	608	!=== ENSURE THE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
	609	DO ix = 1, nbIso
	610	iso => isotopes(ix)
	611	!--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
	612	DO it = 1, iso%ntiso
	613	np = SUM([(COUNT(tracers(:)%name == addPhase(iso%trac(it), iso%phase(ip:ip))), ip=1, iso%nphas)])
	614	IF(np == iso%nphas) CYCLE
	615	WRITE(msg1,'("Found ",i0," phases for ",s," instead of ",i0)')np, iso%trac(it), iso%nphas
	616	CALL abort_gcm(modname, msg1, 1)
	617	END DO
	618	DO it = 1, iso%niso
	619	nz = SUM([(COUNT(iso%trac == iso%trac(it)//'_'//iso%zone(iz)), iz=1, iso%nzone)])
	620	IF(nz == iso%nzone) CYCLE
	621	WRITE(msg1,'("Found ",i0," tagging zones for ",s," instead of ",i0)')nz, iso%trac(it), iso%nzone
	622	CALL abort_gcm(modname, msg1, 1)
	623	END DO
	624	END DO
	625	nqtottr = COUNT(tracers%iso_iName == 0)
[2270]	626
[4063]	627	END IF
[2270]	628
[4063]	629	!=== DISPLAY THE RESULTING LIST
	630	t => tracers
	631	CALL msg('Information stored in infotrac :')
[4064]	632	IF(dispTable('isssssssssiiiiiiiii', &
[4071]	633	['iq ', 'name ', 'longN. ', 'gen0N. ', 'parent ', 'type ', 'phase ', 'compon. ', 'isAdv. ', 'isPhy. '&
[4064]	634	,'iadv ', 'iGen. ', 'iqPar. ', 'nqDes. ', 'nqChil. ', 'iso_iG. ', 'iso_iN. ', 'iso_iZ. ', 'iso_iP. '], &
	635	cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, &
[4071]	636	t%component, bool2str(t%isAdvected), bool2str(t%isInPhysics)), &
[4064]	637	cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, &
	638	t%nqChilds, t%iso_iGroup, t%iso_iName, t%iso_iZone, t%iso_iPhase))) &
[4063]	639	CALL abort_gcm(modname, "problem with the tracers table content", 1)
[3923]	640
[4063]	641	!--- Some aliases to be removed later
[4064]	642	ntraciso => isotope%ntiso
	643	ntraceurs_zone => isotope%nzone
[4063]	644	qperemin = min_qParent
	645	masseqmin = min_qMass
	646	ratiomin = min_ratio
	647	CALL msg('end', modname)
[3923]	648
[4063]	649	END SUBROUTINE infotrac_init
[3923]	650
[1114]	651
[2180]	652
[4063]	653	SUBROUTINE infotrac_setHeredity
	654	!--- Purpose: Set fields %iqParent, %nqChilds, %iGeneration, %iqDescen, %nqDescen (old method)
	655	USE strings_mod, ONLY: strIdx
	656	INTEGER :: iq, ipere, ifils
	657	INTEGER, ALLOCATABLE :: iqfils(:,:)
	658	CHARACTER(LEN=maxlen) :: msg1, modname='infotrac_init'
	659	INCLUDE "iniprint.h"
[1114]	660
[4063]	661	!=== SET FIELDS %iqParent, %nqChilds
	662	ALLOCATE(iqfils(nqtot,nqtot)); iqfils(:,:) = 0
[2270]	663
[4063]	664	DO iq = 1, nqtot
	665	msg1 = 'Tracer nr. '//TRIM(int2str(iq))//', called "'//TRIM(tracers(iq)%name)//'" is '
	666
	667	!--- IS IT A GENERATION 0 TRACER ? IF SO, tracers(iq)%iqParent KEEPS ITS DEFAULT VALUE (0)
	668	IF(fmsg(TRIM(msg1)//' a parent', modname, tracers(iq)%parent == tran0)) CYCLE
	669
	670	!--- TRACERS OF GENERATION > 0 ; FIND ITS PARENT INDEX
	671	ipere = strIdx(tracers(:)%name, tracers(iq)%parent)
	672	IF(ipere == 0) CALL abort_gcm('infotrac_init', TRIM(msg1)//' an orphan', 1)
	673	IF(iq == ipere) CALL abort_gcm('infotrac_init', TRIM(msg1)//' its own parent',1)
	674
	675	CALL msg(TRIM(msg1)//' the child of '//TRIM(tracers(ipere)%name), modname)
	676	tracers(iq)%iqParent = ipere
	677	tracers(ipere)%nqChilds = tracers(ipere)%nqChilds+1
	678	iqfils(tracers(ipere)%nqChilds,ipere) = iq
	679	END DO
[4077]	680
[4063]	681	CALL msg('nqGen0 = '//int2str(COUNT(tracers(:)%parent == 'air')), modname)
	682	CALL msg('nqChilds = '//strStack(int2str(tracers(:)%nqChilds)), modname)
	683	CALL msg('iqParent = '//strStack(int2str(tracers(:)%iqParent)), modname)
[4064]	684	CALL msg('iqChilds = '//strStack(int2str(PACK(iqfils,MASK=.TRUE.))),modname)
[4063]	685
[4077]	686
[4063]	687	!=== SET FIELDS %iGeneration, %iqDescen, %nqDescen
	688	tracers(:)%iGeneration = 0
	689	DO iq = 1, nqtot
	690	ifils = iq
	691	DO WHILE(tracers(ifils)%iqParent > 0)
	692	ipere = tracers(ifils)%iqParent
	693	tracers(ipere)%nqDescen = tracers(ipere)%nqDescen+1
	694	tracers(iq)%iGeneration = tracers(iq)%iGeneration+1
	695	iqfils(tracers(ipere)%nqDescen,ipere) = iq
	696	ifils = ipere
	697	END DO
	698	msg1 = 'Tracer nr. '//TRIM(int2str(iq))//', called "'//TRIM(tracers(iq)%name)//'" is '
	699	CALL msg(TRIM(msg1)//' of generation '//TRIM(int2str(tracers(iq)%iGeneration)), modname)
	700	END DO
	701	DO iq=1,nqtot
	702	tracers(iq)%iqDescen = iqfils(1:tracers(iq)%nqDescen,iq)
	703	END DO
	704
	705	CALL msg('nqDescen = '//TRIM(strStack(int2str(tracers(:)%nqDescen))), modname)
	706	CALL msg('nqDescen_tot = ' //TRIM(int2str(SUM(tracers(:)%nqDescen))), modname)
[4064]	707	CALL msg('iqChilds = '//strStack(int2str(PACK(iqfils, MASK=.TRUE.))), modname)
[4063]	708
[4077]	709
[4063]	710	END SUBROUTINE infotrac_setHeredity
	711
	712
	713
[4064]	714	SUBROUTINE infotrac_isoinit
[4063]	715
[2270]	716	#ifdef CPP_IOIPSL
[4063]	717	USE IOIPSL
[2270]	718	#else
[4063]	719	USE ioipsl_getincom
[2270]	720	#endif
[4063]	721	IMPLICIT NONE
	722	CHARACTER(LEN=3) :: tnom_iso(niso_possibles)
[4067]	723	INTEGER, ALLOCATABLE :: nb_iso(:,:), nb_traciso(:,:), nb_isoind(:)
	724	INTEGER :: ii, ip, iq, it, iz, ixt, nzone_prec
[4063]	725	TYPE(isot_type), POINTER :: i
	726	TYPE(trac_type), POINTER :: t(:)
	727	CHARACTER(LEN=maxlen) :: tnom_trac
	728	CHARACTER(LEN=maxlen), ALLOCATABLE :: str(:)
[4067]	729	LOGICAL, DIMENSION(:), ALLOCATABLE :: mask
[4063]	730	INCLUDE "iniprint.h"
[2270]	731
[4063]	732	tnom_iso = ['eau', 'HDO', 'O18', 'O17', 'HTO']
	733	ALLOCATE(nb_iso (niso_possibles,nqo))
	734	ALLOCATE(nb_traciso (niso_possibles,nqo))
	735	ALLOCATE(use_iso (niso_possibles))
	736	ALLOCATE(indnum_fn_num(niso_possibles))
	737	ALLOCATE(iso_indnum(nqtot))
[4067]	738	ALLOCATE(nb_isoind(nqo))
[4064]	739
[4063]	740	iso_indnum (:) = 0
	741	use_iso (:) = .FALSE.
	742	indnum_fn_num(:) = 0
	743	nb_iso (:,:) = 0
	744	nb_traciso (:,:) = 0
[4067]	745	nb_isoind (:) = 0
[2270]	746
[4063]	747	DO iq=1, nqtot
	748	IF(delPhase(tracers(iq)%name) == 'H2O' .OR. .NOT.tracers(iq)%isAdvected) CYCLE
	749	outer:DO ip = 1, nqo
	750	DO ixt= 1,niso_possibles
	751	tnom_trac = 'H2O'//old_phases(ip:ip)//'_'//TRIM(tnom_iso(ixt))
	752	IF (tracers(iq)%name == tnom_trac) THEN
	753	nb_iso(ixt,ip) = nb_iso(ixt,ip)+1
[4067]	754	nb_isoind (ip) = nb_isoind (ip)+1
[4063]	755	tracers(iq)%type = 'tracer'
	756	tracers(iq)%iso_iGroup = 1
	757	tracers(iq)%iso_iName = ixt
[4067]	758	iso_indnum(iq) = nb_isoind(ip)
[4063]	759	indnum_fn_num(ixt) = iso_indnum(iq)
	760	tracers(iq)%iso_iPhase = ip
	761	EXIT outer
	762	ELSE IF(tracers(iq)%iqParent> 0) THEN
	763	IF(tracers(tracers(iq)%iqParent)%name == tnom_trac) THEN
[4067]	764	nb_traciso(ixt,ip) = nb_traciso(ixt,ip)+1
[4063]	765	iso_indnum(iq) = indnum_fn_num(ixt)
[4067]	766	tracers(iq)%type = 'tag'
[4063]	767	tracers(iq)%iso_iGroup = 1
	768	tracers(iq)%iso_iName = ixt
	769	tracers(iq)%iso_iZone = nb_traciso(ixt,ip)
	770	tracers(iq)%iso_iPhase = ip
	771	EXIT outer
	772	END IF
	773	END IF
	774	END DO
	775	END DO outer
	776	END DO
[2270]	777
[4063]	778	niso = 0; nzone_prec = nb_traciso(1,1)
	779	DO ixt = 1, niso_possibles
	780	IF(nb_iso(ixt,1) == 0) CYCLE
	781	IF(nb_iso(ixt,1) /= 1) CALL abort_gcm('infotrac_init', 'Isotopes are not well defined in traceur.def', 1)
[2270]	782
[4063]	783	! on verifie que toutes les phases ont le meme nombre d'isotopes
	784	IF(ANY(nb_iso(ixt,:) /= 1)) CALL abort_gcm('infotrac_init', 'Phases must have same number of isotopes', 1)
[2270]	785
[4063]	786	niso = niso+1
	787	use_iso(ixt) = .TRUE.
	788	nzone = nb_traciso(ixt,1)
[2270]	789
[4063]	790	! on verifie que toutes les phases ont le meme nombre de traceurs d'isotopes
	791	IF(ANY(nb_traciso(ixt,2:nqo) /= nzone)) CALL abort_gcm('infotrac_init','Phases must have same number of tracers',1)
[2270]	792
[4063]	793	! on verifie que tous les isotopes ont le meme nombre de traceurs d'isotopes
	794	IF(nzone /= nzone_prec) CALL abort_gcm('infotrac_init','Isotope tracers are not well defined in traceur.def',1)
	795	nzone_prec = nzone
	796	END DO
[2270]	797
[4063]	798	! dimensions et flags isotopiques:
	799	ntiso = niso*(nzone+1)
	800	ok_isotopes = niso > 0
	801	ok_isotrac = nzone > 0
[2270]	802
[4063]	803	IF(ok_isotopes) THEN
	804	ok_iso_verif = .FALSE.; CALL getin('ok_iso_verif', ok_iso_verif)
	805	ok_init_iso = .FALSE.; CALL getin('ok_init_iso', ok_init_iso)
	806	END IF
	807	tnat = [1.0, 155.76e-6, 2005.2e-6, 0.004/100., 0.0]
	808	alpha_ideal = [1.0, 1.01, 1.006, 1.003, 1.0]
	809	! END IF
[2270]	810
[4063]	811	! remplissage du tableau iqiso(ntiso,phase)
	812	ALLOCATE(iqiso(ntiso,nqo))
	813	iqiso(:,:)=0
	814	DO iq = 1, nqtot
	815	IF(tracers(iq)%iso_iName <= 0) CYCLE
	816	ixt = iso_indnum(iq) + tracers(iq)%iso_iZone*niso
	817	iqiso(ixt, tracers(iq)%iso_iPhase) = iq
	818	END DO
[2270]	819
[4063]	820	! remplissage du tableau index_trac(nzone,niso)
	821	ALLOCATE(index_trac(nzone, niso))
	822	IF(ok_isotrac) then
	823	DO ii = 1, niso; index_trac(:, ii) = ii + niso*[(iz, iz=1, nzone)]; END DO
	824	ELSE
	825	index_trac(:,:)=0.0
	826	END IF
[2270]	827
[4063]	828	ALLOCATE(isotopes(1)) !--- Only water
	829	nbIso = 1
[4067]	830	t => tracers
[4063]	831	i => isotopes(1)
	832	i%parent = 'H2O'
[4067]	833
	834	!--- Isotopes names list (embedded in the "keys" field)
	835	i%niso = niso
	836	ALLOCATE(i%keys(i%niso))
	837	mask = t%type=='tracer' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%phase == 'g' .AND. t%iGeneration==1
[4068]	838	str = strTail(PACK(delPhase(t%name), MASK=mask), '_')
	839	CALL strReduce(str)
	840	i%keys(:)%name = str
[4067]	841
	842	!--- Full isotopes list, with isotopes tagging tracers (if any) following the previous list
[4068]	843	i%ntiso = ntiso
	844	ALLOCATE(i%trac(i%ntiso))
[4067]	845	mask = t%type=='tag' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%phase == 'g' .AND. t%iGeneration==2
[4068]	846	str = PACK(delPhase(t%name), MASK=mask)
	847	CALL strReduce(str)
	848	i%trac(:) = [i%keys(:)%name, str]
[4067]	849
	850	!--- Tagging zones names list
[4063]	851	i%nzone = nzone
[4067]	852	i%zone = strTail(str, '_', .TRUE.)
	853
	854	!--- Effective phases list
[4063]	855	i%nphas = nqo
[4067]	856	i%phase = ''
	857	DO ip=1,nphases; IF(strIdx(t%name, addPhase('H2O',old_phases(ip:ip),''))/=0) i%phase=TRIM(i%phase)//known_phases(ip:ip); END DO
	858
	859	!--- Table: index in "qx" of an isotope, knowing its indices "it","ip" in "isotope%iName,%iPhase"
	860	i%iTraPha = RESHAPE([((strIdx(t%name, TRIM(addPhase('H2O', new2oldPhase(i%phase(ip:ip)), ''))//'_'//TRIM(i%trac(it))), &
	861	it=1,i%ntiso), ip=1,i%nphas)], [i%ntiso,i%nphas])
	862
	863	!--- Table: index in "isotope%tracs(:)%name" of an isotopic tagging tracer, knowing its indices "iz","ip" in "isotope%iZone,%iName"
[4063]	864	i%iZonIso = RESHAPE([((strIdx(i%trac,TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))),iz=1,i%nzone),it=1,i%niso )],[i%nzone,i%niso ])
	865	DO it=1,ntiso
	866	WRITE(lunout,'(a,i0,a)')TRIM('infotrac_init')//': iqiso (',it,',:) = '//strStack(int2str(iqiso(it,:)))
	867	WRITE(lunout,'(a,i0,a)')TRIM('infotrac_init')//': iTraPha(',it,',:) = '//strStack(int2str(i%iTraPha(it,:)))
	868	END DO
	869	DO iz=1,nzone
	870	WRITE(lunout,'(a,i0,a)')TRIM('infotrac_init')//': index_trac(',iz,',:) = '//strStack(int2str(index_trac(iz,:)))
	871	WRITE(lunout,'(a,i0,a)')TRIM('infotrac_init')//': iZonIso (',iz,',:) = '//strStack(int2str(i%iZonIso(iz,:)))
	872	END DO
[2270]	873
[4063]	874	! Finalize :
	875	DEALLOCATE(nb_iso)
[2270]	876
[4063]	877	END SUBROUTINE infotrac_isoinit
[2270]	878
[4063]	879
	880	!==============================================================================================================================
	881	!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
	882	! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
	883	!==============================================================================================================================
	884	LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
	885	IMPLICIT NONE
	886	CHARACTER(LEN=*), INTENT(IN) :: iName
	887	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
	888	INTEGER :: iIso
	889	LOGICAL :: lV
	890	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
	891	iIso = strIdx(isotopes(:)%parent, iName)
	892	lerr = iIso == 0
	893	CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lerr .AND. lV)
	894	IF(lerr) RETURN
	895	lerr = isoSelectByIndex(iIso, lV)
	896	END FUNCTION isoSelectByName
	897	!==============================================================================================================================
	898	LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
	899	IMPLICIT NONE
	900	INTEGER, INTENT(IN) :: iIso
	901	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
	902	LOGICAL :: lv
	903	lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
	904	lerr = .FALSE.
	905	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
	906	lerr = iIso<=0 .OR. iIso>nbIso
	907	CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',&
	908	ll=lerr .AND. lV)
	909	IF(lerr) RETURN
	910	ixIso = iIso !--- Update currently selected family index
	911	isotope => isotopes(ixIso) !--- Select corresponding component
	912	isoKeys => isotope%keys; niso = isotope%niso
	913	isoName => isotope%trac; ntiso = isotope%ntiso
	914	isoZone => isotope%zone; nzone = isotope%nzone
	915	isoPhas => isotope%phase; nphas = isotope%nphas
	916	iZonIso => isotope%iZonIso; isoCheck = isotope%check
	917	iTraPha => isotope%iTraPha
	918	END FUNCTION isoSelectByIndex
	919	!==============================================================================================================================
	920
[1114]	921	END MODULE infotrac

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

Download in other formats:

Original Format