Context Navigation

readTracFiles_mod.f90 @ 5188

Last change on this file since 5188 was 5184, checked in by dcugnet, 10 months ago
Few corrections, more is needed to fix the previous commit.
File size: 172.7 KB

Rev	Line
[4046]	1	MODULE readTracFiles_mod
	2
[4987]	3	USE strings_mod, ONLY: msg, find, get_in, dispTable, strHead, strReduce, strFind, strStack, strIdx, &
[5001]	4	removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
	5	int2str, str2int, real2str, str2real, bool2str, str2bool
[4046]	6
	7	IMPLICIT NONE
	8
	9	PRIVATE
	10
[4325]	11	PUBLIC :: maxlen !--- PARAMETER FOR CASUAL STRING LENGTH
[5183]	12	PUBLIC :: keys_type, tracers, setGeneration, indexUpdate !--- TRACERS DESCRIPTION DATABASE + ASSOCIATED TOOLS
[4325]	13	PUBLIC :: testTracersFiles, readTracersFiles !--- TRACERS FILES READING ROUTINES
[4987]	14	PUBLIC :: getKeysDBase, setKeysDBase !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
	15	PUBLIC :: addTracer, delTracer !--- ADD/REMOVE A TRACER FROM
[5183]	16	PUBLIC :: addKey, delKey, getKey !--- TOOLS TO SET/DEL/GET KEYS FROM/TO tracers & isotopes
[4987]	17	PUBLIC :: addPhase, delPhase, getPhase, getiPhase, & !--- FUNCTIONS RELATED TO THE PHASES
	18	nphases, old_phases, phases_sep, 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
[5001]	23	PUBLIC :: tran0 !--- TRANSPORTING FLUID (USUALLY air)
[4301]	24
	25	!=== FOR ISOTOPES: GENERAL
[5001]	26	PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER
[4301]	27
[4325]	28	!=== FOR ISOTOPES: H2O FAMILY ONLY
	29	PUBLIC :: iH2O
	30
	31	!=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
	32	PUBLIC :: isotope, isoKeys !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
	33	PUBLIC :: isoName, isoZone, isoPhas !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
	34	PUBLIC :: niso, nzone, nphas, ntiso !--- " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
	35	PUBLIC :: itZonIso !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
	36	PUBLIC :: iqIsoPha !--- Idx IN qx(1:nqtot) = f(isotope idx, phase idx)
[5183]	37	PUBLIC :: iqWIsoPha !--- SAME AS iqIsoPha BUT ISOTOPES LIST STARTS WITH PARENT TRAC
[4325]	38	PUBLIC :: isoCheck !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
	39
[4193]	40	PUBLIC :: maxTableWidth
[4046]	41	!------------------------------------------------------------------------------------------------------------------------------
[4987]	42	TYPE :: keys_type !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
	43	CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:) !--- Keys string list
	44	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:) !--- Corresponding values string list
[4325]	45	END TYPE keys_type
	46	!------------------------------------------------------------------------------------------------------------------------------
[5183]	47	TYPE :: isot_type !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "name"
	48	CHARACTER(LEN=maxlen) :: name !--- Isotopes family name (example: H2O)
[4987]	49	TYPE(keys_type), ALLOCATABLE :: keys(:) !--- Isotopes keys/values pairs list (length: niso)
	50	LOGICAL :: check=.FALSE. !--- Flag for checking routines triggering
	51	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: ntiso)
	52	CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzone)
	53	CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phases list: [g][l][s] (length: nphas)
	54	INTEGER :: niso = 0 !--- Number of isotopes, excluding tagging tracers
	55	INTEGER :: ntiso = 0 !--- Number of isotopes, including tagging tracers
	56	INTEGER :: nzone = 0 !--- Number of geographic tagging zones
	57	INTEGER :: nphas = 0 !--- Number of phases
[5001]	58	INTEGER, ALLOCATABLE :: iqIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso),phas)
[4987]	59	!--- (former name: "iqiso"
[5001]	60	INTEGER, ALLOCATABLE :: iqWIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)
[4987]	61	INTEGER, ALLOCATABLE :: itZonIso(:,:) !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
	62	END TYPE isot_type !--- (former name: "index_trac")
[4325]	63	!------------------------------------------------------------------------------------------------------------------------------
	64	TYPE :: dataBase_type !=== TYPE FOR TRACERS SECTION
[4987]	65	CHARACTER(LEN=maxlen) :: name !--- Section name
[5183]	66	TYPE(keys_type), ALLOCATABLE :: trac(:) !--- Tracers descriptors
[4046]	67	END TYPE dataBase_type
	68	!------------------------------------------------------------------------------------------------------------------------------
	69	INTERFACE getKey
[5001]	70	MODULE PROCEDURE &
	71	getKeyByIndex_s111, getKeyByIndex_sm11, getKeyByIndex_s1m1, getKeyByIndex_smm1, getKeyByIndex_s1mm, getKeyByIndex_smmm, &
	72	getKeyByIndex_i111, getKeyByIndex_im11, getKeyByIndex_i1m1, getKeyByIndex_imm1, getKeyByIndex_i1mm, getKeyByIndex_immm, &
	73	getKeyByIndex_r111, getKeyByIndex_rm11, getKeyByIndex_r1m1, getKeyByIndex_rmm1, getKeyByIndex_r1mm, getKeyByIndex_rmmm, &
	74	getKeyByIndex_l111, getKeyByIndex_lm11, getKeyByIndex_l1m1, getKeyByIndex_lmm1, getKeyByIndex_l1mm, getKeyByIndex_lmmm, &
	75	getKeyByName_s111, getKeyByName_sm11, getKeyByName_s1m1, getKeyByName_smm1, getKeyByName_s1mm, getKeyByName_smmm, &
	76	getKeyByName_i111, getKeyByName_im11, getKeyByName_i1m1, getKeyByName_imm1, getKeyByName_i1mm, getKeyByName_immm, &
	77	getKeyByName_r111, getKeyByName_rm11, getKeyByName_r1m1, getKeyByName_rmm1, getKeyByName_r1mm, getKeyByName_rmmm, &
	78	getKeyByName_l111, getKeyByName_lm11, getKeyByName_l1m1, getKeyByName_lmm1, getKeyByName_l1mm, getKeyByName_lmmm
[4046]	79	END INTERFACE getKey
	80	!------------------------------------------------------------------------------------------------------------------------------
[4987]	81	INTERFACE addKey
	82	MODULE PROCEDURE addKey_s11, addKey_s1m, addKey_smm, addKey_i11, addKey_i1m, addKey_imm, &
	83	addKey_r11, addKey_r1m, addKey_rmm, addKey_l11, addKey_l1m, addKey_lmm
	84	END INTERFACE addKey
	85	!------------------------------------------------------------------------------------------------------------------------------
[5001]	86	INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
	87	INTERFACE old2newH2O; MODULE PROCEDURE old2newH2O_1, old2newH2O_m; END INTERFACE old2newH2O
	88	INTERFACE new2oldH2O; MODULE PROCEDURE new2oldH2O_1, new2oldH2O_m; END INTERFACE new2oldH2O
	89	INTERFACE addTracer; MODULE PROCEDURE addTracer_1, addTracer_1def; END INTERFACE addTracer
	90	INTERFACE delTracer; MODULE PROCEDURE delTracer_1, delTracer_1def; END INTERFACE delTracer
	91	INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase
	92	INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
[4046]	93	!------------------------------------------------------------------------------------------------------------------------------
	94
	95	!=== MAIN DATABASE: files sections descriptors
	96	TYPE(dataBase_type), SAVE, ALLOCATABLE, TARGET :: dBase(:)
	97
	98	!--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
[4301]	99	CHARACTER(LEN=maxlen), SAVE :: tran0 = 'air' !--- Default transporting fluid
[4987]	100	CHARACTER(LEN=maxlen), PARAMETER :: old_phases = 'vlirb' !--- Old phases for water (no separator)
	101	CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsrb' !--- Known phases initials
[4301]	102	INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases) !--- Number of phases
	103	CHARACTER(LEN=maxlen), SAVE :: phases_names(nphases) & !--- Known phases names
[4987]	104	= ['gaseous ', 'liquid ', 'solid ', 'cloud ','blownSnow']
	105	CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator
[4325]	106	CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
[4046]	107
[4301]	108	!--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
[4400]	109	CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau', 'HDO', 'O18', 'O17', 'HTO' ]
	110	CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H216O', 'HDO ', 'H218O', 'H217O', 'HTO ']
[4120]	111
[4987]	112	!--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES (FOR REPROBUS)
[4301]	113	CHARACTER(LEN=maxlen), SAVE :: oldHNO3(2) = ['HNO3_g ', 'HNO3 ']
	114	CHARACTER(LEN=maxlen), SAVE :: newHNO3(2) = ['HNO3 ', 'HNO3tot']
	115
[4325]	116	!=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
[5183]	117	TYPE(keys_type), ALLOCATABLE, TARGET, SAVE :: tracers(:)
[4046]	118	TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
	119
[4325]	120	!=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
	121	TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
[4987]	122	INTEGER, SAVE :: ixIso, iH2O=0 !--- Index of the selected isotopes family and H2O family
[4325]	123	INTEGER, SAVE :: nbIso !--- Number of isotopes classes
	124	LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines
	125	TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
	126	CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
	127	isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY
	128	isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY
	129	INTEGER, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
	130	nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
	131	INTEGER, SAVE, POINTER ::itZonIso(:,:), & !--- INDEX IN "isoTrac" AS f(tagging zone idx, isotope idx)
[5001]	132	iqIsoPha(:,:), & !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx)
	133	iqWIsoPha(:,:) !--- INDEX IN "qx" AS f(H2O + isotopic tracer idx, phase idx)
[4325]	134
[4987]	135	!=== PARAMETERS FOR DEFAULT BEHAVIOUR
	136	LOGICAL, PARAMETER :: lTracsMerge = .FALSE. !--- Merge/stack tracers lists
	137	LOGICAL, PARAMETER :: lSortByGen = .TRUE. !--- Sort by growing generation
	138
[4325]	139	INTEGER, PARAMETER :: maxTableWidth = 192 !--- Maximum width of a table displayed with "dispTable"
[4046]	140	CHARACTER(LEN=maxlen) :: modname
	141
	142	CONTAINS
	143
	144	!==============================================================================================================================
	145	!==============================================================================================================================
	146	!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
[4301]	147	!=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
[4046]	148	!=== 0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
	149	!=== 1: AN "OLD STYLE" TRACERS FILE "traceur.def":
	150	!=== First line: <nb tracers> Other lines: <hadv> <vadv> <tracer name> [<parent name>]
	151	!=== 2: A "NEW STYLE" TRACERS FILE "tracer.def" WITH SEVERAL SECTIONS.
	152	!=== 3: SEVERAL " " TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
	153	!=== REMARKS:
	154	!=== * EACH SECTION BEGINS WITH A "&<section name> LINE
	155	!=== * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
	156	!=== * EACH SECTION LINE HAS THE STRUCTURE: <name(s)> <key1>=<value1> <key2>=<value2> ...
	157	!=== * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
	158	!=== * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
	159	!=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
	160	!=== ABOUT THE KEYS:
	161	! * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
	162	! But some variables are stored as direct-access keys to make the code more readable and because they are used often.
[4063]	163	! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
[4046]	164	! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
[4063]	165	! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
[4046]	166	! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
	167	!==============================================================================================================================
[5001]	168	LOGICAL FUNCTION readTracersFiles(type_trac, tracs, lRepr) RESULT(lerr)
[4046]	169	!------------------------------------------------------------------------------------------------------------------------------
[5001]	170	CHARACTER(LEN=*), INTENT(IN) :: type_trac !--- List of components used
[5183]	171	TYPE(keys_type), ALLOCATABLE, TARGET, OPTIONAL, INTENT(OUT) :: tracs(:) !--- Tracers descriptor for external storage
[5001]	172	LOGICAL, OPTIONAL, INTENT(IN) :: lRepr !--- Activate the HNO3 exceptions for REPROBUS
[4120]	173	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:)
[5183]	174	CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname, ttype
[4325]	175	INTEGER :: nsec, ierr, it, ntrac, ns, ip, ix, fType
[5001]	176	INTEGER, ALLOCATABLE :: iGen(:)
[4301]	177	LOGICAL :: lRep
[4325]	178	TYPE(keys_type), POINTER :: k
[4046]	179	!------------------------------------------------------------------------------------------------------------------------------
	180	lerr = .FALSE.
	181	modname = 'readTracersFiles'
	182	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
[4363]	183	lRep=.FALSE.; IF(PRESENT(lRepr)) lRep = lRepr
[4046]	184
[4325]	185	!--- Required sections + corresponding files names (new style single section case) for tests
[5001]	186	lerr = testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections); IF(lerr) RETURN
[4325]	187	nsec = SIZE(sections)
[4046]	188
	189	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[5001]	190	SELECT CASE(fType) !--- Set name, component, parent, phase, iGeneration, gen0Name, type
[4046]	191	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4301]	192	CASE(1) !=== OLD FORMAT "traceur.def"
[4063]	193	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	194	!--- OPEN THE "traceur.def" FILE
[5001]	195	OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', POSITION='REWIND', IOSTAT=ierr)
[4046]	196
[4063]	197	!--- GET THE TRACERS NUMBER
	198	READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers
[5001]	199	lerr = ierr/=0; IF(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, lerr)) RETURN
[4046]	200
[4063]	201	!--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
[4325]	202	ALLOCATE(tracers(ntrac))
[5001]	203	DO it = 1, ntrac !=== READ RAW DATA: loop on the line/tracer number
[4063]	204	READ(90,'(a)',IOSTAT=ierr) str
[5001]	205	lerr = ierr>0; IF(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, lerr)) RETURN
	206	lerr = ierr<0; IF(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, lerr)) RETURN
[4348]	207	lerr = strParse(str, ' ', s, ns)
[4063]	208	CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1)
	209	CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
[5183]	210	k => tracers(it)
[4301]	211
	212	!=== NAME OF THE TRACER
	213	tname = old2newH2O(s(3), ip)
	214	ix = strIdx(oldHNO3, s(3))
	215	IF(ix /= 0 .AND. lRep) tname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
[5183]	216	CALL addKey('name', tname, tracers) !--- Set the name of the tracer
	217	! tracers(it)%name = tname !--- Copy tracers names in keys components
[4301]	218
	219	!=== NAME OF THE COMPONENT
	220	cname = type_trac !--- Name of the model component
	221	IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
[5183]	222	CALL addKey('component', cname, tracers) !--- Set the name of the model component
[4301]	223
	224	!=== NAME OF THE PARENT
	225	pname = tran0 !--- Default name: default transporting fluid (air)
	226	IF(ns == 4) THEN
	227	pname = old2newH2O(s(4))
	228	ix = strIdx(oldHNO3, s(4))
	229	IF(ix /= 0 .AND. lRep) pname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY)
	230	END IF
[5183]	231	CALL addKey('parent', pname, tracers) !--- Set the parent name
[4301]	232
	233	!=== PHASE AND ADVECTION SCHEMES NUMBERS
[5183]	234	CALL addKey('phase', known_phases(ip:ip), tracers) !--- Set the phase of the tracer (default: "g"azeous)
[5001]	235	CALL addKey('hadv', s(1), k) !--- Set the horizontal advection schemes number
	236	CALL addKey('vadv', s(2), k) !--- Set the vertical advection schemes number
[4063]	237	END DO
	238	CLOSE(90)
[5001]	239	lerr = setGeneration(tracers); IF(lerr) RETURN !--- Set iGeneration and gen0Name
[5183]	240	lerr = getKey('iGeneration', iGen, tracers(:)) !--- Generation number
[5005]	241	DO it = 1, ntrac
[5183]	242	ttype = 'tracer'; IF(iGen(it) == 2) ttype = 'tag'
	243	CALL addKey('type', ttype, tracers(it)) !--- Set the type of tracer
[5005]	244	END DO
[5001]	245	lerr = checkTracers(tracers, fname, fname); IF(lerr) RETURN !--- Detect orphans and check phases
	246	lerr = checkUnique (tracers, fname, fname); IF(lerr) RETURN !--- Detect repeated tracers
	247	CALL sortTracers (tracers) !--- Sort the tracers
[4063]	248	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[5001]	249	CASE(2); lerr=feedDBase(["tracer.def"], [type_trac], modname); IF(lerr) RETURN !=== SINGLE FILE, MULTIPLE SECTIONS
[4063]	250	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[5001]	251	CASE(3); lerr=feedDBase( trac_files , sections, modname); IF(lerr) RETURN !=== MULTIPLE FILES, SINGLE SECTION
[4046]	252	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4063]	253	END SELECT
[4046]	254	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4120]	255	IF(ALL([2,3] /= fType)) RETURN
[5001]	256	IF(nsec == 1) tracers = dBase(1)%trac
	257	IF(nsec /= 1) THEN
	258	CALL msg('Multiple sections are MERGED', modname, lTracsMerge)
	259	CALL msg('Multiple sections are CUMULATED', modname, .NOT.lTracsMerge)
	260	IF( lTracsMerge) lerr = cumulTracers(dBase, tracers)
	261	IF(.NOT.lTracsMerge) lerr = cumulTracers(dBase, tracers)
	262	IF(lerr) RETURN
	263	END IF
	264	lerr = indexUpdate(tracers); IF(lerr) RETURN !--- Set iqParent, iqDescen, nqDescen, nqChildren
[5183]	265	IF(PRESENT(tracs)) tracs = tracers
[4046]	266	END FUNCTION readTracersFiles
	267	!==============================================================================================================================
	268
[4325]	269
[4046]	270	!==============================================================================================================================
[4328]	271	LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
[4325]	272	CHARACTER(LEN=*), INTENT(IN) :: modname, type_trac
	273	INTEGER, INTENT(OUT) :: fType
[4389]	274	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4325]	275	CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
	276	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
	277	LOGICAL, ALLOCATABLE :: ll(:)
[4454]	278	LOGICAL :: lD, lFound
[4325]	279	INTEGER :: is, nsec
[4389]	280	lD = .FALSE.; IF(PRESENT(lDisp)) lD = lDisp
	281	lerr = .FALSE.
[4325]	282
[4389]	283	!--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
	284	!--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
[5001]	285	lerr = strParse(type_trac, '\|', sections, n=nsec); IF(lerr) RETURN !--- Parse "type_trac" list
[4325]	286	IF(PRESENT(sects)) sects = sections
[4454]	287	ALLOCATE(trac_files(nsec), ll(nsec))
	288	DO is=1, nsec
	289	trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'
	290	INQUIRE(FILE=TRIM(trac_files(is)), EXIST=ll(is))
	291	END DO
[4325]	292	IF(PRESENT(tracf)) tracf = trac_files
	293	fType = 0
[4454]	294	INQUIRE(FILE='traceur.def', EXIST=lFound); IF(lFound) fType = 1 !--- OLD STYLE FILE
	295	INQUIRE(FILE='tracer.def', EXIST=lFound); IF(lFound) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS
	296	IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
[4389]	297	IF(.NOT.lD) RETURN !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
[4325]	298	IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES
[5001]	299	lerr = checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'); IF(lerr) RETURN
[4325]	300	END IF
	301
	302	!--- TELLS WHAT WAS IS ABOUT TO BE USED
	303	CALL msg('Trying to read old-style tracers description file "traceur.def"', modname, fType==1)
	304	CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"', modname, fType==2)
	305	CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
	306	END FUNCTION testTracersFiles
	307	!==============================================================================================================================
	308
	309	!==============================================================================================================================
[4120]	310	LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
[4169]	311	! Purpose: Read the sections "snames(is)" (pipe-separated list) from each "fnames(is)"
[4046]	312	! file and create the corresponding tracers set descriptors in the database "dBase":
[5183]	313	! * dBase(id)%name : section name
	314	! * dBase(id)%trac(:) : tracers descriptor (the key "name" of tracers(i) is the name of the ith tracer)
	315	! * dBase(id)%trac(it)%key(:): names of keys associated to tracer dBase(id)%trac(it)%name
	316	! * dBase(id)%trac(it)%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
[4046]	317	!------------------------------------------------------------------------------------------------------------------------------
	318	CHARACTER(LEN=*), INTENT(IN) :: fnames(:) !--- Files names
[4169]	319	CHARACTER(LEN=*), INTENT(IN) :: snames(:) !--- Pipe-deparated list of sections (one list each file)
[4120]	320	CHARACTER(LEN=*), INTENT(IN) :: modname !--- Calling routine name
	321	INTEGER, ALLOCATABLE :: ndb(:) !--- Number of sections for each file
[4046]	322	INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list
[4120]	323	CHARACTER(LEN=maxlen) :: fnm, snm
[4046]	324	INTEGER :: idb, i
	325	LOGICAL :: ll
	326	!------------------------------------------------------------------------------------------------------------------------------
	327	!=== READ THE REQUIRED SECTIONS
[4169]	328	ll = strCount(snames, '\|', ndb) !--- Number of sections for each file
[4046]	329	ALLOCATE(ixf(SUM(ndb)))
[5001]	330	DO i=1, SIZE(fnames) !--- Set name, keys
	331	lerr = readSections(fnames(i), snames(i), 'default'); IF(lerr) RETURN
[4046]	332	ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list
	333	END DO
	334	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	335	DO idb=1,SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS
	336	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[4063]	337	fnm = fnames(ixf(idb)); snm = dBase(idb)%name !--- FILE AND SECTION NAMES
[4120]	338	lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
[5001]	339	lerr = expandSection(dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- EXPAND NAMES ; SET parent, type, component
	340	lerr = setGeneration(dBase(idb)%trac); IF(lerr) RETURN !--- SET iGeneration, genOName
	341	lerr = checkTracers (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK ORPHANS AND PHASES
	342	lerr = checkUnique (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK TRACERS UNIQUENESS
	343	lerr = expandPhases (dBase(idb)%trac); IF(lerr) RETURN !--- EXPAND PHASES ; set phase
	344	CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS
[4120]	345	lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
[4046]	346	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	347	END DO
	348	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	349	END FUNCTION feedDBase
	350	!------------------------------------------------------------------------------------------------------------------------------
	351
	352	!------------------------------------------------------------------------------------------------------------------------------
	353	LOGICAL FUNCTION readSections(fnam,snam,defName) RESULT(lerr)
	354	!------------------------------------------------------------------------------------------------------------------------------
	355	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- File name
[4169]	356	CHARACTER(LEN=*), INTENT(IN) :: snam !--- Pipe-separated sections list
[4046]	357	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: defName !--- Special section (default values) name
	358	!------------------------------------------------------------------------------------------------------------------------------
	359	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
	360	CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:)
	361	INTEGER, ALLOCATABLE :: ix(:)
[4363]	362	INTEGER :: n0, idb, ndb
[4046]	363	LOGICAL :: ll
	364	!------------------------------------------------------------------------------------------------------------------------------
	365	n0 = SIZE(dBase) + 1 !--- Index for next entry in the database
	366	CALL readSections_all() !--- Read all the sections of file "fnam"
	367	ndb= SIZE(dBase) !--- Current number of sections in the database
	368	IF(PRESENT(defName)) THEN !--- Add default values to all the tracers
[5183]	369	DO idb=n0,ndb !--- and remove the virtual tracer "defName"
	370	lerr = addDefault(dBase(idb)%trac, defName); IF(lerr) RETURN
	371	END DO
[4046]	372	END IF
[4169]	373	ll = strParse(snam, '\|', keys = sec) !--- Requested sections names
[4046]	374	ix = strIdx(dBase(:)%name, sec(:)) !--- Indexes of requested sections in database
[5001]	375	lerr = checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'); IF(lerr) RETURN
[4046]	376	tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))] !--- Keep requested sections only
	377
	378	CONTAINS
	379
	380	!------------------------------------------------------------------------------------------------------------------------------
	381	SUBROUTINE readSections_all()
	382	!------------------------------------------------------------------------------------------------------------------------------
	383	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), v(:)
[5183]	384	TYPE(keys_type), ALLOCATABLE :: tt(:)
[4193]	385	CHARACTER(LEN=1024) :: str, str2
[4046]	386	CHARACTER(LEN=maxlen) :: secn
	387	INTEGER :: ierr, n
	388	!------------------------------------------------------------------------------------------------------------------------------
	389	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
[5001]	390	OPEN(90, FILE=fnam, FORM='formatted', POSITION='REWIND', STATUS='old')
[4193]	391	DO; str=''
	392	DO
	393	READ(90,'(a)', IOSTAT=ierr)str2 !--- Read a full line
	394	str=TRIM(str)//' '//TRIM(str2) !--- Append "str" with the current line
	395	n=LEN_TRIM(str); IF(n == 0) EXIT !--- Empty line (probably end of file)
	396	IF(IACHAR(str(n:n)) /= 92) EXIT !--- No "\" continuing line symbol found => end of line
	397	str = str(1:n-1) !--- Remove the "\" continuing line symbol
	398	END DO
	399	str = ADJUSTL(str) !--- Remove the front space
[4046]	400	IF(ierr /= 0 ) EXIT !--- Finished: error or end of file
	401	IF(str(1:1)=='#') CYCLE !--- Skip comments lines
	402	CALL removeComment(str) !--- Skip comments at the end of a line
[5001]	403	IF(LEN_TRIM(str) == 0) CYCLE !--- Empty line (probably end of file)
[4046]	404	IF(str == '') CYCLE !--- Skip empty line (probably at the end of the file)
	405	IF(str(1:1)=='&') THEN !=== SECTION HEADER LINE
	406	ndb = SIZE(dBase) !--- Number of sections so far
	407	secn = str(2:LEN_TRIM(str))//' ' !--- Current section name
	408	IF(ANY(dBase(:)%name == secn)) CYCLE !--- Already known section
	409	IF(secn(1:7) == 'version') CYCLE !--- Skip the "version" special section
	410	ndb = ndb + 1 !--- Extend database
	411	ALLOCATE(tdb(ndb))
	412	tdb(1:ndb-1) = dBase
	413	tdb(ndb)%name = secn
	414	ALLOCATE(tdb(ndb)%trac(0))
	415	CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
	416	ELSE !=== TRACER LINE
[4348]	417	ll = strParse(str,' ', s, n, v) !--- Parse <key>=<val> pairs
[4046]	418	tt = dBase(ndb)%trac(:)
[4987]	419	v(1) = s(1); s(1) = 'name' !--- Convert "name" into a regular key
[5183]	420	dBase(ndb)%trac = [tt(:), keys_type(s(:), v(:))]
	421	DEALLOCATE(tt)
[4046]	422	END IF
	423	END DO
	424	CLOSE(90)
	425
	426	END SUBROUTINE readSections_all
	427	!------------------------------------------------------------------------------------------------------------------------------
	428
	429	END FUNCTION readSections
	430	!==============================================================================================================================
	431
	432
	433	!==============================================================================================================================
[5183]	434	LOGICAL FUNCTION addDefault(t, defName) RESULT(lerr)
[4046]	435	!------------------------------------------------------------------------------------------------------------------------------
	436	! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
	437	!------------------------------------------------------------------------------------------------------------------------------
[5183]	438	TYPE(keys_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
[4046]	439	CHARACTER(LEN=*), INTENT(IN) :: defName
	440	INTEGER :: jd, it, k
[5183]	441	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
	442	TYPE(keys_type), ALLOCATABLE :: tt(:)
	443	lerr = getKey('name', tname, t(:)); IF(lerr) RETURN
	444	jd = strIdx(tname(:), defName)
[4046]	445	IF(jd == 0) RETURN
[5183]	446	DO k = 1, SIZE(t(jd)%key) !--- Loop on the keys of the tracer named "defName"
	447	! CALL addKey(t(jd)%key(k), t(jd)%val(k), t(:), .FALSE.) !--- Add key to all the tracers (no overwriting)
	448	DO it = 1, SIZE(t); CALL addKey(t(jd)%key(k), t(jd)%val(k), t(it), .FALSE.); END DO
[4046]	449	END DO
	450	tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
[5183]	451	END FUNCTION addDefault
[4046]	452	!==============================================================================================================================
	453
	454	!==============================================================================================================================
[5183]	455	LOGICAL FUNCTION subDefault(t, defName, lSubLocal) RESULT(lerr)
[4046]	456	!------------------------------------------------------------------------------------------------------------------------------
	457	! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
	458	! Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
	459	!------------------------------------------------------------------------------------------------------------------------------
[5183]	460	TYPE(keys_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
[4046]	461	CHARACTER(LEN=*), INTENT(IN) :: defName
	462	LOGICAL, INTENT(IN) :: lSubLocal
	463	INTEGER :: i0, it, ik
[5183]	464	TYPE(keys_type), ALLOCATABLE :: tt(:)
	465	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
	466	lerr = getKey('name', tname, t(:)); IF(lerr) RETURN
	467	i0 = strIdx(tname(:), defName)
[4046]	468	IF(i0 == 0) RETURN
	469	DO it = 1, SIZE(t); IF(it == i0) CYCLE !--- Loop on the tracers
	470
	471	!--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
[5183]	472	DO ik = 1, SIZE(t(i0)%key); CALL strReplace(t(it)%val, t(i0)%key(ik), t(i0)%val(ik), .TRUE.); END DO
[4046]	473
	474	IF(.NOT.lSubLocal) CYCLE
	475	!--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
[5183]	476	DO ik = 1, SIZE(t(it)%key); CALL strReplace(t(it)%val, t(it)%key(ik), t(it)%val(ik), .TRUE.); END DO
[4046]	477	END DO
	478	tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
	479
[5183]	480	END FUNCTION subDefault
[4046]	481	!==============================================================================================================================
	482
	483
	484	!==============================================================================================================================
	485	LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
	486	!------------------------------------------------------------------------------------------------------------------------------
	487	! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
	488	! Note: * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
	489	! * Default values are provided for these keys because they are necessary.
	490	!------------------------------------------------------------------------------------------------------------------------------
[5183]	491	TYPE(keys_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
[5001]	492	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Current section name
	493	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- Tracers description file name
[5183]	494	TYPE(keys_type), ALLOCATABLE :: ttr(:)
[5001]	495	CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:), tname(:), parent(:), dType(:)
[4363]	496	CHARACTER(LEN=maxlen) :: msg1, modname
	497	INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
[4046]	498	LOGICAL :: ll
	499	modname = 'expandSection'
	500	lerr = .FALSE.
	501	nt = SIZE(tr)
[5183]	502	lerr = getKey('name', tname, tr(:)); IF(lerr) RETURN
	503	lerr = getKey('parent', parent, tr(:), def = tran0); IF(lerr) RETURN
	504	lerr = getKey('type', dType, tr(:), def = 'tracer'); IF(lerr) RETURN
[4046]	505	nq = 0
	506	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	507	DO it = 1, nt !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
	508	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	509	!--- Extract useful keys: parent name, type, component name
[5183]	510	CALL addKey('component', sname, tr(it))
[4046]	511
	512	!--- Determine the number of tracers and parents ; coherence checking
[5001]	513	ll = strCount( tname(it), ',', ntr)
	514	ll = strCount(parent(it), ',', npr)
[4046]	515
	516	!--- Tagging tracers only can have multiple parents
[5001]	517	lerr = npr /=1 .AND. TRIM(dType(it)) /= 'tag'
	518	IF(lerr) THEN
[4046]	519	msg1 = 'Check section "'//TRIM(sname)//'"'
[5001]	520	IF(PRESENT(fname)) msg1 = TRIM(msg1)//' in file "'//TRIM(fname)//'"'
	521	CALL msg(TRIM(msg1)//': "'//TRIM(tname(it))//'" has several parents but is not a tag', modname); RETURN
[4046]	522	END IF
	523	nq = nq + ntr*npr
	524	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	525	END DO
	526	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	527
	528	ALLOCATE(ttr(nq))
	529	iq = 1
	530	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	531	DO it = 1, nt !=== EXPAND TRACERS AND PARENTS NAMES LISTS
	532	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[5001]	533	ll = strParse( tname(it), ',', ta, ntr) !--- Number of tracers
	534	ll = strParse(parent(it), ',', pa, npr) !--- Number of parents
	535	DO ipr = 1, npr !--- Loop on parents list elts
	536	DO itr = 1, ntr !--- Loop on tracers list elts
[5183]	537	ttr(iq)%key = tr(it)%key
	538	ttr(iq)%val = tr(it)%val
	539	CALL addKey('name', ta(itr), ttr(iq))
	540	CALL addKey('parent', pa(ipr), ttr(iq))
	541	CALL addKey('type', dType(it), ttr(iq))
	542	CALL addKey('component', sname, ttr(iq))
[5001]	543	iq = iq + 1
[4046]	544	END DO
	545	END DO
	546	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	547	END DO
	548	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	549	DEALLOCATE(ta,pa)
	550	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
	551
	552	END FUNCTION expandSection
	553	!==============================================================================================================================
	554
[4328]	555
[4046]	556	!==============================================================================================================================
[4325]	557	LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
[4046]	558	!------------------------------------------------------------------------------------------------------------------------------
	559	! Purpose: Determine, for each tracer of "tr(:)":
[5001]	560	! * iGeneration: the generation number
	561	! * gen0Name: the generation 0 ancestor name
	562	! Check also for orphan tracers (tracers without parent).
[4046]	563	!------------------------------------------------------------------------------------------------------------------------------
[5183]	564	TYPE(keys_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
[4328]	565	INTEGER :: iq, jq, ig
[5004]	566	CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), tname(:)
[4046]	567	!------------------------------------------------------------------------------------------------------------------------------
[4328]	568	CHARACTER(LEN=maxlen) :: modname
	569	modname = 'setGeneration'
[5183]	570	lerr = getKey('name', tname, ky=tr(:)); IF(lerr) RETURN
	571	lerr = getKey('parent', parent, ky=tr(:)); IF(lerr) RETURN
[4328]	572	DO iq = 1, SIZE(tr)
	573	jq = iq; ig = 0
	574	DO WHILE(parent(jq) /= tran0)
[5004]	575	jq = strIdx(tname(:), parent(jq))
[5001]	576	lerr = jq == 0
[5004]	577	IF(fmsg('Orphan tracer "'//TRIM(tname(iq))//'"', modname, lerr)) RETURN
[4328]	578	ig = ig + 1
	579	END DO
[5183]	580	CALL addKey('iGeneration', ig, tr(iq))
	581	CALL addKey('gen0Name', tname(jq), tr(iq))
[4046]	582	END DO
[4325]	583	END FUNCTION setGeneration
[4046]	584	!==============================================================================================================================
	585
[4328]	586
[4046]	587	!==============================================================================================================================
	588	LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
	589	!------------------------------------------------------------------------------------------------------------------------------
	590	! Purpose:
[5001]	591	! * check for orphan tracers (without parent)
	592	! * check wether the phases are known or not (elements of "known_phases")
[4046]	593	!------------------------------------------------------------------------------------------------------------------------------
[5183]	594	TYPE(keys_type), INTENT(IN) :: tr(:) !--- Tracers description vector
[4046]	595	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
	596	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
[5001]	597	CHARACTER(LEN=1) :: p
[4046]	598	CHARACTER(LEN=maxlen) :: mesg
	599	CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha !--- Bad phases list, phases of current tracer
[5001]	600	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
	601	INTEGER, ALLOCATABLE :: iGen(:)
[4046]	602	INTEGER :: ip, np, iq, nq
	603	!------------------------------------------------------------------------------------------------------------------------------
[5001]	604	CHARACTER(LEN=maxlen) :: modname
	605	modname = 'checkTracers'
[4046]	606	nq = SIZE(tr,DIM=1) !--- Number of tracers lines
	607	mesg = 'Check section "'//TRIM(sname)//'"'
	608	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
[5183]	609	lerr = getKey('iGeneration', iGen, tr(:)); IF(lerr) RETURN
	610	lerr = getKey('name', tname, tr(:)); IF(lerr) RETURN
[4046]	611
	612	!=== CHECK FOR ORPHAN TRACERS
[5001]	613	lerr = checkList(tname, iGen==-1, mesg, 'tracers', 'orphan'); IF(lerr) RETURN
[4046]	614
	615	!=== CHECK PHASES
[5001]	616	DO iq = 1, nq; IF(iGen(iq) /= 0) CYCLE !--- Generation O only is checked
[5183]	617	IF(getKey(['phases','phase '], pha, iq, tr(:), lDisp=.FALSE.)) pha = 'g' !--- Phase
[4046]	618	np = LEN_TRIM(pha); bp(iq)=' '
[5001]	619	DO ip = 1, np; p = pha(ip:ip); IF(INDEX(known_phases, p) == 0) bp(iq) = TRIM(bp(iq))//p; END DO
	620	IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tname(iq))//': '//TRIM(bp(iq))
[4046]	621	END DO
[5001]	622	lerr = checkList(bp, iGen == 0 .AND. bp /= '', mesg, 'tracers phases', 'unknown')
[4046]	623	END FUNCTION checkTracers
	624	!==============================================================================================================================
	625
[4328]	626
[4046]	627	!==============================================================================================================================
[4063]	628	LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
[4046]	629	!------------------------------------------------------------------------------------------------------------------------------
	630	! Purpose: Make sure that tracers are not repeated.
	631	!------------------------------------------------------------------------------------------------------------------------------
[5183]	632	TYPE(keys_type), INTENT(IN) :: tr(:) !--- Tracers description vector
[4046]	633	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
	634	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
	635	!------------------------------------------------------------------------------------------------------------------------------
	636	INTEGER :: ip, np, iq, nq, k
	637	LOGICAL, ALLOCATABLE :: ll(:)
[5001]	638	CHARACTER(LEN=maxlen) :: mesg, phase, tdup(SIZE(tr,DIM=1))
	639	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), dType(:)
	640	INTEGER, ALLOCATABLE :: iGen(:)
	641	CHARACTER(LEN=1) :: p
[4046]	642	!------------------------------------------------------------------------------------------------------------------------------
[5001]	643	CHARACTER(LEN=maxlen) :: modname
	644	modname = 'checkUnique'
[4046]	645	mesg = 'Check section "'//TRIM(sname)//'"'
	646	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
	647	nq=SIZE(tr,DIM=1); lerr=.FALSE. !--- Number of lines ; error flag
	648	tdup(:) = ''
[5183]	649	lerr = getKey('name', tname, tr); IF(lerr) RETURN
	650	lerr = getKey('type', dType, tr); IF(lerr) RETURN
	651	lerr = getKey('iGeneration', iGen, tr); IF(lerr) RETURN
[5001]	652	DO iq = 1, nq
	653	IF(dType(iq) == 'tag') CYCLE !--- Tags can be repeated
	654	ll = tname==TRIM(tname(iq)) !--- Mask for current tracer name
	655	IF(COUNT(ll) == 1) CYCLE !--- Tracer is not repeated
	656	IF(iGen(iq) > 0) THEN
	657	tdup(iq) = tname(iq) !--- gen>0: MUST be unique
[4046]	658	ELSE
[5001]	659	DO ip = 1, nphases; p = known_phases(ip:ip) !--- Loop on known phases
	660	np = 0
	661	DO k = 1, nq
	662	IF(.NOT.ll(k)) CYCLE !--- Skip tracers different from current one
[5183]	663	IF(getKey(['phases','phase '], phase, k, tr, lDisp=.FALSE.)) phase='g'!--- Get current phases
[5001]	664	IF(INDEX(phase, p) /= 0) np = np + 1 !--- One more appearance of current tracer with phase "p"
	665	END DO
	666	IF(np <= 1) CYCLE !--- Regular case: no or a single appearance
	667	tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip)) !--- Repeated phase
[4046]	668	IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)='' !--- Avoid repeating same messages
	669	END DO
	670	END IF
[5001]	671	IF(tdup(iq) /= '') tdup(iq)=TRIM(tname(iq))//' in '//TRIM(tdup(iq))//' phase(s)'
[4046]	672	END DO
	673	lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
	674	END FUNCTION checkUnique
	675	!==============================================================================================================================
	676
[4328]	677
[4046]	678	!==============================================================================================================================
[5001]	679	LOGICAL FUNCTION expandPhases(tr) RESULT(lerr)
[4046]	680	!------------------------------------------------------------------------------------------------------------------------------
[4120]	681	! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
[4046]	682	!------------------------------------------------------------------------------------------------------------------------------
[5183]	683	TYPE(keys_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracers description vector
[4046]	684	!------------------------------------------------------------------------------------------------------------------------------
[5183]	685	TYPE(keys_type), ALLOCATABLE :: ttr(:)
[5001]	686	INTEGER, ALLOCATABLE :: i0(:), iGen(:)
	687	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:), phase(:), parents(:), dType(:)
[5003]	688	CHARACTER(LEN=maxlen) :: nam, gen0Nm, pha, parent
[4120]	689	CHARACTER(LEN=1) :: p
[4046]	690	INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
[4301]	691	LOGICAL :: lTag, lExt
[4046]	692	!------------------------------------------------------------------------------------------------------------------------------
[5001]	693	CHARACTER(LEN=maxlen) :: modname
	694	modname = 'expandPhases'
[4046]	695	nq = SIZE(tr, DIM=1)
	696	nt = 0
[5183]	697	lerr = getKey('name', tname, tr); IF(lerr) RETURN !--- Names of the tracers
	698	lerr = getKey('gen0Name', gen0N, tr); IF(lerr) RETURN !--- Names of the tracers of first generation
	699	lerr = getKey('iGeneration', iGen, tr); IF(lerr) RETURN !--- Generation number
	700	lerr = getKey('phases', phase, tr); IF(lerr) RETURN !--- Phases names
	701	lerr = getKey('parent', parents, tr); IF(lerr) RETURN !--- Parents names
	702	lerr = getKey('type', dType, tr); IF(lerr) RETURN !--- Tracers types ('tracer' or 'tag')
[4046]	703	DO iq = 1, nq !--- GET THE NUMBER OF TRACERS
[5001]	704	IF(iGen(iq) /= 0) CYCLE !--- Only deal with generation 0 tracers
	705	nc = COUNT(gen0N == tname(iq) .AND. iGen /= 0) !--- Number of children of tr(iq)
	706	np = LEN_TRIM(phase(iq)) !--- Number of phases of tr(iq)
[4046]	707	nt = nt + (1+nc) * np !--- Number of tracers after expansion
	708	END DO
[4120]	709	ALLOCATE(ttr(nt)) !--- Version of "tr" after phases expansion
[4046]	710	it = 1 !--- Current "ttr(:)" index
	711	DO iq = 1, nq !--- Loop on "tr(:)" indexes
[5001]	712	lTag = dType(iq)=='tag' !--- Current tracer is a tag
	713	i0 = strFind(tname, TRIM(gen0N(iq)), n) !--- Indexes of first generation ancestor copies
	714	np = SUM([( LEN_TRIM(phase(i0(i))), i = 1, n )], 1) !--- Number of phases for current tracer tr(iq)
	715	lExt = np > 1 !--- Phase suffix only required if phases number is > 1
	716	IF(lTag) lExt = lExt .AND. iGen(iq) > 0 !--- No phase suffix for generation 0 tags
	717	DO i = 1, n !=== LOOP ON GENERATION 0 ANCESTORS
[4120]	718	jq = i0(i) !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
[5001]	719	IF(iGen(iq) == 0) jq = iq !--- Generation 0: count the current tracer phases only
	720	pha = phase(jq) !--- Phases list for tr(jq)
[4120]	721	DO ip = 1, LEN_TRIM(pha) !=== LOOP ON PHASES LISTS
	722	p = pha(ip:ip)
[5001]	723	nam = tname(iq) !--- Tracer name (regular case)
	724	IF(lTag) nam = TRIM(parents(iq)) !--- Parent name (tagging case)
[4301]	725	IF(lExt) nam = addPhase(nam, p ) !--- Phase extension needed
[5001]	726	IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname(iq)) !--- <parent>_<name> for tags
[4046]	727	ttr(it) = tr(iq) !--- Same <key>=<val> pairs
[5183]	728	CALL addKey('name', nam, ttr(it)) !--- Name with possibly phase suffix
	729	CALL addKey('phase', p, ttr(it)) !--- Single phase entry
[5001]	730	IF(lExt) THEN
	731	parent = parents(iq); IF(iGen(iq) > 0) parent = addPhase(parent, p)
	732	gen0Nm = gen0N(iq); IF(iGen(iq) > 0) gen0Nm = addPhase(gen0Nm, p)
[5183]	733	CALL addKey('parent', parent, ttr(it))
	734	CALL addKey('gen0Name', gen0Nm, ttr(it))
[4046]	735	END IF
[4120]	736	it = it+1
[4046]	737	END DO
[5001]	738	IF(iGen(iq) == 0) EXIT !--- Break phase loop for gen 0
[4046]	739	END DO
	740	END DO
	741	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
[5183]	742	CALL delKey(['phases'], tr) !--- Remove "phases" key, useless since "phase" is defined
[4046]	743
[5001]	744	END FUNCTION expandPhases
[4046]	745	!==============================================================================================================================
	746
[4328]	747
[4046]	748	!==============================================================================================================================
	749	SUBROUTINE sortTracers(tr)
	750	!------------------------------------------------------------------------------------------------------------------------------
	751	! Purpose: Sort tracers:
[4120]	752	! * Put water at the beginning of the vector, in the "known_phases" order.
[4046]	753	! * lGrowGen == T: in ascending generations numbers.
[4325]	754	! * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
[4063]	755	! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
[4046]	756	!------------------------------------------------------------------------------------------------------------------------------
[5183]	757	TYPE(keys_type), INTENT(INOUT) :: tr(:) !--- Tracers description vector
[4046]	758	!------------------------------------------------------------------------------------------------------------------------------
[5183]	759	TYPE(keys_type), ALLOCATABLE :: tr2(:)
	760	INTEGER, ALLOCATABLE :: iy(:), iz(:), iGen(:)
[5001]	761	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:)
	762	INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
	763	LOGICAL :: lerr
[4233]	764	! tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
	765	!------------------------------------------------------------------------------------------------------------------------------
[5183]	766	lerr = getKey('iGeneration', iGen, tr); IF(lerr) RETURN !--- Generation number
[4063]	767	nq = SIZE(tr)
	768	DO ip = nphases, 1, -1
[5183]	769	lerr = getKey('name', tname, tr); IF(lerr) RETURN !--- Names of the tracers of first generation
[5001]	770	iq = strIdx(tname, addPhase('H2O', ip))
[4120]	771	IF(iq == 0) CYCLE
[4233]	772	tr2 = tr(:)
	773	tr = [tr2(iq), tr2(1:iq-1), tr2(iq+1:nq)]
[4063]	774	END DO
[4046]	775	IF(lSortByGen) THEN
[4120]	776	iq = 1
[5001]	777	ng = MAXVAL(iGen, MASK=.TRUE., DIM=1) !--- Number of generations
[4046]	778	DO ig = 0, ng !--- Loop on generations
[5001]	779	iy = PACK([(k, k=1, nq)], MASK=iGen(:) == ig) !--- Generation ig tracers indexes
[4046]	780	n = SIZE(iy)
	781	ix(iq:iq+n-1) = iy !--- Stack growing generations idxs
	782	iq = iq + n
	783	END DO
	784	ELSE
[5183]	785	lerr = getKey('gen0Name', gen0N, tr); IF(lerr) RETURN !--- Names of the tracers iq = 1
[4120]	786	DO jq = 1, nq !--- Loop on generation 0 tracers
[5001]	787	IF(iGen(jq) /= 0) CYCLE !--- Skip generations /= 0
[4120]	788	ix(iq) = jq !--- Generation 0 ancestor index first
	789	iq = iq + 1 !--- Next "iq" for next generations tracers
[5001]	790	iy = strFind(gen0N(:), TRIM(tname(jq))) !--- Indices of "tr(jq)" children in "tr(:)"
	791	ng = MAXVAL(iGen(iy), MASK=.TRUE., DIM=1) !--- Number of generations of the "tr(jq)" family
[4120]	792	DO ig = 1, ng !--- Loop on generations of the "tr(jq)" family
[5001]	793	iz = find(iGen(iy), ig, n) !--- Indices of the tracers "tr(iy(:))" of generation "ig"
[4046]	794	ix(iq:iq+n-1) = iy(iz) !--- Same indexes in "tr(:)"
	795	iq = iq + n
	796	END DO
	797	END DO
	798	END IF
	799	tr = tr(ix) !--- Reorder the tracers
	800	END SUBROUTINE sortTracers
	801	!==============================================================================================================================
	802
[4325]	803
[4046]	804	!==============================================================================================================================
	805	LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
	806	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
[5183]	807	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
	808	TYPE(keys_type), POINTER :: t1(:), t2(:)
[4046]	809	INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
[5001]	810	INTEGER :: is, ik, ik1, ik2, nk2, i1, i2, nt2
[4046]	811	CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
[5001]	812	CHARACTER(LEN=maxlen), ALLOCATABLE :: keys(:), n1(:), n2(:)
[4046]	813	modname = 'mergeTracers'
	814	lerr = .FALSE.
[5001]	815	keys = ['parent ', 'type ', 'iGeneration'] !--- Mandatory keys
[5183]	816	t1 => sections(1)%trac(:) !--- Alias: first tracers section
	817	lerr = getKey('name', n1, t1); IF(lerr) RETURN !--- Names of the tracers
[4046]	818	tr = t1
	819	!----------------------------------------------------------------------------------------------------------------------------
	820	DO is=2,SIZE(sections) !=== SEVERAL SECTIONS: MERGE THEM
	821	!----------------------------------------------------------------------------------------------------------------------------
	822	t2 => sections(is)%trac(:) !--- Alias: current tracers section
[5183]	823	lerr = getKey('name', n2, t2); IF(lerr) RETURN !--- Names of the tracers
[4046]	824	nt2 = SIZE(t2(:), DIM=1) !--- Number of tracers in section
[5001]	825	ixct = strIdx(n1(:), n2(:)) !--- Indexes of common tracers
[4046]	826	tr = [tr, PACK(t2, MASK= ixct==0)] !--- Append with new tracers
	827	IF( ALL(ixct == 0) ) CYCLE !--- No common tracers => done
	828	CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
[5001]	829	CALL msg(n1(PACK(ixct, MASK = ixct/=0)), modname, nmax=128) !--- Display duplicates (the 128 first at most)
[4046]	830	!--------------------------------------------------------------------------------------------------------------------------
[5183]	831	DO i2=1,nt2; tnam = TRIM(n2(i2)) !=== LOOP ON COMMON TRACERS
[4046]	832	!--------------------------------------------------------------------------------------------------------------------------
	833	i1 = ixct(i2); IF(i1 == 0) CYCLE !--- Idx in t1(:) ; skip new tracers
	834
	835	!=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
	836	s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
[5001]	837	DO ik = 1, SIZE(keys)
[5183]	838	lerr = getKey(keys(ik), v1, i1, t1)
	839	lerr = getKey(keys(ik), v2, i2, t2)
[5001]	840	lerr = v1 /= v2; IF(fmsg(TRIM(keys(ik))//TRIM(s1), modname, lerr)) RETURN
	841	END DO
[4046]	842
[5183]	843	!=== GET THE INDICES IN tr(i2)%key(:) OF THE KEYS ALSO PRESENT IN tr(i1)%key(:)
	844	nk2 = SIZE(t2(i2)%key(:)) !--- Keys number in current section
	845	ixck = strIdx(t1(i1)%key(:), t2(i2)%key(:)) !--- Common keys indexes
	846	!--- APPEND THE NEW KEYS PAIRS IN tr(i1)%key(:)
	847	tr(i1)%key = [ tr(i1)%key, PACK(tr(i2)%key, MASK = ixck==0)]
	848	tr(i1)%val = [ tr(i1)%val, PACK(tr(i2)%val, MASK = ixck==0)]
[4046]	849
[5001]	850	!=== KEEP TRACK OF THE COMPONENTS NAMES: COMA-SEPARATED LIST
[5183]	851	lerr = getKey('component', v1, i1, t1)
	852	lerr = getKey('component', v2, i2, t2)
	853	CALL addKey('component', TRIM(v1)//','//TRIM(v2), tr(i1))
[4046]	854
[5001]	855	!=== FOR TRACERS COMMON TO PREVIOUS AND CURRENT SECTIONS: CHECK WETHER SOME KEYS HAVE DIFFERENT VALUES ; KEEP OLD ONE
	856	DO ik2 = 1, nk2 !--- Collect the corresponding indices
	857	ik1 = ixck(ik2); IF(ik1 == 0) CYCLE
[5183]	858	IF(t1(i1)%val(ik1) == t2(i2)%val(ik2)) ixck(ik2)=0
[4046]	859	END DO
[5001]	860	IF(ALL(ixck==0)) CYCLE !--- No identical keys with /=values => nothing to display
	861	CALL msg('Key(s)'//TRIM(s1), modname) !--- Display the keys with /=values (names list)
	862	DO ik2 = 1, nk2 !--- Loop on keys found in both t1(:) and t2(:)
[5183]	863	knam = t2(i2)%key(ik2) !--- Name of the current key
[5001]	864	ik1 = ixck(ik2) !--- Corresponding index in t1(:)
	865	IF(ik1 == 0) CYCLE !--- New keys are skipped
[5183]	866	v1 = t1(i1)%val(ik1); v2 = t2(i2)%val(ik2) !--- Key values in t1(:) and t2(:)
[4046]	867	CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
	868	END DO
	869	!------------------------------------------------------------------------------------------------------------------------
	870	END DO
	871	!--------------------------------------------------------------------------------------------------------------------------
	872	END DO
	873	CALL sortTracers(tr)
	874
	875	END FUNCTION mergeTracers
	876	!==============================================================================================================================
	877
	878	!==============================================================================================================================
[5001]	879	LOGICAL FUNCTION cumulTracers(sections, tr, lRename) RESULT(lerr)
[4046]	880	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
[5183]	881	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
[5001]	882	LOGICAL, OPTIONAL, INTENT(IN) :: lRename !--- .TRUE.: add a section suffix to identical names
[5003]	883	CHARACTER(LEN=maxlen) :: tnam_new, modname
[5001]	884	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), comp(:)
	885	INTEGER :: iq, jq, is
	886	modname = 'cumulTracers'
	887	lerr = .FALSE.
	888	tr = [( sections(is)%trac(:), is = 1, SIZE(sections) )] !--- Concatenated tracers vector
	889	IF(PRESENT(lRename)) THEN; IF(lRename) RETURN; END IF !--- No renaming: finished
[5183]	890	lerr = getKey('name', tname, tr); IF(lerr) RETURN !--- Names
	891	lerr = getKey('parent', parent, tr); IF(lerr) RETURN !--- Parents
	892	lerr = getKey('component', comp, tr); IF(lerr) RETURN !--- Component name
[4046]	893	!----------------------------------------------------------------------------------------------------------------------------
[5001]	894	DO iq = 1, SIZE(tr); IF(COUNT(tname == tname(iq)) == 1) CYCLE !=== LOOP ON TRACERS
[4046]	895	!----------------------------------------------------------------------------------------------------------------------------
[5001]	896	tnam_new = TRIM(tname(iq))//'_'//TRIM(comp(iq)) !--- Same with section extension
[5183]	897	CALL addKey('name', tnam_new, tr(iq)) !--- Modify tracer name
[4046]	898	!--------------------------------------------------------------------------------------------------------------------------
[5001]	899	DO jq = 1, SIZE(tr); IF(parent(jq) /= tname(iq)) CYCLE !=== LOOP ON TRACERS PARENTS
[4046]	900	!--------------------------------------------------------------------------------------------------------------------------
[5183]	901	CALL addKey('parent', tnam_new, tr(jq)) !--- Modify tracer name
[4046]	902	!--------------------------------------------------------------------------------------------------------------------------
	903	END DO
	904	!----------------------------------------------------------------------------------------------------------------------------
	905	END DO
	906	!----------------------------------------------------------------------------------------------------------------------------
	907	CALL sortTracers(tr)
	908	END FUNCTION cumulTracers
	909	!==============================================================================================================================
	910
[4063]	911
[4046]	912	!==============================================================================================================================
[5001]	913	LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
[4046]	914	CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
[5001]	915	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:,:), n(:), tmp(:)
	916	CHARACTER(LEN=maxlen) :: p
[4046]	917	INTEGER :: idb, iq, nq
	918	idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
[5001]	919	nq = SIZE(dBase(idb)%trac)
	920	p = ''
[5002]	921	CALL append(['iq'], .TRUE. ); IF(lerr) RETURN
	922	CALL append(['name'], .TRUE. ); IF(lerr) RETURN
	923	CALL append(['phases','phase '], .FALSE., 'pha'); IF(lerr) RETURN
	924	CALL append(['hadv'], .TRUE. ); IF(lerr) RETURN
	925	CALL append(['vadv'], .TRUE. ); IF(lerr) RETURN
	926	CALL append(['parent'], .FALSE.); IF(lerr) RETURN
	927	CALL append(['iGen'], .FALSE.); IF(lerr) RETURN
[4046]	928	CALL msg(TRIM(message)//':', modname)
[5001]	929	lerr = dispTable(p, n, s, nColMax=maxTableWidth, nHead=2, sub=modname); IF(lerr) RETURN
	930
	931	CONTAINS
	932
	933	SUBROUTINE append(nam, lMandatory, snam)
	934	! Test whether key named "nam(:)" is available.
	935	! * yes: - get its value for all species in "tmp(:)" and append table "s(:,:)" with it
	936	! - append titles list with "nam(1)" (or, if specified, "snam", usually a short name).
	937	! * no: return to calling routine with an error flag if the required key is mandatory
	938	CHARACTER(LEN=*), INTENT(IN) :: nam(:)
	939	LOGICAL, INTENT(IN) :: lMandatory
	940	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: snam
	941	INTEGER :: m
[5003]	942	CHARACTER(LEN=maxlen), ALLOCATABLE :: n0(:)
[5001]	943	CHARACTER(LEN=maxlen) :: nm
	944	lerr = .FALSE.
	945	IF(nam(1) == 'iq') THEN
	946	tmp = int2str([(iq, iq=1, nq)])
[4120]	947	ELSE
[5183]	948	lerr = getKey(nam, tmp, dBase(idb)%trac(:), lDisp=lMandatory)
[4120]	949	END IF
[5001]	950	IF(lerr) THEN; lerr = lMandatory; RETURN; END IF
	951	nm = nam(1); IF(PRESENT(snam)) nm = snam
	952	p = TRIM(p)//'s'
	953	IF(ALLOCATED(s)) THEN; s = cat(s, tmp); ELSE; ALLOCATE(s(nq,1)); s(:,1) = tmp; END IF
	954	IF(ALLOCATED(n)) THEN; m = SIZE(n); ALLOCATE(n0(m+1)); n0(1:m)=n; n0(m+1)=nm; CALL MOVE_ALLOC(FROM=n0, TO=n)
	955	ELSE; n=nam(1:1); END IF
	956	END SUBROUTINE append
	957
[4046]	958	END FUNCTION dispTraSection
	959	!==============================================================================================================================
	960
	961
	962	!==============================================================================================================================
[5001]	963	!=== CREATE TRACER(S) ALIAS: SCALAR/VECTOR FROM NAME(S) OR INDICE(S) ==========================================================
[4046]	964	!==============================================================================================================================
[5001]	965	LOGICAL FUNCTION aliasTracer(tname, trac, alias) RESULT(lerr) !=== TRACER NAMED "tname" - SCALAR
	966	CHARACTER(LEN=*), INTENT(IN) :: tname
[5183]	967	TYPE(keys_type), TARGET, INTENT(IN) :: trac(:)
	968	TYPE(keys_type), POINTER, INTENT(OUT) :: alias
[4046]	969	INTEGER :: it
[5001]	970	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
	971	alias => NULL()
[5183]	972	lerr = getKey('name', tnames, trac(:))
[5001]	973	it = strIdx(tnames, tname)
	974	lerr = it /= 0; IF(.NOT.lerr) alias => trac(it)
[4046]	975	END FUNCTION aliasTracer
[4301]	976	!==============================================================================================================================
[5001]	977	LOGICAL FUNCTION trSubset_Indx(trac, idx, alias) RESULT(lerr) !=== TRACERS WITH INDICES "idx(:)" - VECTOR
[5183]	978	TYPE(keys_type), ALLOCATABLE, INTENT(IN) :: trac(:)
[5001]	979	INTEGER, INTENT(IN) :: idx(:)
[5183]	980	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
[5001]	981	alias = trac(idx)
	982	lerr = indexUpdate(alias)
[4046]	983	END FUNCTION trSubset_Indx
	984	!------------------------------------------------------------------------------------------------------------------------------
[5001]	985	LOGICAL FUNCTION trSubset_Name(trac, tname, alias) RESULT(lerr) !=== TRACERS NAMED "tname(:)" - VECTOR
[5183]	986	TYPE(keys_type), ALLOCATABLE, INTENT(IN) :: trac(:)
[5001]	987	CHARACTER(LEN=*), INTENT(IN) :: tname(:)
[5183]	988	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
[5001]	989	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
[5183]	990	lerr = getKey('name', tnames, trac(:))
[5001]	991	alias = trac(strIdx(tnames, tname))
	992	lerr = indexUpdate(alias)
[4046]	993	END FUNCTION trSubset_Name
[4301]	994	!==============================================================================================================================
[5001]	995	LOGICAL FUNCTION trSubset_gen0Name(trac, gen0Nm, alias) RESULT(lerr) !=== TRACERS OF COMMON 1st GENERATION ANCESTOR
[5183]	996	TYPE(keys_type), ALLOCATABLE, INTENT(IN) :: trac(:)
[5001]	997	CHARACTER(LEN=*), INTENT(IN) :: gen0Nm
[5183]	998	TYPE(keys_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
[5001]	999	CHARACTER(LEN=maxlen), ALLOCATABLE :: gen0N(:)
[5183]	1000	lerr = getKey('gen0Name', gen0N, trac(:))
[5001]	1001	alias = trac(strFind(delPhase(gen0N), gen0Nm))
	1002	lerr = indexUpdate(alias)
[4046]	1003	END FUNCTION trSubset_gen0Name
[4301]	1004	!==============================================================================================================================
[4046]	1005
	1006
	1007	!==============================================================================================================================
[5183]	1008	!=== UPDATE THE INDEXES iqParent, iqDescen, nqDescen, nqChildren IN THE TRACERS DESCRIPTOR LIST "tr" ==========================
[4046]	1009	!==============================================================================================================================
[5001]	1010	LOGICAL FUNCTION indexUpdate(tr) RESULT(lerr)
[5183]	1011	TYPE(keys_type), INTENT(INOUT) :: tr(:)
[5001]	1012	INTEGER :: iq, jq, nq, ig, nGen
	1013	INTEGER, ALLOCATABLE :: iqDescen(:), ix(:), iy(:)
	1014	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:), parent(:)
[5003]	1015	INTEGER, DIMENSION(SIZE(tr)) :: iqParent, iGen
[5183]	1016	lerr = getKey('name', tnames, tr); IF(lerr) RETURN !--- Names
	1017	lerr = getKey('parent', parent, tr); IF(lerr) RETURN !--- Parents
[5001]	1018	nq = SIZE(tr)
	1019
[5183]	1020	!=== iqParent
[5001]	1021	DO iq = 1, nq; iGen(iq) = 0; jq = iq
[5004]	1022	iqParent(iq) = strIdx(tnames, parent(iq))
[5001]	1023	DO; jq = strIdx(tnames, parent(jq)); IF(jq == 0) EXIT; iGen(iq) = iGen(iq) + 1; END DO
[5183]	1024	CALL addKey('iqParent', iqParent(iq), tr(iq))
[5001]	1025	END DO
	1026
[5004]	1027	!=== nqChildren, iqDescen, nqDescen
[5001]	1028	nGen = MAXVAL(iGen, MASK=.TRUE.)
	1029	DO iq = 1, nq
	1030	ix = [iq]; ALLOCATE(iqDescen(0))
[5183]	1031	CALL addKey('nqChildren', 0, tr(iq))
[5001]	1032	DO ig = iGen(iq)+1, nGen
	1033	iy = find(iqParent, ix); iqDescen = [iqDescen, iy]; ix = iy
	1034	IF(ig /= iGen(iq)+1) CYCLE
[5183]	1035	CALL addKey('nqChildren', SIZE(iqDescen), tr(iq))
[4120]	1036	END DO
[5183]	1037	CALL addKey('iqDescen', strStack(int2str(iqDescen)), tr(iq))
	1038	CALL addKey('nqDescen', SIZE(iqDescen), tr(iq))
[5001]	1039	DEALLOCATE(iqDescen)
[4046]	1040	END DO
[5001]	1041	END FUNCTION indexUpdate
[4301]	1042	!==============================================================================================================================
[4046]	1043
	1044
	1045	!==============================================================================================================================
[5183]	1046	!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS ISOTOPES CLASSES IN "isot(:)%name": ====
	1047	!=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%name" ====
[4046]	1048	!=== * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ====
	1049	!=== NOTES: ====
[5001]	1050	!=== * Most of the "isot" components have been defined in the calling routine (processIsotopes): ====
[5183]	1051	!=== name, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iqIsoPha(:,:), itZonPhi(:,:) ====
[4046]	1052	!=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ====
	1053	!=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ====
	1054	!=== * In case keys are found both in the "params" section and the "*.def" file, the later value is retained ====
	1055	!=== * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution) ====
	1056	!=== * The routine gives an error if a required isotope is not available in the database stored in "fnam" ====
	1057	!==============================================================================================================================
[5001]	1058	LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
[4046]	1059	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name
[5183]	1060	TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %name must be defined!)
[4454]	1061	LOGICAL :: lFound
[4363]	1062	INTEGER :: is, iis, it, idb, ndb, nb0
[5183]	1063	CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:), tname(:), iname(:)
[4363]	1064	CHARACTER(LEN=maxlen) :: modname
[5183]	1065	TYPE(keys_type), POINTER :: t
[4046]	1066	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
	1067	modname = 'readIsotopesFile'
	1068
	1069	!--- THE INPUT FILE MUST BE PRESENT
[5183]	1070	INQUIRE(FILE=TRIM(fnam), EXIST=lFound)
	1071	lerr = .NOT.lFound
	1072	CALL msg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr)
	1073	IF(lerr) RETURN
[4046]	1074
[5183]	1075	!--- READ THE FILE SECTIONS, ONE EACH ISOTOPES CLASS (FIEDL %name)
[4046]	1076	nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index
[5183]	1077	lerr = readSections(fnam,strStack(isot(:)%name,'\|')); IF(lerr) RETURN !--- Read sections, one each isotopes class %name
[4046]	1078	ndb = SIZE(dBase, DIM=1) !--- Current database size
	1079	DO idb = nb0, ndb
[4301]	1080	iis = idb-nb0+1
[4046]	1081
	1082	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
[5183]	1083	! lerr = addKeysFromDef(dBase(idb)%trac, 'params'); IF(lerr) RETURN
[4046]	1084
	1085	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
[5183]	1086	lerr = subDefault(dBase(idb)%trac, 'params', .TRUE.); IF(lerr) RETURN
[4046]	1087
	1088	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
[5183]	1089	lerr = getKey('name', tname, dBase(idb)%trac); IF(lerr) RETURN
	1090	lerr = getKey('name', iname, isot(iis)%keys); IF(lerr) RETURN
[4046]	1091	DO it = 1, SIZE(dBase(idb)%trac)
	1092	t => dBase(idb)%trac(it)
[5183]	1093	is = strIdx(iname, tname(it)) !--- Index in "iname(:)" of isotope "tname(it)"
[4046]	1094	IF(is == 0) CYCLE
[5183]	1095	lerr = ANY(reduceExpr(t%val, vals)); IF(lerr) RETURN !--- Reduce expressions ; detect non-numerical elements
	1096	isot(iis)%keys(is)%key = t%key
[4325]	1097	isot(iis)%keys(is)%val = vals
[4046]	1098	END DO
	1099
	1100	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
[5183]	1101	lerr = checkList(iname, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
[5001]	1102	'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing')
	1103	IF(lerr) RETURN
[4046]	1104	END DO
	1105
	1106	!--- CLEAN THE DATABASE ENTRIES
	1107	IF(nb0 == 1) THEN
	1108	DEALLOCATE(dBase); ALLOCATE(dBase(0))
	1109	ELSE
	1110	ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
	1111	END IF
[4120]	1112
	1113	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
[5183]	1114	CALL get_in('ok_iso_verif', isot(strIdx(iname, 'H2O'))%check, .FALSE.)
[4120]	1115
[4325]	1116	lerr = dispIsotopes()
[4046]	1117
[4325]	1118	CONTAINS
	1119
	1120	!------------------------------------------------------------------------------------------------------------------------------
	1121	LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
	1122	INTEGER :: ik, nk, ip, it, nt
	1123	CHARACTER(LEN=maxlen) :: prf
[5183]	1124	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:), tname(:)
[4325]	1125	CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
[5183]	1126	DO ip = 1, SIZE(isot) !--- Loop on isotopes classes
	1127	IF(SIZE(isot(ip)%keys) == 0) CYCLE
[4325]	1128	nk = SIZE(isot(ip)%keys(1)%key) !--- Same keys for each isotope
	1129	nt = SIZE(isot(ip)%keys) !--- Number of isotopes
	1130	prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing
	1131	ALLOCATE(ttl(nk+2), val(nt,nk+1))
	1132	ttl(1:2) = ['it ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
[5183]	1133	lerr = getKey('name', tname, isot(ip)%keys); IF(lerr) RETURN
	1134	val(:,1) = tname !--- Values table 1st column: isotopes names
[4325]	1135	DO ik = 1, nk
	1136	DO it = 1, nt
	1137	val(it,ik+1) = isot(ip)%keys(it)%val(ik) !--- Other columns: keys values
	1138	END DO
	1139	END DO
[5001]	1140	lerr = dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)
	1141	IF(fmsg('Problem with the table content', modname, lerr)) RETURN
[4325]	1142	DEALLOCATE(ttl, val)
	1143	END DO
	1144	END FUNCTION dispIsotopes
	1145	!------------------------------------------------------------------------------------------------------------------------------
	1146
[5001]	1147	END FUNCTION readIsotopesFile
[4046]	1148	!==============================================================================================================================
	1149
[4301]	1150
[4046]	1151	!==============================================================================================================================
	1152	!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: ===
	1153	!=== * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS). ===
[5183]	1154	!=== * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS (defined by "keys(:)") ===
	1155	!=== * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS) /!\ DISABLED FUNCTION /!\ ===
[4046]	1156	!==============================================================================================================================
[5183]	1157	LOGICAL FUNCTION processIsotopes(keys, isot, iClasses) RESULT(lerr)
	1158	TYPE(keys_type), TARGET, OPTIONAL, INTENT(INOUT) :: keys(:)
	1159	TYPE(isot_type), TARGET, ALLOCATABLE, OPTIONAL, INTENT(OUT) :: isot(:)
	1160	CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: iClasses(:)
[5184]	1161	CHARACTER(LEN=maxlen), ALLOCATABLE :: str1(:), str2(:) !--- Temporary storage
[5183]	1162	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), dType(:), phase(:), gen0N(:), iCla(:)
	1163	CHARACTER(LEN=maxlen) :: iClass, modname
[5184]	1164	CHARACTER(LEN=1) :: ph !--- Phase
	1165	LOGICAL, ALLOCATABLE :: ll(:) !--- Mask
[5183]	1166	INTEGER, ALLOCATABLE :: iGen(:)
	1167	INTEGER :: ic, ip, iq, ii, it, iz
	1168	TYPE(isot_type), POINTER :: i1
	1169	TYPE(keys_type), POINTER :: k(:)
[5001]	1170
[4193]	1171	lerr = .FALSE.
[4325]	1172	modname = 'readIsotopesFile'
[5183]	1173	k => tracers; IF(PRESENT(keys )) k => keys
	1174	lerr = getKey('name', tname, k); IF(lerr) RETURN !--- Names
	1175	lerr = getKey('parent', parent, k); IF(lerr) RETURN !--- Parents
	1176	lerr = getKey('type', dType, k); IF(lerr) RETURN !--- Tracer type
	1177	lerr = getKey('phase', phase, k); IF(lerr) RETURN !--- Phase
	1178	lerr = getKey('gen0Name', gen0N, k); IF(lerr) RETURN !--- 1st generation ancestor name
	1179	lerr = getKey('iGeneration', iGen, k); IF(lerr) RETURN !--- Generation number
[4046]	1180
[5183]	1181	!--- INITIALIZATION IF ISOTOPES-SPECIFIC KEYS (MUST BE DEFINED EVEN WITHOUT ISOTOPES)
	1182	DO iq = 1, SIZE(k)
	1183	CALL addKey('iso_iGroup',0, k(iq)) !--- Family idx in list "isotopes(:)%parent"
	1184	CALL addKey('iso_iName', 0, k(iq)) !--- Isotope idx in effective isotopes list
	1185	CALL addKey('iso_iZone', 0, k(iq)) !--- Tagging zone idx in effective zones list
	1186	CALL addKey('iso_iPhas', 0, k(iq)) !--- Phase idx in effective phases list
	1187	END DO
[4046]	1188
[4301]	1189	!--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
[5183]	1190	iCla = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
	1191	CALL strReduce(iCla)
[4046]	1192
[5183]	1193	!--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iClasses" ARE AVAILABLE OR NOT
	1194	IF(PRESENT(iClasses)) THEN
	1195	DO it = 1, SIZE(iClasses)
	1196	lerr = ALL(iCla /= iClasses(it))
	1197	IF(fmsg('No isotopes class "'//TRIM(iClasses(it))//'" found among tracers', modname, lerr)) RETURN
[4325]	1198	END DO
[5183]	1199	iCla = iClasses
[4325]	1200	END IF
[5183]	1201	nbIso = SIZE(iCla)
[4325]	1202
[5183]	1203	!--- USE THE ARGUMENT "isot" TO STORE THE ISOTOPIC DATABASE OR THE LOCAL VECTOR "isotopes"
	1204	IF(PRESENT(isot)) THEN
	1205	ALLOCATE( isot(nbIso))
	1206	ELSE
	1207	IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
	1208	ALLOCATE(isotopes(nbIso))
	1209	END IF
[4046]	1210	IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED
	1211
	1212	!--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
[5183]	1213	DO ic = 1, nbIso !--- Loop on isotopes classes
	1214	IF( PRESENT(isot)) i1 => isot (ic)
	1215	IF(.NOT.PRESENT(isot)) i1 => isotopes(ic)
	1216	iClass = iCla(ic) !--- Current isotopes class name (parent tracer name)
	1217	i1%name = iClass
[4046]	1218
[5183]	1219	!=== Isotopes children of tracer "iClass": mask, names, number (same for each phase of "iClass")
	1220	ll = dType=='tracer' .AND. delPhase(parent) == iClass .AND. phase == 'g'
	1221	str1 = PACK(delPhase(tname), MASK = ll) !--- Effectively found isotopes of "iClass"
	1222	i1%niso = SIZE(str1) !--- Number of "effectively found isotopes of "iname"
	1223	ALLOCATE(i1%keys(i1%niso))
	1224	DO it = 1, i1%niso; CALL addKey('name', str1(it), i1%keys(it)); END DO
[4046]	1225
[5183]	1226	!=== Geographic tagging tracers descending on tracer "iClass": mask, names, number
	1227	ll = dType=='tag' .AND. delPhase(gen0N) == iClass .AND. iGen == 2
	1228	i1%zone = PACK(strTail(tname, '_', .TRUE.), MASK = ll) !--- Tagging zones names for isotopes category "iname"
	1229	CALL strReduce(i1%zone)
	1230	i1%nzone = SIZE(i1%zone) !--- Tagging zones number for isotopes category "iClass"
[4046]	1231
[5183]	1232	!=== Geographic tracers of the isotopes children of tracer "iClass" (same for each phase of "iClass")
[4046]	1233	! NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
[5183]	1234	str2 = PACK(delPhase(tname), MASK=ll)
	1235	CALL strReduce(str2)
	1236	i1%ntiso = i1%niso + SIZE(str2) !--- Number of isotopes + their geographic tracers [ntiso]
	1237	ALLOCATE(i1%trac(i1%ntiso))
	1238	DO it = 1, i1%niso; i1%trac(it) = str1(it); END DO
	1239	DO it = i1%niso+1, i1%ntiso; i1%trac(it) = str2(it-i1%niso); END DO
[4046]	1240
[5183]	1241	!=== Phases for tracer "iClass"
	1242	i1%phase = ''
	1243	DO ip = 1, nphases; ph = known_phases(ip:ip); IF(ANY(tname == addPhase(iClass, ph))) i1%phase = TRIM(i1%phase)//ph; END DO
	1244	i1%nphas = LEN_TRIM(i1%phase) !--- Equal to "nqo" for water
[4046]	1245
	1246	!=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
[5183]	1247	DO iq = 1, SIZE(tracers)
	1248	ii = strIdx(i1%trac, strHead(delPhase(tname(iq)), '_', .TRUE.))
	1249	iz = strIdx(i1%zone, strTail( tname(iq), '_', .TRUE.))
	1250	ip = INDEX(i1%phase, TRIM(phase(iq) ))
	1251	IF(delPhase(gen0N(iq)) /= iClass .OR. iGen(iq) == 0) CYCLE !--- Only deal with tracers descending on "iClass"
	1252	CALL addKey('iso_iGroup',ic, k(iq)) !--- Family idx in list "isotopes(:)%name"
	1253	CALL addKey('iso_iName', ii, k(iq)) !--- Isotope idx in effective isotopes list
	1254	CALL addKey('iso_iZone', iz, k(iq)) !--- Tagging zone idx in effective zones list
	1255	CALL addKey('iso_iPhas', ip, k(iq)) !--- Phase idx in effective phases list
	1256	IF(iGen(iq) /= 2) CALL addKey('iso_iZone', 0, k(iq)) !--- Skip possible generation 1 tagging tracers
[4046]	1257	END DO
	1258
	1259	!=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
	1260	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
[5183]	1261	i1%iqIsoPha = RESHAPE( [( (strIdx(tname, addPhase(i1%trac(it),i1%phase(ip:ip))), it=1, i1%ntiso), ip=1, i1%nphas)], &
	1262	[i1%ntiso, i1%nphas] )
[4984]	1263	!=== Table used to get iq (index in dyn array, size nqtot) from the water and isotope and phase indexes ; the full isotopes list
	1264	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
[5183]	1265	i1%iqWIsoPha = RESHAPE( [( [strIdx(tname, addPhase('H2O', i1%phase(ip:ip))), i1%iqIsoPha(:,ip)], ip=1, i1%nphas)], &
	1266	[1+i1%ntiso, i1%nphas] )
[4063]	1267	!=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
[5183]	1268	i1%itZonIso = RESHAPE( [( (strIdx(i1%trac(:), TRIM(i1%trac(it))//'_'//TRIM(i1%zone(iz))), iz=1, i1%nzone), it=1, i1%niso )], &
	1269	[i1%nzone, i1%niso] )
[4046]	1270	END DO
	1271
[5183]	1272	!=== READ PHYSICAL PARAMETERS FROM isoFile FILE (COMMENTED => DISABLED)
	1273	! IF( PRESENT(isot)) lerr = readIsotopesFile(isoFile, isot)
	1274	! IF(.NOT.PRESENT(isot)) lerr = readIsotopesFile(isoFile, isotopes)
	1275	! IF(lerr) RETURN
[4046]	1276
[5001]	1277	!--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
	1278	CALL get_in('ok_iso_verif', isoCheck, .TRUE.)
	1279
[4325]	1280	!=== CHECK CONSISTENCY
[5001]	1281	lerr = testIsotopes(); IF(lerr) RETURN
[4325]	1282
[5001]	1283	!=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
[5183]	1284	IF(isoSelect('H2O', lVerbose=.TRUE.)) THEN
	1285	iH2O = ixIso
	1286	ELSE
	1287	lerr = isoSelect(1, lVerbose=.TRUE.)
	1288	END IF
[4325]	1289
	1290	CONTAINS
	1291
	1292	!------------------------------------------------------------------------------------------------------------------------------
	1293	LOGICAL FUNCTION testIsotopes() RESULT(lerr) !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
	1294	!------------------------------------------------------------------------------------------------------------------------------
[5001]	1295	INTEGER :: ix, it, ip, np, iz, nz, npha, nzon
[4325]	1296	DO ix = 1, nbIso
[5183]	1297	IF( PRESENT(isot)) i1 => isot (ix)
	1298	IF(.NOT.PRESENT(isot)) i1 => isotopes(ix)
[4325]	1299	!--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
[5183]	1300	DO it = 1, i1%ntiso; npha = i1%nphas
	1301	np = SUM([(COUNT(tname(:) == addPhase(i1%trac(it), i1%phase(ip:ip))), ip=1, npha)])
[5001]	1302	lerr = np /= npha
[5183]	1303	CALL msg(TRIM(int2str(np))// ' phases instead of '//TRIM(int2str(npha))//' for '//TRIM(i1%trac(it)), modname, lerr)
[5001]	1304	IF(lerr) RETURN
[4325]	1305	END DO
[5183]	1306	DO it = 1, i1%niso; nzon = i1%nzone
	1307	nz = SUM([(COUNT(i1%trac == TRIM(i1%trac(it))//'_'//i1%zone(iz)), iz=1, nzon)])
[5001]	1308	lerr = nz /= nzon
[5183]	1309	CALL msg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(nzon))//' for '//TRIM(i1%trac(it)), modname, lerr)
[5001]	1310	IF(lerr) RETURN
[4325]	1311	END DO
	1312	END DO
	1313	END FUNCTION testIsotopes
	1314	!------------------------------------------------------------------------------------------------------------------------------
	1315
[5001]	1316	END FUNCTION processIsotopes
[4046]	1317	!==============================================================================================================================
	1318
	1319
	1320	!==============================================================================================================================
[4325]	1321	!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
[5183]	1322	! Single generic "isoSelect" routine, using the predefined index of the class (fast version) or its name (first call).
[4046]	1323	!==============================================================================================================================
[5183]	1324	LOGICAL FUNCTION isoSelectByName(iClass, isot, lVerbose) RESULT(lerr)
[4325]	1325	IMPLICIT NONE
[5183]	1326	CHARACTER(LEN=*), INTENT(IN) :: iClass
	1327	TYPE(isot_type), OPTIONAL, TARGET, INTENT(IN) :: isot(:)
	1328	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
	1329	TYPE(isot_type), POINTER :: iso(:)
[4325]	1330	INTEGER :: iIso
	1331	LOGICAL :: lV
[5183]	1332	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
	1333	iso => isotopes; IF(PRESENT(isot)) iso => isot
	1334	iIso = strIdx(iso(:)%name, iClass)
[5001]	1335	lerr = iIso == 0
	1336	IF(lerr) THEN
[4325]	1337	niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
[5183]	1338	CALL msg('no isotope family named "'//TRIM(iClass)//'"', ll=lV)
[4325]	1339	RETURN
	1340	END IF
[5183]	1341	lerr = isoSelectByIndex(iIso, iso, lV)
[4325]	1342	END FUNCTION isoSelectByName
	1343	!==============================================================================================================================
[5183]	1344	LOGICAL FUNCTION isoSelectByIndex(iIso, isot, lVerbose) RESULT(lerr)
[4325]	1345	IMPLICIT NONE
[5183]	1346	INTEGER, INTENT(IN) :: iIso
	1347	TYPE(isot_type), TARGET, OPTIONAL, INTENT(INOUT) :: isot(:)
	1348	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
	1349	TYPE(isot_type), POINTER :: i(:)
[4325]	1350	LOGICAL :: lV
[5183]	1351	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
	1352	i => isotopes; IF(PRESENT(isot)) i => isot
[4325]	1353	lerr = .FALSE.
	1354	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
[5183]	1355	lerr = iIso<=0 .OR. iIso>SIZE(i)
[4325]	1356	CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
[5183]	1357	//TRIM(int2str(SIZE(i)))//'"', ll = lerr .AND. lV)
[4325]	1358	IF(lerr) RETURN
	1359	ixIso = iIso !--- Update currently selected family index
[5183]	1360	isotope => i(ixIso) !--- Select corresponding component
[4325]	1361	isoKeys => isotope%keys; niso = isotope%niso
	1362	isoName => isotope%trac; ntiso = isotope%ntiso
	1363	isoZone => isotope%zone; nzone = isotope%nzone
	1364	isoPhas => isotope%phase; nphas = isotope%nphas
	1365	itZonIso => isotope%itZonIso; isoCheck = isotope%check
	1366	iqIsoPha => isotope%iqIsoPha
[5183]	1367	iqWIsoPha=> isotope%iqWIsoPha
[4325]	1368	END FUNCTION isoSelectByIndex
	1369	!==============================================================================================================================
[4046]	1370
	1371
	1372	!==============================================================================================================================
[4301]	1373	!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
	1374	!==============================================================================================================================
[4987]	1375	SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
	1376	CHARACTER(LEN=*), INTENT(IN) :: key, sval
[4046]	1377	TYPE(keys_type), INTENT(INOUT) :: ky
	1378	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
[4301]	1379	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1380	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
	1381	INTEGER :: iky, nky
	1382	LOGICAL :: lo
[4325]	1383	lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
[4348]	1384	IF(.NOT.ALLOCATED(ky%key)) THEN
	1385	ALLOCATE(ky%key(1)); ky%key(1)=key
[4987]	1386	ALLOCATE(ky%val(1)); ky%val(1)=sval
[4348]	1387	RETURN
	1388	END IF
[4367]	1389	iky = strIdx(ky%key,key)
[4046]	1390	IF(iky == 0) THEN
[4367]	1391	nky = SIZE(ky%key)
[4987]	1392	ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
	1393	ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = sval; ky%val = v
[4325]	1394	ELSE IF(lo) THEN
[4987]	1395	ky%key(iky) = key; ky%val(iky) = sval
[4046]	1396	END IF
[4987]	1397	END SUBROUTINE addKey_s11
[4046]	1398	!==============================================================================================================================
[4987]	1399	SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
	1400	CHARACTER(LEN=*), INTENT(IN) :: key
	1401	INTEGER, INTENT(IN) :: ival
	1402	TYPE(keys_type), INTENT(INOUT) :: ky
	1403	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1404	!------------------------------------------------------------------------------------------------------------------------------
	1405	CALL addKey_s11(key, int2str(ival), ky, lOverWrite)
	1406	END SUBROUTINE addKey_i11
	1407	!==============================================================================================================================
	1408	SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
	1409	CHARACTER(LEN=*), INTENT(IN) :: key
	1410	REAL, INTENT(IN) :: rval
	1411	TYPE(keys_type), INTENT(INOUT) :: ky
	1412	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1413	!------------------------------------------------------------------------------------------------------------------------------
	1414	CALL addKey_s11(key, real2str(rval), ky, lOverWrite)
	1415	END SUBROUTINE addKey_r11
	1416	!==============================================================================================================================
	1417	SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
	1418	CHARACTER(LEN=*), INTENT(IN) :: key
	1419	LOGICAL, INTENT(IN) :: lval
	1420	TYPE(keys_type), INTENT(INOUT) :: ky
	1421	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1422	!------------------------------------------------------------------------------------------------------------------------------
	1423	CALL addKey_s11(key, bool2str(lval), ky, lOverWrite)
	1424	END SUBROUTINE addKey_l11
	1425	!==============================================================================================================================
	1426	!==============================================================================================================================
	1427	SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
	1428	CHARACTER(LEN=*), INTENT(IN) :: key, sval
[4046]	1429	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1430	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
[4301]	1431	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1432	INTEGER :: itr
[5001]	1433	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval, ky(itr), lOverWrite); END DO
[4987]	1434	END SUBROUTINE addKey_s1m
[4046]	1435	!==============================================================================================================================
[4987]	1436	SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
	1437	CHARACTER(LEN=*), INTENT(IN) :: key
	1438	INTEGER, INTENT(IN) :: ival
[4325]	1439	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1440	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1441	!------------------------------------------------------------------------------------------------------------------------------
	1442	INTEGER :: itr
[5001]	1443	DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite); END DO
[4987]	1444	END SUBROUTINE addKey_i1m
[4325]	1445	!==============================================================================================================================
[4987]	1446	SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
	1447	CHARACTER(LEN=*), INTENT(IN) :: key
	1448	REAL, INTENT(IN) :: rval
	1449	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1450	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1451	!------------------------------------------------------------------------------------------------------------------------------
	1452	INTEGER :: itr
[5001]	1453	DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite); END DO
[4987]	1454	END SUBROUTINE addKey_r1m
	1455	!==============================================================================================================================
	1456	SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
	1457	CHARACTER(LEN=*), INTENT(IN) :: key
	1458	LOGICAL, INTENT(IN) :: lval
	1459	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1460	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1461	!------------------------------------------------------------------------------------------------------------------------------
	1462	INTEGER :: itr
[5001]	1463	DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite); END DO
[4987]	1464	END SUBROUTINE addKey_l1m
	1465	!==============================================================================================================================
	1466	!==============================================================================================================================
	1467	SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
	1468	CHARACTER(LEN=*), INTENT(IN) :: key, sval(:)
	1469	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1470	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1471	!------------------------------------------------------------------------------------------------------------------------------
	1472	INTEGER :: itr
	1473	DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite); END DO
	1474	END SUBROUTINE addKey_smm
	1475	!==============================================================================================================================
	1476	SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
	1477	CHARACTER(LEN=*), INTENT(IN) :: key
	1478	INTEGER, INTENT(IN) :: ival(:)
	1479	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1480	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1481	!------------------------------------------------------------------------------------------------------------------------------
	1482	INTEGER :: itr
	1483	DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival(itr)), ky(itr), lOverWrite); END DO
	1484	END SUBROUTINE addKey_imm
	1485	!==============================================================================================================================
	1486	SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
	1487	CHARACTER(LEN=*), INTENT(IN) :: key
	1488	REAL, INTENT(IN) :: rval(:)
	1489	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1490	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1491	!------------------------------------------------------------------------------------------------------------------------------
	1492	INTEGER :: itr
	1493	DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval(itr)), ky(itr), lOverWrite); END DO
	1494	END SUBROUTINE addKey_rmm
	1495	!==============================================================================================================================
	1496	SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
	1497	CHARACTER(LEN=*), INTENT(IN) :: key
	1498	LOGICAL, INTENT(IN) :: lval(:)
	1499	TYPE(keys_type), INTENT(INOUT) :: ky(:)
	1500	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1501	!------------------------------------------------------------------------------------------------------------------------------
	1502	INTEGER :: itr
	1503	DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval(itr)), ky(itr), lOverWrite); END DO
	1504	END SUBROUTINE addKey_lmm
	1505	!==============================================================================================================================
[4301]	1506
	1507
	1508	!==============================================================================================================================
	1509	!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
	1510	!==============================================================================================================================
[5183]	1511	LOGICAL FUNCTION addKeysFromDef(t, tr0) RESULT(lerr)
	1512	TYPE(keys_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
[4046]	1513	CHARACTER(LEN=*), INTENT(IN) :: tr0
[4301]	1514	!------------------------------------------------------------------------------------------------------------------------------
[5183]	1515	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
[4046]	1516	CHARACTER(LEN=maxlen) :: val
	1517	INTEGER :: ik, jd
[5183]	1518	lerr = getKey('name', tname, t); IF(lerr) RETURN
	1519	jd = strIdx(tname(:), tr0)
[4046]	1520	IF(jd == 0) RETURN
[5183]	1521	DO ik = 1, SIZE(t(jd)%key)
	1522	CALL get_in(t(jd)%key(ik), val, 'none')
	1523	IF(val /= 'none') CALL addKey(t(jd)%key(ik), val, t(jd), .TRUE.)
[4046]	1524	END DO
[5183]	1525	END FUNCTION addKeysFromDef
[4046]	1526	!==============================================================================================================================
[4301]	1527
	1528
	1529	!==============================================================================================================================
	1530	!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
	1531	!==============================================================================================================================
[4046]	1532	SUBROUTINE delKey_1(itr, keyn, ky)
	1533	INTEGER, INTENT(IN) :: itr
	1534	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
[5183]	1535	TYPE(keys_type), INTENT(INOUT) :: ky(:)
[4301]	1536	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1537	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
	1538	LOGICAL, ALLOCATABLE :: ll(:)
	1539	INTEGER :: iky
	1540	IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range
[5183]	1541	ll = [( ALL(keyn/=ky(itr)%key(iky)), iky=1, SIZE(ky(itr)%key) )]
	1542	k = PACK(ky(itr)%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%key)
	1543	v = PACK(ky(itr)%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%val)
[4046]	1544	END SUBROUTINE delKey_1
	1545	!==============================================================================================================================
	1546	SUBROUTINE delKey(keyn, ky)
	1547	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
[5183]	1548	TYPE(keys_type), INTENT(INOUT) :: ky(:)
[4301]	1549	!------------------------------------------------------------------------------------------------------------------------------
[4046]	1550	INTEGER :: iky
	1551	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
	1552	END SUBROUTINE delKey
	1553	!==============================================================================================================================
	1554
	1555
	1556	!==============================================================================================================================
[5001]	1557	!=== INTERNAL FUNCTION: GET THE VALUE OF A KEY FOR "itr"th TRACER FROM A "keys_type" DERIVED TYPE AND RETURN THE RESULT ===
	1558	!=== IF keyn CONTAINS SEVERAL ELEMENTS, TRY WITH EACH ELEMENT ONE AFTER THE OTHER ===
[4301]	1559	!==============================================================================================================================
[5001]	1560	CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx(itr, keyn, ky, lerr) RESULT(val)
[4325]	1561	INTEGER, INTENT(IN) :: itr
[5001]	1562	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
[4325]	1563	TYPE(keys_type), INTENT(IN) :: ky(:)
	1564	LOGICAL, OPTIONAL, INTENT(OUT) :: lerr
[4046]	1565	!------------------------------------------------------------------------------------------------------------------------------
[5001]	1566	INTEGER :: ik
[4325]	1567	LOGICAL :: ler
[5001]	1568	ler = .TRUE.
	1569	DO ik = 1, SIZE(keyn)
	1570	CALL getKeyIdx(keyn(ik)); IF(.NOT.ler) EXIT
	1571	END DO
[4325]	1572	IF(PRESENT(lerr)) lerr = ler
[5001]	1573
	1574	CONTAINS
	1575
	1576	SUBROUTINE getKeyIdx(keyn)
	1577	CHARACTER(LEN=*), INTENT(IN) :: keyn
[4120]	1578	!------------------------------------------------------------------------------------------------------------------------------
[5001]	1579	INTEGER :: iky
	1580	iky = 0; val = ''
	1581	ler = itr <= 0 .OR. itr > SIZE(ky); IF(ler) RETURN
	1582	iky = strIdx(ky(itr)%key(:), keyn)
	1583	ler = iky == 0; IF(ler) RETURN
	1584	val = ky(itr)%val(iky)
	1585	END SUBROUTINE getKeyIdx
	1586
	1587	END FUNCTION fgetKeyIdx
[4120]	1588	!==============================================================================================================================
[4301]	1589
	1590
	1591	!==============================================================================================================================
[5001]	1592	!=== GET KEYS VALUES FROM TRACERS INDICES ===
[4301]	1593	!==============================================================================================================================
[5001]	1594	!=== TRY TO GET THE KEY NAMED "key" FOR THE "itr"th TRACER IN: ===
	1595	!=== * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE: ===
[5183]	1596	!=== * IN INTERNAL TRACERS DATABASE "tracers(:)" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)") ===
[5001]	1597	!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER: ===
	1598	!=== * A SCALAR ===
	1599	!=== * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR "," ===
	1600	!=== ===
	1601	!=== SYNTAX: lerr = getKeyByIndex_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], itr[, ky(:)] [, def][, lDisp]) ===
	1602	!==============================================================================================================================
	1603	!=== IF "itr" IS NOT PRESENT, VALUES FOR ALL THE TRACERS OF THE SELECTED DATABASE ARE STORED IN THE VECTOR "val(:)" ===
	1604	!=== THE NAME OF THE TRACERS FOUND IN THE EFFECTIVELY USED DATABASE CAN BE RETURNED OPTIONALLY IN "nam(:)" ===
	1605	!=== SYNTAX lerr = getKeyByIndex_{sirl}{1m}mm (keyn[(:)], val (:) [, ky(:)][, nam(:)][, def][, lDisp]) ===
	1606	!==============================================================================================================================
	1607	LOGICAL FUNCTION getKeyByIndex_s111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
[4046]	1608	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1609	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
[5001]	1610	INTEGER, INTENT(IN) :: itr
[4046]	1611	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[5001]	1612	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
	1613	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1614	lerr = getKeyByIndex_sm11([keyn], val, itr, ky, def, lDisp)
	1615	END FUNCTION getKeyByIndex_s111
	1616	!==============================================================================================================================
	1617	LOGICAL FUNCTION getKeyByIndex_i111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1618	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1619	INTEGER, INTENT(OUT) :: val
	1620	INTEGER, INTENT(IN) :: itr
	1621	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1622	INTEGER, OPTIONAL, INTENT(IN) :: def
	1623	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1624	lerr = getKeyByIndex_im11([keyn], val, itr, ky, def, lDisp)
	1625	END FUNCTION getKeyByIndex_i111
	1626	!==============================================================================================================================
	1627	LOGICAL FUNCTION getKeyByIndex_r111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1628	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1629	REAL , INTENT(OUT) :: val
	1630	INTEGER, INTENT(IN) :: itr
	1631	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1632	REAL, OPTIONAL, INTENT(IN) :: def
	1633	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1634	lerr = getKeyByIndex_rm11([keyn], val, itr, ky, def, lDisp)
	1635	END FUNCTION getKeyByIndex_r111
	1636	!==============================================================================================================================
	1637	LOGICAL FUNCTION getKeyByIndex_l111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1638	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1639	LOGICAL, INTENT(OUT) :: val
	1640	INTEGER, INTENT(IN) :: itr
	1641	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1642	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1643	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1644	lerr = getKeyByIndex_lm11([keyn], val, itr, ky, def, lDisp)
	1645	END FUNCTION getKeyByIndex_l111
	1646	!==============================================================================================================================
	1647	!==============================================================================================================================
	1648	LOGICAL FUNCTION getKeyByIndex_sm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1649	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1650	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
	1651	INTEGER, INTENT(IN) :: itr
	1652	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1653	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
	1654	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4301]	1655	!------------------------------------------------------------------------------------------------------------------------------
[5001]	1656	CHARACTER(LEN=maxlen) :: s
	1657	LOGICAL :: lD
	1658	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
	1659	s = 'key "'//TRIM(strStack(keyn, '/'))//'" for tracer nr. '//TRIM(int2str(itr))
	1660	lerr = .TRUE.
	1661	IF(lerr .AND. PRESENT(ky)) val = fgetKey(ky) !--- "ky"
[5183]	1662	IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)) !--- "tracers"
[5001]	1663	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
	1664	IF(lerr .AND. PRESENT(def)) THEN
	1665	val = def; lerr = .NOT.PRESENT(def)
	1666	CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
[4046]	1667	END IF
[5001]	1668	CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
	1669
	1670	CONTAINS
	1671
	1672	CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
	1673	TYPE(keys_type), INTENT(IN) :: ky(:)
	1674	lerr = SIZE(ky) == 0; IF(lerr) RETURN
	1675	val = fgetKeyIdx(itr, keyn(:), ky, lerr)
	1676	END FUNCTION fgetKey
	1677
	1678	END FUNCTION getKeyByIndex_sm11
[4046]	1679	!==============================================================================================================================
[5001]	1680	LOGICAL FUNCTION getKeyByIndex_im11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1681	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1682	INTEGER, INTENT(OUT) :: val
	1683	INTEGER, INTENT(IN) :: itr
	1684	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1685	INTEGER, OPTIONAL, INTENT(IN) :: def
	1686	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1687	!------------------------------------------------------------------------------------------------------------------------------
	1688	CHARACTER(LEN=maxlen) :: sval, s
	1689	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
	1690	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
	1691	IF(lerr) RETURN
	1692	val = str2int(sval)
	1693	lerr = val == -HUGE(1)
	1694	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1695	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
	1696	END FUNCTION getKeyByIndex_im11
	1697	!==============================================================================================================================
	1698	LOGICAL FUNCTION getKeyByIndex_rm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1699	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1700	REAL , INTENT(OUT) :: val
	1701	INTEGER, INTENT(IN) :: itr
	1702	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1703	REAL, OPTIONAL, INTENT(IN) :: def
	1704	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1705	!------------------------------------------------------------------------------------------------------------------------------
	1706	CHARACTER(LEN=maxlen) :: sval, s
	1707	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
	1708	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
	1709	IF(lerr) RETURN
	1710	val = str2real(sval)
	1711	lerr = val == -HUGE(1.)
	1712	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1713	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
	1714	END FUNCTION getKeyByIndex_rm11
	1715	!==============================================================================================================================
	1716	LOGICAL FUNCTION getKeyByIndex_lm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1717	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1718	LOGICAL, INTENT(OUT) :: val
	1719	INTEGER, INTENT(IN) :: itr
	1720	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1721	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1722	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1723	!------------------------------------------------------------------------------------------------------------------------------
	1724	CHARACTER(LEN=maxlen) :: sval, s
	1725	INTEGER :: ival
	1726	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
	1727	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
	1728	IF(lerr) RETURN
	1729	ival = str2bool(sval)
	1730	lerr = ival == -1
	1731	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1732	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
	1733	IF(.NOT.lerr) val = ival == 1
	1734	END FUNCTION getKeyByIndex_lm11
	1735	!==============================================================================================================================
	1736	!==============================================================================================================================
	1737	LOGICAL FUNCTION getKeyByIndex_s1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
[4328]	1738	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1739	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
[5001]	1740	INTEGER, INTENT(IN) :: itr
[4328]	1741	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[5001]	1742	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	1743	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4328]	1744	!------------------------------------------------------------------------------------------------------------------------------
[5001]	1745	CHARACTER(LEN=maxlen) :: sval
	1746	lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
[4328]	1747	lerr = strParse(sval, ',', val)
[5001]	1748	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	1749	END FUNCTION getKeyByIndex_s1m1
[4328]	1750	!==============================================================================================================================
[5001]	1751	LOGICAL FUNCTION getKeyByIndex_i1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1752	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1753	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1754	INTEGER, INTENT(IN) :: itr
	1755	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1756	INTEGER, OPTIONAL, INTENT(IN) :: def
	1757	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1758	!------------------------------------------------------------------------------------------------------------------------------
	1759	CHARACTER(LEN=maxlen) :: sval, s
	1760	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	1761	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, int2str(def), lDisp)
	1762	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
	1763	IF(lerr) RETURN
	1764	lerr = strParse(sval, ',', svals)
	1765	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	1766	val = str2int(svals)
[5183]	1767	lerr = ANY(val == -HUGE(1)) .AND. sval /= ''
[5001]	1768	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1769	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
	1770	END FUNCTION getKeyByIndex_i1m1
	1771	!==============================================================================================================================
	1772	LOGICAL FUNCTION getKeyByIndex_r1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1773	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1774	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1775	INTEGER, INTENT(IN) :: itr
	1776	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1777	REAL, OPTIONAL, INTENT(IN) :: def
	1778	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1779	!------------------------------------------------------------------------------------------------------------------------------
	1780	CHARACTER(LEN=maxlen) :: sval, s
	1781	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	1782	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, real2str(def), lDisp)
	1783	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
	1784	lerr = strParse(sval, ',', svals)
	1785	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	1786	val = str2real(svals)
[5183]	1787	lerr = ANY(val == -HUGE(1.)) .AND. sval /= ''
[5001]	1788	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1789	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
	1790	END FUNCTION getKeyByIndex_r1m1
	1791	!==============================================================================================================================
	1792	LOGICAL FUNCTION getKeyByIndex_l1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1793	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1794	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1795	INTEGER, INTENT(IN) :: itr
	1796	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1797	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1798	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1799	!------------------------------------------------------------------------------------------------------------------------------
	1800	CHARACTER(LEN=maxlen) :: sval, s
	1801	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	1802	INTEGER, ALLOCATABLE :: ivals(:)
	1803	IF( PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, bool2str(def), lDisp)
	1804	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
	1805	lerr = strParse(sval, ',', svals)
	1806	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	1807	ivals = str2bool(svals)
[5183]	1808	lerr = ANY(ivals == -1) .AND. sval /= ''
[5001]	1809	s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1810	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
	1811	IF(.NOT.lerr) val = ivals == 1
	1812	END FUNCTION getKeyByIndex_l1m1
	1813	!==============================================================================================================================
	1814	!==============================================================================================================================
	1815	LOGICAL FUNCTION getKeyByIndex_smm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1816	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1817	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1818	INTEGER, INTENT(IN) :: itr
	1819	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1820	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	1821	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1822	!------------------------------------------------------------------------------------------------------------------------------
[5003]	1823	CHARACTER(LEN=maxlen) :: sval
[5001]	1824	lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
	1825	lerr = strParse(sval, ',', val)
	1826	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	1827	END FUNCTION getKeyByIndex_smm1
	1828	!==============================================================================================================================
	1829	LOGICAL FUNCTION getKeyByIndex_imm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1830	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1831	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1832	INTEGER, INTENT(IN) :: itr
	1833	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1834	INTEGER, OPTIONAL, INTENT(IN) :: def
	1835	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1836	!------------------------------------------------------------------------------------------------------------------------------
	1837	CHARACTER(LEN=maxlen) :: sval, s
	1838	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	1839	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
	1840	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
	1841	IF(lerr) RETURN
	1842	lerr = strParse(sval, ',', svals)
	1843	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	1844	val = str2int(svals)
[5183]	1845	lerr = ANY(val == -HUGE(1)) .AND. sval /= ''
[5001]	1846	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1847	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
	1848	END FUNCTION getKeyByIndex_imm1
	1849	!==============================================================================================================================
	1850	LOGICAL FUNCTION getKeyByIndex_rmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1851	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1852	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1853	INTEGER, INTENT(IN) :: itr
	1854	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1855	REAL, OPTIONAL, INTENT(IN) :: def
	1856	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1857	!------------------------------------------------------------------------------------------------------------------------------
	1858	CHARACTER(LEN=maxlen) :: sval, s
	1859	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	1860	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
	1861	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
	1862	IF(lerr) RETURN
	1863	lerr = strParse(sval, ',', svals)
	1864	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	1865	val = str2real(svals)
[5183]	1866	lerr = ANY(val == -HUGE(1.)) .AND. sval /= ''
[5001]	1867	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1868	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
	1869	END FUNCTION getKeyByIndex_rmm1
	1870	!==============================================================================================================================
	1871	LOGICAL FUNCTION getKeyByIndex_lmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
	1872	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1873	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1874	INTEGER, INTENT(IN) :: itr
	1875	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1876	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1877	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1878	!------------------------------------------------------------------------------------------------------------------------------
	1879	CHARACTER(LEN=maxlen) :: sval, s
	1880	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	1881	INTEGER, ALLOCATABLE :: ivals(:)
	1882	IF( PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
	1883	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
	1884	IF(lerr) RETURN
	1885	lerr = strParse(sval, ',', svals)
	1886	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	1887	ivals = str2bool(svals)
[5183]	1888	lerr = ANY(ivals == -1) .AND. sval /= ''
[5001]	1889	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
	1890	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
	1891	IF(.NOT.lerr) val = ivals == 1
	1892	END FUNCTION getKeyByIndex_lmm1
	1893	!==============================================================================================================================
	1894	!==============================================================================================================================
[5183]	1895	LOGICAL FUNCTION getKeyByIndex_s1mm(keyn, val, ky, def, lDisp) RESULT(lerr)
	1896	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1897	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1898	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1899	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	1900	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1901	lerr = getKeyByIndex_smmm([keyn], val, ky, def, lDisp)
[5001]	1902	END FUNCTION getKeyByIndex_s1mm
	1903	!==============================================================================================================================
[5183]	1904	LOGICAL FUNCTION getKeyByIndex_i1mm(keyn, val, ky, def, lDisp) RESULT(lerr)
	1905	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1906	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1907	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1908	INTEGER, OPTIONAL, INTENT(IN) :: def
	1909	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1910	lerr = getKeyByIndex_immm([keyn], val, ky, def, lDisp)
[5001]	1911	END FUNCTION getKeyByIndex_i1mm
	1912	!==============================================================================================================================
[5183]	1913	LOGICAL FUNCTION getKeyByIndex_r1mm(keyn, val, ky, def, lDisp) RESULT(lerr)
	1914	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1915	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1916	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1917	REAL, OPTIONAL, INTENT(IN) :: def
	1918	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1919	lerr = getKeyByIndex_rmmm([keyn], val, ky, def, lDisp)
[5001]	1920	END FUNCTION getKeyByIndex_r1mm
	1921	!==============================================================================================================================
[5183]	1922	LOGICAL FUNCTION getKeyByIndex_l1mm(keyn, val, ky, def, lDisp) RESULT(lerr)
	1923	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1924	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1925	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1926	LOGICAL, OPTIONAL, INTENT(IN) :: def
	1927	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	1928	lerr = getKeyByIndex_lmmm([keyn], val, ky, def, lDisp)
[5001]	1929	END FUNCTION getKeyByIndex_l1mm
	1930	!==============================================================================================================================
	1931	!==============================================================================================================================
[5183]	1932	LOGICAL FUNCTION getKeyByIndex_smmm(keyn, val, ky, def, lDisp) RESULT(lerr)
	1933	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1934	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	1935	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1936	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	1937	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4301]	1938	!------------------------------------------------------------------------------------------------------------------------------
[5001]	1939	CHARACTER(LEN=maxlen) :: s
	1940	INTEGER :: iq, nq(3), k
	1941	LOGICAL :: lD, l(3)
	1942	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
	1943	s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
	1944	lerr = .TRUE.
	1945	IF(PRESENT(ky)) THEN; val = fgetKey(ky) !--- "ky"
[5183]	1946	ELSE IF(ALLOCATED(tracers)) THEN; val = fgetKey(tracers(:)) !--- "tracers"
[5001]	1947	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
	1948	END IF
[5183]	1949	IF(.NOT.lerr) RETURN
[5001]	1950	IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
[4325]	1951
[5001]	1952	!--- DEFAULT VALUE
	1953	l = [PRESENT(ky), ALLOCATED(tracers), ASSOCIATED(isotope)]; nq(:) = 0
	1954	IF(l(1)) nq(1) = SIZE(ky)
	1955	IF(l(2)) nq(2) = SIZE(tracers)
	1956	IF(l(3)) nq(3) = SIZE(isotope%keys)
	1957	DO k = 1, 3; IF(l(k) .AND. nq(k) /= 0) THEN; val = [(def, iq = 1, nq(k))]; EXIT; END IF; END DO
	1958	lerr = k == 4
	1959	CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD .AND. .NOT.lerr)
	1960	CALL msg('No '//TRIM(s), modname, lD .AND. lerr)
[4325]	1961
[5001]	1962	CONTAINS
[4325]	1963
[5001]	1964	FUNCTION fgetKey(ky) RESULT(val)
	1965	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
	1966	TYPE(keys_type), INTENT(IN) :: ky(:)
	1967	LOGICAL :: ler(SIZE(ky))
	1968	INTEGER :: iq
	1969	lerr = SIZE(ky) == 0; IF(lerr) RETURN
	1970	val = [(fgetKeyIdx(iq, keyn(:), ky, ler(iq)), iq = 1, SIZE(ky))]
	1971	lerr = ANY(ler)
	1972	END FUNCTION fgetKey
[4325]	1973
[5001]	1974	END FUNCTION getKeyByIndex_smmm
[4046]	1975	!==============================================================================================================================
[5183]	1976	LOGICAL FUNCTION getKeyByIndex_immm(keyn, val, ky, def, lDisp) RESULT(lerr)
	1977	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1978	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1979	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1980	INTEGER, OPTIONAL, INTENT(IN) :: def
	1981	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4325]	1982	!------------------------------------------------------------------------------------------------------------------------------
[5001]	1983	CHARACTER(LEN=maxlen) :: s
	1984	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
	1985	LOGICAL, ALLOCATABLE :: ll(:)
[5183]	1986	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, int2str(def), lDisp)
	1987	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, lDisp=lDisp)
[5001]	1988	IF(lerr) RETURN
	1989	val = str2int(svals)
[5183]	1990	ll = val == -HUGE(1) .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
	1991	lerr = ANY(ll); IF(.NOT.lerr) RETURN
	1992	IF(getKeyByIndex_smmm(['name'], tname, ky)) RETURN
[5001]	1993	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not'
	1994	CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname, lerr)
	1995	END FUNCTION getKeyByIndex_immm
	1996	!==============================================================================================================================
[5183]	1997	LOGICAL FUNCTION getKeyByIndex_rmmm(keyn, val, ky, def, lDisp) RESULT(lerr)
	1998	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	1999	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2000	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2001	REAL, OPTIONAL, INTENT(IN) :: def
	2002	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[5001]	2003	!------------------------------------------------------------------------------------------------------------------------------
	2004	CHARACTER(LEN=maxlen) :: s
	2005	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
	2006	LOGICAL, ALLOCATABLE :: ll(:)
[5183]	2007	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, real2str(def), lDisp)
	2008	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, lDisp=lDisp)
[5001]	2009	IF(lerr) RETURN
	2010	val = str2real(svals)
[5183]	2011	ll = val == -HUGE(1.) .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
	2012	lerr = ANY(ll); IF(.NOT.lerr) RETURN
	2013	IF(getKeyByIndex_smmm(['name'], tname, ky)) RETURN
[5001]	2014	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not a'
	2015	CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
	2016	END FUNCTION getKeyByIndex_rmmm
	2017	!==============================================================================================================================
[5183]	2018	LOGICAL FUNCTION getKeyByIndex_lmmm(keyn, val, ky, def, lDisp) RESULT(lerr)
	2019	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
	2020	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2021	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2022	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2023	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[5001]	2024	!------------------------------------------------------------------------------------------------------------------------------
	2025	CHARACTER(LEN=maxlen) :: s
	2026	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
	2027	LOGICAL, ALLOCATABLE :: ll(:)
	2028	INTEGER, ALLOCATABLE :: ivals(:)
[5183]	2029	IF( PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, bool2str(def), lDisp)
	2030	IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, lDisp=lDisp)
[5001]	2031	IF(lerr) RETURN
	2032	ivals = str2bool(svals)
[5183]	2033	ll = ivals == -1 .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
	2034	lerr = ANY(ll); IF(.NOT.lerr) RETURN
	2035	IF(getKeyByIndex_smmm(['name'], tname, ky)) RETURN
[5001]	2036	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
	2037	CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
[5184]	2038	IF(.NOT.lerr) val = ivals == 1
[5001]	2039	END FUNCTION getKeyByIndex_lmmm
	2040	!==============================================================================================================================
	2041
	2042
	2043
	2044	!==============================================================================================================================
	2045	!=== GET KEYS VALUES FROM TRACERS NAMES ===
	2046	!==============================================================================================================================
	2047	!=== TRY TO GET THE KEY NAMED "key" FOR THE TRACER NAMED "tname" IN: ===
	2048	!=== * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE: ===
[5183]	2049	!=== * IN INTERNAL TRACERS DATABASE "tracers(:)" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)") ===
[5001]	2050	!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER: ===
	2051	!=== * A SCALAR ===
	2052	!=== * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR "," ===
	2053	!=== ===
	2054	!=== SYNTAX: lerr = getKeyByName_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], tname [, ky(:)][, def][, lDisp]) ===
	2055	!==============================================================================================================================
	2056	!=== IF "tname(:)" IS A VECTOR, THE RETURNED VALUES (ONE EACH "tname(:)" ELEMENT) ARE STORED IN THE VECTOR "val(:)" ===
	2057	!=== ===
	2058	!=== SYNTAX lerr = getKeyByName_{sirl}{1m}mm (keyn[(:)], val (:), tname(:)[, ky(:)][, def][, lDisp]) ===
	2059	!==============================================================================================================================
	2060	LOGICAL FUNCTION getKeyByName_s111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2061	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
	2062	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
	2063	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2064	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
	2065	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2066	lerr = getKeyByName_sm11([keyn], val, tname, ky, def, lDisp)
	2067	END FUNCTION getKeyByName_s111
	2068	!==============================================================================================================================
	2069	LOGICAL FUNCTION getKeyByName_i111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2070	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
	2071	INTEGER, INTENT(OUT) :: val
	2072	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2073	INTEGER, OPTIONAL, INTENT(IN) :: def
	2074	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2075	lerr = getKeyByName_im11([keyn], val, tname, ky, def, lDisp)
	2076	END FUNCTION getKeyByName_i111
	2077	!==============================================================================================================================
	2078	LOGICAL FUNCTION getKeyByName_r111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2079	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
	2080	REAL , INTENT(OUT) :: val
	2081	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2082	REAL, OPTIONAL, INTENT(IN) :: def
	2083	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2084	lerr = getKeyByName_rm11([keyn], val, tname, ky, def, lDisp)
	2085	END FUNCTION getKeyByName_r111
	2086	!==============================================================================================================================
	2087	LOGICAL FUNCTION getKeyByName_l111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2088	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
	2089	LOGICAL, INTENT(OUT) :: val
	2090	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2091	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2092	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2093	lerr = getKeyByName_lm11([keyn], val, tname, ky, def, lDisp)
	2094	END FUNCTION getKeyByName_l111
	2095	!==============================================================================================================================
	2096	!==============================================================================================================================
	2097	LOGICAL FUNCTION getKeyByName_sm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2098	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
	2099	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
	2100	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2101	CHARACTER(LEN=*),OPTIONAL, INTENT(IN) :: def
	2102	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2103	!------------------------------------------------------------------------------------------------------------------------------
	2104	CHARACTER(LEN=maxlen) :: s, tnam
	2105	LOGICAL :: lD
	2106	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
	2107	s = 'key "'//TRIM(strStack(keyn, '/'))//'" for "'//TRIM(tname)//'"'
	2108	lerr = .TRUE.
	2109	tnam = strHead(delPhase(tname),'_',.TRUE.) !--- Remove phase and tag
	2110	IF(lerr .AND. PRESENT(ky)) val = fgetKey(ky) !--- "ky"
[5183]	2111	IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)) !--- "tracers"
[5001]	2112	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
	2113	IF(lerr .AND. PRESENT(def)) THEN
	2114	val = def; lerr = .NOT.PRESENT(def)
	2115	CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
[4328]	2116	END IF
[5001]	2117	CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
	2118
	2119	CONTAINS
	2120
	2121	CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
	2122	TYPE(keys_type), INTENT(IN) :: ky(:)
[5183]	2123	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname_all(:)
	2124	lerr = SIZE(ky) == 0; IF(lerr) RETURN
	2125	lerr = getKey('name', tname_all, ky); IF(lerr) RETURN
	2126	val = fgetKeyIdx(strIdx(tname_all, tname), [keyn], ky, lerr)
	2127	IF(lerr) val = fgetKeyIdx(strIdx(tname_all, tnam ), [keyn], ky, lerr)
[5001]	2128	END FUNCTION fgetKey
	2129
	2130	END FUNCTION getKeyByName_sm11
[4325]	2131	!==============================================================================================================================
[5001]	2132	LOGICAL FUNCTION getKeyByName_im11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2133	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
[4046]	2134	INTEGER, INTENT(OUT) :: val
	2135	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[5001]	2136	INTEGER, OPTIONAL, INTENT(IN) :: def
	2137	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4301]	2138	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2139	CHARACTER(LEN=maxlen) :: sval, s
	2140	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
	2141	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
	2142	IF(lerr) RETURN
	2143	val = str2int(sval)
[5183]	2144	lerr = val == -HUGE(1) .AND. sval /= ''
[5001]	2145	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
	2146	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
	2147	END FUNCTION getKeyByName_im11
[4046]	2148	!==============================================================================================================================
[5001]	2149	LOGICAL FUNCTION getKeyByName_rm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2150	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
	2151	REAL , INTENT(OUT) :: val
	2152	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2153	REAL, OPTIONAL, INTENT(IN) :: def
	2154	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4301]	2155	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2156	CHARACTER(LEN=maxlen) :: sval, s
	2157	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
	2158	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
	2159	IF(lerr) RETURN
	2160	val = str2real(sval)
[5183]	2161	lerr = val == -HUGE(1.) .AND. sval /= ''
[5001]	2162	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
	2163	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
	2164	END FUNCTION getKeyByName_rm11
[4328]	2165	!==============================================================================================================================
[5001]	2166	LOGICAL FUNCTION getKeyByName_lm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2167	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
	2168	LOGICAL, INTENT(OUT) :: val
	2169	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2170	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2171	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4328]	2172	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2173	CHARACTER(LEN=maxlen) :: sval, s
	2174	INTEGER :: ival
	2175	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
	2176	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
	2177	IF(lerr) RETURN
	2178	ival = str2bool(sval)
[5183]	2179	lerr = ival == -1 .AND. sval /= ''
[5001]	2180	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
	2181	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
	2182	IF(.NOT.lerr) val = ival == 1
	2183	END FUNCTION getKeyByName_lm11
[4046]	2184	!==============================================================================================================================
[5001]	2185	!==============================================================================================================================
	2186	LOGICAL FUNCTION getKeyByName_s1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2187	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
	2188	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	2189	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2190	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	2191	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4325]	2192	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2193	CHARACTER(LEN=maxlen) :: sval
	2194	lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
	2195	lerr = strParse(sval, ',', val)
	2196	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	2197	END FUNCTION getKeyByName_s1m1
[4325]	2198	!==============================================================================================================================
[5001]	2199	LOGICAL FUNCTION getKeyByName_i1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2200	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
	2201	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
[4046]	2202	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[5001]	2203	INTEGER, OPTIONAL, INTENT(IN) :: def
	2204	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4301]	2205	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2206	CHARACTER(LEN=maxlen) :: sval, s
	2207	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2208	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, int2str(def), lDisp)
	2209	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
	2210	IF(lerr) RETURN
	2211	lerr = strParse(sval, ',', svals)
	2212	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	2213	val = str2int(svals)
[5183]	2214	lerr = ANY(val == -HUGE(1)) .AND. sval /= ''
[5001]	2215	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
	2216	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
	2217	END FUNCTION getKeyByName_i1m1
[4046]	2218	!==============================================================================================================================
[5001]	2219	LOGICAL FUNCTION getKeyByName_r1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2220	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
	2221	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2222	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2223	REAL, OPTIONAL, INTENT(IN) :: def
	2224	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4301]	2225	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2226	CHARACTER(LEN=maxlen) :: sval, s
	2227	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2228	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, real2str(def), lDisp)
	2229	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
	2230	IF(lerr) RETURN
	2231	lerr = strParse(sval, ',', svals)
	2232	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	2233	val = str2real(svals)
[5183]	2234	lerr = ANY(val == -HUGE(1.)) .AND. sval /= ''
[5001]	2235	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
	2236	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
	2237	END FUNCTION getKeyByName_r1m1
[4328]	2238	!==============================================================================================================================
[5001]	2239	LOGICAL FUNCTION getKeyByName_l1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2240	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname
	2241	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2242	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2243	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2244	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4328]	2245	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2246	CHARACTER(LEN=maxlen) :: sval, s
	2247	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2248	INTEGER, ALLOCATABLE :: ivals(:)
	2249	IF( PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, bool2str(def), lDisp)
	2250	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
	2251	IF(lerr) RETURN
	2252	lerr = strParse(sval, ',', svals)
	2253	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	2254	ivals = str2bool(svals)
[5183]	2255	lerr = ANY(ivals == -1) .AND. sval /= ''
[5001]	2256	s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
	2257	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
	2258	IF(.NOT.lerr) val = ivals == 1
	2259	END FUNCTION getKeyByName_l1m1
[4046]	2260	!==============================================================================================================================
[5001]	2261	!==============================================================================================================================
	2262	LOGICAL FUNCTION getKeyByName_smm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2263	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
	2264	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	2265	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2266	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	2267	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4328]	2268	!------------------------------------------------------------------------------------------------------------------------------
[5003]	2269	CHARACTER(LEN=maxlen) :: sval
[5001]	2270	lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
	2271	lerr = strParse(sval, ',', val)
	2272	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	2273	END FUNCTION getKeyByName_smm1
[4328]	2274	!==============================================================================================================================
[5001]	2275	LOGICAL FUNCTION getKeyByName_imm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2276	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
	2277	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
[4328]	2278	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[5001]	2279	INTEGER, OPTIONAL, INTENT(IN) :: def
	2280	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4328]	2281	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2282	CHARACTER(LEN=maxlen) :: sval, s
	2283	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2284	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
	2285	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
	2286	IF(lerr) RETURN
	2287	lerr = strParse(sval, ',', svals)
	2288	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	2289	val = str2int(svals)
[5183]	2290	lerr = ANY(val == -HUGE(1)) .AND. sval /= ''
[5001]	2291	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
	2292	CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
	2293	END FUNCTION getKeyByName_imm1
[4328]	2294	!==============================================================================================================================
[5001]	2295	LOGICAL FUNCTION getKeyByName_rmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2296	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
	2297	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2298	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2299	REAL, OPTIONAL, INTENT(IN) :: def
	2300	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4325]	2301	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2302	CHARACTER(LEN=maxlen) :: sval, s
	2303	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2304	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
	2305	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
	2306	IF(lerr) RETURN
	2307	lerr = strParse(sval, ',', svals)
	2308	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	2309	val = str2real(svals)
[5183]	2310	lerr = ANY(val == -HUGE(1.)) .AND. sval /= ''
[5001]	2311	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
	2312	CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
	2313	END FUNCTION getKeyByName_rmm1
[4325]	2314	!==============================================================================================================================
[5001]	2315	LOGICAL FUNCTION getKeyByName_lmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2316	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname
	2317	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2318	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2319	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2320	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4328]	2321	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2322	CHARACTER(LEN=maxlen) :: sval, s
	2323	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2324	INTEGER, ALLOCATABLE :: ivals(:)
	2325	IF( PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
	2326	IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
	2327	IF(lerr) RETURN
	2328	lerr = strParse(sval, ',', svals)
	2329	IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
	2330	ivals = str2bool(svals)
[5183]	2331	lerr = ANY(ivals == -1) .AND. sval /= ''
[5001]	2332	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
	2333	CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
	2334	IF(.NOT.lerr) val = ivals == 1
	2335	END FUNCTION getKeyByName_lmm1
[4328]	2336	!==============================================================================================================================
[5001]	2337	!==============================================================================================================================
	2338	LOGICAL FUNCTION getKeyByName_s1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2339	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
	2340	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	2341	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2342	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	2343	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2344	lerr = getKeyByName_smmm([keyn], val, tname, ky, def, lDisp)
	2345	END FUNCTION getKeyByName_s1mm
	2346	!==============================================================================================================================
	2347	LOGICAL FUNCTION getKeyByName_i1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2348	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
	2349	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	2350	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2351	INTEGER, OPTIONAL, INTENT(IN) :: def
	2352	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2353	lerr = getKeyByName_immm([keyn], val, tname, ky, def, lDisp)
	2354	END FUNCTION getKeyByName_i1mm
	2355	!==============================================================================================================================
	2356	LOGICAL FUNCTION getKeyByName_r1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2357	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
	2358	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2359	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2360	REAL, OPTIONAL, INTENT(IN) :: def
	2361	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2362	lerr = getKeyByName_rmmm([keyn], val, tname, ky, def, lDisp)
	2363	END FUNCTION getKeyByName_r1mm
	2364	!==============================================================================================================================
	2365	LOGICAL FUNCTION getKeyByName_l1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2366	CHARACTER(LEN=*), INTENT(IN) :: keyn, tname(:)
	2367	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2368	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2369	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2370	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2371	lerr = getKeyByName_lmmm([keyn], val, tname, ky, def, lDisp)
	2372	END FUNCTION getKeyByName_l1mm
	2373	!==============================================================================================================================
	2374	!==============================================================================================================================
	2375	LOGICAL FUNCTION getKeyByName_smmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2376	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
	2377	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
	2378	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2379	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	2380	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4328]	2381	!------------------------------------------------------------------------------------------------------------------------------
[5001]	2382	CHARACTER(LEN=maxlen) :: s
[4363]	2383	INTEGER :: iq, nq
[5001]	2384	LOGICAL :: lD
	2385	nq = SIZE(tname); ALLOCATE(val(nq))
	2386	lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
	2387	s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
	2388	lerr = .TRUE.
	2389	IF(PRESENT(ky)) THEN; val = fgetKey(ky) !--- "ky"
[5183]	2390	ELSE IF(ALLOCATED(tracers)) THEN; val = fgetKey(tracers(:)) !--- "tracers"
[5001]	2391	IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:)) !--- "isotope"
	2392	END IF
	2393	IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
	2394
	2395	!--- DEFAULT VALUE
	2396	val = [(def, iq = 1, SIZE(tname))]
	2397	CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD)
	2398
	2399	CONTAINS
	2400
	2401	FUNCTION fgetKey(ky) RESULT(val)
	2402	CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
	2403	TYPE(keys_type), INTENT(IN) :: ky(:)
	2404	LOGICAL, ALLOCATABLE :: ler(:)
[5183]	2405	CHARACTER(LEN=maxlen), ALLOCATABLE :: tname_all(:)
	2406	lerr = SIZE(ky) == 0; IF(lerr) RETURN
	2407	lerr = getKey('name', tname_all, ky); IF(lerr) RETURN
[5001]	2408	ALLOCATE(ler(SIZE(tname)))
[5183]	2409	val = [(fgetKeyIdx(strIdx(tname_all, tname(iq)), keyn, ky, ler(iq)), iq = 1, SIZE(tname))]
[5001]	2410	lerr = ANY(ler)
	2411	END FUNCTION fgetKey
	2412
	2413	END FUNCTION getKeyByName_smmm
[4328]	2414	!==============================================================================================================================
[5001]	2415	LOGICAL FUNCTION getKeyByName_immm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2416	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
	2417	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	2418	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2419	INTEGER, OPTIONAL, INTENT(IN) :: def
	2420	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2421	!------------------------------------------------------------------------------------------------------------------------------
	2422	CHARACTER(LEN=maxlen) :: s
	2423	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2424	LOGICAL, ALLOCATABLE :: ll(:)
	2425	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, int2str(def), lDisp)
	2426	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
	2427	IF(lerr) RETURN
	2428	val = str2int(svals)
[5183]	2429	ll = val == -HUGE(1) .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
[5001]	2430	lerr = ANY(ll); IF(.NOT.lerr) RETURN
	2431	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
	2432	CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname)
	2433	END FUNCTION getKeyByName_immm
	2434	!==============================================================================================================================
	2435	LOGICAL FUNCTION getKeyByName_rmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2436	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
	2437	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2438	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2439	REAL, OPTIONAL, INTENT(IN) :: def
	2440	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2441	!------------------------------------------------------------------------------------------------------------------------------
	2442	CHARACTER(LEN=maxlen) :: s
	2443	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2444	LOGICAL, ALLOCATABLE :: ll(:)
	2445	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, real2str(def), lDisp)
	2446	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
	2447	IF(lerr) RETURN
	2448	val = str2real(svals)
[5183]	2449	ll = val == -HUGE(1.) .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
[5001]	2450	lerr = ANY(ll); IF(.NOT.lerr) RETURN
	2451	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
	2452	CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
	2453	END FUNCTION getKeyByName_rmmm
	2454	!==============================================================================================================================
	2455	LOGICAL FUNCTION getKeyByName_lmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
	2456	CHARACTER(LEN=*), INTENT(IN) :: keyn(:), tname(:)
	2457	LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	2458	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	2459	LOGICAL, OPTIONAL, INTENT(IN) :: def
	2460	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	2461	!------------------------------------------------------------------------------------------------------------------------------
[5003]	2462	CHARACTER(LEN=maxlen) :: s
[5001]	2463	CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
	2464	LOGICAL, ALLOCATABLE :: ll(:)
	2465	INTEGER, ALLOCATABLE :: ivals(:)
	2466	IF( PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, bool2str(def), lDisp)
	2467	IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
	2468	IF(lerr) RETURN
	2469	ivals = str2bool(svals)
[5183]	2470	ll = ivals == -1 .AND. (SIZE(svals) /=1 .OR. svals(1) /= '')
[5001]	2471	lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; RETURN; END IF
	2472	s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
	2473	CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
	2474	END FUNCTION getKeyByName_lmmm
	2475	!==============================================================================================================================
[4046]	2476
	2477
	2478	!==============================================================================================================================
[4325]	2479	!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
	2480	!==============================================================================================================================
	2481	SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
[5183]	2482	TYPE(keys_type), OPTIONAL, INTENT(IN) :: tracers_(:)
[4325]	2483	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
	2484	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
	2485	!------------------------------------------------------------------------------------------------------------------------------
	2486	TYPE(isot_type), ALLOCATABLE :: iso(:)
	2487	INTEGER :: ix, nbIso
	2488	IF(PRESENT( tracers_)) THEN; tracers = tracers_; ELSE; ALLOCATE( tracers(0)); END IF
	2489	IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
	2490	IF(PRESENT(isotope_ )) THEN
[5183]	2491	ix = strIdx(isotopes(:)%name, isotope_%name)
[4325]	2492	IF(ix /= 0) THEN
	2493	isotopes(ix) = isotope_
	2494	ELSE
	2495	nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
	2496	CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
	2497	END IF
	2498	END IF
	2499	END SUBROUTINE setKeysDBase
	2500	!==============================================================================================================================
	2501	SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
[5183]	2502	TYPE(keys_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: tracers_(:)
[4325]	2503	TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
	2504	TYPE(isot_type), OPTIONAL, INTENT(OUT) :: isotope_
	2505	!------------------------------------------------------------------------------------------------------------------------------
	2506	INTEGER :: ix
	2507	IF(PRESENT( tracers_)) THEN; tracers_ = tracers; ELSE; ALLOCATE( tracers_(0)); END IF
	2508	IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
[5183]	2509	IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%name, isotope%name); IF(ix /= 0) isotope_=isotopes(ix); END IF
[4325]	2510	END SUBROUTINE getKeysDBase
	2511	!==============================================================================================================================
	2512
	2513
	2514	!==============================================================================================================================
[4046]	2515	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
	2516	!==============================================================================================================================
	2517	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
[4325]	2518	CHARACTER(LEN=*), INTENT(IN) :: s
[4301]	2519	!------------------------------------------------------------------------------------------------------------------------------
	2520	INTEGER :: ix, ip, ns
	2521	out = s; ns = LEN_TRIM(s)
[4394]	2522	IF(s == '' .OR. ns<=2) RETURN !--- Empty string or LEN(name)<=2: nothing to do
[4301]	2523	IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
	2524	out='H2O'//s(5:ns) !--- H2O<phase>[_<iso>][_<tag>]
	2525	ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
	2526	out = s(1:ns-2); RETURN !--- <var><phase_sep><phase>
	2527	ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
	2528	IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns) !--- <var><phase_sep><phase>_<tag>
[4046]	2529	END IF
	2530	END FUNCTION delPhase
[4301]	2531	!==============================================================================================================================
[4120]	2532	CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
[4063]	2533	CHARACTER(LEN=*), INTENT(IN) :: s
	2534	CHARACTER(LEN=1), INTENT(IN) :: pha
[4301]	2535	!------------------------------------------------------------------------------------------------------------------------------
[4046]	2536	INTEGER :: l, i
	2537	out = s
	2538	IF(s == '') RETURN !--- Empty string: nothing to do
	2539	i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names
	2540	l = LEN_TRIM(s)
[4120]	2541	IF(i == 0) out = TRIM(s)//phases_sep//pha !--- <var> => return <var><sep><pha>
	2542	IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>
	2543	END FUNCTION addPhase_s1
[4301]	2544	!==============================================================================================================================
[4120]	2545	FUNCTION addPhase_sm(s,pha) RESULT(out)
[4063]	2546	CHARACTER(LEN=*), INTENT(IN) :: s(:)
	2547	CHARACTER(LEN=1), INTENT(IN) :: pha
	2548	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
[4301]	2549	!------------------------------------------------------------------------------------------------------------------------------
[4046]	2550	INTEGER :: k
[4120]	2551	out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
	2552	END FUNCTION addPhase_sm
[4301]	2553	!==============================================================================================================================
[4120]	2554	CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
	2555	CHARACTER(LEN=*), INTENT(IN) :: s
	2556	INTEGER, INTENT(IN) :: ipha
	2557	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
[4301]	2558	!------------------------------------------------------------------------------------------------------------------------------
[4120]	2559	out = s
	2560	IF(s == '') RETURN !--- Empty string: nothing to do
[4301]	2561	IF(ipha == 0 .OR. ipha > nphases) RETURN !--- Absurd index: no phase to add
[4120]	2562	IF( PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha))
	2563	IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
	2564	END FUNCTION addPhase_i1
[4301]	2565	!==============================================================================================================================
[4120]	2566	FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
	2567	CHARACTER(LEN=*), INTENT(IN) :: s(:)
	2568	INTEGER, INTENT(IN) :: ipha
	2569	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
	2570	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
[4301]	2571	!------------------------------------------------------------------------------------------------------------------------------
[4120]	2572	INTEGER :: k
	2573	IF( PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, phases), k=1, SIZE(s) )]
	2574	IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
	2575	END FUNCTION addPhase_im
[4301]	2576	!==============================================================================================================================
[4046]	2577
	2578
[4120]	2579	!==============================================================================================================================
[4987]	2580	!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
	2581	!==============================================================================================================================
[5001]	2582	LOGICAL FUNCTION addTracer_1(tname, keys, tracs) RESULT(lerr)
[4987]	2583	CHARACTER(LEN=*), INTENT(IN) :: tname
	2584	TYPE(keys_type), INTENT(IN) :: keys
[5183]	2585	TYPE(keys_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
	2586	TYPE(keys_type), ALLOCATABLE :: tr(:)
[5001]	2587	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
[4987]	2588	INTEGER :: nt, ix
	2589	IF(ALLOCATED(tracs)) THEN
[5183]	2590	lerr = getKey('name', tnames, ky=tracs(:)); IF(lerr) RETURN
[4987]	2591	nt = SIZE(tracs)
[5001]	2592	ix = strIdx(tnames, tname)
[4987]	2593	CALL msg('Modifying existing tracer "'//TRIM(tname)//'"', modname, ix /= 0)
	2594	CALL msg('Appending with tracer "' //TRIM(tname)//'"', modname, ix == 0)
	2595	IF(ix == 0) THEN
	2596	ix = nt+1; ALLOCATE(tr(nt+1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
	2597	END IF
	2598	ELSE
	2599	CALL msg('Creating a tracer descriptor with tracer "'//TRIM(tname)//'"', modname)
	2600	ix = 1; ALLOCATE(tracs(1))
	2601	END IF
[5183]	2602	CALL addKey('name', tname, tracs(ix))
	2603	tracs(ix) = keys
[5001]	2604
	2605	END FUNCTION addTracer_1
[4987]	2606	!==============================================================================================================================
[5001]	2607	LOGICAL FUNCTION addTracer_1def(tname, keys) RESULT(lerr)
[4987]	2608	CHARACTER(LEN=*), INTENT(IN) :: tname
	2609	TYPE(keys_type), INTENT(IN) :: keys
[5001]	2610	lerr = addTracer_1(tname, keys, tracers)
	2611	END FUNCTION addTracer_1def
[4987]	2612	!==============================================================================================================================
	2613
	2614
	2615	!==============================================================================================================================
[5001]	2616	LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
[4987]	2617	CHARACTER(LEN=*), INTENT(IN) :: tname
[5183]	2618	TYPE(keys_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
	2619	TYPE(keys_type), ALLOCATABLE :: tr(:)
[5001]	2620	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
[4987]	2621	INTEGER :: nt, ix
	2622	lerr = .NOT.ALLOCATED(tracs)
	2623	IF(fmsg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr)) RETURN
	2624	nt = SIZE(tracs)
[5183]	2625	lerr = getKey('name', tnames, ky=tracs(:)); IF(lerr) RETURN
[5001]	2626	ix = strIdx(tnames, tname)
[4987]	2627	CALL msg('Removing tracer "' //TRIM(tname)//'"', modname, ix /= 0)
	2628	CALL msg('Can''t remove unknown tracer "'//TRIM(tname)//'"', modname, ix == 0)
	2629	IF(ix /= 0) THEN
	2630	ALLOCATE(tr(nt-1)); tr(1:ix-1) = tracs(1:ix-1); tr(ix:nt-1) = tracs(ix+1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
	2631	END IF
	2632	END FUNCTION delTracer_1
	2633	!==============================================================================================================================
	2634	LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
	2635	CHARACTER(LEN=*), INTENT(IN) :: tname
	2636	lerr = delTracer(tname, tracers)
	2637	END FUNCTION delTracer_1def
	2638	!==============================================================================================================================
	2639
	2640
	2641	!==============================================================================================================================
[4120]	2642	!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
	2643	!==============================================================================================================================
	2644	INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
	2645	CHARACTER(LEN=*), INTENT(IN) :: tname
	2646	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
[4301]	2647	!------------------------------------------------------------------------------------------------------------------------------
[4120]	2648	CHARACTER(LEN=maxlen) :: phase
	2649	IF( PRESENT(phases)) phase = getPhase(tname, phases, iPhase)
	2650	IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
	2651	END FUNCTION getiPhase
[4301]	2652	!==============================================================================================================================
[4120]	2653	CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
	2654	CHARACTER(LEN=*), INTENT(IN) :: tname
	2655	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
	2656	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
[4301]	2657	!------------------------------------------------------------------------------------------------------------------------------
[4120]	2658	INTEGER :: ip
[4403]	2659	phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.)) !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
[4120]	2660	IF( PRESENT(phases)) ip = INDEX( phases, phase)
	2661	IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
	2662	IF(ip == 0) phase = 'g'
	2663	IF(PRESENT(iPhase)) iPhase = ip
	2664	END FUNCTION getPhase
[4301]	2665	!==============================================================================================================================
[4067]	2666
[4120]	2667
[4301]	2668	!==============================================================================================================================
[5183]	2669	!======== CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION & VICE VERSA ; OTHER NAMES ARE LEFT UNTOUCHED =========
	2670	!===== OLD NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ==
	2671	!==== NEW NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var>='H2O' or from "newH2OIso") ==
[4301]	2672	!==============================================================================================================================
	2673	CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
[4120]	2674	CHARACTER(LEN=*), INTENT(IN) :: oldName
	2675	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
[4301]	2676	!------------------------------------------------------------------------------------------------------------------------------
[4120]	2677	CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
[4301]	2678	INTEGER :: ix, ip, nt
	2679	LOGICAL :: lerr
[4120]	2680	newName = oldName
	2681	IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase
[4348]	2682	lerr = strParse(oldName, '_', tmp, nt) !--- Parsing: 1 up to 3 elements.
[4301]	2683	ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) ) !--- Phase index
	2684	IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index
	2685	IF(ip == 0 .AND. tmp(1) /= 'H2O') RETURN !--- Not an old-style water-related species
	2686	IF(nt == 1) THEN
	2687	newName = addPhase('H2O',ip) !=== WATER WITH OR WITHOUT PHASE
	2688	ELSE
	2689	ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list
[4403]	2690	IF(ix /= 0) newName = newH2OIso(ix) !--- Move to new isotope name
	2691	IF(ip /= 0) newName = addPhase(newName, ip) !--- Add phase to isotope name
	2692	IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3)) !=== WATER ISOTOPE OR TAGGING TRACER
[4140]	2693	END IF
[4301]	2694	END FUNCTION old2newH2O_1
	2695	!==============================================================================================================================
	2696	FUNCTION old2newH2O_m(oldName) RESULT(newName)
	2697	CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
	2698	CHARACTER(LEN=maxlen) :: newName(SIZE(oldName))
[4120]	2699	!------------------------------------------------------------------------------------------------------------------------------
	2700	INTEGER :: i
[4301]	2701	newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
	2702	END FUNCTION old2newH2O_m
	2703	!==============================================================================================================================
	2704	CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
	2705	CHARACTER(LEN=*), INTENT(IN) :: newName
	2706	INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
[4120]	2707	!------------------------------------------------------------------------------------------------------------------------------
[4301]	2708	INTEGER :: ix, ip
	2709	CHARACTER(LEN=maxlen) :: var
	2710	oldName = newName
[4120]	2711	ip = getiPhase(newName) !--- Phase index
[4403]	2712	IF(PRESENT(iPhase)) iPhase = MAX(ip, 1) !--- Return phase index ; default: 1 (gazeous)
	2713	var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Variable without phase and tag
[4301]	2714	ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list
[4403]	2715	IF(ix == 0 .AND. var /= 'H2O') RETURN !--- Neither H2O nor an H2O isotope => finished
	2716	oldName = 'H2O'
	2717	IF(ip /= 0) oldName = TRIM(oldName)//old_phases(ip:ip) !--- Add phase if needed
	2718	IF(ix /= 0) oldName = TRIM(oldName)//'_'//oldH2OIso(ix) !--- H2O isotope name
	2719	IF(newName /= addPhase(var, ip)) &
	2720	oldName = TRIM(oldName)//strTail(newName, '_', .TRUE.) !--- Add the tag suffix
	2721	IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_') !--- Isotope with no phase: remove 'H2O_' prefix
[4301]	2722	END FUNCTION new2oldH2O_1
	2723	!==============================================================================================================================
	2724	FUNCTION new2oldH2O_m(newName) RESULT(oldName)
	2725	CHARACTER(LEN=*), INTENT(IN) :: newName(:)
	2726	CHARACTER(LEN=maxlen) :: oldName(SIZE(newName))
[4120]	2727	!------------------------------------------------------------------------------------------------------------------------------
	2728	INTEGER :: i
[4301]	2729	oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
	2730	END FUNCTION new2oldH2O_m
	2731	!==============================================================================================================================
[4120]	2732
[4046]	2733	END MODULE readTracFiles_mod

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

Download in other formats:

Original Format