Context Navigation

readTracFiles_mod.f90 @ 5097

Last change on this file since 5097 was 4727, checked in by idelkadi, 13 months ago
Merged trunk changes -r4488:4726 LMDZ_ECRad branch
File size: 129.4 KB

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

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

Download in other formats:

Original Format