Changeset 5746


Ignore:
Timestamp:
Jul 1, 2025, 5:48:46 PM (2 days ago)
Author:
dcugnet
Message:

Remove the "fmsg" function.

Location:
LMDZ6/trunk/libf
Files:
3 edited

Legend:

Unmodified
Added
Removed

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

    r5508 r5746  
    22
    33  USE strings_mod,    ONLY: msg, find, get_in, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
    4              removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
     4             removeComment, cat,       maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
    55             int2str, str2int, real2str, str2real, bool2str, str2bool
    66
    … …  
    220220      !--- GET THE TRACERS NUMBER
    221221      READ(90,'(i3)',IOSTAT=ierr)ntrac                               !--- Number of lines/tracers
    222       lerr = ierr/=0; IF(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, lerr)) RETURN
     222      lerr = ierr/=0; CALL msg('Invalid format for "'//TRIM(fname)//'"', modname, lerr); IF(lerr) RETURN
    223223
    224224      !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
    … …  
    226226      DO it = 1, ntrac                                               !=== READ RAW DATA: loop on the line/tracer number
    227227        READ(90,'(a)',IOSTAT=ierr) str
    228         lerr = ierr>0; IF(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, lerr)) RETURN
    229         lerr = ierr<0; IF(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, lerr)) RETURN
     228        lerr = ierr>0; CALL msg('Invalid format for "' //TRIM(fname)//'"', modname, lerr); IF(lerr) RETURN
     229        lerr = ierr<0; CALL msg('Not enough lines in "'//TRIM(fname)//'"', modname, lerr); IF(lerr) RETURN
    230230        lerr = strParse(str, ' ', s, ns)
    231231        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
    … …  
    609609      jq = strIdx(tname(:), parent(jq))
    610610      lerr = jq == 0
    611       IF(fmsg('Orphan tracer "'//TRIM(tname(iq))//'"', modname, lerr)) RETURN
     611      CALL msg('Orphan tracer "'//TRIM(tname(iq))//'"', modname, lerr); IF(lerr) RETURN
    612612      ig = ig + 1
    613613    END DO
    … …  
    882882        lerr = getKey(keys(ik), v1, i1, k1)
    883883        lerr = getKey(keys(ik), v2, i2, k2)
    884         lerr = v1 /= v2; IF(fmsg(TRIM(keys(ik))//TRIM(s1), modname, lerr)) RETURN
     884        lerr = v1 /= v2; CALL msg(TRIM(keys(ik))//TRIM(s1), modname, lerr); IF(lerr) RETURN
    885885      END DO
    886886
    … …  
    11221122  !--- THE INPUT FILE MUST BE PRESENT
    11231123  INQUIRE(FILE=TRIM(fnam), EXIST=lFound); lerr = .NOT.lFound
    1124   IF(fmsg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr)) RETURN
     1124  CALL msg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr); IF(lerr) RETURN
    11251125
    11261126  !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
    … …  
    11881188    END DO
    11891189    lerr = dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)
    1190     IF(fmsg('Problem with the table content', modname, lerr)) RETURN
     1190    CALL msg('Problem with the table content', modname, lerr); IF(lerr) RETURN
    11911191    DEALLOCATE(ttl, val)
    11921192  END DO       
    … …  
    12371237    DO it = 1, SIZE(iNames)
    12381238      lerr = ALL(p /= iNames(it))
    1239       IF(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, lerr)) RETURN
     1239      CALL msg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, lerr); IF(lerr) RETURN
    12401240    END DO
    12411241    p = iNames; nbIso = SIZE(p)
    … …  
    17651765  lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
    17661766  lerr = strParse(sval, ',', val)
    1767   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1767  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    17681768END FUNCTION getKeyByIndex_s1m1
    17691769!==============================================================================================================================
    … …  
    17821782  IF(lerr) RETURN
    17831783  lerr = strParse(sval, ',', svals)
    1784   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1784  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    17851785  val = str2int(svals)
    17861786  lerr = ANY(val == -HUGE(1))
    … …  
    18021802  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
    18031803  lerr = strParse(sval, ',', svals)
    1804   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1804  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    18051805  val = str2real(svals)
    18061806  lerr = ANY(val == -HUGE(1.))
    … …  
    18231823  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
    18241824  lerr = strParse(sval, ',', svals)
    1825   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1825  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    18261826  ivals = str2bool(svals)
    18271827  lerr = ANY(ivals == -1)
    … …  
    18431843  lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
    18441844  lerr = strParse(sval, ',', val)
    1845   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1845  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    18461846END FUNCTION getKeyByIndex_smm1
    18471847!==============================================================================================================================
    … …  
    18601860  IF(lerr) RETURN
    18611861  lerr = strParse(sval, ',', svals)
    1862   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1862  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    18631863  val = str2int(svals)
    18641864  lerr = ANY(val == -HUGE(1))
    … …  
    18811881  IF(lerr) RETURN
    18821882  lerr = strParse(sval, ',', svals)
    1883   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1883  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    18841884  val = str2real(svals)
    18851885  lerr = ANY(val == -HUGE(1.))
    … …  
    19031903  IF(lerr) RETURN
    19041904  lerr = strParse(sval, ',', svals)
    1905   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1905  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    19061906  ivals = str2bool(svals)
    19071907  lerr = ANY(ivals == -1)
    … …  
    22202220  lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
    22212221  lerr = strParse(sval, ',', val)
    2222   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2222  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    22232223END FUNCTION getKeyByName_s1m1
    22242224!==============================================================================================================================
    … …  
    22362236  IF(lerr) RETURN
    22372237  lerr = strParse(sval, ',', svals)
    2238   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2238  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    22392239  val = str2int(svals)
    22402240  lerr = ANY(val == -HUGE(1))
    … …  
    22562256  IF(lerr) RETURN
    22572257  lerr = strParse(sval, ',', svals)
    2258   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2258  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    22592259  val = str2real(svals)
    22602260  lerr = ANY(val == -HUGE(1.))
    … …  
    22772277  IF(lerr) RETURN
    22782278  lerr = strParse(sval, ',', svals)
    2279   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2279  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    22802280  ivals = str2bool(svals)
    22812281  lerr = ANY(ivals == -1)
    … …  
    22962296  lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
    22972297  lerr = strParse(sval, ',', val)
    2298   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2298  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    22992299END FUNCTION getKeyByName_smm1
    23002300!==============================================================================================================================
    … …  
    23122312  IF(lerr) RETURN
    23132313  lerr = strParse(sval, ',', svals)
    2314   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2314  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    23152315  val = str2int(svals)
    23162316  lerr = ANY(val == -HUGE(1))
    … …  
    23322332  IF(lerr) RETURN
    23332333  lerr = strParse(sval, ',', svals)
    2334   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2334  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    23352335  val = str2real(svals)
    23362336  lerr = ANY(val == -HUGE(1.))
    … …  
    23532353  IF(lerr) RETURN
    23542354  lerr = strParse(sval, ',', svals)
    2355   IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2355  CALL msg('can''t parse '//TRIM(sval), modname, lerr); IF(lerr) RETURN
    23562356  ivals = str2bool(svals)
    23572357  lerr = ANY(ivals == -1)
    … …  
    26462646  INTEGER :: nt, ix
    26472647  lerr = .NOT.ALLOCATED(tracs)
    2648   IF(fmsg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr)) RETURN
     2648  CALL msg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr); IF(lerr) RETURN
    26492649  nt = SIZE(tracs)
    26502650  lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN

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

    r5745 r5746  
    44
    55  PRIVATE
    6   PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level
     6  PUBLIC :: maxlen, init_printout, msg, get_in, lunout, prt_level
    77  PUBLIC :: strLower, strHead, strStack,  strCount, strReduce,  strClean, strIdx
    88  PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, cat
    … …  
    1414  INTERFACE get_in;     MODULE PROCEDURE getin_s,  getin_i,  getin_r,  getin_l;  END INTERFACE get_in
    1515  INTERFACE  msg;       MODULE PROCEDURE        msg_1,                    msg_m; END INTERFACE  msg
    16   INTERFACE fmsg;       MODULE PROCEDURE       fmsg_1,                   fmsg_m; END INTERFACE fmsg
    1716  INTERFACE strHead;    MODULE PROCEDURE    strHead_1,                strHead_m; END INTERFACE strHead
    1817  INTERFACE strTail;    MODULE PROCEDURE    strTail_1,                strTail_m; END INTERFACE strTail
    … …  
    136135  DO k=1,SIZE(s); CALL msg_1(s(k), subn,  l,   unt); END DO
    137136END SUBROUTINE msg_m
    138 !==============================================================================================================================
    139  FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
    140   IMPLICIT NONE
    141   CHARACTER(LEN=*),           INTENT(IN) :: str
    142   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    143   LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    144   INTEGER,          OPTIONAL, INTENT(IN) :: unit
    145   LOGICAL                                :: l
    146 !------------------------------------------------------------------------------------------------------------------------------
    147   CHARACTER(LEN=maxlen) :: subn
    148   INTEGER :: unt
    149   subn = '';    IF(PRESENT(modname)) subn = modname
    150   l   = .TRUE.; IF(PRESENT(ll))     l = ll
    151   unt = lunout; IF(PRESENT(unit)) unt = unit
    152   CALL msg_1(str, subn, l, unt)
    153 END FUNCTION fmsg_1
    154 !==============================================================================================================================
    155  FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
    156   IMPLICIT NONE
    157   CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
    158   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    159   LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    160   INTEGER,          OPTIONAL, INTENT(IN) :: unit
    161   INTEGER,          OPTIONAL, INTENT(IN)  :: nmax
    162   LOGICAL                                 :: l
    163 !------------------------------------------------------------------------------------------------------------------------------
    164   CHARACTER(LEN=maxlen) :: subn
    165   INTEGER :: unt, nmx
    166   subn = '';    IF(PRESENT(modname)) subn = modname
    167   l   = .TRUE.; IF(PRESENT(ll))     l = ll
    168   unt = lunout; IF(PRESENT(unit)) unt = unit
    169   nmx = 128;    IF(PRESENT(nmax)) nmx = nmax
    170   CALL msg_m(str, subn, l, unt, nmx)
    171 END FUNCTION fmsg_m
    172137!==============================================================================================================================
    173138
    … …  
    592557  DO
    593558    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
    594     IF(fmsg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll=lerr)) RETURN
     559    CALL msg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll = lerr); IF(lerr) RETURN
    595560    IF(ie == 0 .OR. jd == 0) EXIT
    596561    ib = ie + LEN(delimiter(jd))
    … …  
    11191084
    11201085  !--- CHECK ARGUMENTS COHERENCE
    1121   lerr = np /= SIZE(titles); IF(fmsg('display map "p" length and titles list mismatch', subn, lerr)) RETURN
     1086  lerr = np /= SIZE(titles); CALL msg('display map "p" length and titles list mismatch', subn, lerr); IF(lerr) RETURN
    11221087  IF(ls) THEN
    11231088    ns = SIZE(s, 1); ncol = ncol + SIZE(s, 2); lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, 2)
    … …  
    11291094    nr = SIZE(r, 1); ncol = ncol + SIZE(r, 2); lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, 2)
    11301095  END IF
    1131   IF(fmsg('display map "p" length and arguments number mismatch', subn, lerr)) RETURN
    1132   lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', subn, lerr)) RETURN
    1133   lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', subn, lerr)) RETURN
    1134   lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg(   'string and real arguments lengths mismatch', subn, lerr)) RETURN
    1135   lerr = li.AND.lr.AND.ni/=nr; IF(fmsg(  'integer and real arguments lengths mismatch', subn, lerr)) RETURN
     1096  CALL msg('display map "p" length and arguments number mismatch', subn, lerr); IF(lerr) RETURN
     1097  lerr = ncol /= SIZE(titles); CALL msg('"titles" length and arguments number mismatch', subn, lerr); IF(lerr) RETURN
     1098  lerr = ls.AND.li.AND.ns/=ni; CALL msg('string and integer arguments lengths mismatch', subn, lerr); IF(lerr) RETURN
     1099  lerr = ls.AND.lr.AND.ns/=nr; CALL msg(   'string and real arguments lengths mismatch', subn, lerr); IF(lerr) RETURN
     1100  lerr = li.AND.lr.AND.ni/=nr; CALL msg(  'integer and real arguments lengths mismatch', subn, lerr); IF(lerr) RETURN
    11361101  nmx = MAX(ns,ni,nr)+1; IF(PRESENT(nRowMax)) nmx = MIN(nmx,nRowMax+1)
    11371102
    … …  
    12301195    lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, DIM=2)
    12311196  END IF
    1232   IF(fmsg('display map "p" length and arguments number mismatch', ll=lerr)) RETURN
    1233   lerr = ncol /= SIZE(titles); IF(fmsg('"titles" length and arguments number mismatch', ll=lerr)) RETURN
    1234   lerr = ls.AND.li.AND.ns/=ni; IF(fmsg('string and integer arguments lengths mismatch', ll=lerr)) RETURN
    1235   lerr = ls.AND.lr.AND.ns/=nr; IF(fmsg(   'string and real arguments lengths mismatch', ll=lerr)) RETURN
    1236   lerr = li.AND.lr.AND.ni/=nr; IF(fmsg(  'integer and real arguments lengths mismatch', ll=lerr)) RETURN
     1197  CALL msg('display map "p" length and arguments number mismatch', ll=lerr); IF(lerr) RETURN
     1198  lerr = ncol /= SIZE(titles); CALL msg('"titles" length and arguments number mismatch', ll=lerr); IF(lerr) RETURN
     1199  lerr = ls.AND.li.AND.ns/=ni; CALL msg('string and integer arguments lengths mismatch', ll=lerr); IF(lerr) RETURN
     1200  lerr = ls.AND.lr.AND.ns/=nr; CALL msg(   'string and real arguments lengths mismatch', ll=lerr); IF(lerr) RETURN
     1201  lerr = li.AND.lr.AND.ni/=nr; CALL msg(  'integer and real arguments lengths mismatch', ll=lerr); IF(lerr) RETURN
    12371202
    12381203  !--- Allocate the assembled quantities array
    … …  
    13861351  nHd = 1;                IF(PRESENT(nHead))   nHd = nHead           !--- Number of front columns to duplicate
    13871352  unt = lunout;                  IF(PRESENT(unit))    unt = unit     !--- Unit to print messages
    1388   lerr= SIZE(vnm) /= nv;         IF(fmsg('SIZE(nam) /= SIZE(a,2)',                  sub, lerr, unt)) RETURN
    1389   lerr= SIZE(a,1) /= SIZE(ll);   IF(fmsg('"ll" and "a" sizes mismatch',             sub, lerr, unt)) RETURN
    1390   lerr= SIZE(a,1) /= PRODUCT(n); IF(fmsg('profile "n" does not match "a" and "ll"', sub, lerr, unt)) RETURN
     1353  lerr= SIZE(vnm) /= nv;         CALL msg('SIZE(nam) /= SIZE(a,2)',                  sub, lerr, unt); IF(lerr) RETURN
     1354  lerr= SIZE(a,1) /= SIZE(ll);   CALL msg('"ll" and "a" sizes mismatch',             sub, lerr, unt); IF(lerr) RETURN
     1355  lerr= SIZE(a,1) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll"', sub, lerr, unt); IF(lerr) RETURN
    13911356
    13921357  SELECT CASE(rk)                                                   !--- Indices list
    … …  
    14331398  ll = strCount(s,')',nn)
    14341399  lerr = nl /= nn
    1435   IF(fmsg('Mismatching number of opening and closing parenthesis: '//TRIM(s), ll=lerr)) RETURN
     1400  CALL msg('Mismatching number of opening and closing parenthesis: '//TRIM(s), ll=lerr); IF(lerr) RETURN
    14361401  nl = 2*nl-1
    14371402

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

    r5199 r5746  
    148148   USE isotopes_mod, ONLY: iso_eau, ntracisoOR, initialisation_iso
    149149   USE dimphy,       ONLY: klon, klev
    150    USE  strings_mod, ONLY: int2str, strStack, strTail, strHead, strIdx, fmsg
     150   USE  strings_mod, ONLY: int2str, strStack, strTail, strHead, strIdx
    151151
    152152   IMPLICIT NONE
    … …  
    157157   INTEGER :: nzone_opt
    158158
    159    IF(fmsg("traceurs_init 18: isotrac ne marche que si on met l'eau comme isotope", 'iso_traceurs_init', iso_eau==0)) STOP
     159   CALL msg("traceurs_init 18: isotrac ne marche que si on met l'eau comme isotope", 'iso_traceurs_init', iso_eau==0)
     160   IF(lerr) STOP
    160161
    161162   !--- Initialize
Note: See TracChangeset for help on using the changeset viewer.