Ignore:
Timestamp:
Nov 8, 2022, 3:49:23 PM (20 months ago)
Author:
dcugnet
Message:
  • rewrite few routines from "readTracFiles_mod" to avoid crashes with gfortran, in particular "setGeneration" and "addKey".
  • make "addKey" routine public and replace "addKey_m" and "addKey_mm" with callings to "addKey_1" in loops to avoid a gfortran-specific crash
  • rewrite the "getKey" functions family so that when "tname" is not specified, result is as expected, even for tracers lists with repeated tracers (use index instead of name search).
File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

    r4327 r4328  
    1212  PUBLIC :: trac_type, setGeneration, indexUpdate               !--- TRACERS  DESCRIPTION ASSOCIATED TOOLS
    1313  PUBLIC :: testTracersFiles, readTracersFiles                  !--- TRACERS FILES READING ROUTINES
    14   PUBLIC :: getKey, fGetKey, fGetKeys, setDirectKeys            !--- TOOLS TO GET/SET KEYS FROM/TO  tracers & isotopes
     14  PUBLIC :: getKey, fGetKey, fGetKeys, addKey, setDirectKeys    !--- TOOLS TO GET/SET KEYS FROM/TO  tracers & isotopes
    1515  PUBLIC :: getKeysDBase,    setKeysDBase                       !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
    1616
    … …  
    9292!------------------------------------------------------------------------------------------------------------------------------
    9393  INTERFACE getKey
    94     MODULE PROCEDURE getKeyByName_s1,  getKeyByName_i1,  getKeyByName_r1, &
    95                      getKeyByName_sm,  getKeyByName_im,  getKeyByName_rm, &
    96                      getKeyByName_s1m, getKeyByName_i1m, getKeyByName_r1m
     94    MODULE PROCEDURE getKeyByName_s1, getKeyByName_s1m, getKeyByName_sm, getKey_sm, &
     95                     getKeyByName_i1, getKeyByName_i1m, getKeyByName_im, getKey_im, &
     96                     getKeyByName_r1, getKeyByName_r1m, getKeyByName_rm, getKey_rm, &
     97                     getKeyByName_l1, getKeyByName_l1m, getKeyByName_lm, getKey_lm
    9798  END INTERFACE getKey
    9899!------------------------------------------------------------------------------------------------------------------------------
    … …  
    104105  INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt;    END INTERFACE idxAncestor
    105106  INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m,    ancestor_mt;    END INTERFACE    ancestor
    106   INTERFACE      addKey;   MODULE PROCEDURE      addKey_1,      addKey_m,     addKey_mm;     END INTERFACE addKey
     107  INTERFACE      addKey;   MODULE PROCEDURE      addKey_1; END INTERFACE addKey!,      addKey_m,     addKey_mm;     END INTERFACE addKey
    107108  INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
    108109!------------------------------------------------------------------------------------------------------------------------------
    … …  
    196197
    197198  !--- Required sections + corresponding files names (new style single section case) for tests
    198   IF(test(testTracersFiles(modname, type_trac, fType, trac_files, sections), lerr)) RETURN
     199  IF(test(testTracersFiles(modname, type_trac, fType, .TRUE., trac_files, sections), lerr)) RETURN
    199200  IF(PRESENT(fTyp)) fTyp = fType
    200201  nsec = SIZE(sections)
    … …  
    229230        IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
    230231        tracers(it)%name = tname                                     !--- Set %name
    231         CALL addKey('name', tname, k)                                !--- Set the name of the tracer
     232        CALL addKey_1('name', tname, k)                              !--- Set the name of the tracer
    232233        tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
    233234
    … …  
    236237        IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
    237238        tracers(it)%component = cname                                !--- Set %component
    238         CALL addKey('component', cname, k)                           !--- Set the name of the model component
     239        CALL addKey_1('component', cname, k)                         !--- Set the name of the model component
    239240
    240241        !=== NAME OF THE PARENT
    … …  
    246247        END IF
    247248        tracers(it)%parent = pname                                   !--- Set %parent
    248         CALL addKey('parent', pname, k)
     249        CALL addKey_1('parent', pname, k)
    249250
    250251        !=== PHASE AND ADVECTION SCHEMES NUMBERS
    251252        tracers(it)%phase = known_phases(ip:ip)                      !--- Set %phase:  tracer phase (default: "g"azeous)
    252         CALL addKey('phase', known_phases(ip:ip), k)                 !--- Set the phase  of the tracer (default: "g"azeous)
    253         CALL addKey('hadv', s(1),  k)                                !--- Set the horizontal advection schemes number
    254         CALL addKey('vadv', s(2),  k)                                !--- Set the vertical   advection schemes number
     253        CALL addKey_1('phase', known_phases(ip:ip), k)               !--- Set the phase  of the tracer (default: "g"azeous)
     254        CALL addKey_1('hadv', s(1),  k)                              !--- Set the horizontal advection schemes number
     255        CALL addKey_1('vadv', s(2),  k)                              !--- Set the vertical   advection schemes number
    255256      END DO
    256257      CLOSE(90)
    257258      IF(test(setGeneration(tracers), lerr)) RETURN                  !--- Set %iGeneration and %gen0Name
    258259      WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag'        !--- Set %type:        'tracer' or 'tag'
    259       CALL addKey('type', tracers(:)%type, tracers(:)%keys)          !--- Set the type of tracers
     260      DO it=1,ntrac
     261        CALL addKey_1('type', tracers(it)%type, tracers(it)%keys)    !--- Set the type of tracer
     262      END DO
    260263      IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN     !--- Detect orphans and check phases
    261264      IF(test(checkUnique (tracers, fname, fname), lerr)) RETURN     !--- Detect repeated tracers
    … …  
    268271  END SELECT
    269272  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    270 
    271273  IF(ALL([2,3] /= fType)) RETURN
    272274
    … …  
    286288
    287289!==============================================================================================================================
    288 LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, tracf, sects) RESULT(lerr)
     290LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
    289291  CHARACTER(LEN=*),                             INTENT(IN)  :: modname, type_trac
    290292  INTEGER,                                      INTENT(OUT) :: fType
     293  LOGICAL,                                      INTENT(IN)  :: lDisp
    291294  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
    292295  CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
    293296  LOGICAL, ALLOCATABLE :: ll(:)
    294297  INTEGER :: is, nsec
    295   lerr = .FALSE.
    296298
    297299  !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINNGLE SECTION PER FILE)
    … …  
    307309  IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
    308310  IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
     311  IF(.NOT.test(lDisp, lerr)) RETURN                                  !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
    309312  IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
    310313    IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
    … …  
    523526    tr(it)%type      = fgetKey(it, 'type'  , tr(:)%keys, 'tracer')
    524527    tr(it)%component = sname
    525     CALL addKey('component', sname, tr(:)%keys)
     528!   CALL addKey_m('component', sname, tr(:)%keys)
     529    DO iq=1,SIZE(tr); CALL addKey_1('component', sname, tr(iq)%keys); END DO
    526530
    527531    !--- Determine the number of tracers and parents ; coherence checking
    … …  
    552556        ttr(iq)%keys%val  = tr(it)%keys%val
    553557        ttr(iq)%keys%name = ta(itr)
    554         ttr(iq)%name      = TRIM(ta(itr));    CALL addKey('name',      ta(itr),          ttr(iq)%keys)
    555         ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey('parent',    pa(ipr),          ttr(iq)%keys)
    556         ttr(iq)%type      = tr(it)%type;      CALL addKey('type',      tr(it)%type,      ttr(iq)%keys)
    557         ttr(iq)%component = tr(it)%component; CALL addKey('component', tr(it)%component, ttr(iq)%keys)
     558        ttr(iq)%name      = TRIM(ta(itr));    CALL addKey_1('name',      ta(itr),          ttr(iq)%keys)
     559        ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey_1('parent',    pa(ipr),          ttr(iq)%keys)
     560        ttr(iq)%type      = tr(it)%type;      CALL addKey_1('type',      tr(it)%type,      ttr(iq)%keys)
     561        ttr(iq)%component = tr(it)%component; CALL addKey_1('component', tr(it)%component, ttr(iq)%keys)
    558562        iq = iq+1
    559563      END DO
    … …  
    568572!==============================================================================================================================
    569573
     574
    570575!==============================================================================================================================
    571576LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
    … …  
    574579!   * %iGeneration: the generation number
    575580!   * %gen0Name:    the generation 0 ancestor name
     581!          Check also for orphan tracers (tracers not descending on "tran0").
    576582!------------------------------------------------------------------------------------------------------------------------------
    577583  TYPE(trac_type),     INTENT(INOUT) :: tr(:)                        !--- Tracer derived type vector
    578   INTEGER                            :: iq, nq, ig
    579   CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), prn(:)
    580   CHARACTER(LEN=maxlen) :: gen0(SIZE(tr))
    581   INTEGER               :: iGen(SIZE(tr))
    582   LOGICAL               ::   lg(SIZE(tr))
    583 !------------------------------------------------------------------------------------------------------------------------------
    584   iGen(:) = -1                                                       !--- error if -1
    585   nq = SIZE(tr, DIM=1)                                               !--- Number of tracers lines
    586   IF(test(fmsg('missing "parent" attribute', 'setGeneration', getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
    587   WHERE(parent == tran0) iGen(:) = 0
    588 
    589   !=== Determine generation for each tracer
    590   ig=-1; prn = [tran0]
    591   DO                                                                 !--- Update current generation flag
    592     IF(ig/=-1) prn = PACK( tr(:)%name, MASK = iGen == ig)
    593     lg(:) = [(ANY(prn(:) == parent(iq)), iq=1, nq)]                  !--- Current generation tracers flag
    594     IF( ALL( .NOT. lg ) ) EXIT                                       !--- Empty current generation
    595     ig = ig+1; WHERE(lg) iGen(:) = ig
    596   END DO
    597   tr%iGeneration = iGen; CALL addKey_mm('iGeneration', int2str(iGen(:)), tr(:)%keys)
    598   CALL ancestor(tr, gen0)                                            !--- First generation ancestor name
    599   tr%gen0Name    = gen0; CALL addKey_mm('gen0Name',    gen0,             tr(:)%keys)
    600 
     584  INTEGER                            :: iq, jq, ig
     585  CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:)
     586!------------------------------------------------------------------------------------------------------------------------------
     587  CHARACTER(LEN=maxlen) :: modname
     588  modname = 'setGeneration'
     589  IF(test(fmsg('missing "parent" attribute', modname, getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
     590  DO iq = 1, SIZE(tr)
     591    jq = iq; ig = 0
     592    DO WHILE(parent(jq) /= tran0)
     593      jq = strIdx(tr(:)%name, parent(iq))
     594      IF(test(fmsg('Orphan tracer "'//TRIM(tr(iq)%name)//'"', modname, jq == 0), lerr)) RETURN
     595      ig = ig + 1
     596    END DO
     597    tr(iq)%gen0Name = tr(jq)%name; CALL addKey_1('gen0Name',    tr(iq)%gen0Name,   tr(iq)%keys)
     598    tr(iq)%iGeneration = ig;       CALL addKey_1('iGeneration', TRIM(int2str(ig)), tr(iq)%keys)
     599  END DO
    601600END FUNCTION setGeneration
    602601!==============================================================================================================================
     602
    603603
    604604!==============================================================================================================================
    … …  
    634634END FUNCTION checkTracers
    635635!==============================================================================================================================
     636
    636637
    637638!==============================================================================================================================
    … …  
    673674END FUNCTION checkUnique
    674675!==============================================================================================================================
     676
    675677
    676678!==============================================================================================================================
    … …  
    720722        ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
    721723        ttr(it)%phase     = p                                        !--- Single phase entry
    722         CALL addKey('name', nam, ttr(it)%keys)
    723         CALL addKey('phase', p,  ttr(it)%keys)
     724        CALL addKey_1('name', nam, ttr(it)%keys)
     725        CALL addKey_1('phase', p,  ttr(it)%keys)
    724726        IF(lExt .AND. tr(iq)%iGeneration>0) THEN
    725727          ttr(it)%parent   = addPhase(tr(iq)%parent,   p)
    726728          ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
    727           CALL addKey('parent',   ttr(it)%parent,   ttr(it)%keys)
    728           CALL addKey('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
     729          CALL addKey_1('parent',   ttr(it)%parent,   ttr(it)%keys)
     730          CALL addKey_1('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
    729731        END IF
    730732        it = it+1
    … …  
    738740END SUBROUTINE expandPhases
    739741!==============================================================================================================================
     742
    740743
    741744!==============================================================================================================================
    … …  
    9981001  INTEGER :: iq, ig, ng, igen, ngen, ix(SIZE(tr))
    9991002  tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent )                !--- Parent index
    1000   CALL addKey('iqParent', int2str(tr%iqParent), tr(:)%keys)
     1003  DO iq = 1, SIZE(tr); CALL addKey_1('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO
    10011004  ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
    10021005  DO iq = 1, SIZE(tr)
    … …  
    10101013      IF(igen == ig+1) THEN
    10111014        tr(iq)%nqChildren = tr(iq)%nqDescen
    1012         CALL addKey('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
     1015        CALL addKey_1('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
    10131016      END IF
    10141017    END DO
    1015     CALL addKey('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
    1016   END DO
    1017   CALL addKey('nqDescen', int2str(tr(:)%nqDescen), tr(:)%keys)
     1018    CALL addKey_1('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
     1019    CALL addKey_1('nqDescen',          int2str(tr(iq)%nqDescen) , tr(iq)%keys)
     1020  END DO
     1021print*,'coin9'
    10181022END SUBROUTINE indexUpdate
    10191023!==============================================================================================================================
    … …  
    13081312  IF(iky == 0) THEN
    13091313    nky = SIZE(ky%key)
    1310     IF(nky == 0) THEN; ky%key = [key]; ky%val = [val]; ELSE; ky%key = [ky%key, key]; ky%val = [ky%val, val]; END IF
     1314    ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
     1315    ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = val; ky%val = v
    13111316  ELSE IF(lo) THEN
    13121317    ky%key(iky) = key; ky%val(iky) = val
    … …  
    13201325!------------------------------------------------------------------------------------------------------------------------------
    13211326  INTEGER :: itr
    1322   DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lOverWrite); END DO
     1327  DO itr = 1, SIZE(ky)
     1328    CALL addKey_1(key, val, ky(itr), lOverWrite)
     1329  PRINT*,'COINCOINCOIN '//TRIM(key)//', '//TRIM(val)//', '//TRIM(ky(itr)%name)
     1330  END DO
     1331  print*,'COINCOINCOINCOIN'
    13231332END SUBROUTINE addKey_m
    13241333!==============================================================================================================================
    … …  
    14581467END FUNCTION getKeyByName_s1
    14591468!==============================================================================================================================
    1460 LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
    1461   CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
    1462   CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: val(:)
    1463   CHARACTER(LEN=*),           TARGET, OPTIONAL, INTENT(IN)  :: tname(:)
    1464   TYPE(keys_type),            TARGET, OPTIONAL, INTENT(IN)  :: ky(:)
    1465   CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: nam(:)
    1466 !------------------------------------------------------------------------------------------------------------------------------
    1467   CHARACTER(LEN=maxlen), ALLOCATABLE :: names(:)
    1468   TYPE(keys_type),       POINTER     ::  keys(:)
    1469   LOGICAL :: lk, lt, li, ll
    1470   INTEGER :: iq, nq
    1471 
    1472   !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
    1473   lk = PRESENT(ky)
    1474   lt = .NOT.lk .AND. ALLOCATED(tracers);  IF(lt) lt = SIZE(tracers)  /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
    1475   li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
    1476 
    1477   IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
    1478   IF(lk) keys => ky(:)
    1479   IF(lt) keys => tracers(:)%keys
    1480   IF(li) keys => isotope%keys(:)
    1481 
    1482   !--- DETERMINE THE NAMES
    1483   IF(PRESENT(tname)) THEN
    1484     ALLOCATE(names(SIZE(tname))); names(:) = tname(:)
    1485   ELSE
    1486     ALLOCATE(names(SIZE(keys)));  names(:) = keys(:)%name
    1487   END IF
    1488   nq = SIZE(names); ALLOCATE(val(nq)); IF(PRESENT(nam)) THEN; ALLOCATE(nam(nq)); nam(:) = names(:); END IF
    1489 
    1490   !--- GET THE DATA
    1491   lerr = ANY([(getKeyByName_s1(keyn, val(iq), names(iq), keys(:)), iq=1, nq)])
    1492 
    1493 END FUNCTION getKeyByName_sm
    1494 !==============================================================================================================================
    14951469LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr)
    14961470  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    … …  
    15041478  lerr = strParse(sval, ',', val)
    15051479END FUNCTION getKeyByName_s1m
     1480!==============================================================================================================================
     1481LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
     1482  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1483  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
     1484  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
     1485  TYPE(keys_type),       OPTIONAL, TARGET,      INTENT(IN)  :: ky(:)
     1486  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
     1487!------------------------------------------------------------------------------------------------------------------------------
     1488  TYPE(keys_type), POINTER ::  keys(:)
     1489  LOGICAL :: lk, lt, li, ll
     1490  INTEGER :: iq, nq
     1491
     1492  !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
     1493  lk = PRESENT(ky)
     1494  lt = .NOT.lk .AND. ALLOCATED(tracers);  IF(lt) lt = SIZE(tracers)  /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
     1495  li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
     1496
     1497  !--- LINK "keys" TO THE RIGHT DATABASE
     1498  IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
     1499  IF(lk) keys => ky(:)
     1500  IF(lt) keys => tracers(:)%keys
     1501  IF(li) keys => isotope%keys(:)
     1502
     1503  !--- GET THE DATA
     1504  nq = SIZE(tname)
     1505  ALLOCATE(val(nq))
     1506  lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq), keys(:)), iq=1, nq)])
     1507  IF(PRESENT(nam)) nam = tname(:)
     1508
     1509END FUNCTION getKeyByName_sm
     1510!==============================================================================================================================
     1511LOGICAL FUNCTION getKey_sm(keyn, val, ky, nam) RESULT(lerr)
     1512  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1513  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
     1514  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  :: ky(:)
     1515  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
     1516!------------------------------------------------------------------------------------------------------------------------------
     1517! Note: if names are repeated, getKeyByName_sm can't be used ; this routine, using indexes, must be used instead.
     1518  IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
     1519    val = fgetKeys(keyn, ky, lerr=lerr)
     1520    IF(PRESENT(nam)) nam = ky(:)%name
     1521  ELSE
     1522    IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
     1523    IF(.NOT.lerr) val = fgetKeys(keyn, tracers%keys, lerr=lerr)
     1524    IF(.NOT.lerr.AND.PRESENT(nam)) nam = tracers(:)%keys%name
     1525    IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
     1526    IF(.NOT.lerr) val = fgetKeys(keyn, isotope%keys, lerr=lerr)
     1527    IF(.NOT.lerr.AND.PRESENT(nam)) nam = isotope%keys(:)%name
     1528  END IF
     1529END FUNCTION getKey_sm
    15061530!==============================================================================================================================
    15071531LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    15191543END FUNCTION getKeyByName_i1
    15201544!==============================================================================================================================
    1521 LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr)
    1522   CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    1523   INTEGER,               ALLOCATABLE, INTENT(OUT) ::   val(:)
    1524   CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN)  :: tname(:)
    1525   TYPE(keys_type),  OPTIONAL, TARGET, INTENT(IN)  ::    ky(:)
    1526 !------------------------------------------------------------------------------------------------------------------------------
    1527   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), nam(:)
    1528   INTEGER :: ierr, iq
    1529   IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
    1530   ALLOCATE(val(SIZE(sval)))
    1531   DO iq = 1, SIZE(sval)                                              !--- CONVERT THE KEYS TO INTEGERS
    1532     READ(sval(iq), *, IOSTAT=ierr) val(iq)
    1533     IF(test(fmsg('key "'//TRIM(keyn)//'" of "'//TRIM(nam(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
    1534   END DO
    1535 END FUNCTION getKeyByName_im
    1536 !==============================================================================================================================
    15371545LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr)
    1538   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1539   INTEGER,       ALLOCATABLE, INTENT(OUT) :: val(:)
    1540   CHARACTER(LEN=*),           INTENT(IN)  :: tname
    1541   TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
    1542 !------------------------------------------------------------------------------------------------------------------------------
    1543   CHARACTER(LEN=maxlen), ALLOCATABLE :: v(:)
    1544   INTEGER :: ierr, iq
    1545   IF(test(getKeyByName_s1m(keyn, v, tname, ky), lerr)) RETURN
    1546   ALLOCATE(val(SIZE(v)))
    1547   lerr = .FALSE.; DO iq=1, SIZE(v); READ(v(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
     1546  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1547  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
     1548  CHARACTER(LEN=*),          INTENT(IN)  :: tname
     1549  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
     1550!------------------------------------------------------------------------------------------------------------------------------
     1551  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1552  INTEGER :: ierr, iq, nq
     1553  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
     1554  nq = SIZE(sval); ALLOCATE(val(nq))
     1555  lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
    15481556  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
    15491557END FUNCTION getKeyByName_i1m
     1558!==============================================================================================================================
     1559LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky, nam) RESULT(lerr)
     1560  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
     1561  INTEGER,                         ALLOCATABLE, INTENT(OUT) ::   val(:)
     1562  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
     1563  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
     1564  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
     1565!------------------------------------------------------------------------------------------------------------------------------
     1566  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
     1567  INTEGER :: ierr, iq, nq
     1568  IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
     1569  nq = SIZE(sval); ALLOCATE(val(nq))
     1570  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
     1571    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1572    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1573  END DO
     1574END FUNCTION getKeyByName_im
     1575!==============================================================================================================================
     1576LOGICAL FUNCTION getKey_im(keyn, val, ky, nam) RESULT(lerr)
     1577  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1578  INTEGER,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
     1579  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
     1580  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
     1581!------------------------------------------------------------------------------------------------------------------------------
     1582  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
     1583  INTEGER :: ierr, iq, nq
     1584  IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
     1585  nq = SIZE(sval); ALLOCATE(val(nq))
     1586  DO iq = 1, nq
     1587    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1588    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1589  END DO
     1590  IF(PRESENT(nam)) nam = names
     1591END FUNCTION getKey_im
    15501592!==============================================================================================================================
    15511593LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    15631605END FUNCTION getKeyByName_r1
    15641606!==============================================================================================================================
    1565 LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky) RESULT(lerr)
    1566   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1567   REAL,          ALLOCATABLE, INTENT(OUT) ::   val(:)
    1568   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: tname(:)
    1569   TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
    1570 !------------------------------------------------------------------------------------------------------------------------------
    1571   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), nam(:)
    1572   INTEGER :: ierr, iq
    1573   IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
    1574   ALLOCATE(val(SIZE(sval)))
    1575   DO iq = 1, SIZE(sval)                                              !--- CONVERT THE KEYS TO INTEGERS
    1576     READ(sval(iq), *, IOSTAT=ierr) val(iq)
    1577     IF(test(fmsg('key "'//TRIM(keyn)//'" of "'//TRIM(nam(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
    1578   END DO
    1579 END FUNCTION getKeyByName_rm
    1580 !==============================================================================================================================
    15811607LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr)
    15821608  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    … …  
    15851611  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
    15861612!------------------------------------------------------------------------------------------------------------------------------
    1587   CHARACTER(LEN=maxlen), ALLOCATABLE :: v(:)
    1588   INTEGER :: ierr, iq
    1589   IF(     PRESENT(ky)) lerr = getKeyByName_s1m(keyn, v, tname, ky)
    1590   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1m(keyn, v, tname)
    1591   ALLOCATE(val(SIZE(v)))
    1592   lerr = .FALSE.; DO iq=1, SIZE(v); READ(v(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
    1593   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN
     1613  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1614  INTEGER :: ierr, iq, nq
     1615  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
     1616  nq = SIZE(sval); ALLOCATE(val(nq))
     1617  lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
     1618  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a vector of reals', modname, lerr), lerr)) RETURN
    15941619END FUNCTION getKeyByName_r1m
     1620!==============================================================================================================================
     1621LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky, nam) RESULT(lerr)
     1622  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
     1623  REAL,                            ALLOCATABLE, INTENT(OUT) ::   val(:)
     1624  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
     1625  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
     1626  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
     1627!------------------------------------------------------------------------------------------------------------------------------
     1628  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
     1629  INTEGER :: ierr, iq, nq
     1630  IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
     1631  nq = SIZE(sval); ALLOCATE(val(nq))
     1632  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
     1633    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1634    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
     1635  END DO
     1636  IF(PRESENT(nam)) nam = names
     1637END FUNCTION getKeyByName_rm
     1638!==============================================================================================================================
     1639LOGICAL FUNCTION getKey_rm(keyn, val, ky, nam) RESULT(lerr)
     1640  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1641  REAL,                            ALLOCATABLE, INTENT(OUT) ::  val(:)
     1642  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
     1643  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
     1644!------------------------------------------------------------------------------------------------------------------------------
     1645  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
     1646  INTEGER :: ierr, iq, nq
     1647  IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
     1648  nq = SIZE(sval); ALLOCATE(val(nq))
     1649  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
     1650    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1651    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
     1652  END DO
     1653  IF(PRESENT(nam)) nam = names
     1654END FUNCTION getKey_rm
     1655!==============================================================================================================================
     1656LOGICAL FUNCTION getKeyByName_l1(keyn, val, tname, ky) RESULT(lerr)
     1657  USE strings_mod, ONLY: str2bool
     1658  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1659  LOGICAL,                   INTENT(OUT) :: val
     1660  CHARACTER(LEN=*),          INTENT(IN)  :: tname
     1661  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1662!------------------------------------------------------------------------------------------------------------------------------
     1663  CHARACTER(LEN=maxlen) :: sval
     1664  INTEGER :: ierr
     1665  lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1666  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
     1667  val = str2bool(sval)
     1668END FUNCTION getKeyByName_l1
     1669!==============================================================================================================================
     1670LOGICAL FUNCTION getKeyByName_l1m(keyn, val, tname, ky) RESULT(lerr)
     1671  USE strings_mod, ONLY: str2bool
     1672  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1673  LOGICAL,       ALLOCATABLE, INTENT(OUT) :: val(:)
     1674  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1675  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
     1676!------------------------------------------------------------------------------------------------------------------------------
     1677  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1678  INTEGER :: ierr, iq, nq
     1679  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
     1680  nq = SIZE(sval); ALLOCATE(val(nq))
     1681  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
     1682END FUNCTION getKeyByName_l1m
     1683!==============================================================================================================================
     1684LOGICAL FUNCTION getKeyByName_lm(keyn, val, tname, ky, nam) RESULT(lerr)
     1685  USE strings_mod, ONLY: str2bool
     1686  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
     1687  LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::   val(:)
     1688  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
     1689  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
     1690  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
     1691!------------------------------------------------------------------------------------------------------------------------------
     1692  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1693  INTEGER :: ierr, iq, nq
     1694  IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
     1695  nq = SIZE(sval); ALLOCATE(val(nq))
     1696  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
     1697END FUNCTION getKeyByName_lm
     1698!==============================================================================================================================
     1699LOGICAL FUNCTION getKey_lm(keyn, val, ky, nam) RESULT(lerr)
     1700  USE strings_mod, ONLY: str2bool
     1701  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1702  LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
     1703  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
     1704  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
     1705!------------------------------------------------------------------------------------------------------------------------------
     1706  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1707  INTEGER :: ierr, iq, nq
     1708  IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN
     1709  nq = SIZE(sval); ALLOCATE(val(nq))
     1710  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
     1711END FUNCTION getKey_lm
    15951712!==============================================================================================================================
    15961713
    … …  
    16091726  IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
    16101727  IF(PRESENT(isotope_ )) THEN
    1611     ix = strIdx(isotopes(:)%parent, isotope%parent)
     1728    ix = strIdx(isotopes(:)%parent, isotope_%parent)
    16121729    IF(ix /= 0) THEN
    16131730      isotopes(ix) = isotope_
Note: See TracChangeset for help on using the changeset viewer.