Commit 9ec01c15 authored by thomas.forbriger's avatar thomas.forbriger Committed by thomas.forbriger
Browse files

prepared for libfapidxx

This is a legacy commit from before 2015-03-01.
It may be incomplete as well as inconsistent.
See COPYING.legacy and README.history for details.

SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/branches/su1
SVN Revision: 3679
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 6d424212
......@@ -79,7 +79,7 @@ c V1.26 02/07/07 provide option to set tick intervals
c V1.27 18/01/08 do not use write statement for annotations
c just assign to character variable line
c V1.28 04/12/09 use correct DIN notation for units
c V1.29 02/01/11 start implementing libfapidxx
c V1.29 13/01/11 program is prepared fro libfapidxx interface
c
c======================================================================
program stuplo
......@@ -1159,46 +1159,23 @@ c go
c read trace
moretraces=.false.
nsamp=maxsamples-firstsample(trace)
call sff_RTraceI(lu, sectime(trace), dt(trace),
& wid2line, nsamp,
& sectime(trace), dt(trace),
& data(firstsample(trace)),
& idata(firstsample(trace)),
& nfree, freelines, maxfree, mfreelen,
& code, last,
& loccs(trace),locc1(trace),locc2(trace),
& c3,nstack,ierr)
if (debug) print *,'(DEBUG): call sff_RTraceI'
call sff_RTraceFI(lu, sectime(trace), dt(trace),
& wid2line, nsamp,
& data(firstsample(trace)),
& idata(firstsample(trace)),
& code, last,
& nfree, freelines, maxfree, mfreelen,
& loccs(trace),locc1(trace),locc2(trace),
& c3,nstack,ierr)
if (debug) print *,'(DEBUG): returned from sff_RTraceI'
if (ierr.ne.0) stop 'ERROR: reading trace'
nsamples(trace)=nsamp
if ((nsamples(trace)+firstsample(trace)-1).gt.maxsamples)
& stop 'ERROR: too many samples\n'
moretraces=(.not.last)
c skip optional blocks but catch first line of FREE block
i=1
loccs(trace)='X'
1 if (code(i:i).ne.' ') then
if (code(i:i).eq.'F') then
read (lu, err=97, end=96, fmt='(a5)') line
if (line.ne.'FREE ')
& stop 'ERROR: not a FREE block\n'
firstfree(trace)=' '
read (lu, err=97, end=96, fmt='(a)') line
if (line(1:5).ne.'FREE ') then
call sff_TrimLen(line, ntrim)
firstfree(trace)=line(1:ntrim)
2 read (lu, err=97, end=96, fmt='(a)') line
if (line(1:5).ne.'FREE ') goto 2
endif
elseif (code(i:i).eq.'I') then
call sff_RInfo(lu,loccs(trace),locc1(trace),locc2(trace),
& c3,nstack,ierr)
if (ierr.ne.0) stop 'ERROR: INFO line'
elseif (code(i:i).eq.'D') then
moretraces=.true.
endif
i=i+1
goto 1
endif
firstfree(trace)=' '
if (nfree.gt.0) firstfree(trace)=freelines(1)
c translate data from integer to real
minv=float(idata(firstsample(trace)))*ampfac
maxv=minv
......@@ -1210,8 +1187,7 @@ c translate data from integer to real
endif
if (debug) print *,'DEBUG: minv:',minv,' maxv:',maxv,' avg:',avg
do sample=firstsample(trace),(firstsample(trace)+nsamples(trace)-1)
value=float(idata(sample))*ampfac
data(sample)=value
value=data(sample)
timeax(sample)=stime+dt(trace)*float(sample-firstsample(trace))+
& timeshift
avg=avg+dble(value)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment