Initial commit
This commit is contained in:
260
pgm/tricslog.f
Normal file
260
pgm/tricslog.f
Normal file
@@ -0,0 +1,260 @@
|
||||
program trilog_pgm
|
||||
! ------------------
|
||||
|
||||
implicit none
|
||||
|
||||
integer nmax
|
||||
parameter (nmax=10000)
|
||||
|
||||
character filelist*2048, files*2048
|
||||
character trilog*1024, trihead*1024, sumvars*1024
|
||||
character var*64
|
||||
integer ls, l, k, km, i, n, pin, pout, j, lhead, ltot
|
||||
real xval(nmax), yval(nmax), sig(nmax), rmon(nmax)
|
||||
|
||||
external list_values, list_vars
|
||||
|
||||
integer mcols
|
||||
parameter (mcols=32)
|
||||
integer ncol, nframes
|
||||
real cnts, fmt(mcols)
|
||||
character line*1024, names(mcols)*32, opt*80, time*6
|
||||
common /sum_com/ncol, nframes, cnts, fmt, line, names, time
|
||||
|
||||
! call fit_init
|
||||
call sys_setenv('dat_defspec', 'TRICS')
|
||||
call sys_get_cmdpar(files,l)
|
||||
|
||||
call sys_getenv('trilog', trilog)
|
||||
call sys_getenv('trihead', trihead)
|
||||
if (trilog .eq. ' ') then
|
||||
trilog=
|
||||
& 'dTime:5,stt:7.2,om:7.3,chi:7.2,phi:7.2'
|
||||
& //',dg1:7.2,dg2:7.2,dg3:7.2,Sum1:8.,Sum2:8.,Sum3:8.'
|
||||
& //',Temp:8.2,sMon:11.,time:7.,bMon:11.'
|
||||
endif
|
||||
if (trihead .eq. ' ') then
|
||||
trihead='Numor:5,Date:16,Title:60,Sample:20,Owner:20'
|
||||
endif
|
||||
if (files .eq. ' ') then
|
||||
call dat_ask_filelist(filelist, ' ')
|
||||
if (filelist .eq. ' ') goto 91
|
||||
print *
|
||||
print *,'Variables listed by default '
|
||||
& ,'(configure default with setenv trilog / setenv trihead):'
|
||||
print *
|
||||
call str_trim(trihead, trihead, l)
|
||||
print '(x,a)',trihead(1:l)
|
||||
30 print *
|
||||
& ,'enter new header variable list, empty line for default'
|
||||
& ,', ? for a list of variables:'
|
||||
read(*, '(a)', err=91) line
|
||||
if (line .eq. '?') then
|
||||
call dat_silent
|
||||
print *
|
||||
pin=0
|
||||
pout=0
|
||||
call dat_set_options(
|
||||
& '1,512,bank=detector1,entry=frame0000,frame=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. ' ') trihead=line
|
||||
call str_trim(trilog, trilog, l)
|
||||
print '(x,a)',trilog(1:l)
|
||||
31 print *
|
||||
& ,'enter new frame variable list, empty line for default'
|
||||
& ,', ? for a list of variables:'
|
||||
read(*, '(a)', err=91) line
|
||||
if (line .eq. '?') then
|
||||
call dat_silent
|
||||
print *
|
||||
pin=0
|
||||
pout=0
|
||||
call dat_set_options(
|
||||
& '1,512,bank=detector1,entry=frame0000,frame=0')
|
||||
call dat_open_next(filelist, pin, files, pout
|
||||
& , list_vars, nmax, n, xval, yval, sig, rmon)
|
||||
call list_vars('*', 0.0)
|
||||
print *
|
||||
goto 31
|
||||
endif
|
||||
if (line .ne. ' ') trilog=line
|
||||
else
|
||||
filelist=files
|
||||
endif
|
||||
|
||||
call str_trim(sumvars, trihead, ls)
|
||||
sumvars(min(len(sumvars),ls+1):)=','
|
||||
|
||||
ncol=0
|
||||
k=0
|
||||
l=0
|
||||
line=' '
|
||||
lhead=0
|
||||
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
|
||||
i=int(fmt(ncol)+0.001)
|
||||
if (index(var, '.') .eq. 0) then ! left just
|
||||
line(l+1:l+i)=names(ncol)
|
||||
else
|
||||
line(l+max(0,i-n)+1:l+i)=names(ncol)
|
||||
endif
|
||||
call str_upcase(names(ncol), names(ncol))
|
||||
l=l+i+1
|
||||
endif
|
||||
k=k+km
|
||||
goto 35
|
||||
elseif (lhead .eq. 0) then
|
||||
call str_trim(sumvars, trilog, ls)
|
||||
sumvars(min(len(sumvars),ls+1):)=','
|
||||
k=0
|
||||
lhead=l
|
||||
goto 35
|
||||
endif
|
||||
|
||||
38 if (l .le. 1) goto 91
|
||||
ltot=l-1
|
||||
trihead=line(1:lhead)
|
||||
trilog=line(lhead+1:ltot)
|
||||
pin=0
|
||||
pout=0
|
||||
nframes=0
|
||||
40 line=' '
|
||||
call dat_silent
|
||||
call dat_set_options(
|
||||
& '1,512,bank=detector1,entry=frame0000,frame=0')
|
||||
call dat_open_next(filelist, pin, files, pout, list_values
|
||||
& , nmax, n, xval, yval, sig, rmon)
|
||||
if (n .le. 0) goto 39
|
||||
print *
|
||||
print '(x,a)',trihead(1:lhead)
|
||||
print '(x,a)',line(1:lhead)
|
||||
print *
|
||||
print '(x,a)',trilog(1:ltot-lhead)
|
||||
|
||||
do i=0,nframes-1
|
||||
line=' '
|
||||
! call list_values('Frame', 1.0*i)
|
||||
do j=1,3
|
||||
cnts=0
|
||||
write(opt, '(a,i1,a,i4.4,a,i4)')
|
||||
& '1,512,bank=detector',j,',entry=frame',i,',frame=',i
|
||||
call dat_set_options(opt)
|
||||
call dat_read_again(list_values
|
||||
& , nmax, n, xval, yval, sig, rmon)
|
||||
call list_values('Sum'//char(48+j), cnts)
|
||||
enddo
|
||||
call list_values('dTime='//time, 0.0)
|
||||
call str_trim(line, line(lhead+1:ltot), l)
|
||||
if (line(1:l) .ne. ' ') then
|
||||
print '(x,a)',line(1:l)
|
||||
endif
|
||||
enddo
|
||||
|
||||
39 if (pin .le. len(filelist)) goto 40
|
||||
91 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 k,i,l,j,k0
|
||||
character unam*32, form*8
|
||||
real f
|
||||
|
||||
integer mcols
|
||||
parameter (mcols=32)
|
||||
integer ncol, nframes
|
||||
real cnts, fmt(mcols)
|
||||
character line*1024, names(mcols)*32, time*6
|
||||
common /sum_com/ncol, nframes, cnts, fmt, line, names, 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
|
||||
k=0
|
||||
do i=1,ncol
|
||||
l=int(fmt(i)+0.001)
|
||||
k0=k+l+1
|
||||
if (unam .eq. names(i)) then
|
||||
if (j .gt. 0) then ! string
|
||||
line(k+1:k+l)=name(j+1:)
|
||||
else
|
||||
f=fmt(i)
|
||||
if (value .lt. 0.0 .and. k .gt. 0) then ! allow minus sign left overlow field
|
||||
k=k-1
|
||||
l=l+1
|
||||
f=f+1
|
||||
endif
|
||||
if (f-l .lt. 0.04) then
|
||||
write(form, '(a,i3,a)') '(i',l,')'
|
||||
write(line(k+1:k+l), form) nint(value)
|
||||
else
|
||||
write(form, '(a,f5.1,a)') '(f',f,')'
|
||||
write(line(k+1:k+l), form) value
|
||||
endif
|
||||
endif
|
||||
! goto 39
|
||||
endif
|
||||
k=k0
|
||||
if (k .gt. len(line)) goto 39
|
||||
line(k:k)=' '
|
||||
enddo
|
||||
39 continue
|
||||
end
|
||||
Reference in New Issue
Block a user