Changeset 16 for readTracFiles_mod.f90


Ignore:
Timestamp:
Apr 5, 2022, 1:13:00 PM (3 years ago)
Author:
dcugnet
Message:
  • fixes in strTail_m and strHead_m
  • "old" water names are management is simplified.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • readTracFiles_mod.f90

    r14 r16  
    1414  PUBLIC :: getKey_init, getKey, fGetKey, setDirectKeys              !--- GET/SET KEYS FROM/TO tracers & isotopes
    1515
    16   PUBLIC :: known_phases, old_phases, nphases, phases_names, &       !--- VARIABLES RELATED TO THE PHASES
    17             phases_sep, delPhase, addPhase, new2oldPhase,    &       !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
    18             old2newName, new2oldName
     16  PUBLIC :: addPhase, new2oldName,  getPhase, &                      !--- FUNCTIONS RELATED TO THE PHASES
     17            delPhase, old2newName, getiPhase, &                      !--- + ASSOCIATED VARIABLES
     18            known_phases, old_phases, phases_sep, phases_names, nphases
     19
     20  PUBLIC :: oldH2OIso, newH2OIso                                     !--- NEEDED FOR BACKWARD COMPATIBILITY (OLD traceur.def)
    1921
    2022  PUBLIC :: tran0, idxAncestor, ancestor                             !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
    21 
    2223!------------------------------------------------------------------------------------------------------------------------------
    2324  TYPE :: dataBase_type                                              !=== TYPE FOR TRACERS SECTION
    … …  
    3536  INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m; END INTERFACE    ancestor
    3637  INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
     38  INTERFACE old2newName;   MODULE PROCEDURE old2newName_1, old2newName_m; END INTERFACE old2newName
     39  INTERFACE new2oldName;   MODULE PROCEDURE new2oldName_1, new2oldName_m; END INTERFACE new2oldName
    3740!------------------------------------------------------------------------------------------------------------------------------
    3841
    … …  
    5053  LOGICAL,          SAVE :: tracs_merge = .TRUE.                     !--- Merge/stack tracers lists
    5154  LOGICAL,          SAVE :: lSortByGen  = .TRUE.                     !--- Sort by growing generation
     55
     56  !--- KEPT JUST TO MANAGE OLD WATER ISOTOPES NAMES
     57  !--- Apart from that context, on limitaion on isotopes names (as long as they have a corresponding line in isotopes_params.def)
     58  CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau',     'HDO',     'O18',     'O17',     'HTO'    ]
     59  CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO ']
     60
    5261
    5362  !=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
    … …  
    179188  WHERE(tracs%gen0Name(1:3) /= 'H2O') tracs%isInPhysics=.TRUE.       !--- Set %isInPhysics: passed to physics
    180189  CALL setDirectKeys(tracs)                                          !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
    181 
    182190END FUNCTION readTracersFiles
    183191!==============================================================================================================================
    … …  
    832840SUBROUTINE indexUpdate(tr)
    833841  TYPE(trac_type), INTENT(INOUT) :: tr(:)
    834   INTEGER :: iq, ig, ng, ngen
     842  INTEGER :: iq, ig, ng, igen, ngen
    835843  INTEGER, ALLOCATABLE :: ix(:)
    836844  tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent )                !--- Parent index
    837845  ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
    838846  DO iq = 1, SIZE(tr)
    839     ng = tr(iq)%iGeneration                                          !--- Generation of the current tracer
    840     ix = idxAncestor(tr, igen = ng); ix = PACK(ix, ix/=0)            !--- Indexes of the tracers with ancestor tr(iq)
    841     !--- Childs indexes in growing generation order
    842     tr(iq)%iqDescen = [( PACK(ix, MASK = tr(ix)%iGeneration == ig), ig = ng+1, ngen)]
    843     tr(iq)%nqDescen =     SUM(  [( COUNT(tr(ix)%iGeneration == ig), ig = ng+1, ngen)] )
    844     tr(iq)%nqChilds =              COUNT(tr(ix)%iGeneration == ng+1)
     847    ig = tr(iq)%iGeneration
     848    IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
     849    ALLOCATE(tr(iq)%iqDescen(0))
     850    ix = idxAncestor(tr, igen=ig)                                    !--- Ancestor of generation "ng" for each tr
     851    DO igen = ig+1, ngen
     852      tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
     853      tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
     854      IF(igen == ig+1) tr(iq)%nqChilds=tr(iq)%nqDescen
     855    END DO
    845856  END DO
    846857END SUBROUTINE indexUpdate
    … …  
    966977    !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
    967978    ll = t(:)%type=='tag'    .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
    968     i%zone = PACK(strTail(t(:)%name,'_',lFirst=.TRUE.), MASK = ll)   !--- Tagging zones names  for isotopes category "iname"
     979    i%zone = PACK(strTail(t(:)%name,'_'), MASK = ll)                 !--- Tagging zones names  for isotopes category "iname"
    969980    CALL strReduce(i%zone)
    970981    i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
    … …  
    13131324END FUNCTION delPhase
    13141325!------------------------------------------------------------------------------------------------------------------------------
    1315 CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha,ph_sep) RESULT(out)
     1326CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
    13161327  CHARACTER(LEN=*),           INTENT(IN) :: s
    13171328  CHARACTER(LEN=1),           INTENT(IN) :: pha
    1318   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
    1319   CHARACTER(LEN=1) :: psep
    13201329  INTEGER :: l, i
    13211330  out = s
    13221331  IF(s == '') RETURN                                                           !--- Empty string: nothing to do
    1323   psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
    13241332  i = INDEX(s, '_')                                                            !--- /=0 for <var>_<tag> tracers names
    13251333  l = LEN_TRIM(s)
    1326   IF(i == 0) out =  TRIM(s)//TRIM(psep)//pha                                   !--- <var>       => return <var><sep><pha>
    1327   IF(i /= 0) out = s(1:i-1)//TRIM(psep)//pha//'_'//s(i+1:l)                    !--- <var>_<tag> => return <var><sep><pha>_<tag>
     1334  IF(i == 0) out =  TRIM(s)//phases_sep//pha                                   !--- <var>       => return <var><sep><pha>
     1335  IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l)                    !--- <var>_<tag> => return <var><sep><pha>_<tag>
    13281336END FUNCTION addPhase_s1
    13291337!------------------------------------------------------------------------------------------------------------------------------
    1330 FUNCTION addPhase_sm(s,pha,ph_sep) RESULT(out)
     1338FUNCTION addPhase_sm(s,pha) RESULT(out)
    13311339  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
    13321340  CHARACTER(LEN=1),           INTENT(IN) :: pha
    1333   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
    13341341  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    1335   CHARACTER(LEN=1) :: psep
    13361342  INTEGER :: k
    1337   psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
    1338   out = [( addPhase_s1(s(k), pha, psep), k=1, SIZE(s) )]
     1343  out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
    13391344END FUNCTION addPhase_sm
    13401345!------------------------------------------------------------------------------------------------------------------------------
    1341 CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,ph_sep) RESULT(out)
     1346CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
    13421347  CHARACTER(LEN=*),           INTENT(IN) :: s
    13431348  INTEGER,                    INTENT(IN) :: ipha
    1344   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
    1345   CHARACTER(LEN=1) :: psep
     1349  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
    13461350  out = s
    13471351  IF(s == '') RETURN                                                           !--- Empty string: nothing to do
    1348   psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
    1349   IF(psep == '') out = addPhase_s1(s,   old_phases(ipha:ipha), psep)
    1350   IF(psep /= '') out = addPhase_s1(s, known_phases(ipha:ipha), psep)
     1352  IF(ipha==0) RETURN                                                           !--- Null index: no phase to add
     1353  IF(     PRESENT(phases)) out = addPhase_s1(s,       phases(ipha:ipha))
     1354  IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
    13511355END FUNCTION addPhase_i1
    13521356!------------------------------------------------------------------------------------------------------------------------------
    1353 FUNCTION addPhase_im(s,ipha,ph_sep) RESULT(out)
     1357FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
    13541358  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
    13551359  INTEGER,                    INTENT(IN) :: ipha
    1356   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep
     1360  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
    13571361  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    1358   CHARACTER(LEN=1) :: psep
    13591362  INTEGER :: k
    1360   psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep
    1361   out = [( addPhase_i1(s(k), ipha, psep), k=1, SIZE(s) )]
     1363  IF(     PRESENT(phases)) out = [( addPhase_i1(s(k), ipha,       phases), k=1, SIZE(s) )]
     1364  IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
    13621365END FUNCTION addPhase_im
    13631366!------------------------------------------------------------------------------------------------------------------------------
    13641367
    13651368
    1366 INTEGER FUNCTION getiPhase(tname, lPhase) RESULT(iphase)
    1367   CHARACTER(LEN=*),  INTENT(IN)  :: tname
    1368   LOGICAL, OPTIONAL, INTENT(OUT) :: lPhase
    1369   CHARACTER(LEN=maxlen) :: s1
     1369!==============================================================================================================================
     1370!=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
     1371!==============================================================================================================================
     1372INTEGER FUNCTION getiPhase(tname, phases) RESULT(iPhase)
     1373  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1374  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: phases
     1375  CHARACTER(LEN=maxlen) :: phase
     1376  IF(     PRESENT(phases)) phase = getPhase(tname,       phases, iPhase)
     1377  IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
     1378END FUNCTION getiPhase
     1379!------------------------------------------------------------------------------------------------------------------------------
     1380CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
     1381  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1382  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: phases
     1383  INTEGER,          OPTIONAL, INTENT(OUT) :: iPhase
    13701384  INTEGER :: ip
    1371   IF(PRESENT(lPhase)) lPhase = .TRUE.
    1372 
    1373   !--- Old tracer name descending on water: H2O[v][l][i][_<isotope>][_<tag>]
    1374   iphase = strIdx([('H2O'//old_phases(ip:ip), ip=1, nphases)], tname(1:MIN(4,LEN_TRIM(tname))))
    1375   IF(iphase /= 0) RETURN
    1376 
    1377   !--- New tracer name: <name>[_<phase>][_<tag>]
    1378   iphase = INDEX(known_phases, TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.)))
    1379   IF(iphase /= 0) RETURN
    1380 
    1381   !---Default case: 1 (gaseous phase)
    1382   iphase = 1
    1383   IF(PRESENT(lPhase)) lPhase = .FALSE.
    1384 END FUNCTION getiPhase 
    1385 
    1386 !------------------------------------------------------------------------------------------------------------------------------
    1387 CHARACTER(LEN=1) FUNCTION new2oldPhase(np) RESULT(op)
    1388   CHARACTER(LEN=1), INTENT(IN) :: np
    1389   op = old_phases(INDEX(known_phases,np):INDEX(known_phases,np))
    1390 END FUNCTION new2oldPhase
    1391 !------------------------------------------------------------------------------------------------------------------------------
    1392 
    1393 !------------------------------------------------------------------------------------------------------------------------------
    1394 CHARACTER(LEN=maxlen) FUNCTION old2newName(oldName, iPhase) RESULT(newName)
     1385  phase = TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.))
     1386  IF(     PRESENT(phases)) ip = INDEX(      phases, phase)
     1387  IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
     1388  IF(ip == 0) phase = 'g'
     1389  IF(PRESENT(iPhase)) iPhase = ip
     1390END FUNCTION getPhase
     1391!------------------------------------------------------------------------------------------------------------------------------
     1392
     1393
     1394!------------------------------------------------------------------------------------------------------------------------------
     1395CHARACTER(LEN=maxlen) FUNCTION old2newName_1(oldName, iPhase) RESULT(newName)
    13951396  !--- Convert an old style name into a new one.
    13961397  !    Only usable with old style "traceur.def" files, in which only water isotopes are allowed.
    … …  
    13991400  CHARACTER(LEN=*),  INTENT(IN)  :: oldName
    14001401  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
    1401   CHARACTER(LEN=maxlen) :: oldIso(5) = ['eau',     'HDO',     'O18',     'O17',     'HTO'    ]
    1402   CHARACTER(LEN=maxlen) :: newIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO ']
    14031402  CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
    14041403  INTEGER :: ix, ip, it, nt
    1405   LOGICAL :: lPhase, lerr
    1406   ip = getiPhase(oldName, lPhase)                                              !--- Get the phase ; lPhase==T: phase is needed
     1404  LOGICAL :: lerr
     1405  newName = oldName
     1406  IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
     1407  IF(oldName(1:MIN(3,LEN_TRIM(oldName))) /= 'H2O') RETURN                      !--- Not a water descendant
     1408  lerr = strParse(oldName, '_', tmp, n=nt)
     1409  ip = strIdx([('H2O'//old_phases(ip:ip), ip=1, nphases)], tmp(1))             !--- Phase index (/=0 if any)
    14071410  IF(PRESENT(iPhase)) iPhase = ip
    1408   IF(.NOT.lPhase) THEN; newName = oldName ; RETURN; END IF                     !--- Not a water descendant
    1409   newName = addPhase('H2O', ip)
    1410   lerr = strParse(oldName, '_', tmp, n=nt)
    1411   IF(nt == 1) RETURN                                                           !--- H2O with phase
    1412   ix = strIdx(oldIso, tmp(2))
    1413   newName = tmp(2); IF(ix /= 0) newName = newIso(ix)                           !--- Isotope name
    1414   IF(lPhase)  newName = addPhase(newName, ip)                                  !--- Phase is needed
     1411  newName = addPhase('H2O', ip)                                                !--- Water
     1412  IF(nt == 1) RETURN                                                           !--- Water: finished
     1413  ix = strIdx(oldH2OIso, tmp(2))                                               !--- Index in the known isotopes list
     1414  IF(ix == 0) newName = addPhase(tmp(2),        ip)                            !--- Not an isotope
     1415  IF(ix /= 0) newName = addPhase(newH2OIso(ix), ip)                            !--- Isotope
    14151416  IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3))                       !--- Tagging tracer
    1416 END FUNCTION old2newName
    1417 !------------------------------------------------------------------------------------------------------------------------------
    1418 
    1419 !------------------------------------------------------------------------------------------------------------------------------
    1420 CHARACTER(LEN=maxlen) FUNCTION new2oldName(newName, iPhase) RESULT(oldName)
     1417END FUNCTION old2newName_1
     1418!------------------------------------------------------------------------------------------------------------------------------
     1419FUNCTION old2newName_m(oldName, iPhase) RESULT(newName)
     1420  CHARACTER(LEN=*),  INTENT(IN)  :: oldName(:)
     1421  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
     1422  CHARACTER(LEN=maxlen)          :: newName(SIZE(oldName))
     1423  INTEGER :: i
     1424  newName = [(old2newName_1(oldName(i), iPhase), i=1, SIZE(oldName))]
     1425END FUNCTION old2newName_m
     1426!------------------------------------------------------------------------------------------------------------------------------
     1427
     1428!------------------------------------------------------------------------------------------------------------------------------
     1429CHARACTER(LEN=maxlen) FUNCTION new2oldName_1(newName, iPhase) RESULT(oldName)
    14211430  !--- Convert a new style name into an old one.
    14221431  !    Only convertable names are water descendants names H2O_<phase>, <isotope>_<phase>, <isotope>_<phase>_<tag>, with:
    … …  
    14241433  CHARACTER(LEN=*),  INTENT(IN)    :: newName
    14251434  INTEGER, OPTIONAL, INTENT(OUT)   :: iPhase
    1426   CHARACTER(LEN=maxlen) :: oldIso(5) = ['eau',     'HDO',     'O18',     'O17',     'HTO'    ]
    1427   CHARACTER(LEN=maxlen) :: newIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO '], tag
    14281435  INTEGER :: ix, ip, it, nt
    1429   LOGICAL :: lPhase, lH2O
    1430   lH2O = newName(1:MIN(3,LEN_TRIM(newName)))=='H2O'
    1431   ix = strIdx(newIso, strHead(strHead(newName,'_',.TRUE.),phases_sep,.TRUE.))  !--- Isotope index
    1432   IF(ix == 0 .AND. .NOT.lH2O) THEN; oldName=newName; RETURN; END IF            !--- Not a water descendant
    1433   ip = getiPhase(newName, lPhase)                                              !--- Get the phase ; lPhase==T: phase is needed
    1434   oldName = 'H2O'; IF(lPhase) oldName = addPhase('H2O', ip, '')                !--- H2O with phase
    1435   IF(ix == 0) RETURN
    1436   oldName = TRIM(oldName)//'_'//oldIso(ix)                                     !--- Isotope
    1437   tag = strTail(delPhase(newName), TRIM(newIso(ix)))
     1436  LOGICAL :: lH2O
     1437  CHARACTER(LEN=maxlen) :: tag
     1438  ix = strIdx([(addPhase('H2O',ip), ip=1, nphases)], newName)                  !--- Phase index for H2O_<phase>
     1439  IF(ix /= 0) THEN; oldName = 'H2O'//old_phases(ix:ix); RETURN; END IF         !--- H2O_<phase> case
     1440  ix = strIdx(newH2OIso, strHead(newName, phases_sep, .TRUE.))                 !--- Isotope index
     1441  IF(ix == 0) THEN; oldName = newName;                  RETURN; END IF         !--- Not a water descendant
     1442  ip = getiPhase(newName)                                                      !--- Phase index
     1443  oldName = TRIM(oldH2OIso(ix))//old_phases(ip:ip)                             !--- <isotope>_<phase>
     1444  tag = strTail(delPhase(newName), TRIM(newH2OIso(ix)))                        !--- Get "_<tag>" if any
    14381445  IF(tag /= delPhase(newName) .AND. tag /= '') oldName = TRIM(oldName)//tag    !--- Tagging tracer
    1439 END FUNCTION new2oldName
     1446END FUNCTION new2oldName_1
     1447!------------------------------------------------------------------------------------------------------------------------------
     1448FUNCTION new2oldName_m(newName, iPhase) RESULT(oldName)
     1449  CHARACTER(LEN=*),  INTENT(IN)  :: newName(:)
     1450  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
     1451  CHARACTER(LEN=maxlen)          :: oldName(SIZE(newName))
     1452  INTEGER :: i
     1453  oldName = [(new2oldName_1(newName(i), iPhase), i=1, SIZE(newName))]
     1454END FUNCTION new2oldName_m
    14401455!------------------------------------------------------------------------------------------------------------------------------
    14411456
Note: See TracChangeset for help on using the changeset viewer.