Initial commit
This commit is contained in:
319
pgm/csvsumvar.f
Normal file
319
pgm/csvsumvar.f
Normal file
@ -0,0 +1,319 @@
|
||||
! 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, <ret> 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
|
||||
Reference in New Issue
Block a user