Context Navigation

readTracFiles_mod.f90 @ 5787

Last change on this file since 5787 was 5771, checked in by dcugnet, 4 months ago
fix: implicit iqParent was badly defined and explicit iqParent was not defined removs nCmx=48 (added to test a routine but left by mistake in the code)
File size: 175.9 KB

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

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

Download in other formats:

Original Format