Context Navigation

readTracFiles_mod.f90 @ 5422

Last change on this file since 5422 was 4369, checked in by lguez, 2 years ago
Sync latest trunk changes to branch Ocean_skin
File size: 129.9 KB

Rev	Line
[4046]	1	MODULE readTracFiles_mod
	2
[4325]	3	USE strings_mod, ONLY: msg, find, get_in, str2int, dispTable, testFile, strReduce, strFind, strStack, strHead, &
[4301]	4	test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, strIdx, reduceExpr
[4046]	5
	6	IMPLICIT NONE
	7
	8	PRIVATE
	9
[4325]	10	PUBLIC :: maxlen !--- PARAMETER FOR CASUAL STRING LENGTH
	11	PUBLIC :: tracers !--- TRACERS DESCRIPTION DATABASE
	12	PUBLIC :: trac_type, setGeneration, indexUpdate !--- TRACERS DESCRIPTION ASSOCIATED TOOLS
	13	PUBLIC :: testTracersFiles, readTracersFiles !--- TRACERS FILES READING ROUTINES
[4328]	14	PUBLIC :: getKey, fGetKey, fGetKeys, addKey, setDirectKeys !--- TOOLS TO GET/SET KEYS FROM/TO tracers & isotopes
[4325]	15	PUBLIC :: getKeysDBase, setKeysDBase !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
[4046]	16
[4325]	17	PUBLIC :: addPhase, getiPhase, old_phases, phases_sep, & !--- FUNCTIONS RELATED TO THE PHASES
	18	nphases, delPhase, getPhase, known_phases, phases_names !--- + ASSOCIATED VARIABLES
[4046]	19
[4325]	20	PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
	21	PUBLIC :: oldHNO3, newHNO3 !--- HNO3 REPRO BACKWARD COMPATIBILITY (OLD start.nc)
[4120]	22
[4325]	23	PUBLIC :: tran0, idxAncestor, ancestor !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
[4301]	24
	25	!=== FOR ISOTOPES: GENERAL
[4325]	26	PUBLIC :: isot_type, readIsotopesFile, isoSelect !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
	27	PUBLIC :: ixIso, nbIso !--- INDEX OF SELECTED ISOTOPES CLASS + NUMBER OF CLASSES
[4301]	28
[4325]	29	!=== FOR ISOTOPES: H2O FAMILY ONLY
	30	PUBLIC :: iH2O
	31
	32	!=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
	33	PUBLIC :: isotope, isoKeys !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
	34	PUBLIC :: isoName, isoZone, isoPhas !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
	35	PUBLIC :: niso, nzone, nphas, ntiso !--- " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
	36	PUBLIC :: itZonIso !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
	37	PUBLIC :: iqIsoPha !--- Idx IN qx(1:nqtot) = f(isotope idx, phase idx)
	38	PUBLIC :: isoCheck !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
	39
[4193]	40	PUBLIC :: maxTableWidth
[4046]	41	!------------------------------------------------------------------------------------------------------------------------------
[4325]	42	TYPE :: keys_type !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
	43	CHARACTER(LEN=maxlen) :: name !--- Tracer name
	44	CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:) !--- Keys string list
	45	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:) !--- Corresponding values string list
	46	END TYPE keys_type
	47	!------------------------------------------------------------------------------------------------------------------------------
	48	TYPE :: trac_type !=== TYPE FOR A SINGLE TRACER NAMED "name"
	49	CHARACTER(LEN=maxlen) :: name = '' !--- Name of the tracer
	50	CHARACTER(LEN=maxlen) :: gen0Name = '' !--- First generation ancestor name
	51	CHARACTER(LEN=maxlen) :: parent = '' !--- Parent name
	52	CHARACTER(LEN=maxlen) :: longName = '' !--- Long name (with advection scheme suffix)
	53	CHARACTER(LEN=maxlen) :: type = 'tracer' !--- Type (so far: 'tracer' / 'tag')
	54	CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phase ('g'as / 'l'iquid / 's'olid)
	55	CHARACTER(LEN=maxlen) :: component = '' !--- Coma-separated list of components (Ex: lmdz,inca)
	56	INTEGER :: iGeneration = -1 !--- Generation number (>=0)
	57	INTEGER :: iqParent = 0 !--- Parent index
	58	INTEGER, ALLOCATABLE :: iqDescen(:) !--- Descendants index (in growing generation order)
	59	INTEGER :: nqDescen = 0 !--- Number of descendants (all generations)
	60	INTEGER :: nqChildren = 0 !--- Number of children (first generation)
[4358]	61	TYPE(keys_type) :: keys !--- <key>=<val> pairs vector
	62	INTEGER :: iadv = 10 !--- Advection scheme used
	63	LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue
	64	LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
[4325]	65	INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:)
	66	INTEGER :: iso_iName = 0 !--- Isotope name index in isotopes(iso_iGroup)%trac(:)
	67	INTEGER :: iso_iZone = 0 !--- Isotope zone index in isotopes(iso_iGroup)%zone(:)
	68	INTEGER :: iso_iPhase = 0 !--- Isotope phase index in isotopes(iso_iGroup)%phase
	69	END TYPE trac_type
	70	!------------------------------------------------------------------------------------------------------------------------------
	71	TYPE :: isot_type !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
	72	CHARACTER(LEN=maxlen) :: parent !--- Isotopes family name (parent tracer name ; ex: H2O)
	73	LOGICAL :: check=.FALSE. !--- Triggering of the checking routines
	74	TYPE(keys_type), ALLOCATABLE :: keys(:) !--- Isotopes keys/values pairs list (length: niso)
	75	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: ntiso)
	76	CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzone)
	77	CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phases list: [g][l][s] (length: nphas)
	78	INTEGER :: niso = 0 !--- Number of isotopes, excluding tagging tracers
	79	INTEGER :: nzone = 0 !--- Number of geographic tagging zones
	80	INTEGER :: ntiso = 0 !--- Number of isotopes, including tagging tracers
	81	INTEGER :: nphas = 0 !--- Number phases
	82	INTEGER, ALLOCATABLE :: iqIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
	83	!--- "iqIsoPha" former name: "iqiso"
	84	INTEGER, ALLOCATABLE :: itZonIso(:,:) !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
	85	!--- "itZonIso" former name: "index_trac"
	86	END TYPE isot_type
	87	!------------------------------------------------------------------------------------------------------------------------------
	88	TYPE :: dataBase_type !=== TYPE FOR TRACERS SECTION
	89	CHARACTER(LEN=maxlen) :: name !--- Section name
	90	TYPE(trac_type), ALLOCATABLE :: trac(:) !--- Tracers descriptors
[4046]	91	END TYPE dataBase_type
	92	!------------------------------------------------------------------------------------------------------------------------------
	93	INTERFACE getKey
[4328]	94	MODULE PROCEDURE getKeyByName_s1, getKeyByName_s1m, getKeyByName_sm, getKey_sm, &
	95	getKeyByName_i1, getKeyByName_i1m, getKeyByName_im, getKey_im, &
	96	getKeyByName_r1, getKeyByName_r1m, getKeyByName_rm, getKey_rm, &
	97	getKeyByName_l1, getKeyByName_l1m, getKeyByName_lm, getKey_lm
[4046]	98	END INTERFACE getKey
	99	!------------------------------------------------------------------------------------------------------------------------------
[4325]	100	INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
[4301]	101	INTERFACE old2newH2O; MODULE PROCEDURE old2newH2O_1, old2newH2O_m; END INTERFACE old2newH2O
	102	INTERFACE new2oldH2O; MODULE PROCEDURE new2oldH2O_1, new2oldH2O_m; END INTERFACE new2oldH2O
[4326]	103	INTERFACE fGetKey; MODULE PROCEDURE fgetKeyIdx_s1, fgetKeyNam_s1; END INTERFACE fGetKey
[4046]	104	INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
[4325]	105	INTERFACE idxAncestor; MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt; END INTERFACE idxAncestor
	106	INTERFACE ancestor; MODULE PROCEDURE ancestor_1, ancestor_m, ancestor_mt; END INTERFACE ancestor
[4328]	107	INTERFACE addKey; MODULE PROCEDURE addKey_1; END INTERFACE addKey!, addKey_m, addKey_mm; END INTERFACE addKey
[4120]	108	INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase
[4046]	109	!------------------------------------------------------------------------------------------------------------------------------
	110
	111	!=== MAIN DATABASE: files sections descriptors
	112	TYPE(dataBase_type), SAVE, ALLOCATABLE, TARGET :: dBase(:)
	113
	114	!--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
[4301]	115	CHARACTER(LEN=maxlen), SAVE :: tran0 = 'air' !--- Default transporting fluid
	116	CHARACTER(LEN=maxlen), PARAMETER :: old_phases = 'vlir' !--- Old phases for water (no separator)
	117	CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr' !--- Known phases initials
	118	INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases) !--- Number of phases
	119	CHARACTER(LEN=maxlen), SAVE :: phases_names(nphases) & !--- Known phases names
[4325]	120	= ['gaseous', 'liquid ', 'solid ', 'cloud ']
[4301]	121	CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator
	122	LOGICAL, SAVE :: tracs_merge = .TRUE. !--- Merge/stack tracers lists
	123	LOGICAL, SAVE :: lSortByGen = .TRUE. !--- Sort by growing generation
[4325]	124	CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
[4046]	125
[4301]	126	!--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
[4120]	127	CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau', 'HDO', 'O18', 'O17', 'HTO' ]
	128	CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO ']
	129
[4301]	130	!--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES
	131	CHARACTER(LEN=maxlen), SAVE :: oldHNO3(2) = ['HNO3_g ', 'HNO3 ']
	132	CHARACTER(LEN=maxlen), SAVE :: newHNO3(2) = ['HNO3 ', 'HNO3tot']
	133
[4325]	134	!=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
[4046]	135	TYPE(trac_type), ALLOCATABLE, TARGET, SAVE :: tracers(:)
	136	TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
	137
[4325]	138	!=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
	139	TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
	140	INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family
	141	INTEGER, SAVE :: nbIso !--- Number of isotopes classes
	142	LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines
	143	TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
	144	CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
	145	isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY
	146	isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY
	147	INTEGER, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
	148	nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
	149	INTEGER, SAVE, POINTER ::itZonIso(:,:), & !--- INDEX IN "isoTrac" AS f(tagging zone idx, isotope idx)
	150	iqIsoPha(:,:) !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx)
	151
	152	INTEGER, PARAMETER :: maxTableWidth = 192 !--- Maximum width of a table displayed with "dispTable"
[4046]	153	CHARACTER(LEN=maxlen) :: modname
	154
	155	CONTAINS
	156
	157	!==============================================================================================================================
	158	!==============================================================================================================================
	159	!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
[4301]	160	!=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
[4046]	161	!=== 0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
	162	!=== 1: AN "OLD STYLE" TRACERS FILE "traceur.def":
	163	!=== First line: <nb tracers> Other lines: <hadv> <vadv> <tracer name> [<parent name>]
	164	!=== 2: A "NEW STYLE" TRACERS FILE "tracer.def" WITH SEVERAL SECTIONS.
	165	!=== 3: SEVERAL " " TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
	166	!=== REMARKS:
	167	!=== * EACH SECTION BEGINS WITH A "&<section name> LINE
	168	!=== * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
	169	!=== * EACH SECTION LINE HAS THE STRUCTURE: <name(s)> <key1>=<value1> <key2>=<value2> ...
	170	!=== * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
	171	!=== * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
	172	!=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
	173	!=== ABOUT THE KEYS:
	174	! * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
	175	! But some variables are stored as direct-access keys to make the code more readable and because they are used often.
[4063]	176	! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
[4046]	177	! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
[4063]	178	! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
[4046]	179	! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
	180	!==============================================================================================================================
[4325]	181	LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, lRepr) RESULT(lerr)
[4046]	182	!------------------------------------------------------------------------------------------------------------------------------
[4325]	183	CHARACTER(LEN=*), INTENT(IN) :: type_trac !--- List of components used
	184	INTEGER, OPTIONAL, INTENT(OUT) :: fTyp !--- Type of input file found
	185	LOGICAL, OPTIONAL, INTENT(IN) :: lRepr !--- Activate the HNNO3 exceptions for REPROBUS
[4120]	186	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:)
[4363]	187	CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname
[4325]	188	INTEGER :: nsec, ierr, it, ntrac, ns, ip, ix, fType
[4301]	189	LOGICAL :: lRep
[4325]	190	TYPE(keys_type), POINTER :: k
[4046]	191	!------------------------------------------------------------------------------------------------------------------------------
	192	lerr = .FALSE.
	193	modname = 'readTracersFiles'
	194	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
[4363]	195	lRep=.FALSE.; IF(PRESENT(lRepr)) lRep = lRepr
[4046]	196
[4325]	197	!--- Required sections + corresponding files names (new style single section case) for tests
[4328]	198	IF(test(testTracersFiles(modname, type_trac, fType, .TRUE., trac_files, sections), lerr)) RETURN
[4301]	199	IF(PRESENT(fTyp)) fTyp = fType
[4325]	200	nsec = SIZE(sections)
[4046]	201
	202	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4063]	203	SELECT CASE(fType) !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys
[4046]	204	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4301]	205	CASE(1) !=== OLD FORMAT "traceur.def"
[4063]	206	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	207	!--- OPEN THE "traceur.def" FILE
	208	OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr)
[4046]	209
[4063]	210	!--- GET THE TRACERS NUMBER
	211	READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers
	212	IF(test(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, ierr /= 0), lerr)) RETURN
[4046]	213
[4063]	214	!--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
[4325]	215	IF(ALLOCATED(tracers)) DEALLOCATE(tracers)
	216	ALLOCATE(tracers(ntrac))
[4063]	217	DO it=1,ntrac !=== READ RAW DATA: loop on the line/tracer number
	218	READ(90,'(a)',IOSTAT=ierr) str
	219	IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN
	220	IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN
[4348]	221	lerr = strParse(str, ' ', s, ns)
[4063]	222	CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1)
	223	CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
[4325]	224	k => tracers(it)%keys
[4301]	225
	226	!=== NAME OF THE TRACER
	227	tname = old2newH2O(s(3), ip)
	228	ix = strIdx(oldHNO3, s(3))
	229	IF(ix /= 0 .AND. lRep) tname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
[4325]	230	tracers(it)%name = tname !--- Set %name
[4328]	231	CALL addKey_1('name', tname, k) !--- Set the name of the tracer
[4325]	232	tracers(it)%keys%name = tname !--- Copy tracers names in keys components
[4301]	233
	234	!=== NAME OF THE COMPONENT
	235	cname = type_trac !--- Name of the model component
	236	IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
[4325]	237	tracers(it)%component = cname !--- Set %component
[4328]	238	CALL addKey_1('component', cname, k) !--- Set the name of the model component
[4301]	239
	240	!=== NAME OF THE PARENT
	241	pname = tran0 !--- Default name: default transporting fluid (air)
	242	IF(ns == 4) THEN
	243	pname = old2newH2O(s(4))
	244	ix = strIdx(oldHNO3, s(4))
	245	IF(ix /= 0 .AND. lRep) pname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
	246	END IF
[4325]	247	tracers(it)%parent = pname !--- Set %parent
[4328]	248	CALL addKey_1('parent', pname, k)
[4301]	249
	250	!=== PHASE AND ADVECTION SCHEMES NUMBERS
[4325]	251	tracers(it)%phase = known_phases(ip:ip) !--- Set %phase: tracer phase (default: "g"azeous)
[4328]	252	CALL addKey_1('phase', known_phases(ip:ip), k) !--- Set the phase of the tracer (default: "g"azeous)
	253	CALL addKey_1('hadv', s(1), k) !--- Set the horizontal advection schemes number
	254	CALL addKey_1('vadv', s(2), k) !--- Set the vertical advection schemes number
[4063]	255	END DO
	256	CLOSE(90)
[4325]	257	IF(test(setGeneration(tracers), lerr)) RETURN !--- Set %iGeneration and %gen0Name
	258	WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag' !--- Set %type: 'tracer' or 'tag'
[4328]	259	DO it=1,ntrac
	260	CALL addKey_1('type', tracers(it)%type, tracers(it)%keys) !--- Set the type of tracer
	261	END DO
[4325]	262	IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN !--- Detect orphans and check phases
	263	IF(test(checkUnique (tracers, fname, fname), lerr)) RETURN !--- Detect repeated tracers
	264	CALL sortTracers (tracers) !--- Sort the tracers
[4063]	265	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4120]	266	CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE FILE, MULTIPLE SECTIONS
[4063]	267	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4120]	268	CASE(3); IF(test(feedDBase( trac_files , sections, modname), lerr)) RETURN !=== MULTIPLE FILES, SINGLE SECTION
[4046]	269	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4063]	270	END SELECT
[4046]	271	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4120]	272	IF(ALL([2,3] /= fType)) RETURN
	273
	274	IF(nsec == 1) THEN;
[4325]	275	tracers = dBase(1)%trac
[4120]	276	ELSE IF(tracs_merge) THEN
	277	CALL msg('The multiple required sections will be MERGED.', modname)
[4325]	278	IF(test(mergeTracers(dBase, tracers), lerr)) RETURN
[4120]	279	ELSE
	280	CALL msg('The multiple required sections will be CUMULATED.', modname)
[4325]	281	IF(test(cumulTracers(dBase, tracers), lerr)) RETURN
[4063]	282	END IF
[4325]	283	CALL setDirectKeys(tracers) !--- Set %iqParent, %iqDescen, %nqDescen, %nqChildren
[4046]	284	END FUNCTION readTracersFiles
	285	!==============================================================================================================================
	286
[4325]	287
[4046]	288	!==============================================================================================================================
[4328]	289	LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
[4325]	290	CHARACTER(LEN=*), INTENT(IN) :: modname, type_trac
	291	INTEGER, INTENT(OUT) :: fType
[4328]	292	LOGICAL, INTENT(IN) :: lDisp
[4325]	293	CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
	294	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
	295	LOGICAL, ALLOCATABLE :: ll(:)
	296	INTEGER :: is, nsec
	297
	298	!--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINNGLE SECTION PER FILE)
	299	IF(test(strParse(type_trac, '\|', sections, n=nsec), lerr)) RETURN !--- Parse "type_trac" list
	300	IF(PRESENT(sects)) sects = sections
	301	ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
	302	IF(PRESENT(tracf)) tracf = trac_files
	303
	304	nsec = SIZE(trac_files, DIM=1)
	305	ll = .NOT.testFile(trac_files)
	306	fType = 0
	307	IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1 !--- OLD STYLE FILE
	308	IF(.NOT.testFile('tracer.def')) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS
	309	IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
[4328]	310	IF(.NOT.test(lDisp, lerr)) RETURN !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
[4325]	311	IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES
	312	IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
	313	END IF
	314
	315	!--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
	316	IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = nsec>1 .AND. fType==1), lerr)) RETURN
	317
	318	!--- TELLS WHAT WAS IS ABOUT TO BE USED
	319	CALL msg('Trying to read old-style tracers description file "traceur.def"', modname, fType==1)
	320	CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"', modname, fType==2)
	321	CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
	322	END FUNCTION testTracersFiles
	323	!==============================================================================================================================
	324
	325	!==============================================================================================================================
[4120]	326	LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
[4169]	327	! Purpose: Read the sections "snames(is)" (pipe-separated list) from each "fnames(is)"
[4046]	328	! file and create the corresponding tracers set descriptors in the database "dBase":
	329	! * dBase(id)%name : section name
	330	! * dBase(id)%trac(:)%name : tracers names
	331	! * dBase(id)%trac(it)%keys%key(:): names of keys associated to tracer dBase(id)%trac(it)%name
	332	! * dBase(id)%trac(it)%keys%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
	333	!------------------------------------------------------------------------------------------------------------------------------
	334	CHARACTER(LEN=*), INTENT(IN) :: fnames(:) !--- Files names
[4169]	335	CHARACTER(LEN=*), INTENT(IN) :: snames(:) !--- Pipe-deparated list of sections (one list each file)
[4120]	336	CHARACTER(LEN=*), INTENT(IN) :: modname !--- Calling routine name
	337	INTEGER, ALLOCATABLE :: ndb(:) !--- Number of sections for each file
[4046]	338	INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list
[4120]	339	CHARACTER(LEN=maxlen) :: fnm, snm
[4046]	340	INTEGER :: idb, i
	341	LOGICAL :: ll
	342	!------------------------------------------------------------------------------------------------------------------------------
	343	!=== READ THE REQUIRED SECTIONS
[4169]	344	ll = strCount(snames, '\|', ndb) !--- Number of sections for each file
[4046]	345	ALLOCATE(ixf(SUM(ndb)))
[4063]	346	DO i=1, SIZE(fnames) !--- Set %name, %keys
[4046]	347	IF(test(readSections(fnames(i), snames(i), 'default'), lerr)) RETURN
	348	ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list
	349	END DO
	350	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	351	DO idb=1,SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS
	352	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4063]	353	fnm = fnames(ixf(idb)); snm = dBase(idb)%name !--- FILE AND SECTION NAMES
[4120]	354	lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
[4063]	355	IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- EXPAND NAMES ; set %parent, %type, %component
[4325]	356	IF(test(setGeneration(dBase(idb)%trac), lerr)) RETURN !--- set %iGeneration, %genOName
[4063]	357	IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK ORPHANS AND PHASES
	358	IF(test(checkUnique (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK TRACERS UNIQUENESS
	359	CALL expandPhases (dBase(idb)%trac) !--- EXPAND PHASES ; set %phase
[4046]	360	CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS
[4120]	361	lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
[4046]	362	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	363	END DO
	364	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	365	END FUNCTION feedDBase
	366	!------------------------------------------------------------------------------------------------------------------------------
	367
	368	!------------------------------------------------------------------------------------------------------------------------------
	369	LOGICAL FUNCTION readSections(fnam,snam,defName) RESULT(lerr)
	370	!------------------------------------------------------------------------------------------------------------------------------
	371	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- File name
[4169]	372	CHARACTER(LEN=*), INTENT(IN) :: snam !--- Pipe-separated sections list
[4046]	373	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: defName !--- Special section (default values) name
	374	!------------------------------------------------------------------------------------------------------------------------------
	375	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
	376	CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:)
	377	INTEGER, ALLOCATABLE :: ix(:)
[4363]	378	INTEGER :: n0, idb, ndb
[4046]	379	LOGICAL :: ll
	380	!------------------------------------------------------------------------------------------------------------------------------
	381	n0 = SIZE(dBase) + 1 !--- Index for next entry in the database
	382	CALL readSections_all() !--- Read all the sections of file "fnam"
	383	ndb= SIZE(dBase) !--- Current number of sections in the database
	384	IF(PRESENT(defName)) THEN !--- Add default values to all the tracers
	385	DO idb=n0,ndb; CALL addDefault(dBase(idb)%trac, defName); END DO !--- and remove the virtual tracer "defName"
	386	END IF
[4169]	387	ll = strParse(snam, '\|', keys = sec) !--- Requested sections names
[4046]	388	ix = strIdx(dBase(:)%name, sec(:)) !--- Indexes of requested sections in database
	389	IF(test(checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'), lerr)) RETURN
	390	tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))] !--- Keep requested sections only
	391
	392	CONTAINS
	393
	394	!------------------------------------------------------------------------------------------------------------------------------
	395	SUBROUTINE readSections_all()
	396	!------------------------------------------------------------------------------------------------------------------------------
	397	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), v(:)
	398	TYPE(trac_type), ALLOCATABLE :: tt(:)
	399	TYPE(trac_type) :: tmp
[4193]	400	CHARACTER(LEN=1024) :: str, str2
[4046]	401	CHARACTER(LEN=maxlen) :: secn
	402	INTEGER :: ierr, n
	403	!------------------------------------------------------------------------------------------------------------------------------
	404	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
	405	OPEN(90, FILE=fnam, FORM='formatted', STATUS='old')
[4193]	406	DO; str=''
	407	DO
	408	READ(90,'(a)', IOSTAT=ierr)str2 !--- Read a full line
	409	str=TRIM(str)//' '//TRIM(str2) !--- Append "str" with the current line
	410	n=LEN_TRIM(str); IF(n == 0) EXIT !--- Empty line (probably end of file)
	411	IF(IACHAR(str(n:n)) /= 92) EXIT !--- No "\" continuing line symbol found => end of line
	412	str = str(1:n-1) !--- Remove the "\" continuing line symbol
	413	END DO
	414	str = ADJUSTL(str) !--- Remove the front space
[4046]	415	IF(ierr /= 0 ) EXIT !--- Finished: error or end of file
	416	IF(str(1:1)=='#') CYCLE !--- Skip comments lines
	417	CALL removeComment(str) !--- Skip comments at the end of a line
	418	IF(str == '') CYCLE !--- Skip empty line (probably at the end of the file)
	419	IF(str(1:1)=='&') THEN !=== SECTION HEADER LINE
	420	ndb = SIZE(dBase) !--- Number of sections so far
	421	secn = str(2:LEN_TRIM(str))//' ' !--- Current section name
	422	IF(ANY(dBase(:)%name == secn)) CYCLE !--- Already known section
	423	IF(secn(1:7) == 'version') CYCLE !--- Skip the "version" special section
	424	ndb = ndb + 1 !--- Extend database
	425	ALLOCATE(tdb(ndb))
	426	tdb(1:ndb-1) = dBase
	427	tdb(ndb)%name = secn
	428	ALLOCATE(tdb(ndb)%trac(0))
	429	CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
	430	ELSE !=== TRACER LINE
[4348]	431	ll = strParse(str,' ', s, n, v) !--- Parse <key>=<val> pairs
[4046]	432	tt = dBase(ndb)%trac(:)
[4063]	433	tmp%name = s(1); tmp%keys = keys_type(s(1), s(2:n), v(2:n)) !--- Set %name and %keys
[4046]	434	dBase(ndb)%trac = [tt(:), tmp]
	435	DEALLOCATE(tt)
[4063]	436	! dBase(ndb)%trac = [dBase(ndb)%trac(:), tra(name=s(1), keys=keys_type(s(1), s(2:n), v(2:n)))]
[4046]	437	END IF
	438	END DO
	439	CLOSE(90)
	440
	441	END SUBROUTINE readSections_all
	442	!------------------------------------------------------------------------------------------------------------------------------
	443
	444	END FUNCTION readSections
	445	!==============================================================================================================================
	446
	447
	448	!==============================================================================================================================
	449	SUBROUTINE addDefault(t, defName)
	450	!------------------------------------------------------------------------------------------------------------------------------
	451	! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
	452	!------------------------------------------------------------------------------------------------------------------------------
	453	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
	454	CHARACTER(LEN=*), INTENT(IN) :: defName
	455	INTEGER :: jd, it, k
	456	TYPE(keys_type), POINTER :: ky
	457	TYPE(trac_type), ALLOCATABLE :: tt(:)
	458	jd = strIdx(t(:)%name, defName)
	459	IF(jd == 0) RETURN
	460	ky => t(jd)%keys
	461	DO k = 1, SIZE(ky%key) !--- Loop on the keys of the tracer named "defName"
[4325]	462	! CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys, .FALSE.) !--- Add key to all the tracers (no overwriting)
	463	DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
[4046]	464	END DO
	465	tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
	466	END SUBROUTINE addDefault
	467	!==============================================================================================================================
	468
	469	!==============================================================================================================================
	470	SUBROUTINE subDefault(t, defName, lSubLocal)
	471	!------------------------------------------------------------------------------------------------------------------------------
	472	! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
	473	! Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
	474	!------------------------------------------------------------------------------------------------------------------------------
	475	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
	476	CHARACTER(LEN=*), INTENT(IN) :: defName
	477	LOGICAL, INTENT(IN) :: lSubLocal
	478	INTEGER :: i0, it, ik
	479	TYPE(keys_type), POINTER :: k0, ky
	480	TYPE(trac_type), ALLOCATABLE :: tt(:)
	481	i0 = strIdx(t(:)%name, defName)
	482	IF(i0 == 0) RETURN
	483	k0 => t(i0)%keys
	484	DO it = 1, SIZE(t); IF(it == i0) CYCLE !--- Loop on the tracers
	485	ky => t(it)%keys
	486
	487	!--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
	488	DO ik = 1, SIZE(k0%key); CALL strReplace(ky%val, k0%key(ik), k0%val(ik), .TRUE.); END DO
	489
	490	IF(.NOT.lSubLocal) CYCLE
	491	!--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
	492	DO ik = 1, SIZE(ky%key); CALL strReplace(ky%val, ky%key(ik), ky%val(ik), .TRUE.); END DO
	493	END DO
	494	tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
	495
	496	END SUBROUTINE subDefault
	497	!==============================================================================================================================
	498
	499
	500	!==============================================================================================================================
	501	LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
	502	!------------------------------------------------------------------------------------------------------------------------------
	503	! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
	504	! Note: * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
	505	! * Default values are provided for these keys because they are necessary.
	506	!------------------------------------------------------------------------------------------------------------------------------
	507	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
	508	CHARACTER(LEN=*), INTENT(IN) :: sname
	509	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname
	510	TYPE(trac_type), ALLOCATABLE :: ttr(:)
	511	CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
[4363]	512	CHARACTER(LEN=maxlen) :: msg1, modname
	513	INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
[4046]	514	LOGICAL :: ll
	515	modname = 'expandSection'
	516	lerr = .FALSE.
	517	nt = SIZE(tr)
	518	nq = 0
	519	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	520	DO it = 1, nt !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
	521	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	522	!--- Extract useful keys: parent name, type, component name
	523	tr(it)%parent = fgetKey(it, 'parent', tr(:)%keys, tran0 )
	524	tr(it)%type = fgetKey(it, 'type' , tr(:)%keys, 'tracer')
	525	tr(it)%component = sname
[4328]	526	! CALL addKey_m('component', sname, tr(:)%keys)
	527	DO iq=1,SIZE(tr); CALL addKey_1('component', sname, tr(iq)%keys); END DO
[4046]	528
	529	!--- Determine the number of tracers and parents ; coherence checking
	530	ll = strCount(tr(it)%name, ',', ntr)
	531	ll = strCount(tr(it)%parent, ',', npr)
	532
	533	!--- Tagging tracers only can have multiple parents
	534	IF(test(npr/=1 .AND. TRIM(tr(it)%type)/='tag', lerr)) THEN
	535	msg1 = 'Check section "'//TRIM(sname)//'"'
	536	IF(PRESENT(fname)) msg1=TRIM(msg1)//' in file "'//TRIM(fname)//'"'
	537	CALL msg(TRIM(msg1)//': "'//TRIM(tr(it)%name)//'" has several parents but is not a tag', modname); RETURN
	538	END IF
	539	nq = nq + ntr*npr
	540	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	541	END DO
	542	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	543
	544	ALLOCATE(ttr(nq))
	545	iq = 1
	546	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	547	DO it = 1, nt !=== EXPAND TRACERS AND PARENTS NAMES LISTS
	548	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4348]	549	ll = strParse(tr(it)%name, ',', ta, ntr) !--- Number of tracers
	550	ll = strParse(tr(it)%parent, ',', pa, npr) !--- Number of parents
[4046]	551	DO ipr=1,npr !--- Loop on parents list elts
	552	DO itr=1,ntr !--- Loop on tracers list elts
[4325]	553	ttr(iq)%keys%key = tr(it)%keys%key
	554	ttr(iq)%keys%val = tr(it)%keys%val
	555	ttr(iq)%keys%name = ta(itr)
[4328]	556	ttr(iq)%name = TRIM(ta(itr)); CALL addKey_1('name', ta(itr), ttr(iq)%keys)
	557	ttr(iq)%parent = TRIM(pa(ipr)); CALL addKey_1('parent', pa(ipr), ttr(iq)%keys)
	558	ttr(iq)%type = tr(it)%type; CALL addKey_1('type', tr(it)%type, ttr(iq)%keys)
	559	ttr(iq)%component = tr(it)%component; CALL addKey_1('component', tr(it)%component, ttr(iq)%keys)
[4325]	560	iq = iq+1
[4046]	561	END DO
	562	END DO
	563	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	564	END DO
	565	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	566	DEALLOCATE(ta,pa)
	567	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
	568
	569	END FUNCTION expandSection
	570	!==============================================================================================================================
	571
[4328]	572
[4046]	573	!==============================================================================================================================
[4325]	574	LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
[4046]	575	!------------------------------------------------------------------------------------------------------------------------------
	576	! Purpose: Determine, for each tracer of "tr(:)":
[4063]	577	! * %iGeneration: the generation number
	578	! * %gen0Name: the generation 0 ancestor name
[4328]	579	! Check also for orphan tracers (tracers not descending on "tran0").
[4046]	580	!------------------------------------------------------------------------------------------------------------------------------
[4063]	581	TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
[4328]	582	INTEGER :: iq, jq, ig
	583	CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:)
[4046]	584	!------------------------------------------------------------------------------------------------------------------------------
[4328]	585	CHARACTER(LEN=maxlen) :: modname
	586	modname = 'setGeneration'
	587	IF(test(fmsg('missing "parent" attribute', modname, getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
	588	DO iq = 1, SIZE(tr)
	589	jq = iq; ig = 0
	590	DO WHILE(parent(jq) /= tran0)
[4333]	591	jq = strIdx(tr(:)%name, parent(jq))
[4328]	592	IF(test(fmsg('Orphan tracer "'//TRIM(tr(iq)%name)//'"', modname, jq == 0), lerr)) RETURN
	593	ig = ig + 1
	594	END DO
	595	tr(iq)%gen0Name = tr(jq)%name; CALL addKey_1('gen0Name', tr(iq)%gen0Name, tr(iq)%keys)
	596	tr(iq)%iGeneration = ig; CALL addKey_1('iGeneration', TRIM(int2str(ig)), tr(iq)%keys)
[4046]	597	END DO
[4325]	598	END FUNCTION setGeneration
[4046]	599	!==============================================================================================================================
	600
[4328]	601
[4046]	602	!==============================================================================================================================
	603	LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
	604	!------------------------------------------------------------------------------------------------------------------------------
	605	! Purpose:
	606	! * check for orphan tracers (without known parent)
	607	! * check wether the phases are known or not ("g"aseous, "l"iquid or "s"olid so far)
	608	!------------------------------------------------------------------------------------------------------------------------------
	609	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
	610	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
	611	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
	612	CHARACTER(LEN=maxlen) :: mesg
	613	CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha !--- Bad phases list, phases of current tracer
	614	CHARACTER(LEN=1) :: p
	615	INTEGER :: ip, np, iq, nq
	616	!------------------------------------------------------------------------------------------------------------------------------
	617	nq = SIZE(tr,DIM=1) !--- Number of tracers lines
	618	mesg = 'Check section "'//TRIM(sname)//'"'
	619	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
	620
	621	!=== CHECK FOR ORPHAN TRACERS
[4063]	622	IF(test(checkList(tr%name, tr%iGeneration==-1, mesg, 'tracers', 'orphan'), lerr)) RETURN
[4046]	623
	624	!=== CHECK PHASES
[4063]	625	DO iq=1,nq; IF(tr(iq)%iGeneration/=0) CYCLE !--- Generation O only is checked
[4046]	626	pha = fgetKey(iq, 'phases', tr(:)%keys, 'g') !--- Phases
	627	np = LEN_TRIM(pha); bp(iq)=' '
	628	DO ip=1,np; p = pha(ip:ip); IF(INDEX(known_phases,p)==0) bp(iq) = TRIM(bp(iq))//p; END DO
	629	IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tr(iq)%name)//': '//TRIM(bp(iq))
	630	END DO
[4063]	631	lerr = checkList(bp, tr%iGeneration==0 .AND. bp/='', mesg, 'tracers phases', 'unknown')
[4046]	632	END FUNCTION checkTracers
	633	!==============================================================================================================================
	634
[4328]	635
[4046]	636	!==============================================================================================================================
[4063]	637	LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
[4046]	638	!------------------------------------------------------------------------------------------------------------------------------
	639	! Purpose: Make sure that tracers are not repeated.
	640	!------------------------------------------------------------------------------------------------------------------------------
	641	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
	642	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
	643	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
	644	!------------------------------------------------------------------------------------------------------------------------------
	645	INTEGER :: ip, np, iq, nq, k
	646	LOGICAL, ALLOCATABLE :: ll(:)
	647	CHARACTER(LEN=maxlen) :: mesg, tnam, tdup(SIZE(tr,DIM=1))
	648	CHARACTER(LEN=1) :: p
	649	!------------------------------------------------------------------------------------------------------------------------------
	650	mesg = 'Check section "'//TRIM(sname)//'"'
	651	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
	652	nq=SIZE(tr,DIM=1); lerr=.FALSE. !--- Number of lines ; error flag
	653	tdup(:) = ''
[4063]	654	DO iq=1,nq; IF(tr(iq)%type == 'tag') CYCLE !--- Tags can be repeated
[4046]	655	tnam = TRIM(tr(iq)%name)
	656	ll = tr(:)%name==TRIM(tnam) !--- Mask for current tracer name
	657	IF(COUNT(ll)==1 ) CYCLE !--- Tracer is not repeated
[4120]	658	IF(tr(iq)%iGeneration>0) THEN
	659	tdup(iq) = tnam !--- gen>0: MUST be unique
[4046]	660	ELSE
	661	DO ip=1,nphases; p=known_phases(ip:ip) !--- Loop on known phases
	662	!--- Number of appearances of the current tracer with known phase "p"
	663	np = COUNT( PACK( [(INDEX(fgetKey(k, 'phases', tr(:)%keys, 'g'),p), k=1, nq)] /=0 , MASK=ll ) )
	664	IF(np <=1) CYCLE
	665	tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))
	666	IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)='' !--- Avoid repeating same messages
	667	END DO
	668	END IF
	669	IF(tdup(iq) /= '') tdup(iq)=TRIM(tnam)//' in '//TRIM(tdup(iq))//' phase(s)'
	670	END DO
	671	lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
	672	END FUNCTION checkUnique
	673	!==============================================================================================================================
	674
[4328]	675
[4046]	676	!==============================================================================================================================
	677	SUBROUTINE expandPhases(tr)
	678	!------------------------------------------------------------------------------------------------------------------------------
[4120]	679	! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
[4046]	680	!------------------------------------------------------------------------------------------------------------------------------
	681	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
	682	!------------------------------------------------------------------------------------------------------------------------------
	683	TYPE(trac_type), ALLOCATABLE :: ttr(:)
	684	INTEGER, ALLOCATABLE :: i0(:)
[4325]	685	CHARACTER(LEN=maxlen) :: nam, pha, tname
[4120]	686	CHARACTER(LEN=1) :: p
[4046]	687	INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
[4301]	688	LOGICAL :: lTag, lExt
[4046]	689	!------------------------------------------------------------------------------------------------------------------------------
	690	nq = SIZE(tr, DIM=1)
	691	nt = 0
	692	DO iq = 1, nq !--- GET THE NUMBER OF TRACERS
[4120]	693	IF(tr(iq)%iGeneration /= 0) CYCLE !--- Only deal with generation 0 tracers
[4325]	694	nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0) !--- Number of children of tr(iq)
	695	tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys) !--- Phases list of tr(iq)
	696	np = LEN_TRIM(tr(iq)%phase) !--- Number of phases of tr(iq)
[4046]	697	nt = nt + (1+nc) * np !--- Number of tracers after expansion
	698	END DO
[4120]	699	ALLOCATE(ttr(nt)) !--- Version of "tr" after phases expansion
[4046]	700	it = 1 !--- Current "ttr(:)" index
	701	DO iq = 1, nq !--- Loop on "tr(:)" indexes
[4301]	702	lTag = tr(iq)%type=='tag' !--- Current tracer is a tag
[4046]	703	i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n) !--- Indexes of first generation ancestor copies
[4120]	704	np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1) !--- Number of phases for current tracer tr(iq)
[4301]	705	lExt = np>1 !--- Phase suffix only required if phases number is > 1
	706	IF(lTag) lExt = lExt .AND. tr(iq)%iGeneration>0 !--- No phase suffix for generation 0 tags
[4120]	707	DO i=1,n !=== LOOP ON GENERATION 0 ANCESTORS
	708	jq = i0(i) !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
	709	IF(tr(iq)%iGeneration==0) jq=iq !--- Generation 0: count the current tracer phases only
[4046]	710	pha = tr(jq)%phase !--- Phases list for tr(jq)
[4120]	711	DO ip = 1, LEN_TRIM(pha) !=== LOOP ON PHASES LISTS
	712	p = pha(ip:ip)
[4325]	713	tname = TRIM(tr(iq)%name); nam = tname !--- Tracer name (regular case)
[4301]	714	IF(lTag) nam = TRIM(tr(iq)%parent) !--- Parent name (tagging case)
	715	IF(lExt) nam = addPhase(nam, p ) !--- Phase extension needed
[4325]	716	IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname) !--- <parent>_<name> for tags
[4046]	717	ttr(it) = tr(iq) !--- Same <key>=<val> pairs
[4120]	718	ttr(it)%name = TRIM(nam) !--- Name with possibly phase suffix
[4046]	719	ttr(it)%keys%name = TRIM(nam) !--- Name inside the keys decriptor
[4120]	720	ttr(it)%phase = p !--- Single phase entry
[4328]	721	CALL addKey_1('name', nam, ttr(it)%keys)
	722	CALL addKey_1('phase', p, ttr(it)%keys)
[4301]	723	IF(lExt .AND. tr(iq)%iGeneration>0) THEN
[4325]	724	ttr(it)%parent = addPhase(tr(iq)%parent, p)
	725	ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
[4328]	726	CALL addKey_1('parent', ttr(it)%parent, ttr(it)%keys)
	727	CALL addKey_1('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
[4046]	728	END IF
[4120]	729	it = it+1
[4046]	730	END DO
[4120]	731	IF(tr(iq)%iGeneration==0) EXIT !--- Break phase loop for gen 0
[4046]	732	END DO
	733	END DO
	734	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
	735	CALL delKey(['phases'],tr) !--- Remove few keys entries
	736
	737	END SUBROUTINE expandPhases
	738	!==============================================================================================================================
	739
[4328]	740
[4046]	741	!==============================================================================================================================
	742	SUBROUTINE sortTracers(tr)
	743	!------------------------------------------------------------------------------------------------------------------------------
	744	! Purpose: Sort tracers:
[4120]	745	! * Put water at the beginning of the vector, in the "known_phases" order.
[4046]	746	! * lGrowGen == T: in ascending generations numbers.
[4325]	747	! * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
[4063]	748	! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
[4046]	749	!------------------------------------------------------------------------------------------------------------------------------
[4120]	750	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
[4046]	751	!------------------------------------------------------------------------------------------------------------------------------
[4233]	752	TYPE(trac_type), ALLOCATABLE :: tr2(:)
	753	INTEGER, ALLOCATABLE :: iy(:), iz(:)
	754	INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
	755	! tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
	756	!------------------------------------------------------------------------------------------------------------------------------
[4063]	757	nq = SIZE(tr)
	758	DO ip = nphases, 1, -1
[4120]	759	iq = strIdx(tr(:)%name, addPhase('H2O', ip))
	760	IF(iq == 0) CYCLE
[4233]	761	tr2 = tr(:)
	762	tr = [tr2(iq), tr2(1:iq-1), tr2(iq+1:nq)]
[4063]	763	END DO
[4046]	764	IF(lSortByGen) THEN
[4120]	765	iq = 1
[4046]	766	ng = MAXVAL(tr(:)%iGeneration, MASK=.TRUE., DIM=1) !--- Number of generations
	767	DO ig = 0, ng !--- Loop on generations
[4063]	768	iy = PACK([(k, k=1, nq)], MASK=tr(:)%iGeneration==ig) !--- Generation ig tracers indexes
[4046]	769	n = SIZE(iy)
	770	ix(iq:iq+n-1) = iy !--- Stack growing generations idxs
	771	iq = iq + n
	772	END DO
	773	ELSE
[4120]	774	iq = 1
	775	DO jq = 1, nq !--- Loop on generation 0 tracers
	776	IF(tr(jq)%iGeneration /= 0) CYCLE !--- Skip generations /= 0
	777	ix(iq) = jq !--- Generation 0 ancestor index first
	778	iq = iq + 1 !--- Next "iq" for next generations tracers
[4325]	779	iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name)) !--- Indexes of "tr(jq)" children in "tr(:)"
[4120]	780	ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1) !--- Number of generations of the "tr(jq)" family
	781	DO ig = 1, ng !--- Loop on generations of the "tr(jq)" family
[4046]	782	iz = find(tr(iy)%iGeneration, ig, n) !--- Indexes of the tracers "tr(iy(:))" of generation "ig"
	783	ix(iq:iq+n-1) = iy(iz) !--- Same indexes in "tr(:)"
	784	iq = iq + n
	785	END DO
	786	END DO
	787	END IF
	788	tr = tr(ix) !--- Reorder the tracers
	789	END SUBROUTINE sortTracers
	790	!==============================================================================================================================
	791
[4325]	792
[4046]	793	!==============================================================================================================================
	794	LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
	795	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
	796	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
	797	TYPE(trac_type), POINTER :: t1(:), t2(:)
	798	INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
	799	INTEGER :: is, k1, k2, nk2, i1, i2, nt2
	800	CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
	801	modname = 'mergeTracers'
	802	lerr = .FALSE.
	803	t1 => sections(1)%trac(:) !--- Alias: first tracers section
	804	tr = t1
	805	!----------------------------------------------------------------------------------------------------------------------------
	806	DO is=2,SIZE(sections) !=== SEVERAL SECTIONS: MERGE THEM
	807	!----------------------------------------------------------------------------------------------------------------------------
	808	t2 => sections(is)%trac(:) !--- Alias: current tracers section
	809	nt2 = SIZE(t2(:), DIM=1) !--- Number of tracers in section
	810	ixct = strIdx(t1(:)%name, t2(:)%name) !--- Indexes of common tracers
	811	tr = [tr, PACK(t2, MASK= ixct==0)] !--- Append with new tracers
	812	IF( ALL(ixct == 0) ) CYCLE !--- No common tracers => done
	813	CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
	814	CALL msg(t1(PACK(ixct, MASK = ixct/=0))%name, modname, nmax=128) !--- Display duplicates (the 128 first at most)
	815	!--------------------------------------------------------------------------------------------------------------------------
	816	DO i2=1,nt2; tnam = TRIM(t2(i2)%name) !=== LOOP ON COMMON TRACERS
	817	!--------------------------------------------------------------------------------------------------------------------------
	818	i1 = ixct(i2); IF(i1 == 0) CYCLE !--- Idx in t1(:) ; skip new tracers
	819
	820	!=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
	821	s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
	822
	823	IF(test(fmsg('Parent name'//TRIM(s1), modname, t1(i1)%parent /= t2(i2)%parent), lerr)) RETURN
	824	IF(test(fmsg('Type' //TRIM(s1), modname, t1(i1)%type /= t2(i2)%type), lerr)) RETURN
	825	IF(test(fmsg('Generation' //TRIM(s1), modname, t1(i1)%iGeneration /= t2(i2)%iGeneration), lerr)) RETURN
	826
	827	!=== APPEND <key>=<val> PAIRS NOT PREVIOULSLY DEFINED
	828	nk2 = SIZE(t2(i2)%keys%key(:)) !--- Keys number in current section
	829	ixck = strIdx(t1(i1)%keys%key(:), t2(i2)%keys%key(:)) !--- Common keys indexes
	830
	831	!=== APPEND NEW KEYS
	832	tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
	833	tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
	834
	835	!--- KEEP TRACK OF THE COMPONENTS NAMES
	836	tr(i1)%component = TRIM(tr(i1)%component)//','//TRIM(tr(i2)%component)
	837
	838	!--- SELECT COMMON TRACERS WITH DIFFERING KEYS VALUES (PREVIOUS VALUE IS KEPT)
	839	DO k2=1,nk2
	840	k1 = ixck(k2); IF(k1 == 0) CYCLE
	841	IF(t1(i1)%keys%val(k1) == t2(i2)%keys%val(k2)) ixck(k2)=0
	842	END DO
	843	IF(ALL(ixck==0)) CYCLE !--- No identical keys with /=values
	844
	845	!--- DISPLAY INFORMATION: OLD VALUES ARE KEPT FOR THE KEYS FOUND IN PREVIOUS AND CURRENT SECTIONS
	846	CALL msg('Key(s)'//TRIM(s1), modname)
	847	DO k2 = 1, nk2 !--- Loop on keys found in both t1(:) and t2(:)
	848	knam = t2(i2)%keys%key(k2) !--- Name of the current key
	849	k1 = ixck(k2) !--- Corresponding index in t1(:)
	850	IF(k1 == 0) CYCLE !--- New keys are skipped
	851	v1 = t1(i1)%keys%val(k1); v2 = t2(i2)%keys%val(k2) !--- Key values in t1(:) and t2(:)
	852	CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
	853	END DO
	854	!------------------------------------------------------------------------------------------------------------------------
	855	END DO
	856	!--------------------------------------------------------------------------------------------------------------------------
	857	END DO
	858	CALL sortTracers(tr)
	859
	860	END FUNCTION mergeTracers
	861	!==============================================================================================================================
	862
	863	!==============================================================================================================================
	864	LOGICAL FUNCTION cumulTracers(sections, tr) RESULT(lerr)
	865	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
	866	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
[4363]	867	TYPE(trac_type), POINTER :: t(:)
[4046]	868	INTEGER, ALLOCATABLE :: nt(:)
	869	CHARACTER(LEN=maxlen) :: tnam, tnam_new
	870	INTEGER :: iq, nq, is, ns, nsec
	871	lerr = .FALSE. !--- Can't fail ; kept to match "mergeTracer" interface.
	872	nsec = SIZE(sections)
	873	tr = [( sections(is)%trac(:) , is=1, nsec )] !--- Concatenated tracers vector
	874	nt = [( SIZE(sections(is)%trac(:)), is=1, nsec )] !--- Number of tracers in each section
	875	!----------------------------------------------------------------------------------------------------------------------------
	876	DO is=1, nsec !=== LOOP ON SECTIONS
	877	!----------------------------------------------------------------------------------------------------------------------------
[4363]	878	t => sections(is)%trac(:)
[4046]	879	!--------------------------------------------------------------------------------------------------------------------------
	880	DO iq=1, nt(is) !=== LOOP ON TRACERS
	881	!--------------------------------------------------------------------------------------------------------------------------
[4363]	882	tnam = TRIM(t(iq)%name) !--- Original name
	883	IF(COUNT(t%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished
[4120]	884	tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name) !--- Same with section extension
[4046]	885	nq = SUM(nt(1:is-1)) !--- Number of tracers in previous sections
	886	ns = nt(is) !--- Number of tracers in the current section
	887	tr(iq + nq)%name = TRIM(tnam_new) !--- Modify tracer name
	888	WHERE(tr(1+nq:ns+nq)%parent==tnam) tr(1+nq:ns+nq)%parent=tnam_new !--- Modify parent name
	889	!--------------------------------------------------------------------------------------------------------------------------
	890	END DO
	891	!----------------------------------------------------------------------------------------------------------------------------
	892	END DO
	893	!----------------------------------------------------------------------------------------------------------------------------
	894	CALL sortTracers(tr)
	895	END FUNCTION cumulTracers
	896	!==============================================================================================================================
	897
	898	!==============================================================================================================================
	899	SUBROUTINE setDirectKeys(tr)
	900	TYPE(trac_type), INTENT(INOUT) :: tr(:)
[4063]	901
[4325]	902	!--- Update %iqParent, %iqDescen, %nqDescen, %nqChildren
[4063]	903	CALL indexUpdate(tr)
	904
	905	!--- Extract some direct-access keys
[4046]	906	! DO iq = 1, SIZE(tr)
[4063]	907	! tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, <default_value> )
[4046]	908	! END DO
	909	END SUBROUTINE setDirectKeys
	910	!==============================================================================================================================
	911
	912	!==============================================================================================================================
	913	LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
	914	CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
	915	INTEGER :: idb, iq, nq
	916	INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
[4325]	917	CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:), prnt(:)
[4046]	918	TYPE(trac_type), POINTER :: tm(:)
	919	lerr = .FALSE.
	920	idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
	921	tm => dBase(idb)%trac
	922	nq = SIZE(tm)
[4120]	923	!--- BEWARE ! Can't use the "getKeyByName" functions yet.
	924	! Names must first include the phases for tracers defined on multiple lines.
[4327]	925	hadv = str2int(fgetKeys('hadv', tm(:)%keys, '10'))
	926	vadv = str2int(fgetKeys('vadv', tm(:)%keys, '10'))
	927	prnt = fgetKeys('parent',tm(:)%keys, '' )
	928	IF(getKey('phases', phas, ky=tm(:)%keys)) phas = fGetKeys('phase', tm(:)%keys, 'g')
[4046]	929	CALL msg(TRIM(message)//':', modname)
[4325]	930	IF(ALL(prnt == 'air')) THEN
	931	IF(test(dispTable('iiiss', ['iq ','hadv ','vadv ','name ','phase '], cat(tm%name, phas), &
[4193]	932	cat([(iq, iq=1, nq)], hadv, vadv), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
[4325]	933	ELSE IF(ALL(tm%iGeneration == -1)) THEN
	934	IF(test(dispTable('iiisss', ['iq ','hadv ','vadv ','name ','parent','phase '], cat(tm%name, prnt, phas), &
	935	cat([(iq, iq=1, nq)], hadv, vadv), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
[4120]	936	ELSE
[4325]	937	IF(test(dispTable('iiissis', ['iq ','hadv ','vadv ','name ','parent','igen ','phase '], cat(tm%name, prnt, phas), &
	938	cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
[4120]	939	END IF
[4046]	940	END FUNCTION dispTraSection
	941	!==============================================================================================================================
	942
	943
	944	!==============================================================================================================================
	945	!== CREATE A SCALAR ALIAS OF THE COMPONENT OF THE TRACERS DESCRIPTOR "t" NAMED "tname" ========================================
	946	!==============================================================================================================================
	947	FUNCTION aliasTracer(tname, t) RESULT(out)
	948	TYPE(trac_type), POINTER :: out
	949	CHARACTER(LEN=*), INTENT(IN) :: tname
	950	TYPE(trac_type), TARGET, INTENT(IN) :: t(:)
	951	INTEGER :: it
	952	it = strIdx(t(:)%name, tname)
	953	out => NULL(); IF(it /= 0) out => t(it)
	954	END FUNCTION aliasTracer
[4301]	955	!==============================================================================================================================
[4046]	956
	957
	958	!==============================================================================================================================
	959	!=== FROM A LIST OF INDEXES OR NAMES, CREATE A SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" ==================================
	960	!==============================================================================================================================
	961	FUNCTION trSubset_Indx(trac,idx) RESULT(out)
	962	TYPE(trac_type), ALLOCATABLE :: out(:)
	963	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	964	INTEGER, INTENT(IN) :: idx(:)
	965	out = trac(idx)
	966	CALL indexUpdate(out)
	967	END FUNCTION trSubset_Indx
	968	!------------------------------------------------------------------------------------------------------------------------------
	969	FUNCTION trSubset_Name(trac,nam) RESULT(out)
	970	TYPE(trac_type), ALLOCATABLE :: out(:)
	971	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	972	CHARACTER(LEN=*), INTENT(IN) :: nam(:)
	973	out = trac(strIdx(trac(:)%name, nam))
	974	CALL indexUpdate(out)
	975	END FUNCTION trSubset_Name
[4301]	976	!==============================================================================================================================
[4046]	977
	978
	979	!==============================================================================================================================
	980	!=== CREATE THE SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" HAVING THE FIRST GENERATION ANCESTOR NAMED "nam" ================
	981	!==============================================================================================================================
	982	FUNCTION trSubset_gen0Name(trac,nam) RESULT(out)
	983	TYPE(trac_type), ALLOCATABLE :: out(:)
	984	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	985	CHARACTER(LEN=*), INTENT(IN) :: nam
	986	out = trac(strFind(delPhase(trac(:)%gen0Name), nam))
	987	CALL indexUpdate(out)
	988	END FUNCTION trSubset_gen0Name
[4301]	989	!==============================================================================================================================
[4046]	990
	991
	992	!==============================================================================================================================
	993	!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
	994	!==============================================================================================================================
	995	SUBROUTINE indexUpdate(tr)
	996	TYPE(trac_type), INTENT(INOUT) :: tr(:)
[4363]	997	INTEGER :: iq, ig, igen, ngen, ix(SIZE(tr))
[4046]	998	tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent ) !--- Parent index
[4328]	999	DO iq = 1, SIZE(tr); CALL addKey_1('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO
[4046]	1000	ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
	1001	DO iq = 1, SIZE(tr)
[4120]	1002	ig = tr(iq)%iGeneration
	1003	IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
	1004	ALLOCATE(tr(iq)%iqDescen(0))
[4325]	1005	CALL idxAncestor(tr, ix, ig) !--- Ancestor of generation "ng" for each tr
[4120]	1006	DO igen = ig+1, ngen
	1007	tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
	1008	tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
[4325]	1009	IF(igen == ig+1) THEN
	1010	tr(iq)%nqChildren = tr(iq)%nqDescen
[4328]	1011	CALL addKey_1('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
[4325]	1012	END IF
[4120]	1013	END DO
[4328]	1014	CALL addKey_1('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
	1015	CALL addKey_1('nqDescen', int2str(tr(iq)%nqDescen) , tr(iq)%keys)
[4046]	1016	END DO
	1017	END SUBROUTINE indexUpdate
[4301]	1018	!==============================================================================================================================
[4046]	1019
	1020
	1021	!==============================================================================================================================
	1022	!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent": ====
	1023	!=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent" ====
	1024	!=== * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ====
	1025	!=== NOTES: ====
[4325]	1026	!=== * Most of the "isot" components have been defined in the calling routine (readIsotopes): ====
[4143]	1027	!=== parent, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iqIsoPha(:,:), itZonPhi(:,:) ====
[4046]	1028	!=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ====
	1029	!=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ====
	1030	!=== * In case keys are found both in the "params" section and the "*.def" file, the later value is retained ====
	1031	!=== * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution) ====
	1032	!=== * The routine gives an error if a required isotope is not available in the database stored in "fnam" ====
	1033	!==============================================================================================================================
[4325]	1034	LOGICAL FUNCTION readIsotopesFile_prv(fnam, isot) RESULT(lerr)
[4046]	1035	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name
[4301]	1036	TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %parent must be defined!)
[4363]	1037	INTEGER :: is, iis, it, idb, ndb, nb0
[4046]	1038	CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:)
[4363]	1039	CHARACTER(LEN=maxlen) :: modname
[4046]	1040	TYPE(trac_type), POINTER :: tt(:), t
	1041	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
	1042	modname = 'readIsotopesFile'
	1043
	1044	!--- THE INPUT FILE MUST BE PRESENT
	1045	IF(test(fmsg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, testFile(fnam)),lerr)) RETURN
	1046
	1047	!--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
	1048	nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index
[4169]	1049	IF(test(readSections(fnam,strStack(isot(:)%parent,'\|')),lerr)) RETURN !--- Read sections, one each parent tracer
[4046]	1050	ndb = SIZE(dBase, DIM=1) !--- Current database size
	1051	DO idb = nb0, ndb
[4301]	1052	iis = idb-nb0+1
[4046]	1053
	1054	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
	1055	CALL addKeysFromDef(dBase(idb)%trac, 'params')
	1056
	1057	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
	1058	CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
	1059
	1060	tt => dBase(idb)%trac
	1061
	1062	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
	1063	DO it = 1, SIZE(dBase(idb)%trac)
	1064	t => dBase(idb)%trac(it)
	1065	is = strIdx(isot(iis)%keys(:)%name, t%name) !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
	1066	IF(is == 0) CYCLE
[4325]	1067	IF(test(ANY(reduceExpr(t%keys%val, vals)), lerr)) RETURN !--- Reduce expressions ; detect non-numerical elements
	1068	isot(iis)%keys(is)%key = t%keys%key
	1069	isot(iis)%keys(is)%val = vals
[4046]	1070	END DO
	1071
	1072	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
[4325]	1073	IF(test(checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
	1074	'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'), lerr)) RETURN
[4046]	1075	END DO
	1076
	1077	!--- CLEAN THE DATABASE ENTRIES
	1078	IF(nb0 == 1) THEN
	1079	DEALLOCATE(dBase); ALLOCATE(dBase(0))
	1080	ELSE
	1081	ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
	1082	END IF
[4120]	1083
	1084	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
	1085	CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
	1086
[4325]	1087	lerr = dispIsotopes()
[4046]	1088
[4325]	1089	CONTAINS
	1090
	1091	!------------------------------------------------------------------------------------------------------------------------------
	1092	LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
	1093	INTEGER :: ik, nk, ip, it, nt
	1094	CHARACTER(LEN=maxlen) :: prf
	1095	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
	1096	CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
	1097	DO ip = 1, SIZE(isot) !--- Loop on parents tracers
	1098	nk = SIZE(isot(ip)%keys(1)%key) !--- Same keys for each isotope
	1099	nt = SIZE(isot(ip)%keys) !--- Number of isotopes
	1100	prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing
	1101	ALLOCATE(ttl(nk+2), val(nt,nk+1))
	1102	ttl(1:2) = ['it ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
	1103	val(:,1) = isot(ip)%keys(:)%name !--- Values table 1st column: isotopes names
	1104	DO ik = 1, nk
	1105	DO it = 1, nt
	1106	val(it,ik+1) = isot(ip)%keys(it)%val(ik) !--- Other columns: keys values
	1107	END DO
	1108	END DO
	1109	IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
	1110	cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
	1111	DEALLOCATE(ttl, val)
	1112	END DO
	1113	END FUNCTION dispIsotopes
	1114	!------------------------------------------------------------------------------------------------------------------------------
	1115
	1116	END FUNCTION readIsotopesFile_prv
[4046]	1117	!==============================================================================================================================
	1118
[4301]	1119
[4046]	1120	!==============================================================================================================================
	1121	!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: ===
	1122	!=== * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS). ===
	1123	!=== * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS ===
[4325]	1124	!=== * CALL readIsotopesFile_prv TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS) ===
[4046]	1125	!=== NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS. ===
	1126	!==============================================================================================================================
[4325]	1127	LOGICAL FUNCTION readIsotopesFile(iNames) RESULT(lerr)
	1128	CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN) :: iNames(:)
[4046]	1129	CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:) !--- Temporary storage
[4325]	1130	CHARACTER(LEN=maxlen) :: iName, modname
[4046]	1131	CHARACTER(LEN=1) :: ph !--- Phase
[4325]	1132	INTEGER :: ic, ip, iq, it, iz
[4046]	1133	LOGICAL, ALLOCATABLE :: ll(:) !--- Mask
	1134	TYPE(trac_type), POINTER :: t(:), t1
[4120]	1135	TYPE(isot_type), POINTER :: i
[4193]	1136	lerr = .FALSE.
[4325]	1137	modname = 'readIsotopesFile'
[4046]	1138
[4325]	1139	t => tracers
[4046]	1140
[4301]	1141	!--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
	1142	p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
[4046]	1143	CALL strReduce(p, nbIso)
	1144
[4325]	1145	!--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
	1146	IF(PRESENT(iNames)) THEN
	1147	DO it = 1, SIZE(iNames)
	1148	IF(test(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, ALL(p /= iNames(it))), lerr)) RETURN
	1149	END DO
	1150	p = iNames; nbIso = SIZE(p)
	1151	END IF
	1152	IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
	1153	ALLOCATE(isotopes(nbIso))
	1154
[4046]	1155	IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED
	1156
	1157	!--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
[4325]	1158	isotopes(:)%parent = p
[4046]	1159	DO ic = 1, SIZE(p) !--- Loop on isotopes classes
[4325]	1160	i => isotopes(ic)
[4120]	1161	iname = i%parent !--- Current isotopes class name (parent tracer name)
[4046]	1162
[4325]	1163	!=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
[4046]	1164	ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
	1165	str = PACK(delPhase(t(:)%name), MASK = ll) !--- Effectively found isotopes of "iname"
[4120]	1166	i%niso = SIZE(str) !--- Number of "effectively found isotopes of "iname"
	1167	ALLOCATE(i%keys(i%niso))
	1168	FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
[4046]	1169
	1170	!=== Geographic tagging tracers descending on tracer "iname": mask, names, number
[4120]	1171	ll = t(:)%type=='tag' .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
	1172	i%zone = PACK(strTail(t(:)%name,'_'), MASK = ll) !--- Tagging zones names for isotopes category "iname"
	1173	CALL strReduce(i%zone)
	1174	i%nzone = SIZE(i%zone) !--- Tagging zones number for isotopes category "iname"
[4046]	1175
[4325]	1176	!=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
[4046]	1177	! NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
	1178	str = PACK(delPhase(t(:)%name), MASK=ll)
	1179	CALL strReduce(str)
[4143]	1180	i%ntiso = i%niso + SIZE(str) !--- Number of isotopes + their geographic tracers [ntiso]
[4120]	1181	ALLOCATE(i%trac(i%ntiso))
	1182	FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
	1183	FORALL(it = i%niso+1:i%ntiso) i%trac(it) = str(it-i%niso)
[4046]	1184
	1185	!=== Phases for tracer "iname"
[4120]	1186	i%phase = ''
	1187	DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name,addPhase(iname, ph)) /= 0) i%phase = TRIM(i%phase)//ph; END DO
	1188	i%nphas = LEN_TRIM(i%phase) !--- Equal to "nqo" for water
[4046]	1189
	1190	!=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
	1191	DO iq = 1, SIZE(t)
[4325]	1192	t1 => tracers(iq)
[4120]	1193	IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE !--- Only deal with tracers descending on "iname"
[4046]	1194	t1%iso_iGroup = ic !--- Isotopes family idx in list "isotopes(:)%parent"
[4120]	1195	t1%iso_iName = strIdx(i%trac, delPhase(strHead(t1%name,'_'))) !--- Current isotope idx in effective isotopes list
	1196	t1%iso_iZone = strIdx(i%zone, strTail(t1%name,'_') ) !--- Current isotope zone idx in effective zones list
	1197	t1%iso_iPhase = INDEX(i%phase,TRIM(t1%phase)) !--- Current isotope phase idx in effective phases list
	1198	IF(t1%iGeneration /= 2) t1%iso_iZone = 0 !--- Skip possible generation 1 tagging tracers
[4046]	1199	END DO
	1200
	1201	!=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
	1202	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
[4325]	1203	i%iqIsoPha = RESHAPE( [( (strIdx(t%name, addPhase(i%trac(it),i%phase(ip:ip))), it=1, i%ntiso), ip=1, i%nphas)], &
[4120]	1204	[i%ntiso, i%nphas] )
[4063]	1205	!=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
[4120]	1206	i%itZonIso = RESHAPE( [( (strIdx(i%trac(:), TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))), iz=1, i%nzone), it=1, i%niso )], &
	1207	[i%nzone, i%niso] )
[4046]	1208	END DO
	1209
[4325]	1210	!=== READ PHYSICAL PARAMETERS FROM isoFile FILE
	1211	IF(test(readIsotopesFile_prv(isoFile, isotopes), lerr)) RETURN
[4046]	1212
[4325]	1213	!=== CHECK CONSISTENCY
	1214	IF(test(testIsotopes(), lerr)) RETURN
	1215
	1216	!=== SELECT FIRST ISOTOPES CLASS OR, IF POSSIBLE, WATER CLASS
	1217	IF(.NOT.test(isoSelect(1, .TRUE.), lerr)) THEN; IF(isotope%parent == 'H2O') iH2O = ixIso; END IF
	1218
	1219	CONTAINS
	1220
	1221	!------------------------------------------------------------------------------------------------------------------------------
	1222	LOGICAL FUNCTION testIsotopes() RESULT(lerr) !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
	1223	!------------------------------------------------------------------------------------------------------------------------------
	1224	INTEGER :: ix, it, ip, np, iz, nz
	1225	TYPE(isot_type), POINTER :: i
	1226	DO ix = 1, nbIso
	1227	i => isotopes(ix)
	1228	!--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
	1229	DO it = 1, i%ntiso
	1230	np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, i%nphas)])
	1231	IF(test(fmsg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(i%nphas))//' for '//TRIM(i%trac(it)), &
	1232	modname, np /= i%nphas), lerr)) RETURN
	1233	END DO
	1234	DO it = 1, i%niso
	1235	nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, i%nzone)])
	1236	IF(test(fmsg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(i%nzone))//' for '//TRIM(i%trac(it)), &
	1237	modname, nz /= i%nzone), lerr)) RETURN
	1238	END DO
	1239	END DO
	1240	END FUNCTION testIsotopes
	1241	!------------------------------------------------------------------------------------------------------------------------------
	1242
	1243	END FUNCTION readIsotopesFile
[4046]	1244	!==============================================================================================================================
	1245
	1246
	1247	!==============================================================================================================================
[4325]	1248	!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
	1249	! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
[4046]	1250	!==============================================================================================================================
[4325]	1251	LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
	1252	IMPLICIT NONE
	1253	CHARACTER(LEN=*), INTENT(IN) :: iName
	1254	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
	1255	INTEGER :: iIso
	1256	LOGICAL :: lV
	1257	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
	1258	iIso = strIdx(isotopes(:)%parent, iName)
	1259	IF(test(iIso == 0, lerr)) THEN
	1260	niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
	1261	CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
	1262	RETURN
	1263	END IF
	1264	lerr = isoSelectByIndex(iIso, lV)
	1265	END FUNCTION isoSelectByName
	1266	!==============================================================================================================================
	1267	LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
	1268	IMPLICIT NONE
	1269	INTEGER, INTENT(IN) :: iIso
	1270	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
	1271	LOGICAL :: lV
	1272	lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
	1273	lerr = .FALSE.
	1274	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
	1275	lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
	1276	CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
	1277	//TRIM(int2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)
	1278	IF(lerr) RETURN
	1279	ixIso = iIso !--- Update currently selected family index
	1280	isotope => isotopes(ixIso) !--- Select corresponding component
	1281	isoKeys => isotope%keys; niso = isotope%niso
	1282	isoName => isotope%trac; ntiso = isotope%ntiso
	1283	isoZone => isotope%zone; nzone = isotope%nzone
	1284	isoPhas => isotope%phase; nphas = isotope%nphas
	1285	itZonIso => isotope%itZonIso; isoCheck = isotope%check
	1286	iqIsoPha => isotope%iqIsoPha
	1287	END FUNCTION isoSelectByIndex
	1288	!==============================================================================================================================
[4046]	1289
	1290
	1291	!==============================================================================================================================
[4301]	1292	!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
	1293	!==============================================================================================================================
[4046]	1294	SUBROUTINE addKey_1(key, val, ky, lOverWrite)
	1295	CHARACTER(LEN=*), INTENT(IN) :: key, val
	1296	TYPE(keys_type), INTENT(INOUT) :: ky
	1297	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
[4301]	1298	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1299	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
	1300	INTEGER :: iky, nky
	1301	LOGICAL :: lo
[4325]	1302	lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
[4348]	1303	IF(.NOT.ALLOCATED(ky%key)) THEN
	1304	ALLOCATE(ky%key(1)); ky%key(1)=key
	1305	ALLOCATE(ky%val(1)); ky%val(1)=val
	1306	RETURN
	1307	END IF
[4369]	1308	iky = strIdx(ky%key,key)
[4046]	1309	IF(iky == 0) THEN
[4369]	1310	nky = SIZE(ky%key)
[4348]	1311	ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
	1312	ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = val; ky%val = v
[4325]	1313	ELSE IF(lo) THEN
[4046]	1314	ky%key(iky) = key; ky%val(iky) = val
	1315	END IF
	1316	END SUBROUTINE addKey_1
	1317	!==============================================================================================================================
	1318	SUBROUTINE addKey_m(key, val, ky, lOverWrite)
	1319	CHARACTER(LEN=*), INTENT(IN) :: key, val
	1320	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1321	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
[4301]	1322	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1323	INTEGER :: itr
[4328]	1324	DO itr = 1, SIZE(ky)
	1325	CALL addKey_1(key, val, ky(itr), lOverWrite)
	1326	END DO
[4046]	1327	END SUBROUTINE addKey_m
	1328	!==============================================================================================================================
[4325]	1329	SUBROUTINE addKey_mm(key, val, ky, lOverWrite)
	1330	CHARACTER(LEN=*), INTENT(IN) :: key, val(:)
	1331	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1332	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1333	!------------------------------------------------------------------------------------------------------------------------------
	1334	INTEGER :: itr
	1335	DO itr = 1, SIZE(ky); CALL addKey_1(key, val(itr), ky(itr), lOverWrite); END DO
	1336	END SUBROUTINE addKey_mm
	1337	!==============================================================================================================================
[4301]	1338
	1339
	1340	!==============================================================================================================================
	1341	!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
	1342	!==============================================================================================================================
[4046]	1343	SUBROUTINE addKeysFromDef(t, tr0)
	1344	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
	1345	CHARACTER(LEN=*), INTENT(IN) :: tr0
[4301]	1346	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1347	CHARACTER(LEN=maxlen) :: val
	1348	INTEGER :: ik, jd
	1349	jd = strIdx(t%name, tr0)
	1350	IF(jd == 0) RETURN
	1351	DO ik = 1, SIZE(t(jd)%keys%key)
[4120]	1352	CALL get_in(t(jd)%keys%key(ik), val, 'none')
	1353	IF(val /= 'none') CALL addKey_1(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
[4046]	1354	END DO
	1355	END SUBROUTINE addKeysFromDef
	1356	!==============================================================================================================================
[4301]	1357
	1358
	1359	!==============================================================================================================================
	1360	!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
	1361	!==============================================================================================================================
[4046]	1362	SUBROUTINE delKey_1(itr, keyn, ky)
	1363	INTEGER, INTENT(IN) :: itr
	1364	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1365	TYPE(trac_type), INTENT(INOUT) :: ky(:)
[4301]	1366	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1367	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
	1368	LOGICAL, ALLOCATABLE :: ll(:)
	1369	INTEGER :: iky
	1370	IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range
	1371	ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
	1372	k = PACK(ky(itr)%keys%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%keys%key)
	1373	v = PACK(ky(itr)%keys%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%keys%val)
	1374	END SUBROUTINE delKey_1
	1375	!==============================================================================================================================
	1376	SUBROUTINE delKey(keyn, ky)
	1377	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1378	TYPE(trac_type), INTENT(INOUT) :: ky(:)
[4301]	1379	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1380	INTEGER :: iky
	1381	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
	1382	END SUBROUTINE delKey
	1383	!==============================================================================================================================
	1384
	1385
	1386	!==============================================================================================================================
[4301]	1387	!================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
	1388	!==============================================================================================================================
[4325]	1389	CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx_s1(itr, keyn, ky, def_val, lerr) RESULT(val)
	1390	INTEGER, INTENT(IN) :: itr
	1391	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1392	TYPE(keys_type), INTENT(IN) :: ky(:)
	1393	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
	1394	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
[4046]	1395	!------------------------------------------------------------------------------------------------------------------------------
[4120]	1396	INTEGER :: iky
[4325]	1397	LOGICAL :: ler
	1398	iky = 0; val = ''
	1399	IF(.NOT.test(itr <= 0 .OR. itr > SIZE(ky), ler)) iky = strIdx(ky(itr)%key(:), keyn) !--- Correct index
	1400	IF(.NOT.test(iky == 0, ler)) val = ky(itr)%val(iky) !--- Found key
	1401	IF(iky == 0) THEN
	1402	IF(.NOT.test(.NOT.PRESENT(def_val), ler)) val = def_val !--- Default value
	1403	END IF
	1404	IF(PRESENT(lerr)) lerr = ler
	1405	END FUNCTION fgetKeyIdx_s1
[4046]	1406	!==============================================================================================================================
[4325]	1407	CHARACTER(LEN=maxlen) FUNCTION fgetKeyNam_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
[4120]	1408	CHARACTER(LEN=*), INTENT(IN) :: tname, keyn
	1409	TYPE(keys_type), INTENT(IN) :: ky(:)
	1410	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
	1411	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
	1412	!------------------------------------------------------------------------------------------------------------------------------
[4325]	1413	val = fgetKeyIdx_s1(strIdx(ky(:)%name, tname), keyn, ky, def_val, lerr)
	1414	END FUNCTION fgetKeyNam_s1
[4120]	1415	!==============================================================================================================================
[4326]	1416	FUNCTION fgetKeys(keyn, ky, def_val, lerr) RESULT(val)
[4325]	1417	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
	1418	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1419	TYPE(keys_type), INTENT(IN) :: ky(:)
	1420	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
	1421	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
	1422	!------------------------------------------------------------------------------------------------------------------------------
	1423	LOGICAL :: ler(SIZE(ky))
	1424	INTEGER :: it
	1425	val = [(fgetKeyIdx_s1(it, keyn, ky, def_val, ler(it)), it = 1, SIZE(ky))]
	1426	IF(PRESENT(lerr)) lerr = ANY(ler)
[4326]	1427	END FUNCTION fgetKeys
[4325]	1428	!==============================================================================================================================
[4301]	1429
	1430
	1431	!==============================================================================================================================
	1432	!========== GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RETURNED VALUE IS THE ERROR CODE ==============
	1433	!========== The key "keyn" is searched in: 1) "ky(:)%name" (if given) ==============
	1434	!========== 2) "tracers(:)%name" ==============
	1435	!========== 3) "isotope%keys(:)%name" ==============
	1436	!========== for the tracer[s] "tname[(:)]" (if given) or all the available tracers from the used set otherwise. ==============
	1437	!========== The type of the returned value(s) can be string, integer or real, scalar or vector ==============
	1438	!==============================================================================================================================
[4046]	1439	LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
	1440	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1441	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
	1442	CHARACTER(LEN=*), INTENT(IN) :: tname
	1443	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[4301]	1444	!------------------------------------------------------------------------------------------------------------------------------
[4120]	1445	CHARACTER(LEN=maxlen) :: tnam
[4325]	1446	tnam = strHead(delPhase(tname),'_',.FALSE.) !--- Remove tag and phase
	1447	IF(PRESENT(ky)) THEN !=== KEY FROM "ky"
	1448	val = fgetKeyNam_s1(tname, keyn, ky, lerr=lerr) !--- "ky" and "tname"
	1449	IF( lerr ) val = fgetKeyNam_s1(tnam, keyn, ky, lerr=lerr) !--- "ky" and "tnam"
[4046]	1450	ELSE
[4325]	1451	IF( .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0 !=== KEY FROM "tracers"
	1452	IF(.NOT.lerr) THEN
	1453	val = fgetKeyNam_s1(tname, keyn, tracers%keys, lerr=lerr) !--- "ky" and "tname"
	1454	IF(lerr) val = fgetKeyNam_s1(tnam, keyn, tracers%keys, lerr=lerr) !--- "ky" and "tnam"
	1455	END IF
	1456	IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0 !=== KEY FROM "isotope"
	1457	IF(.NOT.lerr) THEN
	1458	val = fgetKeyNam_s1(tname, keyn, isotope%keys, lerr=lerr) !--- "ky" and "tname"
	1459	IF(lerr) val = fgetKeyNam_s1(tnam, keyn, isotope%keys, lerr=lerr) !--- "ky" and "tnam"
	1460	END IF
[4046]	1461	END IF
	1462	END FUNCTION getKeyByName_s1
	1463	!==============================================================================================================================
[4328]	1464	LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr)
	1465	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1466	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1467	CHARACTER(LEN=*), INTENT(IN) :: tname
	1468	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1469	!------------------------------------------------------------------------------------------------------------------------------
	1470	CHARACTER(LEN=maxlen) :: sval
	1471	lerr = getKeyByName_s1(keyn, sval, tname, ky)
	1472	IF(test(fmsg('missing key "'//TRIM(keyn)//'" for tracer "'//TRIM(tname)//'"', modname, lerr), lerr)) RETURN
	1473	lerr = strParse(sval, ',', val)
	1474	END FUNCTION getKeyByName_s1m
	1475	!==============================================================================================================================
[4325]	1476	LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
	1477	CHARACTER(LEN=*), INTENT(IN) :: keyn
[4328]	1478	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1479	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
	1480	TYPE(keys_type), OPTIONAL, TARGET, INTENT(IN) :: ky(:)
	1481	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
[4301]	1482	!------------------------------------------------------------------------------------------------------------------------------
[4328]	1483	TYPE(keys_type), POINTER :: keys(:)
[4363]	1484	LOGICAL :: lk, lt, li
[4120]	1485	INTEGER :: iq, nq
[4325]	1486
	1487	!--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
	1488	lk = PRESENT(ky)
	1489	lt = .NOT.lk .AND. ALLOCATED(tracers); IF(lt) lt = SIZE(tracers) /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
	1490	li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
	1491
[4328]	1492	!--- LINK "keys" TO THE RIGHT DATABASE
[4325]	1493	IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
	1494	IF(lk) keys => ky(:)
	1495	IF(lt) keys => tracers(:)%keys
	1496	IF(li) keys => isotope%keys(:)
	1497
	1498	!--- GET THE DATA
[4328]	1499	nq = SIZE(tname)
	1500	ALLOCATE(val(nq))
	1501	lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq), keys(:)), iq=1, nq)])
	1502	IF(PRESENT(nam)) nam = tname(:)
[4325]	1503
[4046]	1504	END FUNCTION getKeyByName_sm
	1505	!==============================================================================================================================
[4328]	1506	LOGICAL FUNCTION getKey_sm(keyn, val, ky, nam) RESULT(lerr)
	1507	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1508	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1509	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1510	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
[4325]	1511	!------------------------------------------------------------------------------------------------------------------------------
[4328]	1512	! Note: if names are repeated, getKeyByName_sm can't be used ; this routine, using indexes, must be used instead.
	1513	IF(PRESENT(ky)) THEN !=== KEY FROM "ky"
	1514	val = fgetKeys(keyn, ky, lerr=lerr)
	1515	IF(PRESENT(nam)) nam = ky(:)%name
	1516	ELSE
	1517	IF( .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0 !=== KEY FROM "tracers"
	1518	IF(.NOT.lerr) val = fgetKeys(keyn, tracers%keys, lerr=lerr)
	1519	IF(.NOT.lerr.AND.PRESENT(nam)) nam = tracers(:)%keys%name
	1520	IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0 !=== KEY FROM "isotope"
	1521	IF(.NOT.lerr) val = fgetKeys(keyn, isotope%keys, lerr=lerr)
	1522	IF(.NOT.lerr.AND.PRESENT(nam)) nam = isotope%keys(:)%name
	1523	END IF
	1524	END FUNCTION getKey_sm
[4325]	1525	!==============================================================================================================================
[4120]	1526	LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
[4046]	1527	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1528	INTEGER, INTENT(OUT) :: val
[4120]	1529	CHARACTER(LEN=*), INTENT(IN) :: tname
[4046]	1530	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[4301]	1531	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1532	CHARACTER(LEN=maxlen) :: sval
	1533	INTEGER :: ierr
[4325]	1534	lerr = getKeyByName_s1(keyn, sval, tname, ky)
	1535	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
[4046]	1536	READ(sval, *, IOSTAT=ierr) val
[4325]	1537	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, ierr/=0), lerr)) RETURN
[4046]	1538	END FUNCTION getKeyByName_i1
	1539	!==============================================================================================================================
[4328]	1540	LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr)
	1541	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1542	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1543	CHARACTER(LEN=*), INTENT(IN) :: tname
	1544	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[4301]	1545	!------------------------------------------------------------------------------------------------------------------------------
[4328]	1546	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
	1547	INTEGER :: ierr, iq, nq
	1548	IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
	1549	nq = SIZE(sval); ALLOCATE(val(nq))
	1550	lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
	1551	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
	1552	END FUNCTION getKeyByName_i1m
	1553	!==============================================================================================================================
	1554	LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky, nam) RESULT(lerr)
	1555	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1556	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1557	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
	1558	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1559	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1560	!------------------------------------------------------------------------------------------------------------------------------
	1561	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
	1562	INTEGER :: ierr, iq, nq
	1563	IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
	1564	nq = SIZE(sval); ALLOCATE(val(nq))
	1565	DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS
[4325]	1566	READ(sval(iq), *, IOSTAT=ierr) val(iq)
[4328]	1567	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
[4325]	1568	END DO
[4363]	1569	IF(PRESENT(nam)) nam = names(:)
[4046]	1570	END FUNCTION getKeyByName_im
	1571	!==============================================================================================================================
[4328]	1572	LOGICAL FUNCTION getKey_im(keyn, val, ky, nam) RESULT(lerr)
	1573	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1574	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1575	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1576	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
[4325]	1577	!------------------------------------------------------------------------------------------------------------------------------
[4328]	1578	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
	1579	INTEGER :: ierr, iq, nq
	1580	IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
	1581	nq = SIZE(sval); ALLOCATE(val(nq))
	1582	DO iq = 1, nq
	1583	READ(sval(iq), *, IOSTAT=ierr) val(iq)
	1584	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
	1585	END DO
	1586	IF(PRESENT(nam)) nam = names
	1587	END FUNCTION getKey_im
[4325]	1588	!==============================================================================================================================
[4120]	1589	LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
[4046]	1590	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1591	REAL, INTENT(OUT) :: val
[4120]	1592	CHARACTER(LEN=*), INTENT(IN) :: tname
[4046]	1593	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[4301]	1594	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1595	CHARACTER(LEN=maxlen) :: sval
	1596	INTEGER :: ierr
[4325]	1597	lerr = getKeyByName_s1(keyn, sval, tname, ky)
[4120]	1598	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
[4046]	1599	READ(sval, *, IOSTAT=ierr) val
[4325]	1600	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, ierr/=0), lerr)) RETURN
[4046]	1601	END FUNCTION getKeyByName_r1
	1602	!==============================================================================================================================
[4328]	1603	LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr)
[4194]	1604	CHARACTER(LEN=*), INTENT(IN) :: keyn
[4328]	1605	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1606	CHARACTER(LEN=*), INTENT(IN) :: tname
	1607	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[4301]	1608	!------------------------------------------------------------------------------------------------------------------------------
[4328]	1609	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
	1610	INTEGER :: ierr, iq, nq
	1611	IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
	1612	nq = SIZE(sval); ALLOCATE(val(nq))
	1613	lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
	1614	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a vector of reals', modname, lerr), lerr)) RETURN
	1615	END FUNCTION getKeyByName_r1m
	1616	!==============================================================================================================================
	1617	LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky, nam) RESULT(lerr)
	1618	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1619	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1620	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
	1621	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1622	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1623	!------------------------------------------------------------------------------------------------------------------------------
	1624	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
	1625	INTEGER :: ierr, iq, nq
	1626	IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
	1627	nq = SIZE(sval); ALLOCATE(val(nq))
	1628	DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS
[4325]	1629	READ(sval(iq), *, IOSTAT=ierr) val(iq)
[4328]	1630	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
[4325]	1631	END DO
[4328]	1632	IF(PRESENT(nam)) nam = names
[4046]	1633	END FUNCTION getKeyByName_rm
	1634	!==============================================================================================================================
[4328]	1635	LOGICAL FUNCTION getKey_rm(keyn, val, ky, nam) RESULT(lerr)
	1636	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1637	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1638	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1639	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1640	!------------------------------------------------------------------------------------------------------------------------------
	1641	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
	1642	INTEGER :: ierr, iq, nq
	1643	IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
	1644	nq = SIZE(sval); ALLOCATE(val(nq))
	1645	DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS
	1646	READ(sval(iq), *, IOSTAT=ierr) val(iq)
	1647	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
	1648	END DO
	1649	IF(PRESENT(nam)) nam = names
	1650	END FUNCTION getKey_rm
	1651	!==============================================================================================================================
	1652	LOGICAL FUNCTION getKeyByName_l1(keyn, val, tname, ky) RESULT(lerr)
	1653	USE strings_mod, ONLY: str2bool
	1654	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1655	LOGICAL, INTENT(OUT) :: val
	1656	CHARACTER(LEN=*), INTENT(IN) :: tname
	1657	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1658	!------------------------------------------------------------------------------------------------------------------------------
	1659	CHARACTER(LEN=maxlen) :: sval
	1660	lerr = getKeyByName_s1(keyn, sval, tname, ky)
	1661	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
	1662	val = str2bool(sval)
	1663	END FUNCTION getKeyByName_l1
	1664	!==============================================================================================================================
	1665	LOGICAL FUNCTION getKeyByName_l1m(keyn, val, tname, ky) RESULT(lerr)
	1666	USE strings_mod, ONLY: str2bool
[4325]	1667	CHARACTER(LEN=*), INTENT(IN) :: keyn
[4328]	1668	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
[4325]	1669	CHARACTER(LEN=*), INTENT(IN) :: tname
	1670	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1671	!------------------------------------------------------------------------------------------------------------------------------
[4328]	1672	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
[4363]	1673	INTEGER :: iq, nq
[4328]	1674	IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
	1675	nq = SIZE(sval); ALLOCATE(val(nq))
	1676	lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
	1677	END FUNCTION getKeyByName_l1m
[4325]	1678	!==============================================================================================================================
[4328]	1679	LOGICAL FUNCTION getKeyByName_lm(keyn, val, tname, ky, nam) RESULT(lerr)
	1680	USE strings_mod, ONLY: str2bool
	1681	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1682	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1683	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
	1684	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1685	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1686	!------------------------------------------------------------------------------------------------------------------------------
	1687	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
[4363]	1688	INTEGER :: iq, nq
[4328]	1689	IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
	1690	nq = SIZE(sval); ALLOCATE(val(nq))
	1691	lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
	1692	END FUNCTION getKeyByName_lm
	1693	!==============================================================================================================================
	1694	LOGICAL FUNCTION getKey_lm(keyn, val, ky, nam) RESULT(lerr)
	1695	USE strings_mod, ONLY: str2bool
	1696	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1697	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1698	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1699	CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
	1700	!------------------------------------------------------------------------------------------------------------------------------
	1701	CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
[4363]	1702	INTEGER :: iq, nq
[4328]	1703	IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN
	1704	nq = SIZE(sval); ALLOCATE(val(nq))
	1705	lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
	1706	END FUNCTION getKey_lm
	1707	!==============================================================================================================================
[4046]	1708
	1709
	1710	!==============================================================================================================================
[4325]	1711	!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
	1712	!==============================================================================================================================
	1713	SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
	1714	TYPE(trac_type), OPTIONAL, INTENT(IN) :: tracers_(:)
	1715	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
	1716	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
	1717	!------------------------------------------------------------------------------------------------------------------------------
	1718	TYPE(isot_type), ALLOCATABLE :: iso(:)
	1719	INTEGER :: ix, nbIso
	1720	IF(PRESENT( tracers_)) THEN; tracers = tracers_; ELSE; ALLOCATE( tracers(0)); END IF
	1721	IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
	1722	IF(PRESENT(isotope_ )) THEN
[4328]	1723	ix = strIdx(isotopes(:)%parent, isotope_%parent)
[4325]	1724	IF(ix /= 0) THEN
	1725	isotopes(ix) = isotope_
	1726	ELSE
	1727	nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
	1728	CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
	1729	END IF
	1730	END IF
	1731	END SUBROUTINE setKeysDBase
	1732	!==============================================================================================================================
	1733	SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
	1734	TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: tracers_(:)
	1735	TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
	1736	TYPE(isot_type), OPTIONAL, INTENT(OUT) :: isotope_
	1737	!------------------------------------------------------------------------------------------------------------------------------
	1738	INTEGER :: ix
	1739	IF(PRESENT( tracers_)) THEN; tracers_ = tracers; ELSE; ALLOCATE( tracers_(0)); END IF
	1740	IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
	1741	IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_=isotopes(ix); END IF
	1742	END SUBROUTINE getKeysDBase
	1743	!==============================================================================================================================
	1744
	1745
	1746	!==============================================================================================================================
[4046]	1747	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
	1748	!==============================================================================================================================
	1749	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
[4325]	1750	CHARACTER(LEN=*), INTENT(IN) :: s
[4301]	1751	!------------------------------------------------------------------------------------------------------------------------------
	1752	INTEGER :: ix, ip, ns
	1753	out = s; ns = LEN_TRIM(s)
	1754	IF(s == '') RETURN !--- Empty string: nothing to do
	1755	IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
	1756	out='H2O'//s(5:ns) !--- H2O<phase>[_<iso>][_<tag>]
	1757	ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
	1758	out = s(1:ns-2); RETURN !--- <var><phase_sep><phase>
	1759	ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
	1760	IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns) !--- <var><phase_sep><phase>_<tag>
[4046]	1761	END IF
	1762	END FUNCTION delPhase
[4301]	1763	!==============================================================================================================================
[4120]	1764	CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
[4063]	1765	CHARACTER(LEN=*), INTENT(IN) :: s
	1766	CHARACTER(LEN=1), INTENT(IN) :: pha
[4301]	1767	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1768	INTEGER :: l, i
	1769	out = s
	1770	IF(s == '') RETURN !--- Empty string: nothing to do
	1771	i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names
	1772	l = LEN_TRIM(s)
[4120]	1773	IF(i == 0) out = TRIM(s)//phases_sep//pha !--- <var> => return <var><sep><pha>
	1774	IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>
	1775	END FUNCTION addPhase_s1
[4301]	1776	!==============================================================================================================================
[4120]	1777	FUNCTION addPhase_sm(s,pha) RESULT(out)
[4063]	1778	CHARACTER(LEN=*), INTENT(IN) :: s(:)
	1779	CHARACTER(LEN=1), INTENT(IN) :: pha
	1780	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
[4301]	1781	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1782	INTEGER :: k
[4120]	1783	out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
	1784	END FUNCTION addPhase_sm
[4301]	1785	!==============================================================================================================================
[4120]	1786	CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
	1787	CHARACTER(LEN=*), INTENT(IN) :: s
	1788	INTEGER, INTENT(IN) :: ipha
	1789	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
[4301]	1790	!------------------------------------------------------------------------------------------------------------------------------
[4120]	1791	out = s
	1792	IF(s == '') RETURN !--- Empty string: nothing to do
[4301]	1793	IF(ipha == 0 .OR. ipha > nphases) RETURN !--- Absurd index: no phase to add
[4120]	1794	IF( PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha))
	1795	IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
	1796	END FUNCTION addPhase_i1
[4301]	1797	!==============================================================================================================================
[4120]	1798	FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
	1799	CHARACTER(LEN=*), INTENT(IN) :: s(:)
	1800	INTEGER, INTENT(IN) :: ipha
	1801	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
	1802	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
[4301]	1803	!------------------------------------------------------------------------------------------------------------------------------
[4120]	1804	INTEGER :: k
	1805	IF( PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, phases), k=1, SIZE(s) )]
	1806	IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
	1807	END FUNCTION addPhase_im
[4301]	1808	!==============================================================================================================================
[4046]	1809
	1810
[4120]	1811	!==============================================================================================================================
	1812	!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
	1813	!==============================================================================================================================
	1814	INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
	1815	CHARACTER(LEN=*), INTENT(IN) :: tname
	1816	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
[4301]	1817	!------------------------------------------------------------------------------------------------------------------------------
[4120]	1818	CHARACTER(LEN=maxlen) :: phase
	1819	IF( PRESENT(phases)) phase = getPhase(tname, phases, iPhase)
	1820	IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
	1821	END FUNCTION getiPhase
[4301]	1822	!==============================================================================================================================
[4120]	1823	CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
	1824	CHARACTER(LEN=*), INTENT(IN) :: tname
	1825	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
	1826	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
[4301]	1827	!------------------------------------------------------------------------------------------------------------------------------
[4120]	1828	INTEGER :: ip
	1829	phase = TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.))
	1830	IF( PRESENT(phases)) ip = INDEX( phases, phase)
	1831	IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
	1832	IF(ip == 0) phase = 'g'
	1833	IF(PRESENT(iPhase)) iPhase = ip
	1834	END FUNCTION getPhase
[4301]	1835	!==============================================================================================================================
[4067]	1836
[4120]	1837
[4301]	1838	!==============================================================================================================================
	1839	!============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
	1840	!======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
	1841	!==============================================================================================================================
	1842	CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
[4120]	1843	CHARACTER(LEN=*), INTENT(IN) :: oldName
	1844	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
[4301]	1845	!------------------------------------------------------------------------------------------------------------------------------
[4120]	1846	CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
[4301]	1847	INTEGER :: ix, ip, nt
	1848	LOGICAL :: lerr
[4120]	1849	newName = oldName
	1850	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
[4348]	1851	lerr = strParse(oldName, '_', tmp, nt) !--- Parsing: 1 up to 3 elements.
[4301]	1852	ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) ) !--- Phase index
	1853	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
	1854	IF(ip == 0 .AND. tmp(1) /= 'H2O') RETURN !--- Not an old-style water-related species
	1855	IF(nt == 1) THEN
	1856	newName = addPhase('H2O',ip) !=== WATER WITH OR WITHOUT PHASE
	1857	ELSE
	1858	ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list
	1859	IF(ix /= 0) tmp(2) = newH2OIso(ix) !--- Move to new isotope name
	1860	IF(ip /= 0) tmp(2) = addPhase(tmp(2), ip) !--- Add phase to isotope name
	1861	newName = TRIM(strStack(tmp(2:nt), '_')) !=== WATER ISOTOPE OR TAGGING TRACER
[4140]	1862	END IF
[4301]	1863	END FUNCTION old2newH2O_1
	1864	!==============================================================================================================================
	1865	FUNCTION old2newH2O_m(oldName) RESULT(newName)
	1866	CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
	1867	CHARACTER(LEN=maxlen) :: newName(SIZE(oldName))
[4120]	1868	!------------------------------------------------------------------------------------------------------------------------------
	1869	INTEGER :: i
[4301]	1870	newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
	1871	END FUNCTION old2newH2O_m
	1872	!==============================================================================================================================
[4120]	1873
[4301]	1874
	1875	!==============================================================================================================================
	1876	!============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
	1877	!==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
	1878	!==============================================================================================================================
	1879	CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
	1880	CHARACTER(LEN=*), INTENT(IN) :: newName
	1881	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
[4120]	1882	!------------------------------------------------------------------------------------------------------------------------------
[4301]	1883	INTEGER :: ix, ip
	1884	CHARACTER(LEN=maxlen) :: var
	1885	oldName = newName
	1886	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
[4120]	1887	ip = getiPhase(newName) !--- Phase index
[4301]	1888	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
[4358]	1889	ix = strIdx(newH2OIso, strHead(newName, '_')) !--- Index in the known H2O isotopes list
	1890	IF(ix /= 0) THEN
	1891	oldName = 'H2O'//'_'//TRIM(oldH2OIso(ix)) !=== WATER ISOTOPE WITHOUT PHASE
	1892	IF(newH2OIso(ix)/=newName) oldName=TRIM(oldName)//'_'//strTail(newName,'_')!=== WATER ISOTOPIC TAGGING TRACER WITHOUT PHASE
	1893	END IF
[4301]	1894	IF(ix /= 0 .OR. ip == 0) RETURN
	1895	oldName = 'H2O'//old_phases(ip:ip)
	1896	IF(newName == addPhase('H2O', ip)) RETURN !=== WATER WITH PHASE
	1897	var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Head variable name (no phase)
	1898	ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list
	1899	IF(ix == 0) RETURN !=== H2O[vli]_<var> (<var> /= H2O isotope)
	1900	oldName = TRIM(oldName)//'_'//TRIM(oldH2OIso(ix)) !=== WATER ISOTOPE WITH PHASE
	1901	var = addPhase(var, ip) !--- Head variable with phase
	1902	IF(newName /= var) oldName = TRIM(oldName)//strTail(newName, TRIM(var)) !=== WATER ISOTOPIC TAGGING TRACER
	1903	END FUNCTION new2oldH2O_1
	1904	!==============================================================================================================================
	1905	FUNCTION new2oldH2O_m(newName) RESULT(oldName)
	1906	CHARACTER(LEN=*), INTENT(IN) :: newName(:)
	1907	CHARACTER(LEN=maxlen) :: oldName(SIZE(newName))
[4120]	1908	!------------------------------------------------------------------------------------------------------------------------------
	1909	INTEGER :: i
[4301]	1910	oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
	1911	END FUNCTION new2oldH2O_m
	1912	!==============================================================================================================================
[4120]	1913
	1914
[4046]	1915	!==============================================================================================================================
	1916	!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen" IN THE TRACERS DESCRIPTORS LIST "tr" =======
	1917	!==============================================================================================================================
[4325]	1918	SUBROUTINE ancestor_1(t, out, tname, igen)
	1919	TYPE(trac_type), INTENT(IN) :: t(:)
	1920	CHARACTER(LEN=maxlen), INTENT(OUT) :: out
	1921	CHARACTER(LEN=*), INTENT(IN) :: tname
	1922	INTEGER, OPTIONAL, INTENT(IN) :: igen
[4301]	1923	!------------------------------------------------------------------------------------------------------------------------------
[4325]	1924	INTEGER :: ix
	1925	CALL idxAncestor_1(t, ix, tname, igen)
[4046]	1926	out = ''; IF(ix /= 0) out = t(ix)%name
[4325]	1927	END SUBROUTINE ancestor_1
[4301]	1928	!==============================================================================================================================
[4325]	1929	SUBROUTINE ancestor_mt(t, out, tname, igen)
	1930	TYPE(trac_type), INTENT(IN) :: t(:)
	1931	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
	1932	CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(tname))
	1933	INTEGER, OPTIONAL, INTENT(IN) :: igen
[4301]	1934	!------------------------------------------------------------------------------------------------------------------------------
[4325]	1935	INTEGER :: ix(SIZE(tname))
	1936	CALL idxAncestor_mt(t, ix, tname, igen)
	1937	out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
	1938	END SUBROUTINE ancestor_mt
[4046]	1939	!==============================================================================================================================
[4325]	1940	SUBROUTINE ancestor_m(t, out, igen)
	1941	TYPE(trac_type), INTENT(IN) :: t(:)
	1942	CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(t))
	1943	INTEGER, OPTIONAL, INTENT(IN) :: igen
	1944	!------------------------------------------------------------------------------------------------------------------------------
	1945	INTEGER :: ix(SIZE(t))
	1946	CALL idxAncestor_m(t, ix, igen)
	1947	out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
	1948	END SUBROUTINE ancestor_m
	1949	!==============================================================================================================================
[4046]	1950
	1951
	1952	!==============================================================================================================================
[4301]	1953	!=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
[4046]	1954	!==============================================================================================================================
[4325]	1955	SUBROUTINE idxAncestor_1(t, idx, tname, igen)
	1956	TYPE(trac_type), INTENT(IN) :: t(:)
	1957	INTEGER, INTENT(OUT) :: idx
	1958	CHARACTER(LEN=*), INTENT(IN) :: tname
	1959	INTEGER, OPTIONAL, INTENT(IN) :: igen
[4046]	1960	INTEGER :: ig
[4063]	1961	ig = 0; IF(PRESENT(igen)) ig = igen
[4325]	1962	idx = strIdx(t(:)%name, tname)
	1963	IF(idx == 0) RETURN !--- Tracer not found
	1964	IF(t(idx)%iGeneration <= ig) RETURN !--- Tracer has a lower generation number than asked generation 'igen"
	1965	DO WHILE(t(idx)%iGeneration > ig); idx = strIdx(t(:)%name, t(idx)%parent); END DO
	1966	END SUBROUTINE idxAncestor_1
[4301]	1967	!------------------------------------------------------------------------------------------------------------------------------
[4325]	1968	SUBROUTINE idxAncestor_mt(t, idx, tname, igen)
	1969	TYPE(trac_type), INTENT(IN) :: t(:)
	1970	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
	1971	INTEGER, INTENT(OUT) :: idx(SIZE(tname))
	1972	INTEGER, OPTIONAL, INTENT(IN) :: igen
	1973	INTEGER :: ix
	1974	DO ix = 1, SIZE(tname); CALL idxAncestor_1(t, idx(ix), tname(ix), igen); END DO
	1975	END SUBROUTINE idxAncestor_mt
	1976	!------------------------------------------------------------------------------------------------------------------------------
	1977	SUBROUTINE idxAncestor_m(t, idx, igen)
	1978	TYPE(trac_type), INTENT(IN) :: t(:)
	1979	INTEGER, INTENT(OUT) :: idx(SIZE(t))
	1980	INTEGER, OPTIONAL, INTENT(IN) :: igen
	1981	INTEGER :: ix
	1982	DO ix = 1, SIZE(t); CALL idxAncestor_1(t, idx(ix), t(ix)%name, igen); END DO
	1983	END SUBROUTINE idxAncestor_m
[4046]	1984	!==============================================================================================================================
	1985
	1986
	1987	END MODULE readTracFiles_mod

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

Download in other formats:

Original Format