Changeset 5752 for LMDZ6

Timestamp:

Jul 2, 2025, 3:49:50 PM (7 days ago)

Author:

dcugnet

Message:

Remove the old outlayers routines. To be replaces by new routines in the next commit.

File:

• LMDZ6/trunk/libf/misc/strings_mod.f90 (modified) (1 diff)

LMDZ6/trunk/libf/misc/strings_mod.f90

@@ -1598 +1598 @@
 
 !==============================================================================================================================
-LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
-  IMPLICIT NONE
-! Display outliers list in tables
-! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
-  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
-  REAL,                       INTENT(IN)  ::  a(:)                   !--- Linearized array of values
-  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling subroutine names
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:)
-  LOGICAL,                    ALLOCATABLE :: m(:)
-  INTEGER,                    ALLOCATABLE :: ki(:), kj(:)
-  INTEGER                                 :: i, j, k, rk, rk1, ib, ie, itr, nm, unt, nRmx, nCmx, nHd, nv
-  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', v, s
-  CHARACTER(LEN=maxlen),      ALLOCATABLE :: vnm(:)
-
-  lerr = ANY(ll); IF(.NOT.lerr) RETURN                               !--- No outliers -> finished
-
-  mes = 'outliers found'; IF(PRESENT(err_msg)) mes = err_msg         !--- Error message
-  vnm = ['a'];            IF(PRESENT(nam ))    vnm = nam             !--- Variables names
-  sub = 'dispOutliers';   IF(PRESENT(subn))    sub = subn            !--- Calling subroutine name
-  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
-  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
-  nHd = 1;                IF(PRESENT(nHead))   nHd = nHead           !--- Number of front columns to duplicate
-  unt = lunout;           IF(PRESENT(unit))    unt = unit            !--- Unit to print messages
-
-  rk = SIZE(n); nv = SIZE(vnm)
-  lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', sub, lerr); IF(lerr) RETURN
-  lerr = SIZE(a) /=   SIZE(ll); CALL msg('ll" and "a" sizes mismatch',             sub, lerr); IF(lerr) RETURN
-  lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', sub, lerr); IF(lerr) RETURN
-  CALL msg(mes, sub, unit=unt)
-
-  !--- SCALAR CASE: single value to display
-  IF(rk==1.AND.n(1)==1) THEN
-    IF(ll(1)) WRITE(unt,'(a," = ",f12.9)')TRIM(nam(1)),a(1); RETURN
-  END IF
-
-  rk1 = rk; IF(nv==1) rk1 = rk-1                                    !--- Rank of each displayed table
-  SELECT CASE(rk1)                                                  !--- Indices list
-    CASE(1,2); ki = [ (i,i=1,n(1)) ]
-    CASE(3);   ki = [((i,i=1,n(1)),j=1,n(2))]; kj = [((j,i=1,n(1)),j=1,n(2))]
-    CASE DEFAULT; WRITE(unt,*)'Sorry: routine "dispOutliers" is limited to rank 3'; RETURN
-  END SELECT
-
-  !--- VECTOR CASE:  table " name | value " (known names)  /  )  /  " i | a(i) " (unknown names)
-  IF(rk==1) THEN
-    ALLOCATE(ttl(2)); ttl(2) = TRIM(vnm(1))//'(i)'; ttl(1) = 'i'
-    IF(nv == 1) lerr = dispTable('sr', ttl,               s=cat(PACK(nam,ll)), r=cat(PACK(a,ll)), &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-    IF(nv /= 1) lerr = dispTable('ir', ['name ','value'], i=cat(PACK(ki,m)),   r=cat(PACK(a,ll)), &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-    CALL msg("can't display outliers table", sub, lerr, unt)
-    RETURN
-  END IF
-
-  !--- OTHER CASES: one table for each tracer (last index)
-  ttl = [(ACHAR(k), k = 105, 104+rk)]                                !--- Titles list ('i', 'j', 'k'...)
-  s = strStack( ttl(1:rk-1) )                                        !--- Tracer name dummy indexes: (i, j, k, ...
-
-  DO itr=1,n(rk)
-    nm = PRODUCT(n(1:rk-1))                                          !--- number of elements per tracer
-    ie = itr*nm; ib = ie-nm+1; m=ll(ib:ie)                           !--- section bounds for tracer "itr" ; outlayers mask
-    IF(.NOT.ANY(m)) CYCLE                                            !--- no outlayers for tracer "itr"
-    v = TRIM(vnm(MIN(itr,SIZE(vnm))))//'('//TRIM(s)                  !--- "<name>("
-    IF(nv == 1) ttl(rk) = TRIM(v)//','//num2str(itr)//')'            !--- "<name>(i,j,itr)" (single name)
-    IF(nv /= 1) ttl(rk) = TRIM(v)//')'                               !--- "<nam(itr)>(i,j)" (one name each table/itr index)
-    IF(rk==2) lerr = dispTable('ir',  ttl, i=cat(PACK(ki,m)),            r=cat(PACK(a(ib:ie),m)), &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-    IF(rk==3) lerr = dispTable('iir', ttl, i=cat(PACK(ki,m),PACK(kj,m)), r=cat(PACK(a(ib:ie),m)), &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-    CALL msg("can't display outliers table", sub, lerr, unt)
-    IF(lerr) RETURN
-  END DO
-END FUNCTION dispOutliers_1
-!==============================================================================================================================
-LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
-  IMPLICIT NONE
-! Display outliers list in tables
-! If "nam" is supplied and, it means the last index is for tracers => one table each tracer for rank > 2.
-  LOGICAL,                    INTENT(IN)  :: ll(:)                   !--- Linearized mask of outliers
-  REAL,                       INTENT(IN)  ::  a(:,:)                 !--- Linearized arrays of values stacked along 2nd dim.
-  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling subroutine names
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nColMax                 !--- Maximum number of characters per line (default: 2048)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
-  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
-!------------------------------------------------------------------------------------------------------------------------------
-  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', prf
-  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:), vnm(:)
-  INTEGER,                    ALLOCATABLE :: ki(:), kj(:), kl(:)
-  INTEGER                                 :: i, j, k, rk, nv, unt, nRmx, nCmx, nHd
-  REAL,                       ALLOCATABLE :: val(:,:)
-
-  lerr = ANY(ll); IF(.NOT.lerr) RETURN                               !--- No outliers -> finished
-  rk = SIZE(n); nv = SIZE(a,2)
-  mes = 'outliers found';        IF(PRESENT(err_msg)) mes = err_msg  !--- Error message
-  vnm = [(ACHAR(k+96),k=1,nv)];  IF(PRESENT(nam ))    vnm = nam      !--- Variables names
-  sub = 'dispOutliers';          IF(PRESENT(subn))    sub = subn     !--- Calling subroutine name
-  nRmx= SIZE(a);          IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax)!-- Maximum number of lines to print
-  nCmx= 2048;             IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax)!-- Maximum number of characters each line
-  nHd = 1;                IF(PRESENT(nHead))   nHd = nHead           !--- Number of front columns to duplicate
-  unt = lunout;                  IF(PRESENT(unit))    unt = unit     !--- Unit to print messages
-  lerr= SIZE(vnm) /= nv;         CALL msg('SIZE(nam) /= SIZE(a,2)',                  sub, lerr, unt); IF(lerr) RETURN
-  lerr= SIZE(a,1) /= SIZE(ll);   CALL msg('"ll" and "a" sizes mismatch',             sub, lerr, unt); IF(lerr) RETURN
-  lerr= SIZE(a,1) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll"', sub, lerr, unt); IF(lerr) RETURN
-
-  SELECT CASE(rk)                                                   !--- Indices list
-    CASE(0); IF(ll(1)) THEN; WRITE(unt,'(a,", ",a," = ",2f12.9)')TRIM(vnm(1)),TRIM(vnm(2)),a(1,1),a(1,2); RETURN; END IF
-    CASE(1); ki = [  (i,i=1,n(1)) ]
-    CASE(2); ki = [ ((i,i=1,n(1)),j=1,n(2))];           kj = [ ((j,i=1,n(1)),j=1,n(2))]
-    CASE(3); ki = [(((i,i=1,n(1)),j=1,n(2)),k=1,n(3))]; kj = [(((j,i=1,n(1)),j=1,n(2)),k=1,n(3))]
-             kl = [(((k,i=1,n(1)),j=1,n(2)),k=1,n(3))]
-    CASE DEFAULT; WRITE(unt,*)'Sorry: routine "dispOutliers_2" is limited to rank 3'; RETURN
-  END SELECT
-
-  ttl = [(ACHAR(k), k = 105, 104+rk), vnm]                           !--- Titles list ('i', 'j', 'k'...'var1', 'var2', ...)
-  prf = REPEAT('i',rk)//REPEAT('r',nv)                               !--- Profile
-  ALLOCATE(val(COUNT(ll),nv)); DO k=1, nv; val(:,k) = PACK(a(:,k),ll); END DO
-  IF(rk == 1) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll)),                         r = val, &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-  IF(rk == 2) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll),PACK(kj,ll)),             r = val, &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-  IF(rk == 3) lerr = dispTable(prf, ttl, i = cat(PACK(ki,ll),PACK(kj,ll),PACK(kl,ll)), r = val, &
-                                 rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=nHd, unit=unt, sub=sub)
-  CALL msg("can't display outliers table", sub, lerr, unt)
-END FUNCTION dispOutliers_2
-!==============================================================================================================================
-
-
-!==============================================================================================================================
 !=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ====================
 !==============================================================================================================================