Index: LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 =================================================================== --- LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 (revision 4327) +++ LMDZ6/trunk/libf/misc/readTracFiles_mod.f90 (revision 4328) @@ -12,5 +12,5 @@ PUBLIC :: trac_type, setGeneration, indexUpdate !--- TRACERS DESCRIPTION ASSOCIATED TOOLS PUBLIC :: testTracersFiles, readTracersFiles !--- TRACERS FILES READING ROUTINES - PUBLIC :: getKey, fGetKey, fGetKeys, setDirectKeys !--- TOOLS TO GET/SET KEYS FROM/TO tracers & isotopes + PUBLIC :: getKey, fGetKey, fGetKeys, addKey, setDirectKeys !--- TOOLS TO GET/SET KEYS FROM/TO tracers & isotopes PUBLIC :: getKeysDBase, setKeysDBase !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes) @@ -92,7 +92,8 @@ !------------------------------------------------------------------------------------------------------------------------------ INTERFACE getKey - MODULE PROCEDURE getKeyByName_s1, getKeyByName_i1, getKeyByName_r1, & - getKeyByName_sm, getKeyByName_im, getKeyByName_rm, & - getKeyByName_s1m, getKeyByName_i1m, getKeyByName_r1m + MODULE PROCEDURE getKeyByName_s1, getKeyByName_s1m, getKeyByName_sm, getKey_sm, & + getKeyByName_i1, getKeyByName_i1m, getKeyByName_im, getKey_im, & + getKeyByName_r1, getKeyByName_r1m, getKeyByName_rm, getKey_rm, & + getKeyByName_l1, getKeyByName_l1m, getKeyByName_lm, getKey_lm END INTERFACE getKey !------------------------------------------------------------------------------------------------------------------------------ @@ -104,5 +105,5 @@ INTERFACE idxAncestor; MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt; END INTERFACE idxAncestor INTERFACE ancestor; MODULE PROCEDURE ancestor_1, ancestor_m, ancestor_mt; END INTERFACE ancestor - INTERFACE addKey; MODULE PROCEDURE addKey_1, addKey_m, addKey_mm; END INTERFACE addKey + INTERFACE addKey; MODULE PROCEDURE addKey_1; END INTERFACE addKey!, addKey_m, addKey_mm; END INTERFACE addKey INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase !------------------------------------------------------------------------------------------------------------------------------ @@ -196,5 +197,5 @@ !--- Required sections + corresponding files names (new style single section case) for tests - IF(test(testTracersFiles(modname, type_trac, fType, trac_files, sections), lerr)) RETURN + IF(test(testTracersFiles(modname, type_trac, fType, .TRUE., trac_files, sections), lerr)) RETURN IF(PRESENT(fTyp)) fTyp = fType nsec = SIZE(sections) @@ -229,5 +230,5 @@ IF(ix /= 0 .AND. lRep) tname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY) tracers(it)%name = tname !--- Set %name - CALL addKey('name', tname, k) !--- Set the name of the tracer + CALL addKey_1('name', tname, k) !--- Set the name of the tracer tracers(it)%keys%name = tname !--- Copy tracers names in keys components @@ -236,5 +237,5 @@ IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz' tracers(it)%component = cname !--- Set %component - CALL addKey('component', cname, k) !--- Set the name of the model component + CALL addKey_1('component', cname, k) !--- Set the name of the model component !=== NAME OF THE PARENT @@ -246,16 +247,18 @@ END IF tracers(it)%parent = pname !--- Set %parent - CALL addKey('parent', pname, k) + CALL addKey_1('parent', pname, k) !=== PHASE AND ADVECTION SCHEMES NUMBERS tracers(it)%phase = known_phases(ip:ip) !--- Set %phase: tracer phase (default: "g"azeous) - CALL addKey('phase', known_phases(ip:ip), k) !--- Set the phase of the tracer (default: "g"azeous) - CALL addKey('hadv', s(1), k) !--- Set the horizontal advection schemes number - CALL addKey('vadv', s(2), k) !--- Set the vertical advection schemes number + CALL addKey_1('phase', known_phases(ip:ip), k) !--- Set the phase of the tracer (default: "g"azeous) + CALL addKey_1('hadv', s(1), k) !--- Set the horizontal advection schemes number + CALL addKey_1('vadv', s(2), k) !--- Set the vertical advection schemes number END DO CLOSE(90) IF(test(setGeneration(tracers), lerr)) RETURN !--- Set %iGeneration and %gen0Name WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag' !--- Set %type: 'tracer' or 'tag' - CALL addKey('type', tracers(:)%type, tracers(:)%keys) !--- Set the type of tracers + DO it=1,ntrac + CALL addKey_1('type', tracers(it)%type, tracers(it)%keys) !--- Set the type of tracer + END DO IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN !--- Detect orphans and check phases IF(test(checkUnique (tracers, fname, fname), lerr)) RETURN !--- Detect repeated tracers @@ -268,5 +271,4 @@ END SELECT !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - IF(ALL([2,3] /= fType)) RETURN @@ -286,12 +288,12 @@ !============================================================================================================================== -LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, tracf, sects) RESULT(lerr) +LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr) CHARACTER(LEN=*), INTENT(IN) :: modname, type_trac INTEGER, INTENT(OUT) :: fType + LOGICAL, INTENT(IN) :: lDisp CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:) CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:) LOGICAL, ALLOCATABLE :: ll(:) INTEGER :: is, nsec - lerr = .FALSE. !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINNGLE SECTION PER FILE) @@ -307,4 +309,5 @@ IF(.NOT.testFile('tracer.def')) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED + IF(.NOT.test(lDisp, lerr)) RETURN !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN @@ -523,5 +526,6 @@ tr(it)%type = fgetKey(it, 'type' , tr(:)%keys, 'tracer') tr(it)%component = sname - CALL addKey('component', sname, tr(:)%keys) +! CALL addKey_m('component', sname, tr(:)%keys) + DO iq=1,SIZE(tr); CALL addKey_1('component', sname, tr(iq)%keys); END DO !--- Determine the number of tracers and parents ; coherence checking @@ -552,8 +556,8 @@ ttr(iq)%keys%val = tr(it)%keys%val ttr(iq)%keys%name = ta(itr) - ttr(iq)%name = TRIM(ta(itr)); CALL addKey('name', ta(itr), ttr(iq)%keys) - ttr(iq)%parent = TRIM(pa(ipr)); CALL addKey('parent', pa(ipr), ttr(iq)%keys) - ttr(iq)%type = tr(it)%type; CALL addKey('type', tr(it)%type, ttr(iq)%keys) - ttr(iq)%component = tr(it)%component; CALL addKey('component', tr(it)%component, ttr(iq)%keys) + ttr(iq)%name = TRIM(ta(itr)); CALL addKey_1('name', ta(itr), ttr(iq)%keys) + ttr(iq)%parent = TRIM(pa(ipr)); CALL addKey_1('parent', pa(ipr), ttr(iq)%keys) + ttr(iq)%type = tr(it)%type; CALL addKey_1('type', tr(it)%type, ttr(iq)%keys) + ttr(iq)%component = tr(it)%component; CALL addKey_1('component', tr(it)%component, ttr(iq)%keys) iq = iq+1 END DO @@ -568,4 +572,5 @@ !============================================================================================================================== + !============================================================================================================================== LOGICAL FUNCTION setGeneration(tr) RESULT(lerr) @@ -574,31 +579,26 @@ ! * %iGeneration: the generation number ! * %gen0Name: the generation 0 ancestor name +! Check also for orphan tracers (tracers not descending on "tran0"). !------------------------------------------------------------------------------------------------------------------------------ TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector - INTEGER :: iq, nq, ig - CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), prn(:) - CHARACTER(LEN=maxlen) :: gen0(SIZE(tr)) - INTEGER :: iGen(SIZE(tr)) - LOGICAL :: lg(SIZE(tr)) -!------------------------------------------------------------------------------------------------------------------------------ - iGen(:) = -1 !--- error if -1 - nq = SIZE(tr, DIM=1) !--- Number of tracers lines - IF(test(fmsg('missing "parent" attribute', 'setGeneration', getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN - WHERE(parent == tran0) iGen(:) = 0 - - !=== Determine generation for each tracer - ig=-1; prn = [tran0] - DO !--- Update current generation flag - IF(ig/=-1) prn = PACK( tr(:)%name, MASK = iGen == ig) - lg(:) = [(ANY(prn(:) == parent(iq)), iq=1, nq)] !--- Current generation tracers flag - IF( ALL( .NOT. lg ) ) EXIT !--- Empty current generation - ig = ig+1; WHERE(lg) iGen(:) = ig - END DO - tr%iGeneration = iGen; CALL addKey_mm('iGeneration', int2str(iGen(:)), tr(:)%keys) - CALL ancestor(tr, gen0) !--- First generation ancestor name - tr%gen0Name = gen0; CALL addKey_mm('gen0Name', gen0, tr(:)%keys) - + INTEGER :: iq, jq, ig + CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen) :: modname + modname = 'setGeneration' + IF(test(fmsg('missing "parent" attribute', modname, getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN + DO iq = 1, SIZE(tr) + jq = iq; ig = 0 + DO WHILE(parent(jq) /= tran0) + jq = strIdx(tr(:)%name, parent(iq)) + IF(test(fmsg('Orphan tracer "'//TRIM(tr(iq)%name)//'"', modname, jq == 0), lerr)) RETURN + ig = ig + 1 + END DO + tr(iq)%gen0Name = tr(jq)%name; CALL addKey_1('gen0Name', tr(iq)%gen0Name, tr(iq)%keys) + tr(iq)%iGeneration = ig; CALL addKey_1('iGeneration', TRIM(int2str(ig)), tr(iq)%keys) + END DO END FUNCTION setGeneration !============================================================================================================================== + !============================================================================================================================== @@ -634,4 +634,5 @@ END FUNCTION checkTracers !============================================================================================================================== + !============================================================================================================================== @@ -673,4 +674,5 @@ END FUNCTION checkUnique !============================================================================================================================== + !============================================================================================================================== @@ -720,11 +722,11 @@ ttr(it)%keys%name = TRIM(nam) !--- Name inside the keys decriptor ttr(it)%phase = p !--- Single phase entry - CALL addKey('name', nam, ttr(it)%keys) - CALL addKey('phase', p, ttr(it)%keys) + CALL addKey_1('name', nam, ttr(it)%keys) + CALL addKey_1('phase', p, ttr(it)%keys) IF(lExt .AND. tr(iq)%iGeneration>0) THEN ttr(it)%parent = addPhase(tr(iq)%parent, p) ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p) - CALL addKey('parent', ttr(it)%parent, ttr(it)%keys) - CALL addKey('gen0Name', ttr(it)%gen0Name, ttr(it)%keys) + CALL addKey_1('parent', ttr(it)%parent, ttr(it)%keys) + CALL addKey_1('gen0Name', ttr(it)%gen0Name, ttr(it)%keys) END IF it = it+1 @@ -738,4 +740,5 @@ END SUBROUTINE expandPhases !============================================================================================================================== + !============================================================================================================================== @@ -998,5 +1001,5 @@ INTEGER :: iq, ig, ng, igen, ngen, ix(SIZE(tr)) tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent ) !--- Parent index - CALL addKey('iqParent', int2str(tr%iqParent), tr(:)%keys) + DO iq = 1, SIZE(tr); CALL addKey_1('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.) DO iq = 1, SIZE(tr) @@ -1010,10 +1013,11 @@ IF(igen == ig+1) THEN tr(iq)%nqChildren = tr(iq)%nqDescen - CALL addKey('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys) + CALL addKey_1('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys) END IF END DO - CALL addKey('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys) - END DO - CALL addKey('nqDescen', int2str(tr(:)%nqDescen), tr(:)%keys) + CALL addKey_1('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys) + CALL addKey_1('nqDescen', int2str(tr(iq)%nqDescen) , tr(iq)%keys) + END DO +print*,'coin9' END SUBROUTINE indexUpdate !============================================================================================================================== @@ -1308,5 +1312,6 @@ IF(iky == 0) THEN nky = SIZE(ky%key) - IF(nky == 0) THEN; ky%key = [key]; ky%val = [val]; ELSE; ky%key = [ky%key, key]; ky%val = [ky%val, val]; END IF + ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k + ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = val; ky%val = v ELSE IF(lo) THEN ky%key(iky) = key; ky%val(iky) = val @@ -1320,5 +1325,9 @@ !------------------------------------------------------------------------------------------------------------------------------ INTEGER :: itr - DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lOverWrite); END DO + DO itr = 1, SIZE(ky) + CALL addKey_1(key, val, ky(itr), lOverWrite) + PRINT*,'COINCOINCOIN '//TRIM(key)//', '//TRIM(val)//', '//TRIM(ky(itr)%name) + END DO + print*,'COINCOINCOINCOIN' END SUBROUTINE addKey_m !============================================================================================================================== @@ -1458,39 +1467,4 @@ END FUNCTION getKeyByName_s1 !============================================================================================================================== -LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr) - CHARACTER(LEN=*), INTENT(IN) :: keyn - CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:) - CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN) :: tname(:) - TYPE(keys_type), TARGET, OPTIONAL, INTENT(IN) :: ky(:) - CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: nam(:) -!------------------------------------------------------------------------------------------------------------------------------ - CHARACTER(LEN=maxlen), ALLOCATABLE :: names(:) - TYPE(keys_type), POINTER :: keys(:) - LOGICAL :: lk, lt, li, ll - INTEGER :: iq, nq - - !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope) - lk = PRESENT(ky) - lt = .NOT.lk .AND. ALLOCATED(tracers); IF(lt) lt = SIZE(tracers) /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn) - li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn) - - IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN - IF(lk) keys => ky(:) - IF(lt) keys => tracers(:)%keys - IF(li) keys => isotope%keys(:) - - !--- DETERMINE THE NAMES - IF(PRESENT(tname)) THEN - ALLOCATE(names(SIZE(tname))); names(:) = tname(:) - ELSE - ALLOCATE(names(SIZE(keys))); names(:) = keys(:)%name - END IF - nq = SIZE(names); ALLOCATE(val(nq)); IF(PRESENT(nam)) THEN; ALLOCATE(nam(nq)); nam(:) = names(:); END IF - - !--- GET THE DATA - lerr = ANY([(getKeyByName_s1(keyn, val(iq), names(iq), keys(:)), iq=1, nq)]) - -END FUNCTION getKeyByName_sm -!============================================================================================================================== LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr) CHARACTER(LEN=*), INTENT(IN) :: keyn @@ -1504,4 +1478,54 @@ lerr = strParse(sval, ',', val) END FUNCTION getKeyByName_s1m +!============================================================================================================================== +LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr) + CHARACTER(LEN=*), INTENT(IN) :: keyn + CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:) + CHARACTER(LEN=*), INTENT(IN) :: tname(:) + TYPE(keys_type), OPTIONAL, TARGET, INTENT(IN) :: ky(:) + CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:) +!------------------------------------------------------------------------------------------------------------------------------ + TYPE(keys_type), POINTER :: keys(:) + LOGICAL :: lk, lt, li, ll + INTEGER :: iq, nq + + !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope) + lk = PRESENT(ky) + lt = .NOT.lk .AND. ALLOCATED(tracers); IF(lt) lt = SIZE(tracers) /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn) + li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn) + + !--- LINK "keys" TO THE RIGHT DATABASE + IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN + IF(lk) keys => ky(:) + IF(lt) keys => tracers(:)%keys + IF(li) keys => isotope%keys(:) + + !--- GET THE DATA + nq = SIZE(tname) + ALLOCATE(val(nq)) + lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq), keys(:)), iq=1, nq)]) + IF(PRESENT(nam)) nam = tname(:) + +END FUNCTION getKeyByName_sm +!============================================================================================================================== +LOGICAL FUNCTION getKey_sm(keyn, val, ky, nam) RESULT(lerr) + CHARACTER(LEN=*), INTENT(IN) :: keyn + CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:) + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) + CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:) +!------------------------------------------------------------------------------------------------------------------------------ +! Note: if names are repeated, getKeyByName_sm can't be used ; this routine, using indexes, must be used instead. + IF(PRESENT(ky)) THEN !=== KEY FROM "ky" + val = fgetKeys(keyn, ky, lerr=lerr) + IF(PRESENT(nam)) nam = ky(:)%name + ELSE + IF( .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0 !=== KEY FROM "tracers" + IF(.NOT.lerr) val = fgetKeys(keyn, tracers%keys, lerr=lerr) + IF(.NOT.lerr.AND.PRESENT(nam)) nam = tracers(:)%keys%name + IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0 !=== KEY FROM "isotope" + IF(.NOT.lerr) val = fgetKeys(keyn, isotope%keys, lerr=lerr) + IF(.NOT.lerr.AND.PRESENT(nam)) nam = isotope%keys(:)%name + END IF +END FUNCTION getKey_sm !============================================================================================================================== LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr) @@ -1519,33 +1543,51 @@ END FUNCTION getKeyByName_i1 !============================================================================================================================== -LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr) - CHARACTER(LEN=*), INTENT(IN) :: keyn - INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:) - CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: tname(:) - TYPE(keys_type), OPTIONAL, TARGET, INTENT(IN) :: ky(:) -!------------------------------------------------------------------------------------------------------------------------------ - CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), nam(:) - INTEGER :: ierr, iq - IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN - ALLOCATE(val(SIZE(sval))) - DO iq = 1, SIZE(sval) !--- CONVERT THE KEYS TO INTEGERS - READ(sval(iq), *, IOSTAT=ierr) val(iq) - IF(test(fmsg('key "'//TRIM(keyn)//'" of "'//TRIM(nam(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN - END DO -END FUNCTION getKeyByName_im -!============================================================================================================================== LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr) - CHARACTER(LEN=*), INTENT(IN) :: keyn - INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:) - CHARACTER(LEN=*), INTENT(IN) :: tname - TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) -!------------------------------------------------------------------------------------------------------------------------------ - CHARACTER(LEN=maxlen), ALLOCATABLE :: v(:) - INTEGER :: ierr, iq - IF(test(getKeyByName_s1m(keyn, v, tname, ky), lerr)) RETURN - ALLOCATE(val(SIZE(v))) - lerr = .FALSE.; DO iq=1, SIZE(v); READ(v(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO + CHARACTER(LEN=*), INTENT(IN) :: keyn + INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:) + CHARACTER(LEN=*), INTENT(IN) :: tname + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) + INTEGER :: ierr, iq, nq + IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN END FUNCTION getKeyByName_i1m +!============================================================================================================================== +LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky, nam) RESULT(lerr) + CHARACTER(LEN=*), INTENT(IN) :: keyn + INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:) + CHARACTER(LEN=*), INTENT(IN) :: tname(:) + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) + CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:) + INTEGER :: ierr, iq, nq + IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS + READ(sval(iq), *, IOSTAT=ierr) val(iq) + IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN + END DO +END FUNCTION getKeyByName_im +!============================================================================================================================== +LOGICAL FUNCTION getKey_im(keyn, val, ky, nam) RESULT(lerr) + CHARACTER(LEN=*), INTENT(IN) :: keyn + INTEGER, ALLOCATABLE, INTENT(OUT) :: val(:) + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) + CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:) + INTEGER :: ierr, iq, nq + IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + DO iq = 1, nq + READ(sval(iq), *, IOSTAT=ierr) val(iq) + IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN + END DO + IF(PRESENT(nam)) nam = names +END FUNCTION getKey_im !============================================================================================================================== LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr) @@ -1563,20 +1605,4 @@ END FUNCTION getKeyByName_r1 !============================================================================================================================== -LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky) RESULT(lerr) - CHARACTER(LEN=*), INTENT(IN) :: keyn - REAL, ALLOCATABLE, INTENT(OUT) :: val(:) - CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:) - TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) -!------------------------------------------------------------------------------------------------------------------------------ - CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), nam(:) - INTEGER :: ierr, iq - IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN - ALLOCATE(val(SIZE(sval))) - DO iq = 1, SIZE(sval) !--- CONVERT THE KEYS TO INTEGERS - READ(sval(iq), *, IOSTAT=ierr) val(iq) - IF(test(fmsg('key "'//TRIM(keyn)//'" of "'//TRIM(nam(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN - END DO -END FUNCTION getKeyByName_rm -!============================================================================================================================== LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr) CHARACTER(LEN=*), INTENT(IN) :: keyn @@ -1585,12 +1611,103 @@ TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) !------------------------------------------------------------------------------------------------------------------------------ - CHARACTER(LEN=maxlen), ALLOCATABLE :: v(:) - INTEGER :: ierr, iq - IF( PRESENT(ky)) lerr = getKeyByName_s1m(keyn, v, tname, ky) - IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1m(keyn, v, tname) - ALLOCATE(val(SIZE(v))) - lerr = .FALSE.; DO iq=1, SIZE(v); READ(v(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO - IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) + INTEGER :: ierr, iq, nq + IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO + IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a vector of reals', modname, lerr), lerr)) RETURN END FUNCTION getKeyByName_r1m +!============================================================================================================================== +LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky, nam) RESULT(lerr) + CHARACTER(LEN=*), INTENT(IN) :: keyn + REAL, ALLOCATABLE, INTENT(OUT) :: val(:) + CHARACTER(LEN=*), INTENT(IN) :: tname(:) + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) + CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:) + INTEGER :: ierr, iq, nq + IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS + READ(sval(iq), *, IOSTAT=ierr) val(iq) + IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN + END DO + IF(PRESENT(nam)) nam = names +END FUNCTION getKeyByName_rm +!============================================================================================================================== +LOGICAL FUNCTION getKey_rm(keyn, val, ky, nam) RESULT(lerr) + CHARACTER(LEN=*), INTENT(IN) :: keyn + REAL, ALLOCATABLE, INTENT(OUT) :: val(:) + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) + CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:) + INTEGER :: ierr, iq, nq + IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + DO iq = 1, nq !--- CONVERT THE KEYS TO INTEGERS + READ(sval(iq), *, IOSTAT=ierr) val(iq) + IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN + END DO + IF(PRESENT(nam)) nam = names +END FUNCTION getKey_rm +!============================================================================================================================== +LOGICAL FUNCTION getKeyByName_l1(keyn, val, tname, ky) RESULT(lerr) + USE strings_mod, ONLY: str2bool + CHARACTER(LEN=*), INTENT(IN) :: keyn + LOGICAL, INTENT(OUT) :: val + CHARACTER(LEN=*), INTENT(IN) :: tname + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen) :: sval + INTEGER :: ierr + lerr = getKeyByName_s1(keyn, sval, tname, ky) + IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN + val = str2bool(sval) +END FUNCTION getKeyByName_l1 +!============================================================================================================================== +LOGICAL FUNCTION getKeyByName_l1m(keyn, val, tname, ky) RESULT(lerr) + USE strings_mod, ONLY: str2bool + CHARACTER(LEN=*), INTENT(IN) :: keyn + LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:) + CHARACTER(LEN=*), INTENT(IN) :: tname + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) + INTEGER :: ierr, iq, nq + IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO +END FUNCTION getKeyByName_l1m +!============================================================================================================================== +LOGICAL FUNCTION getKeyByName_lm(keyn, val, tname, ky, nam) RESULT(lerr) + USE strings_mod, ONLY: str2bool + CHARACTER(LEN=*), INTENT(IN) :: keyn + LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:) + CHARACTER(LEN=*), INTENT(IN) :: tname(:) + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) + CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) + INTEGER :: ierr, iq, nq + IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO +END FUNCTION getKeyByName_lm +!============================================================================================================================== +LOGICAL FUNCTION getKey_lm(keyn, val, ky, nam) RESULT(lerr) + USE strings_mod, ONLY: str2bool + CHARACTER(LEN=*), INTENT(IN) :: keyn + LOGICAL, ALLOCATABLE, INTENT(OUT) :: val(:) + TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) + CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:) + INTEGER :: ierr, iq, nq + IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN + nq = SIZE(sval); ALLOCATE(val(nq)) + lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO +END FUNCTION getKey_lm !============================================================================================================================== @@ -1609,5 +1726,5 @@ IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF IF(PRESENT(isotope_ )) THEN - ix = strIdx(isotopes(:)%parent, isotope%parent) + ix = strIdx(isotopes(:)%parent, isotope_%parent) IF(ix /= 0) THEN isotopes(ix) = isotope_ Index: LMDZ6/trunk/libf/phylmd/infotrac_phy.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/infotrac_phy.F90 (revision 4327) +++ LMDZ6/trunk/libf/phylmd/infotrac_phy.F90 (revision 4328) @@ -251,5 +251,6 @@ IF(readTracersFiles(type_trac, fType, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) ELSE - IF(testTracersFiles(modname, type_trac, fType)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) + CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname) + IF(testTracersFiles(modname, type_trac, fType, .FALSE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) END IF !##############################################################################################################################