Changeset 4403 for LMDZ6/trunk


Ignore:
Timestamp:
Jan 30, 2023, 9:27:31 PM (22 months 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
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

    r4389 r4403  
    379379
    380380   !=== DISPLAY THE RESULTS
    381    IF(prt_level > 1) THEN
    382       CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    383       CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
    384       CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
    385       CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
    386       CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
    387       CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
     381   CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
     382   CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
     383   CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
     384   CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
     385   CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
     386   CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
    388387#ifdef INCA
    389       CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
    390       CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
    391 #endif
    392    END IF
     388   CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
     389   CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
     390#endif
    393391   t => tracers
    394392   CALL msg('Information stored in infotrac :', modname)

  • 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

  • LMDZ6/trunk/libf/phylmd/infotrac_phy.F90

    r4389 r4403  
    386386
    387387   !=== DISPLAY THE RESULTS
    388 !   IF(prt_level > 1) THEN
    389       CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    390       CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
    391       CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
    392       CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
    393       CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
    394       CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
     388   CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
     389   CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
     390   CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
     391   CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
     392   CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
     393   CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
    395394#ifdef INCA
    396       CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
    397       CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
    398 #endif
    399 !   END IF
     395   CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
     396   CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
     397#endif
    400398   t => tracers
    401399   CALL msg('Information stored in infotrac_phy :', modname)

  • LMDZ6/trunk/libf/phylmdiso/isotopes_routines_mod.F90

    r4402 r4403  
    1651616516#endif
    1651716517     xtrain_fall, xtsnow_fall, ql_ancien, xtl_ancien, qs_ancien, xts_ancien, fxtevap, xtsol
    16518    USE indice_sol_mod,    ONLY: nbsrf 
     16518   USE indice_sol_mod,    ONLY: nbsrf
    1651916519   USE isotopes_mod,      ONLY: isoName,iso_HDO,iso_eau
    1652016520   USE phyetat0_get_mod,  ONLY: phyetat0_get, phyetat0_srf
    1652116521   USE readTracFiles_mod, ONLY: new2oldH2O
    16522    USE strings_mod,       ONLY: strIdx, strHead, strTail, maxlen, msg, int2str
     16522   USE strings_mod,       ONLY: strIdx, strTail, maxlen, msg, int2str
    1652316523#ifdef ISOVERIF
    1652416524   USE isotopes_verif_mod
    … …  
    1655816558
    1655916559      outiso = isoName(ixt)
    16560       oldIso = strTail(new2oldH2O(outiso), '_', lFirst=.TRUE.)
     16560      oldIso = strTail(new2oldH2O(outiso), '_')            !--- Remove "H2O_" from "H2O_<iso>[_<tag>]"
    1656116561      ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après fichier:
    1656216562#ifdef ISOTRAC

  • LMDZ6/trunk/libf/phylmdiso/isotrac_mod.F90

    r4325 r4403  
    149149   USE isotopes_mod, ONLY: iso_eau, ntracisoOR, initialisation_iso
    150150   USE dimphy,       ONLY: klon, klev
    151    USE  strings_mod, ONLY: int2str, strStack, strTail, strHead, fmsg
     151   USE  strings_mod, ONLY: int2str, strStack, strTail, strHead, strIdx, fmsg
    152152
    153153   IMPLICIT NONE
    … …  
    658658   END DO
    659659
    660    index_zone = [(INDEX(isoZone, strTail(         isoName(ixt) ,'_')), ixt=1, ntiso)]
    661    index_iso  = [(INDEX(isoName, strHead(delPhase(isoName(ixt)),'_')), ixt=1, ntiso)]
     660   index_zone = [(strIdx(isoZone, strTail(isoName(ixt) ,'_',.TRUE.)), ixt=1, ntiso)]
     661   index_iso  = [(strIdx(isoName, strHead(isoName(ixt) ,'_',.TRUE.)), ixt=1, ntiso)]
    662662   itZonIso_loc = itZonIso(:,:)
    663663#ifdef ISOVERIF
Note: See TracChangeset for help on using the changeset viewer.