Index: LMDZ6/trunk/libf/misc/strings_mod.f90 =================================================================== --- LMDZ6/trunk/libf/misc/strings_mod.f90 (revision 5752) +++ LMDZ6/trunk/libf/misc/strings_mod.f90 (revision 5753) @@ -1598,4 +1598,176 @@ !============================================================================================================================== +!=== DISPLAY OUTLIERS IN TABLES =============================================================================================== +!============================================================================================================================== +!=== lerr = dispOutliers_1(ll(:), a(:[:]), n(:), err_msg, nam(:), sub, nRowmax, nColMax, unit) +!=== * ll linearized mask of outliers +!=== * a linearized fields: +!=== a(:) all the fields are linearized (all contane +!=== Behaviour depends on ll(:), n(:) and nam(:). We note hereafter nv = SIZE(nam). +!=== +!=== 1) if SIZE(ll) == PRODUCT(n) and nv==1 or "nam" is unspecified: outliers of a single variable are displayed +!=== i[,j[,k]] | nam | +!=== ----------+-----------------+ +!=== *[,*[,*]] | val(i[,j[,k]]) | +!=== ... | ... | +!=== +!=== +!=== 2) if SIZE(ll) == PRODUCT(n) and nv>1: "nv" tables of outliers are displayed, each having its own mask +!=== i[,j] | var(1) +!=== ------+-------------- +!=== *[,*] | val(i[,j],1) +!=== ... | ... +!=== +!=== ... +!=== +!=== i[,j] | var(nv) +!=== ------+--------------- +!=== *[,*] | val(i[,j],nv) +!=== ... | ... +!=== +!=== +!=== 3) if SIZE(ll) = PRODUCT(n(1:SIZE(n)-1): outliers of "nv" variables are displayed, all with mask "ll(:)" +!=== i[,j] | var(1) | var(2) | ... | var(nv) +!=== ------+--------------+---------------+-- ... --+--------------- +!=== *[,*] | val(i[,j],1) | val(i[,j],2) | ... | val(i[,j],nv) +!=== ... | ... | ... | ... | ... +!=== +!=== NOTES: +!=== * in cases 2 and 3, SIZE(nam) MUST be equal to n(SIZE(n)). +!=== * for the sake of readability, narrow tables (compared to the max. width "nColMax") are horizontally stacked. +!=== Here is the result in the case 1: +!=== i[,j[,k]] | nam | i[,j[,k]] | nam | ... | i[,j[,k]] | nam +!=== ----------+-----------------+-----------+-----------------+-- ... --+-----------+----------------- +!=== *[,*[,*]] | val(i[,j[,k]]) | *[,*[,*]] | val(i[,j[,k]]) | ... | *[,*[,*]] | val(i[,j[,k]]) +!=== ... | ... | ... | ... | ... | ... | ... +!=== * conversly, in case 3, too wide tables are displayed as several sub-tables. +!=== * too long tables are truncated to nRowMax lines (excluding titles lines). +!============================================================================================================================== +LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, sub, nRowmax, nColMax, 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(:), sub !--- 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) :: unit !--- Output unit (def: lunout) +!------------------------------------------------------------------------------------------------------------------------------ + CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:), vnm(:), c(:,:) + LOGICAL, ALLOCATABLE :: m(:), ld(:) + INTEGER, ALLOCATABLE :: ki(:), kj(:) + INTEGER :: rk, ib, ie, itr, nm, unt, nRmx, nCmx, iv, nv, np + CHARACTER(LEN=maxlen) :: mes, subn, fm='(f12.9)', p + lerr = .FALSE. + + IF(.NOT.ANY(ll)) 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 + subn= 'dispOutliers'; IF(PRESENT(sub)) subn= sub !--- 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 + unt = lunout; IF(PRESENT(unit)) unt = unit !--- Unit to print messages + + rk = SIZE(n) !--- Rank of "a" before linearization + nv = SIZE(vnm) !--- Number of variables + np = PRODUCT(n(1:rk-1)) !--- Number of points per var (in the multiple vars case) + lerr = rk>3; CALL msg('can display field with rank <=3 only !', subn, lerr, unt); IF(lerr) RETURN + lerr = n(rk) == 1; CALL msg('degenerated last dim: n(SIZE(n)) = 1 !', subn, lerr, unt); IF(lerr) RETURN + lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', subn, lerr, unt); IF(lerr) RETURN + lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', subn, lerr, unt); IF(lerr) RETURN + lerr = ALL([PRODUCT(n),np] /= SIZE(ll)) + CALL msg('ll" length must be either PROD(n) or PROD(n(1:rk-1))', subn, lerr, unt); IF(lerr) RETURN + + !============================================================================================================================ + IF(SIZE(ll) == PRODUCT(n)) THEN !=== ll(:) IS A MASK FOR THE WHOLE a(:) VECTOR =========== + !============================================================================================================================ + p = 's'//REPEAT('r',nv) !--- Display map: one string, "nv" reals + IF(nv == 1) THEN !=== SINGLE VARIABLE + CALL buildTitle(n, vnm, t) !--- Build titles list "t" for a single variable + CALL buildCoord(n, ll, c) !--- Masked ("ll") coordinates vector "c" + lerr = dispTable(p, t, s=c, r=cat(PACK(a,ll)), rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=1, unit=unt, sub=subn) + ELSE !=== MULTIPLE VARIABLES + DO iv = 1, nv + CALL buildTitle(n, vnm(iv:iv), t) !--- Titles list "t" for the "iv"th variables + CALL buildCoord(n(1:rk-1), ll, c) !--- Masked ("ll") coordinates vector "c" + ib = 1+(iv-1)*np; ie = ib+np + lerr = dispTable(p, t, s=c, r=cat(PACK(a(ib:ie),ll(ib:ie))), rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=1, & + unit=unt, sub=subn) + CALL msg("can't display outliers table", subn, lerr, unt); IF(lerr) RETURN + END DO + END IF + !============================================================================================================================ + ELSE !=== ll(:) IS A MASK FOR EACH TRACER STACKED IN a(:) VECTOR + !============================================================================================================================ + CALL buildTitle(n, vnm, t) !--- Build titles list "t" for all the variable + CALL duplicate(ll, nv, ld) !--- "ll" concatenated "nv" times + CALL buildCoord(n(1:rk-1), ll, c) !--- Masked ("ll") coordinates vector "c" + lerr = dispTable(p, t, s=c, r=RESHAPE(PACK(a,ld),[np,nv]), rFmt=fm, nRowMax=nRmx, nColMax=nCmx, nHead=1,unit=unt,sub=subn) + !============================================================================================================================ + END IF + !============================================================================================================================ + CALL msg("can't display outliers table", subn, lerr, unt) + +CONTAINS + +SUBROUTINE buildTitle(n, vname, title) !=== BUILD TITLES: [COORD. NAME, THE VARIABLE(S) NAME(S)] + INTEGER, INTENT(IN) :: n(:) + CHARACTER(LEN=maxlen), INTENT(IN) :: vname(:) + CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: title(:) + INTEGER :: rk + rk = SIZE(n) + ALLOCATE(title(1+SIZE(vname))) + title(2:SIZE(vname)+1) = vname + title(1) = 'i' + IF(rk >= 2) title(1) = TRIM(title(1))//', j' + IF(rk >= 3) title(1) = TRIM(title(1))//', k' +END SUBROUTINE buildTitle + +SUBROUTINE buildCoord(n, mask, coord) !=== BUILD MASKED COORDINATES OK FOR "s" ARG OF dispTable + INTEGER, INTENT(IN) :: n(:) + LOGICAL, INTENT(IN) :: mask(:) + CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: coord(:,:) + CHARACTER(LEN=maxlen) :: sj, sk + INTEGER :: i, j, k, m(3), rk, ic + rk = SIZE(n) + m(:) = 1; m(1:rk) = n(:) + ALLOCATE(coord(1,COUNT(mask))) + ic = 0 + DO k = 1, m(3); sk = ', '//num2str(k) + DO j = 1, m(2); sj = ', '//num2str(j) + DO i = 1, m(1) + IF(.NOT.mask(i+m(1)*(j+m(2)*k))) CYCLE + ic = ic+1 + coord(ic,1) = num2str(i) + IF(rk >= 2) coord(ic,1) = TRIM(coord(ic,1))//TRIM(sj) + IF(rk >= 3) coord(ic,1) = TRIM(coord(ic,1))//TRIM(sk) + END DO + END DO + END DO +END SUBROUTINE buildCoord + +END FUNCTION dispOutliers_1 +!============================================================================================================================== +LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, sub, nRowmax, nColMax, 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(:), sub !--- 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) :: unit !--- Output unit (def: lunout) +!------------------------------------------------------------------------------------------------------------------------------ + lerr = dispOutliers_1(ll, PACK(a, MASK=.TRUE.), n, err_msg, nam, sub, nRowmax, nColMax, unit) +END FUNCTION dispOutliers_2 +!============================================================================================================================== + + +!============================================================================================================================== !=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ==================== !==============================================================================================================================