Changeset 4403 for LMDZ6/trunk/libf/misc


Ignore:
Timestamp:
Jan 30, 2023, 9:27:31 PM (2 years ago)
Author:
dcugnet
Message:
  • fix for isotopic tagging tracers
  • modify strHead/strTail: last argument (optional) has the same convention as INDEX: if lBackward==.TRUE., search the pattern starting from the end of the string (default=.FALSE.)
  • consolidate and simplify the new2oldH2O routine
Location:
LMDZ6/trunk/libf/misc
Files:
2 edited

Legend:

Unmodified
Added
Removed

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

    r4400 r4403  
    11671167    !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
    11681168    ll = t(:)%type=='tag'    .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
    1169     i%zone = PACK(strTail(t(:)%name,'_'), MASK = ll)                 !--- Tagging zones names  for isotopes category "iname"
     1169    i%zone = PACK(strTail(t(:)%name,'_',.TRUE.), MASK = ll)          !--- Tagging zones names  for isotopes category "iname"
    11701170    CALL strReduce(i%zone)
    11711171    i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
    … …  
    11901190      IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE  !--- Only deal with tracers descending on "iname"
    11911191      t1%iso_iGroup = ic                                             !--- Isotopes family       idx in list "isotopes(:)%parent"
    1192       t1%iso_iName  = strIdx(i%trac, delPhase(strHead(t1%name,'_'))) !--- Current isotope       idx in effective isotopes list
    1193       t1%iso_iZone  = strIdx(i%zone,          strTail(t1%name,'_') ) !--- Current isotope zone  idx in effective zones    list
     1192      t1%iso_iName  = strIdx(i%trac, strHead(delPhase(t1%name),'_',.TRUE.)) !--- Current isotope       idx in effective isotopes list
     1193      t1%iso_iZone  = strIdx(i%zone,          strTail(t1%name, '_',.TRUE.)) !--- Current isotope zone  idx in effective zones    list
    11941194      t1%iso_iPhase =  INDEX(i%phase,TRIM(t1%phase))                 !--- Current isotope phase idx in effective phases   list
    11951195      IF(t1%iGeneration /= 2) t1%iso_iZone = 0                       !--- Skip possible generation 1 tagging tracers
    … …  
    14411441!------------------------------------------------------------------------------------------------------------------------------
    14421442  CHARACTER(LEN=maxlen) :: tnam
    1443   tnam = strHead(delPhase(tname),'_',.FALSE.)                                            !--- Remove tag and phase
     1443  tnam = strHead(delPhase(tname),'_',.TRUE.)                                             !--- Remove phase and tag
    14441444  IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
    14451445               val = fgetKeyNam_s1(tname, keyn, ky,           lerr=lerr)                 !--- "ky" and "tname"
    … …  
    18241824!------------------------------------------------------------------------------------------------------------------------------
    18251825  INTEGER :: ip
    1826   phase = TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.))
     1826  phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.))     !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
    18271827  IF(     PRESENT(phases)) ip = INDEX(      phases, phase)
    18281828  IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
    … …  
    18541854  ELSE
    18551855    ix = strIdx(oldH2OIso, tmp(2))                                             !--- Index in the known isotopes list
    1856     IF(ix /= 0) tmp(2) = newH2OIso(ix)                                         !--- Move to new isotope name
    1857     IF(ip /= 0) tmp(2) = addPhase(tmp(2), ip)                                  !--- Add phase to isotope name
    1858     newName = TRIM(strStack(tmp(2:nt), '_'))                                   !=== WATER ISOTOPE OR TAGGING TRACER
     1856    IF(ix /= 0) newName = newH2OIso(ix)                                        !--- Move to new isotope name
     1857    IF(ip /= 0) newName = addPhase(newName, ip)                                !--- Add phase to isotope name
     1858    IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3))                     !=== WATER ISOTOPE OR TAGGING TRACER
    18591859  END IF
    18601860END FUNCTION old2newH2O_1
    … …  
    18811881  CHARACTER(LEN=maxlen) :: var
    18821882  oldName = newName
    1883   IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
    18841883  ip = getiPhase(newName)                                                      !--- Phase index
    1885   IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip                                !--- Returning phase index
    1886   ix = strIdx(newH2OIso, strHead(newName, '_'))                                !--- Index in the known H2O isotopes list
    1887   IF(ix /= 0) THEN
    1888     oldName = 'H2O'//'_'//TRIM(oldH2OIso(ix))                                  !=== WATER ISOTOPE WITHOUT PHASE
    1889     IF(newH2OIso(ix)/=newName) oldName=TRIM(oldName)//'_'//strTail(newName,'_')!=== WATER ISOTOPIC TAGGING TRACER WITHOUT PHASE
    1890   END IF
    1891   IF(ix /= 0 .OR. ip == 0)           RETURN
    1892   oldName = 'H2O'//old_phases(ip:ip)
    1893   IF(newName == addPhase('H2O', ip)) RETURN                                    !=== WATER WITH PHASE
    1894   var = TRIM(strHead(newName, phases_sep, .TRUE.))                             !--- Head variable name   (no phase)
     1884  IF(PRESENT(iPhase)) iPhase = MAX(ip, 1)                                      !--- Return phase index ; default: 1 (gazeous)
     1885  var = TRIM(strHead(newName, phases_sep, .TRUE.))                             !--- Variable without phase and tag
    18951886  ix = strIdx(newH2OIso, var)                                                  !--- Index in the known H2O isotopes list
    1896   IF(ix == 0)                        RETURN                                    !=== H2O[vli]_<var> (<var> /= H2O isotope)
    1897   oldName = TRIM(oldName)//'_'//TRIM(oldH2OIso(ix))                            !=== WATER ISOTOPE WITH PHASE
    1898   var = addPhase(var, ip)                                                      !--- Head variable with phase
    1899   IF(newName /= var) oldName = TRIM(oldName)//strTail(newName, TRIM(var))      !=== WATER ISOTOPIC TAGGING TRACER
     1887  IF(ix == 0 .AND. var /= 'H2O') RETURN                                        !--- Neither H2O nor an H2O isotope => finished
     1888  oldName = 'H2O'
     1889  IF(ip /= 0) oldName = TRIM(oldName)//old_phases(ip:ip)                       !--- Add phase if needed
     1890  IF(ix /= 0) oldName = TRIM(oldName)//'_'//oldH2OIso(ix)                      !--- H2O isotope name
     1891  IF(newName /= addPhase(var, ip)) &
     1892    oldName = TRIM(oldName)//strTail(newName, '_', .TRUE.)                     !--- Add the tag suffix
     1893  IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_')                    !--- Isotope with no phase: remove 'H2O_' prefix
    19001894END FUNCTION new2oldH2O_1
    19011895!==============================================================================================================================

  • LMDZ6/trunk/libf/misc/strings_mod.F90

    r4363 r4403  
    194194
    195195!==============================================================================================================================
    196 !=== Extract the substring in front of the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================
     196!=== Extract the substring in front of the first (last if lBackward==TRUE) occurrence of "sep" in "str"        ================
    197197!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
    198198!===    * strHead(..,.FALSE.) = 'a'           ${str%%$sep*}                                                    ================
    199199!===    * strHead(..,.TRUE.)  = 'a_b'         ${str%$sep*}                                                     ================
    200200!==============================================================================================================================
    201 CHARACTER(LEN=maxlen) FUNCTION strHead_1(str,sep,lFirst) RESULT(out)
     201CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
    202202  CHARACTER(LEN=*),           INTENT(IN) :: str
    203203  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    204   LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
    205 !------------------------------------------------------------------------------------------------------------------------------
    206   LOGICAL :: lf
    207   lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
     204  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
     205!------------------------------------------------------------------------------------------------------------------------------
    208206  IF(PRESENT(sep)) THEN
    209     out = str(1:INDEX(str,sep,.NOT.lf)-1)
     207    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,sep,lBackWard)-1)
     208    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,sep)-1)
    210209  ELSE
    211     out = str(1:INDEX(str,'/',.NOT.lf)-1)
     210    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,'/',lBackWard)-1)
     211    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,'/')-1)
    212212  END IF
    213213  IF(out == '') out = str
    214214END FUNCTION strHead_1
    215215!==============================================================================================================================
    216 FUNCTION strHead_m(str,sep,lFirst) RESULT(out)
     216FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
    217217  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    218218  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    219219  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    220   LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
    221 !------------------------------------------------------------------------------------------------------------------------------
    222   LOGICAL :: lf
     220  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
     221!------------------------------------------------------------------------------------------------------------------------------
    223222  INTEGER :: k
    224   lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
    225223  IF(PRESENT(sep)) THEN
    226     out = [(strHead_1(str(k), sep,   lf), k=1, SIZE(str))]
     224    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), sep, lBackWard), k=1, SIZE(str))]
     225    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), sep),            k=1, SIZE(str))]
    227226  ELSE
    228     out = [(strHead_1(str(k), lFirst=lf), k=1, SIZE(str))]
     227    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), '/', lBackWard), k=1, SIZE(str))]
     228    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), '/'),            k=1, SIZE(str))]
    229229  END IF
    230230END FUNCTION strHead_m
    231231!==============================================================================================================================
    232 !=== Extract the substring following the last (first if lFirst==TRUE) occurrence of separator "sep" in "str"   ================
     232!=== Extract the substring following the first (last if lBackward==TRUE) occurrence of "sep" in "str"          ================
    233233!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
    234 !===    * strTail(..,.FALSE.) = 'c'           ${str#*$sep}                                                     ================
    235 !===    * strTail(..,.TRUE.)  = 'b_c'         ${str##*$sep}                                                    ================
    236 !==============================================================================================================================
    237 CHARACTER(LEN=maxlen) FUNCTION strTail_1(str,sep,lFirst) RESULT(out)
     234!===    * strTail(str, '_', .FALSE.) = 'b_c'         ${str#*$sep}                                              ================
     235!===    * strTail(str, '_', .TRUE.)  = 'c'           ${str##*$sep}                                             ================
     236!==============================================================================================================================
     237CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
    238238  CHARACTER(LEN=*),           INTENT(IN) :: str
    239239  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    240   LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
    241 !------------------------------------------------------------------------------------------------------------------------------
    242   LOGICAL :: lf
    243   lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
     240  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
     241!------------------------------------------------------------------------------------------------------------------------------
    244242  IF(PRESENT(sep)) THEN
    245     out = str(INDEX(str,sep,.NOT.lf)+LEN(sep):LEN_TRIM(str))
     243    IF(     PRESENT(lBackWard)) out = str(INDEX(str,sep,lBackWard)+LEN(sep):LEN_TRIM(str))
     244    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,sep)          +LEN(sep):LEN_TRIM(str))
    246245  ELSE
    247     out = str(INDEX(str,'/',.NOT.lf)+1:LEN_TRIM(str))
     246    IF(     PRESENT(lBackWard)) out = str(INDEX(str,'/',lBackWard)+1:LEN_TRIM(str))
     247    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,'/')          +1:LEN_TRIM(str))
    248248  END IF
    249249  IF(out == '') out = str
    250250END FUNCTION strTail_1
    251251!==============================================================================================================================
    252 FUNCTION strTail_m(str,sep,lFirst) RESULT(out)
     252FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
    253253  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    254254  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    255255  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    256   LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
    257 !------------------------------------------------------------------------------------------------------------------------------
    258   LOGICAL :: lf
     256  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
     257!------------------------------------------------------------------------------------------------------------------------------
    259258  INTEGER :: k
    260   lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
    261259  IF(PRESENT(sep)) THEN
    262     out = [(strTail_1(str(k), sep,   lf), k=1, SIZE(str))]
     260    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), sep, lBackWard), k=1, SIZE(str))]
     261    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), sep),            k=1, SIZE(str))]
    263262  ELSE
    264     out = [(strTail_1(str(k), lFirst=lf), k=1, SIZE(str))]
     263    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), '/', lBackWard), k=1, SIZE(str))]
     264    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), '/'),            k=1, SIZE(str))]
    265265  END IF
    266266END FUNCTION strTail_m
Note: See TracChangeset for help on using the changeset viewer.