Index: LMDZ6/trunk/libf/misc/strings_mod.f90 =================================================================== --- LMDZ6/trunk/libf/misc/strings_mod.f90 (revision 5750) +++ LMDZ6/trunk/libf/misc/strings_mod.f90 (revision 5751) @@ -6,5 +6,5 @@ PRIVATE - PUBLIC :: maxlen, init_printout, msg, get_in, lunout, prt_level + PUBLIC :: maxlen, init_printout, msg, get_in, lunout, prt_level, maxTableWidth PUBLIC :: strLower, strHead, strStack, strCount, strReduce, strClean, strIdx PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, duplicate, cat @@ -23,11 +23,13 @@ INTERFACE strCount; MODULE PROCEDURE strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount INTERFACE strReplace; MODULE PROCEDURE strReplace_1, strReplace_m; END INTERFACE strReplace - INTERFACE cat; MODULE PROCEDURE horzcat_s00, horzcat_i00, horzcat_r00, horzcat_d00, & - horzcat_s10, horzcat_i10, horzcat_r10, horzcat_d10, & - horzcat_s11, horzcat_i11, horzcat_r11, horzcat_d11, & - horzcat_s21, horzcat_i21, horzcat_r21; END INTERFACE cat !horzcat_d21 + INTERFACE cat; MODULE PROCEDURE horzcat_s00, horzcat_i00, horzcat_r00, horzcat_d00, horzcat_l00, & + horzcat_s10, horzcat_i10, horzcat_r10, horzcat_d10, horzcat_l10, & + horzcat_s11, horzcat_i11, horzcat_r11, horzcat_d11, horzcat_l11, & + horzcat_s21, horzcat_i21, horzcat_r21, horzcat_d21, horzcat_l21, & + horzcat_s22, horzcat_i22, horzcat_r22, horzcat_d22, horzcat_l22; END INTERFACE cat INTERFACE strFind; MODULE PROCEDURE strFind_1, strFind_m; END INTERFACE strFind - INTERFACE find; MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find + INTERFACE find; MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find INTERFACE duplicate; MODULE PROCEDURE dupl_s, dupl_i, dupl_r, dupl_l; END INTERFACE duplicate + INTERFACE dispTable; MODULE PROCEDURE dispTable_1, dispTable_2; END INTERFACE dispTable INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers INTERFACE reduceExpr; MODULE PROCEDURE reduceExpr_1, reduceExpr_m; END INTERFACE reduceExpr @@ -37,4 +39,5 @@ INTEGER, SAVE :: lunout = 6 !--- Printing unit (default: 6, ie. on screen) INTEGER, SAVE :: prt_level = 1 !--- Printing level (default: 1, ie. print all) + INTEGER, SAVE :: maxTableWidth = 192 !--- Default max. number of characters per lines in dispTable CONTAINS @@ -1216,118 +1219,298 @@ !============================================================================================================================== -!--- Display a clean table composed of successive vectors of same length. +!=== DISPLAY A TABLE COMPOSED OF HORIZONTALLY CONCATENATED COLUMN VECTORS ===================================================== +!============================================================================================================================== !=== The profile "p" describe in which order to pick up the columns from "s", "i" and "r" for display. !=== * nRowMax lines are displayed (default: all lines) -!=== * nColMax characters (default: as long as needed) are displayed at most on a line. If the effective total length is -!=== higher, several partial tables are displayed ; the nHead (default: 1) first columns are included in each sub-table. -!============================================================================================================================== - FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr) - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r - CHARACTER(LEN=*), INTENT(IN) :: titles(:) !--- TITLES (ONE EACH COLUMN) - CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS - INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS - REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS - CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals - INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Display at most "nRowMax" rows - INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Display at most "nColMax" characters each line - INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Head columns repeated for multiple tables display - INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (default: screen) - CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name - LOGICAL :: lerr -!------------------------------------------------------------------------------------------------------------------------------ - CHARACTER(LEN=2048) :: row - CHARACTER(LEN=maxlen) :: rFm, el, subn +!=== * nColMax characters (default: as long as needed) are displayed at most on a line. +!=== - narrow tables are stacked horizontally as much as possible (ie: total width must stay lower than nColMax) . +!=== - wide tables are cut into several sub-tables of columns subsets, with the first nHead columns repeated. +!=== * titles can be a vector (one element each column) or an array (dim 1: number of lines ; dim 2: number of columns) +!============================================================================================================================== +LOGICAL FUNCTION dispTable_1(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r + CHARACTER(LEN=*), INTENT(IN) :: titles(:) !--- TITLES (one each column, single line) + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS + INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS + REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals + INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Display at most "nRowMax" rows + INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Display at most "nColMax" characters each line + INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Head columns repeated for multiple tables display + INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (default: screen) + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name +!------------------------------------------------------------------------------------------------------------------------------ + lerr = dispTable_2(p, RESHAPE(titles, [1,SIZE(titles)]), s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) +END FUNCTION dispTable_1 +!============================================================================================================================== +LOGICAL FUNCTION dispTable_2(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r + CHARACTER(LEN=*), INTENT(IN) :: titles(:,:) !--- TITLES (one each column, possibly more than one line) + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS + INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS + REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals + INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Display at most "nRowMax" rows + INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Display at most "nColMax" characters each line + INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Head columns repeated for multiple tables display + INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (default: screen) + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name +!------------------------------------------------------------------------------------------------------------------------------ + INTEGER, PARAMETER :: nm = 1 + INTEGER, ALLOCATABLE :: n(:), nmx(:) + INTEGER :: nRmx, nCmx, nHd, unt, ib, ic, ie, it, nt, ncol, k, l, l0 + CHARACTER(LEN=maxlen), ALLOCATABLE :: c(:,:), c1(:,:), m(:) + CHARACTER(LEN=maxlen) :: subn + + !=== CONVERT THE ELEMENTS INTO A STRINGS ARRAY + lerr = convertTable(p, titles, c, s, i, r, rFmt, sub); IF(lerr) RETURN + + !=== GET VALUES FOR REMAINING OPTIONAL ARGUMENTS + nRmx= SIZE(c, 1); IF(PRESENT(nRowMax)) nRmx=MIN(nRmx,nRowMax) !--- Maximum number of lines to print + nCmx= maxTableWidth; IF(PRESENT(nColMax)) nCmx=MIN(nCmx,nColMax) !--- Maximum number of characters each line + nHd = 0; IF(PRESENT(nHead)) nHd = nHead !--- Number of front columns to duplicate + unt = lunout; IF(PRESENT(unit)) unt = unit !--- Unit to print messages + subn= 'dispTable'; IF(PRESENT(sub)) subn= sub !--- Calling subroutine name + + !=== SMALL WIDTH TABLE: STACK AS MUCH VERTICAL SECTIONS HORIZONTALLY AS POSSIBLE CONSIDERING nColMax. UNTOUCHED OTHERWISE. + n = tableCellsWidth(c)+2*nm + c1 = gatherTable(c, n, SIZE(titles, 1), nRmx, nCmx, subn) + ncol = SIZE(c1, DIM=2) + IF(ncol /= SIZE(c,2)) n = tableCellsWidth(c1)+2*nm !--- UPDATE "n(:)" IF "c" HAS BEEN STACKED + + nCmx = 48 + + !=== HIGH WIDTH TABLE: CUT IT INTO SUB-TABLES, WITH THE FIRST "nHead" COLUMNS REPEATED IN EACH OF THEM + !--- Build the vector of max column index in case the rows are too long (table must be displayed in multiple parts) + IF(SUM(n+1)-1 > nCmx .AND. ncol > 1) THEN + l0 = 1 + LEN_TRIM(subn) + SUM(n(1:nHd)+1) + + !=== DETERMINE THE NUMBER "nt" OF SUB-TABLES + nt=1; l=l0; DO ic = nHd+1, ncol; IF(l+n(ic)+1 >= nCmx) THEN; l=l0; nt=nt+1; END IF; l = l+n(ic)+1; END DO + + !=== GET THE INDEX OF THE LAST COLUMN FOR EACH SUB-TABLE + ALLOCATE(nmx(nt)) + it=0; l=l0; DO ic = nHd+1, ncol; IF(l+n(ic)+1 >= nCmx) THEN; l=l0; it=it+1; nmx(it)=ic-1; END IF; l = l+n(ic)+1; END DO + nmx(nt) = ncol + + !=== DISPLAY THE SUB-TABLES + DO it = 1, nt + ie = nmx(it); ib = nHd+1; IF(it > 1) ib = nmx(it-1)+1 + m = buildTable(cat(c1(:,1:nHd),c1(:,ib:ie)), nm, SIZE(titles, 1)) + DO k = 1, SIZE(m); CALL msg(TRIM(m(k)), subn, unit=unt); END DO; CALL msg('', subn, unit=unt) + END DO + ELSE + !=== DISPLAY THE SINGLE TABLE + m = buildTable(c1, nm, SIZE(titles,1)) + DO k = 1, SIZE(m); CALL msg(TRIM(m(k)), subn, unit=unt); END DO + END IF + +CONTAINS + +FUNCTION tableCellsWidth(t) RESULT(n) !=== COMPUTE FOR EACH COLUMN THE MIMIMUM WIDTH TO DISPLAY ELEMENTS WITHOUT TRUNCATION + CHARACTER(LEN=*), INTENT(IN) :: t(:,:) + INTEGER, ALLOCATABLE :: n(:) + INTEGER :: i, j + n = [(MAXVAL([(LEN_TRIM(t(i,j)), i=1, SIZE(t,1))], DIM=1), j=1, SIZE(t,2))] +END FUNCTION tableCellsWidth + +END FUNCTION dispTable_2 +!============================================================================================================================== + + +!============================================================================================================================== +!--- Concatenate horizontally the table d0(:,:) so that: +!=== * total width (number of characters per line) remains lower than nColMax (default: 256 characters) +!=== * total number of lines remains lower than nRowMax (default: all lines are kept) +!=== If the table d0 starts with nTitle /= 0 lines for titles, they are duplicated at each section top. +!============================================================================================================================== +FUNCTION gatherTable(d0, n, nTitle, nRowMax, nColMax, sub) RESULT(d1) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: d0(:,:) !--- Input strings array + INTEGER, INTENT(IN) :: n(:) !--- Maximum width of elements in each column (excluding separator) + INTEGER, OPTIONAL, INTENT(IN) :: nTitle !--- Number of rows for titles + INTEGER, OPTIONAL, INTENT(IN) :: nRowMax !--- Maximum number of rows + INTEGER, OPTIONAL, INTENT(IN) :: nColMax !--- Maximum number of characters each line + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name + CHARACTER(LEN=maxlen), ALLOCATABLE :: d1(:,:) !--- Array of horizontally gathered sections + INTEGER :: nr0, nc0, nr1, nc1 !--- Row and columns numbers for original and gathered array + INTEGER :: ih, nh, nv !--- Index and number of stacked sections + INTEGER :: nttl, nrMx, ncMx !--- Titles number and effective max. row and columns numbers + INTEGER :: nrem, nr, ir0, icb, ice + nr0 = SIZE(d0, DIM=1) + nc0 = SIZE(d0, DIM=2) + nttl = 0; IF(PRESENT(nTitle)) nttl = nTitle + ncMx = 256; IF(PRESENT(nColMax)) ncMx = MIN(nCmx, nColMax) + nrMx = nr0; IF(PRESENT(nRowMax)) nrMx = MIN(nrMx, nRowMax) + nh = MAX(1, ncMx/SUM(n+1)) !--- Max. horiz. stackabled sections for ncMx (+1: last separator) + nv = 1+(nr0-nttl-1)/nh !--- Corresponding number ofvertical elements per section + nh = 1+(nr0-nttl-1)/nv !--- Effective number of sections + nr1 = MIN(nrMx,1+ nttl+(nr0-nttl-1)/nh); nc1 = nc0*nh !--- Shape of the stacked array + ALLOCATE(d1(nr1,nc1)) + nrem = nr0 !--- Remaining values to fill in + DO ih = 1, nh + nr = MAX(0,MIN(nr1,nrem)-nttl); nrem=nrem-nr !--- Number of copied rows in ith section (excluding titles) + ir0 = nttl+(ih-1)*(nr1-nttl) !--- Row start index in d1 + ice = ih*nc0; icb = ice-nc0+1 !--- Column end and start indices in d1 + d1(1:nttl, icb:ice) = d0(1:nttl, :) !--- Copy titles line(s) + d1(1+nttl:nr+nttl,icb:ice) = d0(1+ir0:nr+ir0,:) !--- Copy ith section + IF(nr1 == nr + nttl) CYCLE + d1(1+nr+nttl:nr1, icb:ice) =' ' !--- Fill missing cells with a space + END DO +END FUNCTION gatherTable +!============================================================================================================================== + + +!============================================================================================================================== +!--- Convert a set of columns of different natures ("s"trings, "i"ntegers, "r"eals) into a strings table. Default value +!=== * p: profile giving the order to pick up columns from "s", "i" and "r" to construct "c(:,:)". mandatory +!=== * t: titles, one per variable (2nd index), possibly on several lines (1st index). mandatory +!=== * c: assembled array mandatory +!=== * s: horizontally stacked string column vectors of values / +!=== * i: horizontally stacked integer column vectors of values / +!=== * r: horizontally stacked real column vectors of values / +!=== * rFmt: format for real conversion * +!=== * sub: calling subroutine name (for error messages) / +!=== NOTE: The vectors s, i and r do not have necessarly the same length. Empty elements are filled at the end. +!============================================================================================================================== +LOGICAL FUNCTION convertTable(p, t, c, s, i, r, rFmt, sub) RESULT(lerr) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: p !--- DISPLAY MAP: s/i/r + CHARACTER(LEN=*), INTENT(IN) :: t(:,:) !--- TITLES (ONE EACH COLUMN) + CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: c(:,:) !--- CONVERTED STRINGS TABLE + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s(:,:) !--- STRINGS + INTEGER, OPTIONAL, INTENT(IN) :: i(:,:) !--- INTEGERS + REAL, OPTIONAL, INTENT(IN) :: r(:,:) !--- REALS + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sub !--- Subroutine name +!------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:) - CHARACTER(LEN=1) :: s1, sp - INTEGER :: is, ii, ir, it, k, nmx, unt, ic, np - INTEGER :: ns, ni, nr, nt, l, ncol, nHd, ib, l0 - INTEGER, ALLOCATABLE :: n(:), ncmx(:) - INTEGER, PARAMETER :: nm=1 !--- Space between values & columns - LOGICAL :: ls, li, lr + CHARACTER(LEN=maxlen) :: rFm, subn + CHARACTER(LEN=1) :: sp = '|' !--- Table cells separator + INTEGER :: it, is, ii, ir, ic, nmx + INTEGER :: nt, ns, ni, nr, ncol + LOGICAL :: ls, li, lr, ll + rFm = '*'; IF(PRESENT(rFmt)) rFm = rFmt !--- Specified format for reals subn = ''; IF(PRESENT(sub)) subn = sub - rFm = '*'; IF(PRESENT(rFmt)) rFm = rFmt !--- Specified format for reals - unt = lunout; IF(PRESENT(unit)) unt = unit !--- Specified output unit - np = LEN_TRIM(p); ns = 0; ni = 0; nr = 0; ncol = 0 ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r) - lerr = .FALSE.; IF(.NOT.ANY([ls,li,lr])) RETURN !--- Nothing to do - sp = '|' !--- Separator + ns = 0; ni = 0; nr = 0; ncol = 0 + ncol = LEN_TRIM(p) !--- Number of columns of the table + nt = SIZE(t,1) !--- CHECK ARGUMENTS COHERENCE - lerr = np /= SIZE(titles); CALL msg('display map "p" length and titles list mismatch', subn, lerr); IF(lerr) RETURN - IF(ls) THEN - ns = SIZE(s, 1); ncol = ncol + SIZE(s, 2); lerr = COUNT([(p(ic:ic)=='s', ic=1, np)]) /= SIZE(s, 2) + lerr = .NOT.ANY([ls,li,lr]) + CALL msg('missing argument(s) "s", "i" and/or "r"', subn, lerr) + IF(lerr) RETURN + lerr = ncol /= SIZE(t,2) + CALL msg('display map "p" length and titles number mismatch', subn, lerr) + IF(lerr) RETURN + IF(ls) THEN; ns = SIZE(s,1) + lerr = COUNT([(p(ic:ic)=='s', ic=1, ncol)]) /= SIZE(s,2) + CALL msg('display map "p" and string arguments mismatch: nb(p=="s")/=SIZE(s,2)', subn, lerr) + IF(lerr) RETURN END IF - IF(li) THEN - ni = SIZE(i, 1); ncol = ncol + SIZE(i, 2); lerr = COUNT([(p(ic:ic)=='i', ic=1, np)]) /= SIZE(i, 2) + IF(li) THEN; ni = SIZE(i,1) + lerr = COUNT([(p(ic:ic)=='i', ic=1, ncol)]) /= SIZE(i,2) + CALL msg('display map "p" and integer arguments mismatch: nb(p=="i")/=SIZE(i,2)', subn, lerr) + IF(lerr) RETURN END IF - IF(lr) THEN - nr = SIZE(r, 1); ncol = ncol + SIZE(r, 2); lerr = COUNT([(p(ic:ic)=='r', ic=1, np)]) /= SIZE(r, 2) + IF(lr) THEN; nr = SIZE(r,1) + lerr = COUNT([(p(ic:ic)=='r', ic=1, ncol)]) /= SIZE(r,2) + CALL msg('display map "p" and real arguments mismatch: nb(p=="r")/=SIZE(r,2)', subn, lerr) + IF(lerr) RETURN END IF - CALL msg('display map "p" length and arguments number mismatch', subn, lerr); IF(lerr) RETURN - lerr = ncol /= SIZE(titles); CALL msg('"titles" length and arguments number mismatch', subn, lerr); IF(lerr) RETURN - lerr = ls.AND.li.AND.ns/=ni; CALL msg('string and integer arguments lengths mismatch', subn, lerr); IF(lerr) RETURN - lerr = ls.AND.lr.AND.ns/=nr; CALL msg( 'string and real arguments lengths mismatch', subn, lerr); IF(lerr) RETURN - lerr = li.AND.lr.AND.ni/=nr; CALL msg( 'integer and real arguments lengths mismatch', subn, lerr); IF(lerr) RETURN - nmx = MAX(ns,ni,nr)+1; IF(PRESENT(nRowMax)) nmx = MIN(nmx,nRowMax+1) - - !--- Allocate the assembled quantities array - ALLOCATE(d(nmx,ncol), n(ncol)) +! lerr = (ls.AND.li .AND. ns /= ni) .OR. (li.AND.lr .AND. ni /= nr) .OR. (lr.AND.ls .AND. nr /= ns) +! CALL msg('mismatching rows numbers for at least "s", "i" or "r"', subn, lerr) +! IF(lerr) RETURN + nmx = MAX(ns, ni, nr) + nt !--- Assemble the vectors into a strings array in the order indicated by "pattern" + ALLOCATE(c(nmx,ncol)) is = 1; ii = 1; ir = 1 DO ic = 1, ncol - d(1,ic) = TRIM(titles(ic)) + c(1:nt,ic) = t(1:nt,ic) !--- Add titles line(s) SELECT CASE(p(ic:ic)) - CASE('s'); d(2:nmx,ic) = s(:,is) ; is = is + 1 - CASE('i'); d(2:nmx,ic) = num2str(i(:,ii) ); ii = ii + 1 - CASE('r'); d(2:nmx,ic) = num2str(r(:,ir),rFm); ir = ir + 1 + CASE('s'); c(1+nt:nmx,ic) = s(:,is) ; is = is + 1 !--- Add string elements + CASE('i'); c(1+nt:nmx,ic) = num2str(i(:,ii) ); ii = ii + 1 !--- Add integer elements + CASE('r'); c(1+nt:nmx,ic) = num2str(r(:,ir),rFm); ir = ir + 1 !--- Add real elements END SELECT END DO - CALL cleanZeros(d) - DO ic = 1, ncol - n(ic)=0; DO ir=1, nmx; n(ic)=MAX(n(ic), LEN_TRIM(d(ir,ic))); END DO - END DO - n(:) = n(:) + 2*nm - - !--- Build the vector of max column index in case the rows are too long (table must be displayed in multiple parts) - nHd = 1; IF(PRESENT(nHead)) nHd = nHead - IF(.NOT.PRESENT(nColMax)) THEN - nt = 1; ncmx = [ncol] - ELSE - nt = 1; l0 = SUM(n(1:nHd)+1)+1 - IF(PRESENT(sub)) l0=l0+LEN_TRIM(subn)+1 - !--- Count the number of table parts - l = l0; DO ic = nHd+1, ncol; l = l+n(ic)+1; IF(l>=nColMax) THEN; nt = nt+1; l = l0+n(ic)+1; END IF; END DO - !--- Get the index of the last column for each table part - ALLOCATE(ncmx(nt)); k = 1 - l = l0; DO ic = nHd+1, ncol; l = l+n(ic)+1; IF(l>=nColMax) THEN; ncmx(k) = ic-1; l = l0+n(ic)+1; k = k+1; END IF; END DO - ncmx(nt) = ncol - END IF - - !--- Display the strings array as a table - DO it = 1, nt - DO ir = 1, nmx; row = '' - DO ic = 1, nHd; el = d(ir,ic) - s1 = sp - row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1 - END DO - ib = nHd+1; IF(it>1) ib = ncmx(it-1)+1 - DO ic = ib, ncmx(it); el = d(ir,ic) - s1 = sp - row = TRIM(row)//REPEAT(' ',nm)//TRIM(el)//REPEAT(' ',n(ic)-LEN_TRIM(el)-nm)//s1 - END DO - nr = LEN_TRIM(row)-1 !--- Final separator removed - CALL msg(row(1:nr), subn, unit=unt) - IF(ir /= 1) CYCLE !--- Titles only are underlined - row=''; DO ic=1,nHd; row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO - DO ic = ib,ncmx(it); row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO - CALL msg(row(1:LEN_TRIM(row)-1), subn, unit=unt) - END DO - CALL msg('', subn, unit=unt) - END DO - -END FUNCTION dispTable -!============================================================================================================================== + CALL cleanZeros(c) !--- Remove useless zeros in converted numbers + +END FUNCTION convertTable +!============================================================================================================================== + + +!============================================================================================================================== +!--- Build a table from the string array "d(:,:)" as a vector of assembled lines (to be printed as messages). +!=== * each column has the minimum width "n(j)" needed to display the elements "d(:,j)" with at least "nm" spaces each side. +!=== * the structure of a cell is: | (pay attention to the end separator "|") +!=== * n1 and n2 depend on the justification (three methods available) and give a total width of "n(j)", as expected. +!=== * each cell ends with the separator "|", except the last one +!=== * nTitle/=0 means that the first "nTitle" lines will be separated from the rest of the table with an underline. +!============================================================================================================================== +FUNCTION buildTable(d, nm, nTitle) RESULT(m) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: d(:,:) !--- Input array + INTEGER, INTENT(IN) :: nm !--- Number of spaces before and after values + INTEGER, OPTIONAL, INTENT(IN) :: nTitle !--- Number of rows for titles + CHARACTER(LEN=10*maxlen), ALLOCATABLE :: m(:) !--- Lines to issue as messages to display the table + CHARACTER(LEN=1) :: sp = '|' !--- Separator + INTEGER :: ir, ic, nr, nc, i, j, n(SIZE(d,2)), nttl, id, p + nr = SIZE(d, DIM=1); nc = SIZE(d, DIM=2) !--- Dimensions of the table + nttl = 0; IF(PRESENT(nTitle)) nttl = nTitle + n = [(MAXVAL([(LEN_TRIM(d(i,j)), i=1, nr)], DIM=1), j=1, nc)] + 2*nm + ALLOCATE(m(nr+1)) !--- Allocate the vector (+1 for header line) + i = 1 + DO ir = 1, nr + IF(ir <= nttl) CALL centerJustified(d(ir,:), n, i, m(i)) + IF(ir == nttl) CALL headerLine( n, i, m(i)) + IF(ir > nttl) CALL leftJustified(d(ir,:), n, i, m(i)) + END DO + +CONTAINS + +SUBROUTINE leftJustified(d, n, i, r) + CHARACTER(LEN=*), INTENT(IN) :: d(:) + INTEGER, INTENT(IN) :: n(:) + CHARACTER(LEN=*), INTENT(INOUT) :: r + INTEGER, INTENT(INOUT) :: i + r = '' + DO id = 1, nc; r = TRIM(r)//REPEAT(' ',nm)//TRIM(d(id))//REPEAT(' ',n(id)-LEN_TRIM(d(id))-nm)//sp; END DO + r = r(1:LEN_TRIM(r)-1); i = i+1 !--- Final separator removed +END SUBROUTINE leftJustified + +SUBROUTINE centerJustified(d, n, i, r) + CHARACTER(LEN=*), INTENT(IN) :: d(:) + INTEGER, INTENT(IN) :: n(:) + INTEGER, INTENT(INOUT) :: i + CHARACTER(LEN=*), INTENT(INOUT) :: r + INTEGER :: p + r = ''; DO id = 1, nc; p=n(id)-LEN_TRIM(d(id)); r = TRIM(r)//REPEAT(' ', p - p/2)//TRIM(d(id))//REPEAT(' ', p/2)//sp; END DO + r = r(1:LEN_TRIM(r)-1); i = i+1 !--- Final separator removed +END SUBROUTINE centerJustified + +SUBROUTINE rightJustified(d, n, i, r) + CHARACTER(LEN=*), INTENT(IN) :: d(:) + INTEGER, INTENT(IN) :: n(:) + INTEGER, INTENT(INOUT) :: i + CHARACTER(LEN=*), INTENT(INOUT) :: r + r = ''; DO id = 1, nc; r = TRIM(r)//REPEAT(' ',n(id)-LEN_TRIM(d(id))-nm)//TRIM(d(id))//REPEAT(' ',nm)//sp; END DO + r = r(1:LEN_TRIM(r)-1); i = i+1 !--- Final separator removed +END SUBROUTINE rightJustified + +SUBROUTINE headerLine(n, i, r) + INTEGER, INTENT(IN) :: n(:) + INTEGER, INTENT(INOUT) :: i + CHARACTER(LEN=*), INTENT(INOUT) :: r + r = ''; DO id= 1 , nc; r = TRIM(r)//REPEAT('-',n(id))//'+'; END DO + r = r(1:LEN_TRIM(r)-1); i = i+1 !--- Final '+' removed +END SUBROUTINE headerLine + +END FUNCTION buildTable +!============================================================================================================================== + !==============================================================================================================================