Context Navigation

source: readTracFiles_mod.f90 @ 12

Last change on this file since 12 was 12, checked in by dcugnet, 3 years ago
Fix in sortTracers New version of the addPhase routine taking the phase index as a second argument instead of the phase itself.
File size: 90.2 KB

Rev	Line
[1]	1	MODULE readTracFiles_mod
	2
[6]	3	USE strings_mod, ONLY: msg, testFile, strFind, strStack, strReduce, strHead, strCount, find, maxlen, fmsg, &
	4	removeComment, cat, checkList, strIdx, strParse, strReplace, strTail, reduceExpr, test, get_in, dispTable
	5	USE trac_types_mod, ONLY: trac_type, isot_type, keys_type
[1]	6
	7	IMPLICIT NONE
	8
	9	PRIVATE
	10
[6]	11	PUBLIC :: initIsotopes, maxlen, trac_type, isot_type, keys_type
	12	PUBLIC :: readTracersFiles, indexUpdate, setGeneration !--- TOOLS ASSOCIATED TO TRACERS DESCRIPTORS
[2]	13	PUBLIC :: readIsotopesFile !--- TOOLS ASSOCIATED TO ISOTOPES DESCRIPTORS
	14	PUBLIC :: getKey_init, getKey, setDirectKeys !--- GET/SET KEYS FROM/TO tracers & isotopes
[1]	15
[2]	16	PUBLIC :: known_phases, old_phases, nphases, phases_names, & !--- VARIABLES RELATED TO THE PHASES
[7]	17	phases_sep, delPhase, addPhase, & !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
	18	old2newPhase, new2oldPhase
[1]	19
[2]	20	PUBLIC :: tran0, idxAncestor, ancestor !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
[1]	21
	22	!------------------------------------------------------------------------------------------------------------------------------
[2]	23	TYPE :: dataBase_type !=== TYPE FOR TRACERS SECTION
	24	CHARACTER(LEN=maxlen) :: name !--- Section name
	25	TYPE(trac_type), ALLOCATABLE :: trac(:) !--- Tracers descriptors
	26	END TYPE dataBase_type
[1]	27	!------------------------------------------------------------------------------------------------------------------------------
	28	INTERFACE getKey
	29	MODULE PROCEDURE getKeyByName_s1, getKeyByName_i1, getKeyByName_r1, getKeyByName_sm, getKeyByName_im, getKeyByName_rm
	30	END INTERFACE getKey
	31	!------------------------------------------------------------------------------------------------------------------------------
[2]	32	INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
[1]	33	INTERFACE idxAncestor; MODULE PROCEDURE idxAncestor_1, idxAncestor_m; END INTERFACE idxAncestor
	34	INTERFACE ancestor; MODULE PROCEDURE ancestor_1, ancestor_m; END INTERFACE ancestor
[12]	35	INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase
[1]	36	!------------------------------------------------------------------------------------------------------------------------------
	37
	38	!=== MAIN DATABASE: files sections descriptors
[2]	39	TYPE(dataBase_type), SAVE, ALLOCATABLE, TARGET :: dBase(:)
[1]	40
	41	!--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
[2]	42	CHARACTER(LEN=maxlen), SAVE :: tran0 = 'air' !--- Default transporting fluid
[11]	43	CHARACTER(LEN=maxlen), PARAMETER :: old_phases = 'vlir' !--- Old phases for water (no separator)
	44	CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr' !--- Known phases initials
[2]	45	INTEGER, PARAMETER :: nphases=LEN_TRIM(known_phases) !--- Number of phases
	46	CHARACTER(LEN=maxlen), SAVE :: phases_names(nphases) & !--- Known phases names
[11]	47	= ['gaseous', 'liquid ', 'solid ', 'cloud ']
[6]	48	CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator
	49	LOGICAL, SAVE :: tracs_merge = .TRUE. !--- Merge/stack tracers lists
	50	LOGICAL, SAVE :: lSortByGen = .TRUE. !--- Sort by growing generation
[1]	51
	52	!=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
[2]	53	TYPE(trac_type), ALLOCATABLE, TARGET, SAVE :: tracers(:)
	54	TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
[1]	55
[2]	56	CHARACTER(LEN=maxlen) :: modname
[1]	57
	58	CONTAINS
	59
	60	!==============================================================================================================================
	61	!==============================================================================================================================
	62	!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
	63	!=== THE RETURN VALUE fType DEPENDS ON WHAT IS FOUND:
	64	!=== 0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
	65	!=== 1: AN "OLD STYLE" TRACERS FILE "traceur.def":
	66	!=== First line: <nb tracers> Other lines: <hadv> <vadv> <tracer name> [<parent name>]
	67	!=== 2: A "NEW STYLE" TRACERS FILE "tracer.def" WITH SEVERAL SECTIONS.
	68	!=== 3: SEVERAL " " TRACERS FILES "tracer_<component>.def" WITH A SINGLE SECTION IN EACH.
	69	!=== REMARKS:
	70	!=== * EACH SECTION BEGINS WITH A "&<section name> LINE
	71	!=== * DEFAULT VALUES FOR ALL THE SECTIONS OF THE FILE ARE DEFINED IN THE SPECIAL SECTION "&default"
	72	!=== * EACH SECTION LINE HAS THE STRUCTURE: <name(s)> <key1>=<value1> <key2>=<value2> ...
	73	!=== * SO FAR, THE DEFINED KEYS ARE: parent, phases, hadv, vadv, type
	74	!=== * <name> AND <parent> CAN BE LISTS OF COMA-SEPARATED TRACERS ; THE ROUTINE EXPAND THESE FACTORIZATIONS.
	75	!=== FUNCTION RETURN VALUE "lerr" IS FALSE IN CASE SOMETHING WENT WRONG.
	76	!=== ABOUT THE KEYS:
[2]	77	! * The "keys" component (of type keys_type) is in principle enough to store everything we could need.
[1]	78	! But some variables are stored as direct-access keys to make the code more readable and because they are used often.
[6]	79	! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now).
[1]	80	! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)"
[6]	81	! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen).
[1]	82	! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
	83	!==============================================================================================================================
	84	LOGICAL FUNCTION readTracersFiles(type_trac, fType, tracs) RESULT(lerr)
	85	!------------------------------------------------------------------------------------------------------------------------------
[2]	86	CHARACTER(LEN=*), INTENT(IN) :: type_trac !--- List of components used
	87	INTEGER, INTENT(OUT) :: fType !--- Type of input file found
	88	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:)
	89	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:)
[6]	90	CHARACTER(LEN=maxlen) :: str, fname, mesg, oldH2O, newH2O
	91	INTEGER :: is, nsec, ierr, it, ntrac, ns, ip, ix
[2]	92	LOGICAL, ALLOCATABLE :: ll(:), lGen3(:)
[1]	93	!------------------------------------------------------------------------------------------------------------------------------
	94	lerr = .FALSE.
[2]	95	modname = 'readTracersFiles'
[1]	96	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
	97
	98	!--- Required sections + corresponding files names (new style single section case)
	99	IF(test(strParse(type_trac, ',', sections), lerr)) RETURN !--- Parse "type_trac" list
	100
	101	nsec = SIZE(sections, DIM=1)
	102	ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
	103
	104	!--- LOOK AT AVAILABLE FILES
	105	ll = .NOT.testFile(trac_files)
	106	fType = 0
	107	IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1 !--- OLD STYLE FILE
	108	IF(.NOT.testFile('tracer.def')) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS
	109	IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
	110	IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES
	111	IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
	112	END IF
	113
[6]	114	!--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
	115	IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = SIZE(sections)>1 .AND. fType==1), lerr)) RETURN
	116
[1]	117	!--- TELLS WHAT WAS IS ABOUT TO BE USED
[2]	118	IF (fmsg('No adequate tracers description file(s) found ; default values will be used', modname, fType==0)) RETURN
	119	CALL msg('Trying to read old-style tracers description file "traceur.def"', modname, fType==1)
	120	CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"', modname, fType==2)
	121	CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
[1]	122
	123	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[6]	124	SELECT CASE(fType) !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys
[1]	125	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[6]	126	CASE(1) !=== OLD FORMAT "traceur.def"
	127	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	128	!--- OPEN THE "traceur.def" FILE
	129	OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr)
[1]	130
[6]	131	!--- GET THE TRACERS NUMBER
	132	READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers
	133	IF(test(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, ierr /= 0), lerr)) RETURN
[1]	134
[6]	135	!--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
	136	ALLOCATE(tracs(ntrac))
	137	DO it=1,ntrac !=== READ RAW DATA: loop on the line/tracer number
	138	READ(90,'(a)',IOSTAT=ierr) str
	139	IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN
	140	IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN
	141	ll = strParse(str, ' ', s, n=ns)
	142	CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1)
	143	CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
	144	tracs(it)%name = TRIM(s(3)) !--- Set %name: name of the tracer
	145	tracs(it)%parent = tran0 !--- Set %parent: transporting fluid
	146	IF(ns == 4) tracs(it)%parent = s(4) !--- default: 'air' or defined in the file
	147	tracs(it)%phase = known_phases(1:1) !--- Set %phase: tracer phase (default: "g"azeous)
	148	tracs(it)%component = TRIM(type_trac) !--- Set %component: model component name
	149	tracs(it)%keys%key = ['hadv', 'vadv'] !--- Set %keys%key
	150	tracs(it)%keys%val = s(1:2) !--- Set %keys%val
	151	END DO
	152	CLOSE(90)
[1]	153	DO ip = 1, nphases !--- Deal with old water names
[12]	154	oldH2O = addPhase('H2O', ip, '')
	155	newH2O = addPhase('H2O', ip)
[6]	156	ix = strIdx(tracs(:)%name, oldH2O)
	157	IF(ix == 0) CYCLE
	158	tracs(ix)%name = newH2O !--- Set %name: name of the tracer
	159	WHERE(tracs(:)%parent == oldH2O) tracs(:)%parent = newH2O !--- Set %parent: transporting fluid
	160	tracs(ix)%phase = known_phases(ip:ip) !--- Set %phase: tracer phase
[1]	161	END DO
[6]	162	CALL setGeneration(tracs) !--- Set %iGeneration and %gen0Name
	163	WHERE(tracs%iGeneration == 3) tracs%type = 'tag' !--- Set %type: 'tracer' or 'tag'
	164	IF(test(checkTracers(tracs, fname, fname), lerr)) RETURN !--- Detect orphans and check phases
	165	IF(test(checkUnique (tracs, fname, fname), lerr)) RETURN !--- Detect repeated tracers
	166	CALL sortTracers (tracs) !--- Sort the tracers
	167	tracs(:)%keys%name = tracs(:)%name !--- Copy tracers names in keys components
	168	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	169	CASE(2); IF(test(feedDBase(["tracer.def"],[type_trac]), lerr)) RETURN !=== SINGLE FILE, COMA-SEPARATED SECTIONS LIST
	170	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	171	CASE(3); IF(test(feedDBase( trac_files , sections ), lerr)) RETURN !=== MULTIPLE FILES, ONE SECTION EACH FILE
[1]	172	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[6]	173	END SELECT
[1]	174	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	175
[6]	176	IF(ANY([2,3] == fType) .AND. nsec > 1) THEN
	177	IF(tracs_merge) THEN
	178	CALL msg('The multiple required sections will be MERGED.', modname)
	179	IF(test(mergeTracers(dBase, tracs), lerr)) RETURN
	180	ELSE
	181	CALL msg('The multiple required sections will be CUMULATED.', modname)
	182	IF(test(cumulTracers(dBase, tracs), lerr)) RETURN
	183	END IF
[10]	184	WHERE(tracs%gen0Name(1:3) /= 'H2O') tracs%isInPhysics=.TRUE. !--- Set %isInPhysics: passed to physics
[6]	185	CALL setDirectKeys(tracs) !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
	186	END IF
[1]	187
	188	END FUNCTION readTracersFiles
	189	!==============================================================================================================================
	190
	191	!==============================================================================================================================
	192	LOGICAL FUNCTION feedDBase(fnames, snames) RESULT(lerr)
	193	! Purpose: Read the sections "snames(is)" (coma-separated list) from each "fnames(is)"
	194	! file and create the corresponding tracers set descriptors in the database "dBase":
	195	! * dBase(id)%name : section name
	196	! * dBase(id)%trac(:)%name : tracers names
	197	! * dBase(id)%trac(it)%keys%key(:): names of keys associated to tracer dBase(id)%trac(it)%name
	198	! * dBase(id)%trac(it)%keys%val(:): values of keys associated to tracer dBase(id)%trac(it)%name
	199	!------------------------------------------------------------------------------------------------------------------------------
	200	CHARACTER(LEN=*), INTENT(IN) :: fnames(:) !--- Files names
	201	CHARACTER(LEN=*), INTENT(IN) :: snames(:) !--- Coma-deparated list of sections (one list each file)
	202	INTEGER, ALLOCATABLE :: ndb(:) !--- Nuber of sections for each file
	203	INTEGER, ALLOCATABLE :: ixf(:) !--- File index for each section of the expanded list
	204	LOGICAL, ALLOCATABLE :: lTg(:) !--- Tagging tracers mask
[2]	205	CHARACTER(LEN=maxlen) :: fnm, snm, modname
[1]	206	INTEGER :: idb, i
	207	LOGICAL :: ll
	208	!------------------------------------------------------------------------------------------------------------------------------
[2]	209	modname = 'feedDBase'
[1]	210	!=== READ THE REQUIRED SECTIONS
	211	ll = strCount(snames, ',', ndb) !--- Number of sections for each file
	212	ALLOCATE(ixf(SUM(ndb)))
[6]	213	DO i=1, SIZE(fnames) !--- Set %name, %keys
[1]	214	IF(test(readSections(fnames(i), snames(i), 'default'), lerr)) RETURN
	215	ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list
	216	END DO
	217	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	218	DO idb=1,SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS
	219	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[6]	220	fnm = fnames(ixf(idb)); snm = dBase(idb)%name !--- FILE AND SECTION NAMES
	221	IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- EXPAND NAMES ; set %parent, %type, %component
	222	CALL setGeneration (dBase(idb)%trac) !--- set %iGeneration, %genOName
	223	IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK ORPHANS AND PHASES
	224	IF(test(checkUnique (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK TRACERS UNIQUENESS
	225	CALL expandPhases (dBase(idb)%trac) !--- EXPAND PHASES ; set %phase
[1]	226	CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS
	227	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	228	END DO
	229	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	230
	231	!=== DISPLAY BASIC INFORMATION
[2]	232	lerr = ANY([( dispTraSection('Expanded list for section "'//TRIM(dBase(idb)%name)//'"', dBase(idb)%name, modname), &
	233	idb=1, SIZE(dBase) )])
[1]	234	END FUNCTION feedDBase
	235	!------------------------------------------------------------------------------------------------------------------------------
	236
	237	!------------------------------------------------------------------------------------------------------------------------------
	238	LOGICAL FUNCTION readSections(fnam,snam,defName) RESULT(lerr)
	239	!------------------------------------------------------------------------------------------------------------------------------
	240	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- File name
	241	CHARACTER(LEN=*), INTENT(IN) :: snam !--- Coma-separated sections list
	242	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: defName !--- Special section (default values) name
	243	!------------------------------------------------------------------------------------------------------------------------------
[2]	244	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
	245	CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:)
	246	INTEGER, ALLOCATABLE :: ix(:)
[1]	247	INTEGER :: n0, idb, ndb, i, j
	248	LOGICAL :: ll
	249	!------------------------------------------------------------------------------------------------------------------------------
	250	n0 = SIZE(dBase) + 1 !--- Index for next entry in the database
	251	CALL readSections_all() !--- Read all the sections of file "fnam"
	252	ndb= SIZE(dBase) !--- Current number of sections in the database
	253	IF(PRESENT(defName)) THEN !--- Add default values to all the tracers
	254	DO idb=n0,ndb; CALL addDefault(dBase(idb)%trac, defName); END DO !--- and remove the virtual tracer "defName"
	255	END IF
	256	ll = strParse(snam, ',', keys = sec) !--- Requested sections names
	257	ix = strIdx(dBase(:)%name, sec(:)) !--- Indexes of requested sections in database
	258	IF(test(checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'), lerr)) RETURN
	259	tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))] !--- Keep requested sections only
	260
	261	CONTAINS
	262
	263	!------------------------------------------------------------------------------------------------------------------------------
	264	SUBROUTINE readSections_all()
	265	!------------------------------------------------------------------------------------------------------------------------------
[2]	266	CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), v(:)
	267	TYPE(trac_type), ALLOCATABLE :: tt(:)
	268	TYPE(trac_type) :: tmp
	269	CHARACTER(LEN=1024) :: str
	270	CHARACTER(LEN=maxlen) :: secn
	271	INTEGER :: ierr, n
[1]	272	!------------------------------------------------------------------------------------------------------------------------------
	273	IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
	274	OPEN(90, FILE=fnam, FORM='formatted', STATUS='old')
	275	DO; READ(90,'(a)', IOSTAT=ierr)str
	276	IF(ierr /= 0 ) EXIT !--- Finished: error or end of file
	277	IF(str(1:1)=='#') CYCLE !--- Skip comments lines
	278	CALL removeComment(str) !--- Skip comments at the end of a line
	279	IF(str == '') CYCLE !--- Skip empty line (probably at the end of the file)
	280	IF(str(1:1)=='&') THEN !=== SECTION HEADER LINE
	281	ndb = SIZE(dBase) !--- Number of sections so far
	282	secn = str(2:LEN_TRIM(str))//' ' !--- Current section name
	283	IF(ANY(dBase(:)%name == secn)) CYCLE !--- Already known section
	284	IF(secn(1:7) == 'version') CYCLE !--- Skip the "version" special section
	285	ndb = ndb + 1 !--- Extend database
	286	ALLOCATE(tdb(ndb))
	287	tdb(1:ndb-1) = dBase
	288	tdb(ndb)%name = secn
	289	ALLOCATE(tdb(ndb)%trac(0))
	290	CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
	291	ELSE !=== TRACER LINE
	292	ll = strParse(str,' ', keys = s, vals = v, n = n) !--- Parse <key>=<val> pairs
	293	tt = dBase(ndb)%trac(:)
[6]	294	tmp%name = s(1); tmp%keys = keys_type(s(1), s(2:n), v(2:n)) !--- Set %name and %keys
[1]	295	dBase(ndb)%trac = [tt(:), tmp]
	296	DEALLOCATE(tt)
[6]	297	! dBase(ndb)%trac = [dBase(ndb)%trac(:), tra(name=s(1), keys=keys_type(s(1), s(2:n), v(2:n)))]
[1]	298	END IF
	299	END DO
	300	CLOSE(90)
	301
	302	END SUBROUTINE readSections_all
	303	!------------------------------------------------------------------------------------------------------------------------------
	304
	305	END FUNCTION readSections
	306	!==============================================================================================================================
	307
	308
	309	!==============================================================================================================================
	310	SUBROUTINE addDefault(t, defName)
	311	!------------------------------------------------------------------------------------------------------------------------------
	312	! Purpose: Add the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
	313	!------------------------------------------------------------------------------------------------------------------------------
[2]	314	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
	315	CHARACTER(LEN=*), INTENT(IN) :: defName
[1]	316	INTEGER :: jd, it, k
[2]	317	TYPE(keys_type), POINTER :: ky
	318	TYPE(trac_type), ALLOCATABLE :: tt(:)
[1]	319	jd = strIdx(t(:)%name, defName)
	320	IF(jd == 0) RETURN
	321	ky => t(jd)%keys
	322	DO k = 1, SIZE(ky%key) !--- Loop on the keys of the tracer named "defName"
	323	CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys) !--- Add key to all the tracers (no overwriting)
	324	END DO
	325	tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
	326	END SUBROUTINE addDefault
	327	!==============================================================================================================================
	328
	329	!==============================================================================================================================
	330	SUBROUTINE subDefault(t, defName, lSubLocal)
	331	!------------------------------------------------------------------------------------------------------------------------------
	332	! Purpose: Substitute the keys from virtual tracer named "defName" (if any) and remove this virtual tracer.
	333	! Substitute the keys locally (for the current tracer) if the flag "lSubLocal" is .TRUE.
	334	!------------------------------------------------------------------------------------------------------------------------------
[2]	335	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
	336	CHARACTER(LEN=*), INTENT(IN) :: defName
	337	LOGICAL, INTENT(IN) :: lSubLocal
[1]	338	INTEGER :: i0, it, ik
[2]	339	TYPE(keys_type), POINTER :: k0, ky
	340	TYPE(trac_type), ALLOCATABLE :: tt(:)
[1]	341	i0 = strIdx(t(:)%name, defName)
	342	IF(i0 == 0) RETURN
	343	k0 => t(i0)%keys
	344	DO it = 1, SIZE(t); IF(it == i0) CYCLE !--- Loop on the tracers
	345	ky => t(it)%keys
	346
	347	!--- Substitute in the values of <key>=<val> pairs the keys defined in the virtual tracer "defName"
	348	DO ik = 1, SIZE(k0%key); CALL strReplace(ky%val, k0%key(ik), k0%val(ik), .TRUE.); END DO
	349
	350	IF(.NOT.lSubLocal) CYCLE
	351	!--- Substitute in the values of <key>=<val> pairs the keys defined locally (in the current tracer)
	352	DO ik = 1, SIZE(ky%key); CALL strReplace(ky%val, ky%key(ik), ky%val(ik), .TRUE.); END DO
	353	END DO
	354	tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t) !--- Remove the virtual tracer named "defName"
	355
	356	END SUBROUTINE subDefault
	357	!==============================================================================================================================
	358
	359
	360	!==============================================================================================================================
	361	LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
	362	!------------------------------------------------------------------------------------------------------------------------------
	363	! Purpose: Expand tracers and parents lists in the tracers descriptor "tra".
	364	! Note: * The following keys are expanded, so are accessible explicitely using "%" operator: "parent" "type".
	365	! * Default values are provided for these keys because they are necessary.
	366	!------------------------------------------------------------------------------------------------------------------------------
[2]	367	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
	368	CHARACTER(LEN=*), INTENT(IN) :: sname
	369	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname
	370	TYPE(trac_type), ALLOCATABLE :: ttr(:)
	371	CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
	372	CHARACTER(LEN=maxlen) :: msg1, modname
[1]	373	INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr, i
	374	LOGICAL :: ll
[2]	375	modname = 'expandSection'
[1]	376	lerr = .FALSE.
	377	nt = SIZE(tr)
	378	nq = 0
	379	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	380	DO it = 1, nt !=== GET TRACERS NB AFTER EXPANSION + NEEDED KEYS (name, parent, type)
	381	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	382	!--- Extract useful keys: parent name, type, component name
[2]	383	tr(it)%parent = fgetKey(it, 'parent', tr(:)%keys, tran0 )
	384	tr(it)%type = fgetKey(it, 'type' , tr(:)%keys, 'tracer')
	385	tr(it)%component = sname
[1]	386
	387	!--- Determine the number of tracers and parents ; coherence checking
[2]	388	ll = strCount(tr(it)%name, ',', ntr)
	389	ll = strCount(tr(it)%parent, ',', npr)
[1]	390
	391	!--- Tagging tracers only can have multiple parents
	392	IF(test(npr/=1 .AND. TRIM(tr(it)%type)/='tag', lerr)) THEN
	393	msg1 = 'Check section "'//TRIM(sname)//'"'
	394	IF(PRESENT(fname)) msg1=TRIM(msg1)//' in file "'//TRIM(fname)//'"'
[2]	395	CALL msg(TRIM(msg1)//': "'//TRIM(tr(it)%name)//'" has several parents but is not a tag', modname); RETURN
[1]	396	END IF
	397	nq = nq + ntr*npr
	398	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	399	END DO
	400	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	401	CALL delKey(['parent','type '], tr)
	402
	403	ALLOCATE(ttr(nq))
	404	iq = 1
	405	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	406	DO it = 1, nt !=== EXPAND TRACERS AND PARENTS NAMES LISTS
	407	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	408	ll = strParse(tr(it)%name, ',', ta, n=ntr) !--- Number of tracers
[2]	409	ll = strParse(tr(it)%parent, ',', pa, n=npr) !--- Number of parents
[1]	410	DO ipr=1,npr !--- Loop on parents list elts
	411	DO itr=1,ntr !--- Loop on tracers list elts
	412	i = iq+itr-1+(ipr-1)*ntr
[4]	413	ttr(i)%name = TRIM(ta(itr)); ttr(i)%parent = pa(ipr)
[2]	414	ttr(i)%keys = keys_type(ta(itr), tr(it)%keys%key, tr(it)%keys%val)
[1]	415	END DO
	416	END DO
	417	ttr(iq:iq+ntr*npr-1)%type = tr(it)%type !--- Duplicating type
	418	iq = iq + ntr*npr
	419	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	420	END DO
	421	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	422	DEALLOCATE(ta,pa)
	423	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
	424
	425	END FUNCTION expandSection
	426	!==============================================================================================================================
	427
	428	!==============================================================================================================================
	429	SUBROUTINE setGeneration(tr)
	430	!------------------------------------------------------------------------------------------------------------------------------
	431	! Purpose: Determine, for each tracer of "tr(:)":
[6]	432	! * %iGeneration: the generation number
	433	! * %gen0Name: the generation 0 ancestor name
[1]	434	!------------------------------------------------------------------------------------------------------------------------------
[6]	435	TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
	436	INTEGER :: iq, nq, ig
[2]	437	LOGICAL, ALLOCATABLE :: lg(:)
	438	CHARACTER(LEN=maxlen), ALLOCATABLE :: prn(:)
[1]	439	!------------------------------------------------------------------------------------------------------------------------------
[6]	440	tr(:)%iGeneration = -1 !--- error if -1
[1]	441	nq = SIZE(tr, DIM=1) !--- Number of tracers lines
[2]	442	lg = tr(:)%parent == tran0 !--- First generation tracers flag
[6]	443	WHERE(lg) tr(:)%iGeneration = 0 !--- First generation tracers
[1]	444
	445	!=== Determine generation for each tracer
[6]	446	ig=-1; prn = [tran0]
[1]	447	DO !--- Update current generation flag
[6]	448	IF(ig/=-1) prn = PACK( tr(:)%name, MASK=tr(:)%iGeneration == ig)
[2]	449	lg(:) = [(ANY(prn(:) == tr(iq)%parent), iq=1, nq)] !--- Current generation tracers flag
[1]	450	IF( ALL( .NOT. lg ) ) EXIT !--- Empty current generation
[2]	451	ig = ig+1; WHERE(lg) tr(:)%iGeneration = ig
[1]	452	END DO
[2]	453	tr(:)%gen0Name = ancestor(tr) !--- First generation ancestor name
[1]	454
	455	END SUBROUTINE setGeneration
	456	!==============================================================================================================================
	457
	458	!==============================================================================================================================
	459	LOGICAL FUNCTION checkTracers(tr, sname, fname) RESULT(lerr)
	460	!------------------------------------------------------------------------------------------------------------------------------
	461	! Purpose:
	462	! * check for orphan tracers (without known parent)
	463	! * check wether the phases are known or not ("g"aseous, "l"iquid or "s"olid so far)
	464	!------------------------------------------------------------------------------------------------------------------------------
[2]	465	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
[1]	466	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
	467	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
[2]	468	CHARACTER(LEN=maxlen) :: mesg
	469	CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha !--- Bad phases list, phases of current tracer
[1]	470	CHARACTER(LEN=1) :: p
	471	INTEGER :: ip, np, iq, nq
	472	!------------------------------------------------------------------------------------------------------------------------------
	473	nq = SIZE(tr,DIM=1) !--- Number of tracers lines
	474	mesg = 'Check section "'//TRIM(sname)//'"'
	475	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
	476
	477	!=== CHECK FOR ORPHAN TRACERS
[6]	478	IF(test(checkList(tr%name, tr%iGeneration==-1, mesg, 'tracers', 'orphan'), lerr)) RETURN
[1]	479
	480	!=== CHECK PHASES
[6]	481	DO iq=1,nq; IF(tr(iq)%iGeneration/=0) CYCLE !--- Generation O only is checked
[1]	482	pha = fgetKey(iq, 'phases', tr(:)%keys, 'g') !--- Phases
	483	np = LEN_TRIM(pha); bp(iq)=' '
	484	DO ip=1,np; p = pha(ip:ip); IF(INDEX(known_phases,p)==0) bp(iq) = TRIM(bp(iq))//p; END DO
	485	IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tr(iq)%name)//': '//TRIM(bp(iq))
	486	END DO
[6]	487	lerr = checkList(bp, tr%iGeneration==0 .AND. bp/='', mesg, 'tracers phases', 'unknown')
[1]	488	END FUNCTION checkTracers
	489	!==============================================================================================================================
	490
	491	!==============================================================================================================================
[6]	492	LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr)
[1]	493	!------------------------------------------------------------------------------------------------------------------------------
	494	! Purpose: Make sure that tracers are not repeated.
	495	!------------------------------------------------------------------------------------------------------------------------------
[2]	496	TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector
[1]	497	CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name
	498	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name
	499	!------------------------------------------------------------------------------------------------------------------------------
	500	INTEGER :: ip, np, iq, nq, k
[2]	501	LOGICAL, ALLOCATABLE :: ll(:)
	502	CHARACTER(LEN=maxlen) :: mesg, tnam, tdup(SIZE(tr,DIM=1))
	503	CHARACTER(LEN=1) :: p
[1]	504	!------------------------------------------------------------------------------------------------------------------------------
	505	mesg = 'Check section "'//TRIM(sname)//'"'
	506	IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
	507	nq=SIZE(tr,DIM=1); lerr=.FALSE. !--- Number of lines ; error flag
	508	tdup(:) = ''
[6]	509	DO iq=1,nq; IF(tr(iq)%type == 'tag') CYCLE !--- Tags can be repeated
[4]	510	tnam = TRIM(tr(iq)%name)
	511	ll = tr(:)%name==TRIM(tnam) !--- Mask for current tracer name
[1]	512	IF(COUNT(ll)==1 ) CYCLE !--- Tracer is not repeated
[2]	513	IF(tr(iq)%iGeneration>1) THEN
[1]	514	tdup(iq) = tnam !--- gen>1: MUST be unique
	515	ELSE
	516	DO ip=1,nphases; p=known_phases(ip:ip) !--- Loop on known phases
	517	!--- Number of appearances of the current tracer with known phase "p"
	518	np = COUNT( PACK( [(INDEX(fgetKey(k, 'phases', tr(:)%keys, 'g'),p), k=1, nq)] /=0 , MASK=ll ) )
	519	IF(np <=1) CYCLE
	520	tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))
	521	IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)='' !--- Avoid repeating same messages
	522	END DO
	523	END IF
	524	IF(tdup(iq) /= '') tdup(iq)=TRIM(tnam)//' in '//TRIM(tdup(iq))//' phase(s)'
	525	END DO
	526	lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
	527	END FUNCTION checkUnique
	528	!==============================================================================================================================
	529
	530	!==============================================================================================================================
	531	SUBROUTINE expandPhases(tr)
	532	!------------------------------------------------------------------------------------------------------------------------------
	533	! Purpose: Expand the phases in the tracers descriptor "tr".
	534	!------------------------------------------------------------------------------------------------------------------------------
[2]	535	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
[1]	536	!------------------------------------------------------------------------------------------------------------------------------
[2]	537	TYPE(trac_type), ALLOCATABLE :: ttr(:)
	538	INTEGER, ALLOCATABLE :: i0(:)
	539	CHARACTER(LEN=maxlen) :: nam, pha, trn
[1]	540	INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
	541	LOGICAL :: lTg, lEx
	542	!------------------------------------------------------------------------------------------------------------------------------
	543	nq = SIZE(tr, DIM=1)
	544	nt = 0
	545	DO iq = 1, nq !--- GET THE NUMBER OF TRACERS
[2]	546	IF(tr(iq)%iGeneration /= 1) CYCLE
	547	nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=1) !--- Number of childs of tr(iq)
	548	tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys) !--- Phases list of tr(iq)
	549	np = LEN_TRIM(tr(iq)%phase) !--- Number of phases of tr(iq)
[1]	550	nt = nt + (1+nc) * np !--- Number of tracers after expansion
	551	END DO
	552	ALLOCATE(ttr(nt))
	553	it = 1 !--- Current "ttr(:)" index
	554	DO iq = 1, nq !--- Loop on "tr(:)" indexes
	555	lTg = tr(iq)%type=='tag' !--- Current tracer is a tag
[4]	556	i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n) !--- Indexes of first generation ancestor copies
[2]	557	np = SUM( [( LEN_TRIM(tr(i0(i))%phase),i=1,n )],1) !--- Number of phases for current tracer tr(iq)
[1]	558	lEx = np>1 !--- Need of a phase suffix
[2]	559	IF(lTg) lEx=lEx.AND.tr(iq)%iGeneration>1 !--- No phase suffix for first generation tags
[1]	560	DO i=1,n !=== LOOP ON FIRST GENERATION ANCESTORS
	561	jq=i0(i) !--- tr(jq): ith copy of 1st gen. ancestor of tr(iq)
[2]	562	IF(tr(iq)%iGeneration==1) jq=iq !--- Generation 1: current tracer phases only
	563	pha = tr(jq)%phase !--- Phases list for tr(jq)
[1]	564	DO ip=1,LEN_TRIM(pha) !=== LOOP ON PHASES LISTS
	565	trn=TRIM(tr(iq)%name); nam=trn !--- Tracer name (regular case)
[2]	566	IF(lTg) nam = TRIM(tr(iq)%parent) !--- Parent name (tagging case)
[12]	567	IF(lEx) nam = addPhase(nam, ip) !--- Phase extension needed
[1]	568	IF(lTg) nam = TRIM(nam)//'_'//TRIM(trn) !--- <parent>_<name> for tags
	569	ttr(it) = tr(iq) !--- Same <key>=<val> pairs
[4]	570	ttr(it)%name = TRIM(nam) !--- Name with possibly phase suffix
	571	ttr(it)%keys%name = TRIM(nam) !--- Name inside the keys decriptor
[2]	572	ttr(it)%phase = pha(ip:ip) !--- Single phase entry
	573	IF(lEx.AND.tr(iq)%iGeneration>1) THEN
[12]	574	ttr(it)%parent = addPhase(ttr(it)%parent, ip) !--- Modify parent name
	575	ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, ip) !--- Modify generation 0 ancestor name
[1]	576	END IF
	577	it=it+1
	578	END DO
[2]	579	IF(tr(iq)%iGeneration==1) EXIT !--- Break phase loop for gen 1
[1]	580	END DO
	581	END DO
	582	CALL MOVE_ALLOC(FROM=ttr, TO=tr)
	583	CALL delKey(['phases'],tr) !--- Remove few keys entries
	584
	585	END SUBROUTINE expandPhases
	586	!==============================================================================================================================
	587
	588	!==============================================================================================================================
	589	SUBROUTINE sortTracers(tr)
	590	!------------------------------------------------------------------------------------------------------------------------------
	591	! Purpose: Sort tracers:
[6]	592	! * Put water at first places, in the "known_phases" order.
[1]	593	! * lGrowGen == T: in ascending generations numbers.
	594	! * lGrowGen == F: tracer + its childs sorted by growing generation, one after the other.
[6]	595	! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
[1]	596	!------------------------------------------------------------------------------------------------------------------------------
[2]	597	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector
[6]	598	INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
[1]	599	INTEGER, ALLOCATABLE :: iy(:), iz(:)
	600	!------------------------------------------------------------------------------------------------------------------------------
[6]	601	nq = SIZE(tr)
	602	iy = [(k, k=1, nq)]
	603	DO ip = nphases, 1, -1
[12]	604	iq = strIdx(tr(:)%name, addPhase('H2O', ip))
	605	IF(iq/=0) iy = [iq, iy(1:iq-1), iy(iq+1:nq)]
[6]	606	END DO
	607	tr = tr(iy) !--- Water displaces at first positions
[1]	608	iq = 1
	609	IF(lSortByGen) THEN
[2]	610	ng = MAXVAL(tr(:)%iGeneration, MASK=.TRUE., DIM=1) !--- Number of generations
[1]	611	DO ig = 0, ng !--- Loop on generations
[6]	612	iy = PACK([(k, k=1, nq)], MASK=tr(:)%iGeneration==ig) !--- Generation ig tracers indexes
[1]	613	n = SIZE(iy)
	614	ix(iq:iq+n-1) = iy !--- Stack growing generations idxs
	615	iq = iq + n
	616	END DO
	617	ELSE
[6]	618	DO jq = 1, nq !--- Loop on first generation tracers
[2]	619	IF(tr(jq)%iGeneration /= 1) CYCLE !--- Skip generations >= 1
[1]	620	ix(iq) = jq !--- First generation ancestor index first
	621	iq = iq + 1
[4]	622	iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name)) !--- Indexes of "tr(jq)" childs in "tr(:)"
[2]	623	ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1) !--- Generations number of the "tr(jq)" family
[1]	624	DO ig = 2, ng !--- Loop on generations for the tr(jq) family
[2]	625	iz = find(tr(iy)%iGeneration, ig, n) !--- Indexes of the tracers "tr(iy(:))" of generation "ig"
[1]	626	ix(iq:iq+n-1) = iy(iz) !--- Same indexes in "tr(:)"
	627	iq = iq + n
	628	END DO
	629	END DO
	630	END IF
	631	tr = tr(ix) !--- Reorder the tracers
	632	END SUBROUTINE sortTracers
	633	!==============================================================================================================================
	634
	635	!==============================================================================================================================
	636	LOGICAL FUNCTION mergeTracers(sections, tr) RESULT(lerr)
[2]	637	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
	638	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
	639	TYPE(trac_type), POINTER :: t1(:), t2(:)
	640	INTEGER, ALLOCATABLE :: ixct(:), ixck(:)
[1]	641	INTEGER :: is, k1, k2, nk2, i1, i2, nt2
[2]	642	CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
	643	modname = 'mergeTracers'
[1]	644	lerr = .FALSE.
	645	t1 => sections(1)%trac(:) !--- Alias: first tracers section
	646	tr = t1
	647	!----------------------------------------------------------------------------------------------------------------------------
	648	DO is=2,SIZE(sections) !=== SEVERAL SECTIONS: MERGE THEM
	649	!----------------------------------------------------------------------------------------------------------------------------
	650	t2 => sections(is)%trac(:) !--- Alias: current tracers section
	651	nt2 = SIZE(t2(:), DIM=1) !--- Number of tracers in section
	652	ixct = strIdx(t1(:)%name, t2(:)%name) !--- Indexes of common tracers
	653	tr = [tr, PACK(t2, MASK= ixct==0)] !--- Append with new tracers
	654	IF( ALL(ixct == 0) ) CYCLE !--- No common tracers => done
[2]	655	CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
	656	CALL msg(t1(PACK(ixct, MASK = ixct/=0))%name, modname, nmax=128) !--- Display duplicates (the 128 first at most)
[1]	657	!--------------------------------------------------------------------------------------------------------------------------
[4]	658	DO i2=1,nt2; tnam = TRIM(t2(i2)%name) !=== LOOP ON COMMON TRACERS
[1]	659	!--------------------------------------------------------------------------------------------------------------------------
	660	i1 = ixct(i2); IF(i1 == 0) CYCLE !--- Idx in t1(:) ; skip new tracers
	661
	662	!=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
	663	s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
	664
[2]	665	IF(test(fmsg('Parent name'//TRIM(s1), modname, t1(i1)%parent /= t2(i2)%parent), lerr)) RETURN
	666	IF(test(fmsg('Type' //TRIM(s1), modname, t1(i1)%type /= t2(i2)%type), lerr)) RETURN
	667	IF(test(fmsg('Generation' //TRIM(s1), modname, t1(i1)%iGeneration /= t2(i2)%iGeneration), lerr)) RETURN
[1]	668
	669	!=== APPEND <key>=<val> PAIRS NOT PREVIOULSLY DEFINED
	670	nk2 = SIZE(t2(i2)%keys%key(:)) !--- Keys number in current section
	671	ixck = strIdx(t1(i1)%keys%key(:), t2(i2)%keys%key(:)) !--- Common keys indexes
	672
	673	!=== APPEND NEW KEYS
	674	tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
	675	tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
	676
	677	!--- KEEP TRACK OF THE COMPONENTS NAMES
[2]	678	tr(i1)%component = TRIM(tr(i1)%component)//','//TRIM(tr(i2)%component)
[1]	679
	680	!--- SELECT COMMON TRACERS WITH DIFFERING KEYS VALUES (PREVIOUS VALUE IS KEPT)
	681	DO k2=1,nk2
	682	k1 = ixck(k2); IF(k1 == 0) CYCLE
	683	IF(t1(i1)%keys%val(k1) == t2(i2)%keys%val(k2)) ixck(k2)=0
	684	END DO
	685	IF(ALL(ixck==0)) CYCLE !--- No identical keys with /=values
	686
	687	!--- DISPLAY INFORMATION: OLD VALUES ARE KEPT FOR THE KEYS FOUND IN PREVIOUS AND CURRENT SECTIONS
[2]	688	CALL msg('Key(s)'//TRIM(s1), modname)
[1]	689	DO k2 = 1, nk2 !--- Loop on keys found in both t1(:) and t2(:)
	690	knam = t2(i2)%keys%key(k2) !--- Name of the current key
	691	k1 = ixck(k2) !--- Corresponding index in t1(:)
	692	IF(k1 == 0) CYCLE !--- New keys are skipped
	693	v1 = t1(i1)%keys%val(k1); v2 = t2(i2)%keys%val(k2) !--- Key values in t1(:) and t2(:)
[2]	694	CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
[1]	695	END DO
	696	!------------------------------------------------------------------------------------------------------------------------
	697	END DO
	698	!--------------------------------------------------------------------------------------------------------------------------
	699	END DO
	700	CALL sortTracers(tr)
	701
	702	END FUNCTION mergeTracers
	703	!==============================================================================================================================
	704
	705	!==============================================================================================================================
	706	LOGICAL FUNCTION cumulTracers(sections, tr) RESULT(lerr)
[2]	707	TYPE(dataBase_type), TARGET, INTENT(IN) :: sections(:)
	708	TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tr(:)
	709	TYPE(trac_type), POINTER :: t1(:), t2(:)
[1]	710	INTEGER, ALLOCATABLE :: nt(:)
[2]	711	CHARACTER(LEN=maxlen) :: tnam, tnam_new
[1]	712	INTEGER :: iq, nq, is, ns, nsec
	713	lerr = .FALSE. !--- Can't fail ; kept to match "mergeTracer" interface.
	714	nsec = SIZE(sections)
	715	tr = [( sections(is)%trac(:) , is=1, nsec )] !--- Concatenated tracers vector
	716	nt = [( SIZE(sections(is)%trac(:)), is=1, nsec )] !--- Number of tracers in each section
	717	!----------------------------------------------------------------------------------------------------------------------------
	718	DO is=1, nsec !=== LOOP ON SECTIONS
	719	!----------------------------------------------------------------------------------------------------------------------------
	720	t1 => sections(is)%trac(:)
	721	!--------------------------------------------------------------------------------------------------------------------------
	722	DO iq=1, nt(is) !=== LOOP ON TRACERS
	723	!--------------------------------------------------------------------------------------------------------------------------
[4]	724	tnam = TRIM(t1(iq)%name) !--- Original name
[1]	725	IF(COUNT(t1%name == tnam) == 1) CYCLE !--- Current tracer is not duplicated: finished
[12]	726	tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name) !--- Same with section extension
[1]	727	nq = SUM(nt(1:is-1)) !--- Number of tracers in previous sections
	728	ns = nt(is) !--- Number of tracers in the current section
[4]	729	tr(iq + nq)%name = TRIM(tnam_new) !--- Modify tracer name
[2]	730	WHERE(tr(1+nq:ns+nq)%parent==tnam) tr(1+nq:ns+nq)%parent=tnam_new !--- Modify parent name
[1]	731	!--------------------------------------------------------------------------------------------------------------------------
	732	END DO
	733	!----------------------------------------------------------------------------------------------------------------------------
	734	END DO
	735	!----------------------------------------------------------------------------------------------------------------------------
	736	CALL sortTracers(tr)
	737	END FUNCTION cumulTracers
	738	!==============================================================================================================================
	739
	740	!==============================================================================================================================
	741	SUBROUTINE setDirectKeys(tr)
[2]	742	TYPE(trac_type), INTENT(INOUT) :: tr(:)
[6]	743
	744	!--- Update %iqParent, %iqDescen, %nqDescen, %nqChilds
	745	CALL indexUpdate(tr)
	746
	747	!--- Extract some direct-access keys
[1]	748	! DO iq = 1, SIZE(tr)
[6]	749	! tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, <default_value> )
[1]	750	! END DO
	751	END SUBROUTINE setDirectKeys
	752	!==============================================================================================================================
	753
	754	!==============================================================================================================================
[2]	755	LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
	756	CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
[1]	757	INTEGER :: idb, iq, nq
	758	INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
[2]	759	TYPE(trac_type), POINTER :: tm(:)
[1]	760	lerr = .FALSE.
	761	idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
	762	tm => dBase(idb)%trac
	763	nq = SIZE(tm)
	764	IF(test(getKeyByName_im('hadv', hadv, tm(:)%name, tm(:)%keys),lerr)) RETURN
	765	IF(test(getKeyByName_im('vadv', vadv, tm(:)%name, tm(:)%keys),lerr)) RETURN
[2]	766	CALL msg(TRIM(message)//':', modname)
[1]	767	IF(test(dispTable('iiissis', ['iq ','hadv ','vadv ','short name','parent ','igen ','phase '], &
[2]	768	cat(tm(:)%name, tm(:)%parent, tm(:)%phase), cat([(iq, iq=1, nq)], hadv, vadv, tm(:)%iGeneration)), lerr)) RETURN
[1]	769	END FUNCTION dispTraSection
	770	!==============================================================================================================================
	771	!==============================================================================================================================
	772
	773
	774	!==============================================================================================================================
	775	!== CREATE A SCALAR ALIAS OF THE COMPONENT OF THE TRACERS DESCRIPTOR "t" NAMED "tname" ========================================
	776	!==============================================================================================================================
	777	FUNCTION aliasTracer(tname, t) RESULT(out)
[2]	778	TYPE(trac_type), POINTER :: out
	779	CHARACTER(LEN=*), INTENT(IN) :: tname
	780	TYPE(trac_type), TARGET, INTENT(IN) :: t(:)
[1]	781	INTEGER :: it
	782	it = strIdx(t(:)%name, tname)
	783	out => NULL(); IF(it /= 0) out => t(it)
	784	END FUNCTION aliasTracer
	785	!------------------------------------------------------------------------------------------------------------------------------
	786
	787
	788	!==============================================================================================================================
	789	!=== FROM A LIST OF INDEXES OR NAMES, CREATE A SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" ==================================
	790	!==============================================================================================================================
	791	FUNCTION trSubset_Indx(trac,idx) RESULT(out)
[2]	792	TYPE(trac_type), ALLOCATABLE :: out(:)
	793	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	794	INTEGER, INTENT(IN) :: idx(:)
[1]	795	out = trac(idx)
	796	CALL indexUpdate(out)
	797	END FUNCTION trSubset_Indx
	798	!------------------------------------------------------------------------------------------------------------------------------
	799	FUNCTION trSubset_Name(trac,nam) RESULT(out)
[2]	800	TYPE(trac_type), ALLOCATABLE :: out(:)
	801	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	802	CHARACTER(LEN=*), INTENT(IN) :: nam(:)
[1]	803	out = trac(strIdx(trac(:)%name, nam))
	804	CALL indexUpdate(out)
	805	END FUNCTION trSubset_Name
	806	!------------------------------------------------------------------------------------------------------------------------------
	807
	808
	809	!==============================================================================================================================
	810	!=== CREATE THE SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" HAVING THE FIRST GENERATION ANCESTOR NAMED "nam" ================
	811	!==============================================================================================================================
[2]	812	FUNCTION trSubset_gen0Name(trac,nam) RESULT(out)
	813	TYPE(trac_type), ALLOCATABLE :: out(:)
	814	TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
	815	CHARACTER(LEN=*), INTENT(IN) :: nam
	816	out = trac(strFind(delPhase(trac(:)%gen0Name), nam))
[1]	817	CALL indexUpdate(out)
[2]	818	END FUNCTION trSubset_gen0Name
[1]	819	!------------------------------------------------------------------------------------------------------------------------------
	820
	821
	822	!==============================================================================================================================
[2]	823	!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
[1]	824	!==============================================================================================================================
	825	SUBROUTINE indexUpdate(tr)
[2]	826	TYPE(trac_type), INTENT(INOUT) :: tr(:)
[1]	827	INTEGER :: iq, ig, ng, ngen
	828	INTEGER, ALLOCATABLE :: ix(:)
[2]	829	tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent ) !--- Parent index
	830	ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
[1]	831	DO iq = 1, SIZE(tr)
[2]	832	ng = tr(iq)%iGeneration !--- Generation of the current tracer
[1]	833	ix = idxAncestor(tr, igen = ng); ix = PACK(ix, ix/=0) !--- Indexes of the tracers with ancestor tr(iq)
	834	!--- Childs indexes in growing generation order
[2]	835	tr(iq)%iqDescen = [( PACK(ix, MASK = tr(ix)%iGeneration == ig), ig = ng+1, ngen)]
	836	tr(iq)%nqDescen = SUM( [( COUNT(tr(ix)%iGeneration == ig), ig = ng+1, ngen)] )
	837	tr(iq)%nqChilds = COUNT(tr(ix)%iGeneration == ng+1)
[1]	838	END DO
	839	END SUBROUTINE indexUpdate
	840	!------------------------------------------------------------------------------------------------------------------------------
	841
	842
	843	!==============================================================================================================================
[2]	844	!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent": ====
	845	!=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent" ====
[1]	846	!=== * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ====
	847	!=== NOTES: ====
	848	!=== * Most of the "isot" components have been defined in the calling routine (initIsotopes): ====
[6]	849	!=== parent, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iTraPha(:,:), iZonPhi(:,:) ====
[1]	850	!=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ====
	851	!=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ====
	852	!=== * In case keys are found both in the "params" section and the "*.def" file, the later value is retained ====
	853	!=== * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution) ====
	854	!=== * The routine gives an error if a required isotope is not available in the database stored in "fnam" ====
	855	!==============================================================================================================================
	856	LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
[2]	857	CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name
	858	TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field "prnt" must be defined !)
[1]	859	INTEGER :: ik, is, it, idb, nk0, i, iis
	860	INTEGER :: nk, ns, nt, ndb, nb0, i0
[2]	861	CHARACTER(LEN=maxlen), POINTER :: k(:), v(:), k0(:), v0(:)
	862	CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:)
	863	CHARACTER(LEN=maxlen) :: val, modname
	864	TYPE(keys_type), POINTER :: ky(:)
	865	TYPE(trac_type), POINTER :: tt(:), t
	866	TYPE(dataBase_type), ALLOCATABLE :: tdb(:)
	867	LOGICAL, ALLOCATABLE :: liso(:)
	868	modname = 'readIsotopesFile'
[1]	869
	870	!--- THE INPUT FILE MUST BE PRESENT
[2]	871	IF(test(fmsg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, testFile(fnam)),lerr)) RETURN
[1]	872
	873	!--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
	874	nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index
[2]	875	IF(test(readSections(fnam,strStack(isot(:)%parent,',')),lerr)) RETURN !--- Read sections, one each parent tracer
[1]	876	ndb = SIZE(dBase, DIM=1) !--- Current database size
	877	DO idb = nb0, ndb
	878	iis = idb-nb0+1
	879
	880	!--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
	881	CALL addKeysFromDef(dBase(idb)%trac, 'params')
	882
	883	!--- SUBSTITUTE THE KEYS DEFINED IN THE 'params' VIRTUAL TRACER ; SUBSTITUTE LOCAL KEYS ; REMOVE 'params' VIRTUAL TRACER
	884	CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
	885
	886	tt => dBase(idb)%trac
	887
	888	!--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
	889	DO it = 1, SIZE(dBase(idb)%trac)
	890	t => dBase(idb)%trac(it)
	891	is = strIdx(isot(iis)%keys(:)%name, t%name) !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
	892	IF(is == 0) CYCLE
	893	liso = reduceExpr(t%keys%val, vals) !--- Reduce expressions (for substituted variables)
	894	IF(test(ANY(liso), lerr)) RETURN !--- Some non-numerical elements were found
	895	isot(iis)%keys(is)%key = PACK(t%keys%key, MASK=.NOT.liso)
	896	isot(iis)%keys(is)%val = PACK( vals, MASK=.NOT.liso)
	897	END DO
	898
	899	!--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
	900	liso = [( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )]
	901	IF(test(checkList(isot(iis)%keys(:)%name, .NOT.liso, &
	902	'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'),lerr)) RETURN
	903	END DO
	904
	905	!--- CLEAN THE DATABASE ENTRIES
	906	IF(nb0 == 1) THEN
	907	DEALLOCATE(dBase); ALLOCATE(dBase(0))
	908	ELSE
	909	ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
	910	END IF
[2]	911	lerr = dispIsotopes(isot, 'Isotopes parameters read from file', modname)
[1]	912
	913	END FUNCTION readIsotopesFile
	914	!==============================================================================================================================
	915
	916	!==============================================================================================================================
	917	!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: ===
	918	!=== * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS). ===
	919	!=== * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS ===
	920	!=== * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS) ===
	921	!=== NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS. ===
	922	!==============================================================================================================================
	923	SUBROUTINE initIsotopes(trac, isot)
[2]	924	TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: trac(:)
	925	TYPE(isot_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:)
	926	CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:) !--- Temporary storage
	927	CHARACTER(LEN=maxlen) :: iname
[1]	928	CHARACTER(LEN=1) :: ph !--- Phase
	929	INTEGER :: nbIso, ic, ip, iq, it, iz
	930	LOGICAL, ALLOCATABLE :: ll(:) !--- Mask
[2]	931	TYPE(trac_type), POINTER :: t(:), t1
	932	TYPE(isot_type), POINTER :: s
[1]	933
	934	t => trac
	935
[2]	936	p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==2) !--- Parents of 2nd generation isotopes
[1]	937	CALL strReduce(p, nbIso)
	938	ALLOCATE(isot(nbIso))
	939
	940	IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED
	941
	942	!--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
[2]	943	isot(:)%parent = p
[1]	944	DO ic = 1, SIZE(p) !--- Loop on isotopes classes
	945	s => isot(ic)
[2]	946	iname = s%parent !--- Current isotopes class name (parent tracer name)
[1]	947
	948	!=== Isotopes childs of tracer "iname": mask, names, number (same for each phase of "iname")
[2]	949	ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
[1]	950	str = PACK(delPhase(t(:)%name), MASK = ll) !--- Effectively found isotopes of "iname"
	951	s%niso = SIZE(str) !--- Number of "effectively found isotopes of "iname"
	952	ALLOCATE(s%keys(s%niso))
	953	FORALL(it = 1:s%niso) s%keys(it)%name = str(it)
	954
	955	!=== Geographic tagging tracers descending on tracer "iname": mask, names, number
[2]	956	ll = t(:)%type=='tag' .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 3
[1]	957	s%zone = PACK(strTail(t(:)%name,'_',lFirst=.TRUE.), MASK = ll) !--- Tagging zones names for isotopes category "iname"
	958	CALL strReduce(s%zone)
[6]	959	s%nzone = SIZE(s%zone) !--- Tagging zones number for isotopes category "iname"
[1]	960
	961	!=== Geographic tracers of the isotopes childs of tracer "iname" (same for each phase of "iname")
	962	! NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
	963	str = PACK(delPhase(t(:)%name), MASK=ll)
	964	CALL strReduce(str)
[6]	965	s%ntiso = s%niso + SIZE(str) !--- Number of isotopes + their geographic tracers [ntraciso]
	966	ALLOCATE(s%trac(s%ntiso))
[1]	967	FORALL(it = 1:s%niso) s%trac(it) = s%keys(it)%name
[6]	968	FORALL(it = s%niso+1:s%ntiso) s%trac(it) = str(it-s%niso)
[1]	969
	970	!=== Phases for tracer "iname"
[2]	971	s%phase = ''
	972	DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name,addPhase(iname, ph)) /= 0) s%phase = TRIM(s%phase)//ph; END DO
[6]	973	s%nphas = LEN_TRIM(s%phase) !--- Equal to "nqo" for water
[1]	974
	975	!=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
	976	DO iq = 1, SIZE(t)
	977	t1 => trac(iq)
[2]	978	IF(delPhase(t1%gen0Name) /= iname) CYCLE !--- Only deal with tracers descending on "iname"
	979	t1%iso_iGroup = ic !--- Isotopes family idx in list "isotopes(:)%parent"
	980	t1%iso_iName = strIdx(s%trac, delPhase(strHead(t1%name,'_'))) !--- Current isotope idx in effective isotopes list
	981	t1%iso_iZone = strIdx(s%zone, strTail(t1%name,'_') ) !--- Current isotope zone idx in effective zones list
	982	t1%iso_iPhase = INDEX(s%phase,TRIM(t1%phase)) !--- Current isotope phase idx in effective phases list
	983	IF(t1%iGeneration /= 3) t1%iso_iZone = 0 !--- Skip possible generation 2 tagging tracers
[1]	984	END DO
	985
	986	!=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
	987	! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
[6]	988	s%iTraPha = RESHAPE( [( (strIdx(t(:)%name, addPhase(s%trac(it),s%phase(ip:ip))), it=1, s%ntiso), ip=1, s%nphas)], &
	989	[s%ntiso, s%nphas] )
[1]	990
[6]	991	!=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
	992	s%iZonIso = RESHAPE( [( (strIdx(s%trac(:), TRIM(s%trac(it))//'_'//TRIM(s%zone(iz))), iz=1, s%nzone), it=1, s%niso )], &
	993	[s%nzone, s%niso] )
[1]	994	END DO
	995
	996	!=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
	997	! DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat AND alpha_ideal)
	998	IF(readIsotopesFile('isotopes_params.def',isot)) CALL abort_gcm(modname,'Problem when reading isotopes parameters',1)
	999
	1000	END SUBROUTINE initIsotopes
	1001	!==============================================================================================================================
	1002
	1003
	1004	!==============================================================================================================================
[2]	1005	LOGICAL FUNCTION dispIsotopes(ides, message, modname) RESULT(lerr)
	1006	TYPE(isot_type), INTENT(IN) :: ides(:) !--- Isotopes descriptor vector
[1]	1007	CHARACTER(LEN=*), INTENT(IN) :: message !--- Message to display
[2]	1008	CHARACTER(LEN=*), INTENT(IN) :: modname !--- Calling subroutine name
[1]	1009	INTEGER :: ik, nk, ip, it, nt
[2]	1010	CHARACTER(LEN=maxlen) :: prf
	1011	CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
	1012	CALL msg(TRIM(message)//':', modname)
[1]	1013	DO ip = 1, SIZE(ides) !--- Loop on parents tracers
	1014	nk = SIZE(ides(ip)%keys(1)%key) !--- Same keys for each isotope
	1015	nt = SIZE(ides(ip)%keys) !--- Number of isotopes
	1016	prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing
	1017	ALLOCATE(ttl(nk+2), val(nt,nk+1))
	1018	ttl(1:2) = ['iq ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names
	1019	val(:,1) = ides(ip)%keys(:)%name !--- Values table 1st column: isotopes names
	1020	DO ik = 1, nk
	1021	DO it = 1, nt
	1022	val(it,ik+1) = ides(ip)%keys(it)%val(ik) !--- Other columns: keys values
	1023	END DO
	1024	END DO
[2]	1025	IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)')), &
	1026	lerr)) RETURN
[1]	1027	DEALLOCATE(ttl, val)
	1028	END DO
	1029	END FUNCTION dispIsotopes
	1030	!==============================================================================================================================
	1031
	1032
	1033	!==============================================================================================================================
	1034	SUBROUTINE addKey_1(key, val, ky, lOverWrite)
	1035	!------------------------------------------------------------------------------------------------------------------------------
	1036	! Purpose: Add the <key>=<val> pair in the "ky" keys descriptor.
	1037	!------------------------------------------------------------------------------------------------------------------------------
	1038	CHARACTER(LEN=*), INTENT(IN) :: key, val
[2]	1039	TYPE(keys_type), INTENT(INOUT) :: ky
[1]	1040	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
[2]	1041	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
[1]	1042	INTEGER :: iky, nky
	1043	LOGICAL :: lo
	1044	!------------------------------------------------------------------------------------------------------------------------------
	1045	lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
	1046	iky = strIdx(ky%key,key)
	1047	IF(iky == 0) THEN
	1048	nky = SIZE(ky%key)
	1049	IF(nky == 0) THEN; ky%key = [key]; ky%val = [val]; ELSE; ky%key = [ky%key, key]; ky%val = [ky%val, val]; END IF
	1050	ELSE IF(lo) THEN !--- Overwriting
	1051	ky%key(iky) = key; ky%val(iky) = val
	1052	END IF
	1053	END SUBROUTINE addKey_1
	1054	!==============================================================================================================================
	1055	SUBROUTINE addKey_m(key, val, ky, lOverWrite)
	1056	!------------------------------------------------------------------------------------------------------------------------------
	1057	! Purpose: Add the <key>=<val> pair in all the components of the "ky" keys descriptor.
	1058	!------------------------------------------------------------------------------------------------------------------------------
	1059	CHARACTER(LEN=*), INTENT(IN) :: key, val
[2]	1060	TYPE(keys_type), INTENT(INOUT) :: ky(:)
[1]	1061	LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite
	1062	INTEGER :: itr
	1063	LOGICAL :: lo
	1064	!------------------------------------------------------------------------------------------------------------------------------
	1065	lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
	1066	DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lo); END DO
	1067	END SUBROUTINE addKey_m
	1068	!==============================================================================================================================
	1069	SUBROUTINE addKeysFromDef(t, tr0)
	1070	!------------------------------------------------------------------------------------------------------------------------------
	1071	! Purpose: The values of the keys of the tracer named "tr0" are overwritten by the values found in the *.def files, if any.
	1072	!------------------------------------------------------------------------------------------------------------------------------
[2]	1073	TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
	1074	CHARACTER(LEN=*), INTENT(IN) :: tr0
	1075	CHARACTER(LEN=maxlen) :: val
	1076	INTEGER :: ik, jd
[1]	1077	jd = strIdx(t%name, tr0)
	1078	IF(jd == 0) RETURN
	1079	DO ik = 1, SIZE(t(jd)%keys%key)
	1080	CALL get_in(t(jd)%keys%key(ik), val, 'zzzz')
	1081	IF(val /= 'zzzz') CALL addKey_1(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
	1082	END DO
	1083	END SUBROUTINE addKeysFromDef
	1084	!==============================================================================================================================
	1085	SUBROUTINE delKey_1(itr, keyn, ky)
	1086	!------------------------------------------------------------------------------------------------------------------------------
	1087	! Purpose: Internal routine.
	1088	! Remove <key>=<val> pairs in the "itr"th component of the "ky" keys descriptor.
	1089	!------------------------------------------------------------------------------------------------------------------------------
	1090	INTEGER, INTENT(IN) :: itr
	1091	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
[2]	1092	TYPE(trac_type), INTENT(INOUT) :: ky(:)
	1093	CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
	1094	LOGICAL, ALLOCATABLE :: ll(:)
[1]	1095	INTEGER :: iky
	1096	!------------------------------------------------------------------------------------------------------------------------------
	1097	IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range
	1098	ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
	1099	k = PACK(ky(itr)%keys%key, MASK=ll); CALL MOVE_ALLOC(FROM=k, TO=ky(itr)%keys%key)
	1100	v = PACK(ky(itr)%keys%val, MASK=ll); CALL MOVE_ALLOC(FROM=v, TO=ky(itr)%keys%val)
	1101	END SUBROUTINE delKey_1
	1102	!==============================================================================================================================
	1103	SUBROUTINE delKey(keyn, ky)
	1104	!------------------------------------------------------------------------------------------------------------------------------
	1105	! Purpose: Internal routine.
	1106	! Remove <key>=<val> pairs in all the components of the "t" tracers descriptor.
	1107	!------------------------------------------------------------------------------------------------------------------------------
	1108	CHARACTER(LEN=*), INTENT(IN) :: keyn(:)
[2]	1109	TYPE(trac_type), INTENT(INOUT) :: ky(:)
[1]	1110	INTEGER :: iky
	1111	!------------------------------------------------------------------------------------------------------------------------------
	1112	DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
	1113	END SUBROUTINE delKey
	1114	!==============================================================================================================================
	1115
	1116
	1117	!==============================================================================================================================
	1118	!=== PUBLIC ROUTINES: GET A KEY FROM A <key>=<val> LIST ; VECTORS, TRACER AND DATABASE VERSIONS ===============================
	1119	!=== BEWARE !!! IF THE "ky" ARGUMENT IS NOT PRESENT, THEN THE VARIABLES "tracers" AND "isotopes" ARE USED. ====================
	1120	!=== THEY ARE LOCAL TO THIS MODULE, SO MUST MUST BE INITIALIZED FIRST USING the "getKey_init" ROUTINE ====================
	1121	!==============================================================================================================================
	1122	SUBROUTINE getKey_init(tracers_, isotopes_)
[2]	1123	TYPE(trac_type), OPTIONAL, INTENT(IN) :: tracers_(:)
	1124	TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
[1]	1125	IF(PRESENT( tracers_)) tracers = tracers_
	1126	IF(PRESENT(isotopes_)) isotopes = isotopes_
	1127	END SUBROUTINE getKey_init
	1128	!==============================================================================================================================
[2]	1129	CHARACTER(LEN=maxlen) FUNCTION fgetKey(itr, keyn, ky, def_val) RESULT(out)
[1]	1130	!------------------------------------------------------------------------------------------------------------------------------
	1131	! Purpose: Internal function ; get a key value in string format (this is the returned argument).
	1132	!------------------------------------------------------------------------------------------------------------------------------
	1133	INTEGER, INTENT(IN) :: itr
	1134	CHARACTER(LEN=*), INTENT(IN) :: keyn
[2]	1135	TYPE(keys_type), INTENT(IN) :: ky(:)
[1]	1136	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
	1137	!------------------------------------------------------------------------------------------------------------------------------
	1138	INTEGER :: ik
	1139	ik = 0; IF(itr>0 .AND. itr<=SIZE(ky)) ik = strIdx(ky(itr)%key(:), keyn)
	1140	out = ''; IF(ik /= 0) out = ky(itr)%val(ik) !--- Key was found
	1141	IF(PRESENT(def_val) .AND. ik == 0) out = def_val !--- Default value from arguments
	1142	END FUNCTION fgetKey
	1143	!==============================================================================================================================
	1144	LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
	1145	!--- Purpose: Get the value of the key named "keyn" for the tracer named "tnam".
	1146	! * "ky" unspecified: try in "tracers" for "tnam" with phase and tagging suffixes, then in "isotopes" without.
	1147	! * "ky" specified: try in "ky" for "tnam" with phase and tagging suffixes, then without.
	1148	! The returned error code is always .FALSE.: an empty string is returned when the key hasn't been found.
[2]	1149	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1150	CHARACTER(LEN=maxlen), INTENT(OUT) :: val
	1151	CHARACTER(LEN=*), INTENT(IN) :: tname
	1152	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
[1]	1153	INTEGER :: is
	1154	lerr = .FALSE.
	1155	IF(PRESENT(ky)) THEN
[12]	1156	val = getKeyByName_prv(keyn, tname, ky); IF(val /= '') RETURN !--- "ky" and "tnam"
[1]	1157	val = getKeyByName_prv(keyn, delPhase(strHead(tname,'_')), ky) !--- "ky" and "tnam" without phase
	1158	ELSE
	1159	IF(.NOT.ALLOCATED(tracers)) RETURN
	1160	val = getKeyByName_prv(keyn, tname, tracers(:)%keys); IF(val /= '') RETURN !--- "tracers" and "tnam"
	1161	IF(.NOT.ALLOCATED(isotopes)) RETURN
	1162	IF(SIZE(isotopes) == 0) RETURN
	1163	DO is = 1, SIZE(isotopes); IF(strIdx(isotopes(is)%keys(:)%name, delPhase(strHead(tname,'_'))) /= 0) EXIT; END DO
	1164	IF(is /= 0) val = getKeyByName_prv(keyn, tname, isotopes(is)%keys(:)) !--- "isotopes" and "tnam" without phase
	1165	END IF
	1166
	1167	CONTAINS
	1168
	1169	FUNCTION getKeyByName_prv(keyn, tname, ky) RESULT(val)
[2]	1170	CHARACTER(LEN=maxlen) :: val
[1]	1171	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1172	CHARACTER(LEN=*), INTENT(IN) :: tname
[2]	1173	TYPE(keys_type), INTENT(IN) :: ky(:)
[1]	1174	INTEGER :: itr, iky
	1175	val = ''; iky = 0
	1176	itr = strIdx(ky(:)%name, tname); IF(itr==0) RETURN !--- Get the index of the wanted tracer
	1177	IF(itr /= 0) iky = strIdx(ky(itr)%key(:), keyn); IF(iky==0) RETURN !--- Wanted key index
	1178	val = ky(itr)%val(iky)
	1179	END FUNCTION getKeyByName_prv
	1180
	1181	END FUNCTION getKeyByName_s1
	1182	!==============================================================================================================================
	1183	LOGICAL FUNCTION getKeyByName_sm(keyn, val, tnam, ky) RESULT(lerr)
	1184	CHARACTER(LEN=*), INTENT(IN) :: keyn
[2]	1185	CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
[1]	1186	CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: tnam(:)
[2]	1187	TYPE(keys_type), TARGET, OPTIONAL, INTENT(IN) :: ky(:)
[12]	1188	TYPE(keys_type), POINTER :: k(:)
	1189	CHARACTER(LEN=maxlen), POINTER :: n(:)
[1]	1190	INTEGER :: iq
[12]	1191	k => tracers(:)%keys; IF(PRESENT(ky )) k => ky
	1192	n => k(:)%name; IF(PRESENT(tnam)) n => tnam
[1]	1193	ALLOCATE(val(SIZE(n)))
[12]	1194	lerr = ANY([(getKeyByName_s1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
[1]	1195	END FUNCTION getKeyByName_sm
	1196	!==============================================================================================================================
	1197	LOGICAL FUNCTION getKeyByName_i1(keyn, val, tnam, ky) RESULT(lerr)
[2]	1198	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1199	INTEGER, INTENT(OUT) :: val
	1200	CHARACTER(LEN=*), INTENT(IN) :: tnam
	1201	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1202	CHARACTER(LEN=maxlen) :: sval
[1]	1203	INTEGER :: ierr
	1204	IF( PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam, ky)
	1205	IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam)
[2]	1206	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tnam)//'" is missing', modname, lerr), lerr)) RETURN
[1]	1207	READ(sval, *, IOSTAT=ierr) val
[2]	1208	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tnam)//'" is not an integer', modname, lerr), lerr)) RETURN
[1]	1209	END FUNCTION getKeyByName_i1
	1210	!==============================================================================================================================
	1211	LOGICAL FUNCTION getKeyByName_im(keyn, val, tnam, ky) RESULT(lerr)
	1212	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1213	INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:)
	1214	CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: tnam(:)
[2]	1215	TYPE(keys_type), TARGET, OPTIONAL, INTENT(IN) :: ky(:)
[12]	1216	TYPE(keys_type), POINTER :: k(:)
[2]	1217	CHARACTER(LEN=maxlen), POINTER :: n(:)
[1]	1218	INTEGER :: iq
[12]	1219	k => tracers(:)%keys; IF(PRESENT(ky )) k => ky
	1220	n => k(:)%name; IF(PRESENT(tnam)) n => tnam
[1]	1221	ALLOCATE(val(SIZE(n)))
[12]	1222	lerr = ANY([(getKeyByName_i1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
[1]	1223	END FUNCTION getKeyByName_im
	1224	!==============================================================================================================================
	1225	LOGICAL FUNCTION getKeyByName_r1(keyn, val, tnam, ky) RESULT(lerr)
[2]	1226	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1227	REAL, INTENT(OUT) :: val
	1228	CHARACTER(LEN=*), INTENT(IN) :: tnam
	1229	TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:)
	1230	CHARACTER(LEN=maxlen) :: sval
[1]	1231	INTEGER :: ierr
	1232	IF( PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam, ky)
	1233	IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam)
[2]	1234	IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tnam)//'" is missing', modname, lerr), lerr)) RETURN
[1]	1235	READ(sval, *, IOSTAT=ierr) val
[2]	1236	IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tnam)//'" is not a real', modname, lerr), lerr)) RETURN
[1]	1237	END FUNCTION getKeyByName_r1
	1238	!==============================================================================================================================
	1239	LOGICAL FUNCTION getKeyByName_rm(keyn, val, tnam, ky) RESULT(lerr)
	1240	CHARACTER(LEN=*), INTENT(IN) :: keyn
	1241	REAL, ALLOCATABLE, INTENT(OUT) :: val(:)
	1242	CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: tnam(:)
[2]	1243	TYPE(keys_type), TARGET, OPTIONAL, INTENT(IN) :: ky(:)
[12]	1244	TYPE(keys_type), POINTER :: k(:)
[2]	1245	CHARACTER(LEN=maxlen), POINTER :: n(:)
[1]	1246	INTEGER :: iq
[12]	1247	k => tracers(:)%keys; IF(PRESENT(ky )) k => ky
	1248	n => k(:)%name; IF(PRESENT(tnam)) n => tnam
[1]	1249	ALLOCATE(val(SIZE(n)))
[12]	1250	lerr = ANY([(getKeyByName_r1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
[1]	1251	END FUNCTION getKeyByName_rm
	1252	!==============================================================================================================================
	1253
	1254
	1255	!==============================================================================================================================
	1256	!=== REMOVE, IF ANY, OR ADD THE PHASE SUFFIX OF THE TRACER NAMED "s" ==========================================================
	1257	!==============================================================================================================================
[2]	1258	ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
[1]	1259	CHARACTER(LEN=*), INTENT(IN) :: s
	1260	INTEGER :: l, i, ix
[7]	1261	CHARACTER(LEN=maxlen) :: sh, st
[1]	1262	out = s
	1263	IF(s == '') RETURN !--- Empty string: nothing to do
[6]	1264
	1265	!--- Special case: old phases for water, no phases separator
[7]	1266	i = INDEX(s,'_'); sh = s; IF(i/=0) sh=s(1:i-1); st='H2O'; IF(i/=0) st='H2O_'//s(i+1:LEN_TRIM(s))
	1267	IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == sh)) THEN; out=st; RETURN; END IF
[6]	1268
[1]	1269	!--- Index of found phase in "known_phases"
	1270	ix = MAXLOC( [(i, i=1,nphases)], MASK=[( INDEX(s, phases_sep//known_phases(i:i))/=0, i=1, nphases)], DIM=1 )
	1271	IF(ix == 0) RETURN !--- No phase pattern found
	1272	i = INDEX(s, phases_sep//known_phases(ix:ix)) !--- Index of <sep><pha> pattern in "str"
	1273	l = LEN_TRIM(s)
	1274	IF(i == l-1) THEN !--- <var><sep><pha> => return <var>
	1275	out = s(1:l-2)
	1276	ELSE IF(s(i+2:i+2) == '_') THEN !--- <var><sep><pha>_<tag> => return <var>_<tag>
	1277	out = s(1:i-1)//s(i+2:l)
	1278	END IF
	1279	END FUNCTION delPhase
	1280	!------------------------------------------------------------------------------------------------------------------------------
[12]	1281	CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha,ph_sep) RESULT(out)
[6]	1282	CHARACTER(LEN=*), INTENT(IN) :: s
	1283	CHARACTER(LEN=1), INTENT(IN) :: pha
	1284	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
	1285	CHARACTER(LEN=1) :: psep
[1]	1286	INTEGER :: l, i
	1287	out = s
	1288	IF(s == '') RETURN !--- Empty string: nothing to do
[6]	1289	psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
[1]	1290	i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names
	1291	l = LEN_TRIM(s)
[6]	1292	IF(i == 0) out = TRIM(s)//TRIM(psep)//pha !--- <var> => return <var><sep><pha>
	1293	IF(i /= 0) out = s(1:i-1)//TRIM(psep)//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>
[12]	1294	END FUNCTION addPhase_s1
[1]	1295	!------------------------------------------------------------------------------------------------------------------------------
[12]	1296	FUNCTION addPhase_sm(s,pha,ph_sep) RESULT(out)
[6]	1297	CHARACTER(LEN=*), INTENT(IN) :: s(:)
	1298	CHARACTER(LEN=1), INTENT(IN) :: pha
	1299	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
	1300	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	1301	CHARACTER(LEN=1) :: psep
[1]	1302	INTEGER :: k
[6]	1303	psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
[12]	1304	out = [( addPhase_s1(s(k), pha, psep), k=1, SIZE(s) )]
	1305	END FUNCTION addPhase_sm
[1]	1306	!------------------------------------------------------------------------------------------------------------------------------
[12]	1307	CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,ph_sep) RESULT(out)
	1308	CHARACTER(LEN=*), INTENT(IN) :: s
	1309	INTEGER, INTENT(IN) :: ipha
	1310	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
	1311	CHARACTER(LEN=1) :: psep
	1312	out = s
	1313	IF(s == '') RETURN !--- Empty string: nothing to do
	1314	psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
	1315	IF(psep == '') out = addPhase_s1(s, old_phases(ipha:ipha), psep)
	1316	IF(psep /= '') out = addPhase_s1(s, known_phases(ipha:ipha), psep)
	1317	END FUNCTION addPhase_i1
	1318	!------------------------------------------------------------------------------------------------------------------------------
	1319	FUNCTION addPhase_im(s,ipha,ph_sep) RESULT(out)
	1320	CHARACTER(LEN=*), INTENT(IN) :: s(:)
	1321	INTEGER, INTENT(IN) :: ipha
	1322	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
	1323	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	1324	CHARACTER(LEN=1) :: psep
	1325	INTEGER :: k
	1326	psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
	1327	out = [( addPhase_i1(s(k), ipha, psep), k=1, SIZE(s) )]
	1328	END FUNCTION addPhase_im
	1329	!------------------------------------------------------------------------------------------------------------------------------
[1]	1330
[7]	1331	CHARACTER(LEN=1) FUNCTION old2newPhase(op) RESULT(np)
	1332	CHARACTER(LEN=1), INTENT(IN) :: op
	1333	np = known_phases(INDEX(old_phases,op):INDEX(old_phases,op))
	1334	END FUNCTION old2newPhase
[1]	1335
[7]	1336	CHARACTER(LEN=1) FUNCTION new2oldPhase(np) RESULT(op)
	1337	CHARACTER(LEN=1), INTENT(IN) :: np
	1338	op = old_phases(INDEX(known_phases,np):INDEX(known_phases,np))
	1339	END FUNCTION new2oldPhase
	1340
[1]	1341	!==============================================================================================================================
	1342	!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen" IN THE TRACERS DESCRIPTORS LIST "tr" =======
	1343	!==============================================================================================================================
[2]	1344	CHARACTER(LEN=maxlen) FUNCTION ancestor_1(t, tname, igen) RESULT(out)
	1345	TYPE(trac_type), INTENT(IN) :: t(:)
[1]	1346	CHARACTER(LEN=*), INTENT(IN) :: tname
	1347	INTEGER, OPTIONAL, INTENT(IN) :: igen
	1348	INTEGER :: ig, ix
[6]	1349	ig = 0; IF(PRESENT(igen)) ig = igen
[1]	1350	ix = idxAncestor_1(t, tname, ig)
	1351	out = ''; IF(ix /= 0) out = t(ix)%name
	1352	END FUNCTION ancestor_1
	1353	!------------------------------------------------------------------------------------------------------------------------------
	1354	FUNCTION ancestor_m(t, tname, igen) RESULT(out)
[2]	1355	CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
	1356	TYPE(trac_type), INTENT(IN) :: t(:)
[1]	1357	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
	1358	INTEGER, OPTIONAL, INTENT(IN) :: igen
	1359	INTEGER, ALLOCATABLE :: ix(:)
	1360	INTEGER :: ig
[6]	1361	ig = 0; IF(PRESENT(igen)) ig = igen
[1]	1362	IF( PRESENT(tname)) ix = idxAncestor_m(t, tname, ig)
	1363	IF(.NOT.PRESENT(tname)) ix = idxAncestor_m(t, t(:)%name, ig)
	1364	ALLOCATE(out(SIZE(ix))); out(:) = ''
	1365	WHERE(ix /= 0) out = t(ix)%name
	1366	END FUNCTION ancestor_m
	1367	!==============================================================================================================================
	1368
	1369
	1370	!==============================================================================================================================
	1371	!=== GET THE INDEX(ES) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen" IN THE TRACERS DESCRIPTORS LIST "tr" =====
	1372	!==============================================================================================================================
	1373	INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out)
[6]	1374	! Return the name of the generation "igen" (>=0) ancestor of "tname"
[2]	1375	TYPE(trac_type), INTENT(IN) :: t(:)
[1]	1376	CHARACTER(LEN=*), INTENT(IN) :: tname
	1377	INTEGER, OPTIONAL, INTENT(IN) :: igen
	1378	INTEGER :: ig
[6]	1379	ig = 0; IF(PRESENT(igen)) ig = igen
[1]	1380	out = strIdx(t(:)%name, tname)
[6]	1381	IF(out == 0) RETURN !--- Tracer not found
	1382	IF(t(out)%iGeneration <= ig) RETURN !--- Tracer has a lower generation number than asked generation 'igen"
[2]	1383	DO WHILE(t(out)%iGeneration > ig); out = strIdx(t(:)%name, t(out)%parent); END DO
[1]	1384	END FUNCTION idxAncestor_1
	1385	!------------------------------------------------------------------------------------------------------------------------------
	1386	FUNCTION idxAncestor_m(t, tname, igen) RESULT(out)
	1387	INTEGER, ALLOCATABLE :: out(:)
[2]	1388	TYPE(trac_type), INTENT(IN) :: t(:)
[1]	1389	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
	1390	INTEGER, OPTIONAL, INTENT(IN) :: igen
	1391	INTEGER :: ig, ix
[6]	1392	ig = 0; IF(PRESENT(igen)) ig = igen
[1]	1393	IF( PRESENT(tname)) out = [(idxAncestor_1(t, tname(ix), ig), ix=1, SIZE(tname))]
	1394	IF(.NOT.PRESENT(tname)) out = [(idxAncestor_1(t, t(ix)%name, ig), ix=1, SIZE(t))]
	1395	END FUNCTION idxAncestor_m
	1396	!==============================================================================================================================
	1397
	1398
	1399	END MODULE readTracFiles_mod

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

Download in other formats:

Original Format