! Output variables for list of files in comma separated variable format ! ! interactive usage: csvsumvar ! allows specification of output variables, list of files, and output file ! ! non-interactive usage: csvsumvar [list of files] {output filename} ! relies upon environment variables `dat_defspec` and `sumvar` to ! determine which variables are included in output (same as plain sumvar) ! The output filename is optional, if omitted output is sent to STDOUT. ! ! Cobbled together from the guts of sumvar.f by Gregory Tucker -- 2017-11-02 program csvsumvar ! -------------- implicit none integer nmax parameter (nmax=10000) character filelist*2048, files*2048, spec*16, sumvars*256 character var*64, filename*128 integer l, k, km, i, n, pin, pout, lun, iostat integer first,last real xval(nmax), yval(nmax), sig(nmax), rmon(nmax) external list_values, list_vars, list_nix integer mcols parameter (mcols=32) integer ncol, nframes real cnts, fmt(mcols), vmin(mcols), vmax(mcols) character line*1024, names(mcols)*32, time*6 character formatted(mcols)*128 common /sum_com/ncol, nframes, cnts, fmt, vmin, vmax & ,line, names, formatted, time ! call fit_init call sys_get_cmdpar(files,l) ! l is set by sys_get_cmdpar to the length of returned character variable, but isn't used call dat_def_options('entry=') ! check if files contains the output filename too filename=' ' call findfirstlastnonblank(files,first,last) if (last-first .gt. 0) then files=files(first:last) ! remove any preceeding or trailing spaces i=index(files(first:last)," ") ! look for any internal spaces if (i .gt. 0) then filename=files(first+i:last) ! after space is filename files=files(first:first+i-1) ! before space is files specification endif endif if (files .eq. ' ') then call dat_ask_filelist(filelist, ' ') if (filelist .eq. ' ') goto 91 call dat_silent pin=0 pout=0 call dat_open_next(filelist, pin, line, pout & , list_nix, nmax, n, xval, yval, sig, rmon) endif call sys_getenv('dat_defspec', spec) call sys_getenv('sumvar', sumvars) if (sumvars .eq. ' ') call sys_getenv('sumvars', sumvars) if (sumvars .eq. ' ') then call sys_getenv('sumvar_'//spec, sumvars) endif if (sumvars .eq. ' ') then sumvars= & 'Numor:5,Date:16,Title:25,Temp:10.3,dTemp:8.3,sMon:10.' endif if (files .eq. ' ') then print * print *,' Variables listed by default:' call str_trim(sumvars, sumvars, l) print '(x,a)',sumvars(1:l) print * 30 print *,' Enter a new variable list, for default' & ,', or ? for help:' read(*, '(a)', err=91, end=91) line if (line .eq. '?') then print * &,'--------------------------------------------------------------' print * &,' You may configure the default with the environment variables' &,' sumvar or sumvar_',spec print * &,' Example (to be typed on the Unix prompt):' print * print '(x,3a)' &,'> setenv sumvars "',sumvars(1:l),'"' print * print * &,' For each column, write the variable name and the column' &,' width, separated by a colon. For numeric values, give' &,' also the number of digits after decimal point, separated' &,' with a point. The columns have to be separated by a comma.' &,' The column title is right justified, if a point is present.' print * print * &,' List of variables in the first file:' call dat_silent pin=0 pout=0 call dat_open_next(filelist, pin, files, pout & , list_vars, nmax, n, xval, yval, sig, rmon) call list_vars('*', 0.0) print * &,'--------------------------------------------------------------' goto 30 endif if (line .ne. ' ') sumvars=line print * print *,'Output file name (default: terminal):' read(*, '(a)', err=91, end=91) filename else filelist=files endif if (filename .eq. ' ') then lun=6 else lun=1 call sys_open(lun, filename, 'w', iostat) if (iostat .ne. 0) then print *,'can not open',filename stop endif call findfirstlastnonblank(sumvars,first,last) print *,"saving output ",sumvars(first:last) call findfirstlastnonblank(files,first,last) print *,"from files ",files(first:last)," to ",filename endif call str_trim(sumvars, sumvars, last) ! last is the length of sumvars without trailing space(s) sumvars(min(len(sumvars),last+1):)=',' ncol=0 k=0 line=' ' 35 km=index(sumvars(k+1:),',') if (km .gt. 0) then if (km .gt. 1 .and. ncol .lt. mcols) then ncol=ncol+1 var=sumvars(k+1:k+km-1) i=index(var, ':') if (i .eq. 0) then call str_trim(names(ncol), var, n) fmt(ncol)=16.3 else call str_trim(names(ncol), var(1:i-1), n) fmt(ncol)=0 read(var(i+1:),*,err=36) fmt(ncol) 36 if (fmt(ncol) .eq. 0) fmt(ncol)=16.3 endif call findfirstlastnonblank(names(ncol),first,last) if (last-first .gt. 0) then formatted(ncol)='"'//names(ncol)(first:last)//'",' ! stash for output endif call str_upcase(names(ncol), names(ncol)) endif k=k+km goto 35 endif 38 if (ncol .le. 1) goto 91 call putonline(formatted,ncol,line) call findfirstlastnonblank(line,first,last) if (last-first .gt. 1) then write(lun, '(a)') line(first:last-1) ! cut off the trailing comma endif pin=0 pout=0 40 line=' ' call fillspaces(formatted,ncol) ! reset the formatted column strings (only up to the number of columns) call dat_def_options('entry=*') call dat_silent call dat_open_next(filelist, pin, files, pout & , list_values, nmax, n, xval, yval, sig, rmon) ! this calls subroutine list_values for the pin_th entry of filelist call putonline(formatted,ncol,line) call findfirstlastnonblank(line,first,last) if (last-first .gt. 1) then write(lun, '(a)') line(first:last-1) ! cut off the trailing comma endif if (pin .le. len(filelist)) goto 40 91 end subroutine list_nix(name, value) character name*(*) real value end subroutine list_vars(name, value) character name*(*) real value integer l/0/,j character line*80 save line, l if (name .eq. 'ShowLevel') return j=index(name, '=')-1 if (j .le. 0) call str_trim(name, name, j) if (l+j .ge. 80 .or. name .eq. '*') then print *,line(1:l) l=0 endif if (l .gt. 0) then line(l+1:l+1)=',' l=l+1 endif line(l+1:)=name(1:j) l=min(80,l+j) end subroutine list_values(name, value) character name*(*) real value integer i,l,j,first,last character unam*32, form*8, field*128 real f integer mcols parameter (mcols=32) integer ncol, nframes real cnts, fmt(mcols), vmin(mcols), vmax(mcols) character line*1024, names(mcols)*32, time*6 character formatted(mcols)*128 common /sum_com/ncol, nframes, cnts, fmt, vmin, vmax & ,line, names, formatted, time if (name .eq. 'ranges') then nframes=nint(value) elseif (name .eq. 'Counts') then cnts=value elseif (len(name) .gt. 5) then if (name(1:5) .eq. 'Date=') then time=name(17:) endif endif j=index(name, '=') if (j .gt. 1) then ! string call str_upcase(unam, name(1:j-1)) else call str_upcase(unam, name) endif do i=1,ncol if (unam .eq. names(i)) then f=fmt(i)+1 l=int(f+0.001) if (l .ge. len(field)) l=len(field) field(1:)=' ' if (j .gt. 0) then ! string field(1:l)=' '//name(j+1:) else if (f-l .lt. 0.04) then write(form, '(a,I2,a)') '(i',l,')' write(field(1:l), form) nint(value) else write(form, '(a,f5.1,a)') '(f',f,')' write(field(1:l), form) value endif endif if (field(1:1) .ne. '-') field(1:1)=' ' call findfirstlastnonblank(field,first,last) formatted(i)='"'//field(first:last)//'",' endif enddo end subroutine findfirstlastnonblank(field,intf,intl) character field*(*) integer intf,intl intl=LEN(field) intf=1 if (intl .gt. 0) then do while (field(intf:intf) .eq. ' ') intf=intf+1 if (intf .ge. intl) exit enddo do while (field(intl:intl) .eq. ' ') intl=intl-1 if (intl .le. intf) exit enddo endif end subroutine fillspaces(vecchars,lv) integer lv character vecchars(lv)*(*) integer i do i=1,lv vecchars(i)=' ' enddo end subroutine putonline(vecchars,lv,outline) integer lv character vecchars(lv)*(*), outline*(*) integer lo,i,first,last,k,thisl lo=len(outline) k=0 do i=1,lv call findfirstlastnonblank(vecchars(i),first,last) if (last-first .gt. 0) then if (k .lt. lo) then thisl=last-first+1 outline(k+1:k+thisl)=vecchars(i)(first:last) k=k+thisl endif endif if (k .ge. lo) exit ! shortcut if we've run past the end of the outline enddo end