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

bugfix: correct determination of extrema

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/trunk
SVN Revision: 3873
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent d5333770
......@@ -80,6 +80,10 @@ 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 13/01/11 program is prepared fro libfapidxx interface
c V1.30 21/04/11 rename data->fdata, maxval->maxsval,
c minval->minsval
c removed ampfac from sffread
c correct determination of extrema
c
c======================================================================
program stuplo
......@@ -90,7 +94,7 @@ c
c version
character*77 version, creator
parameter(version=
& 'STUPLO V1.29 plot seismic time series (SFF format)')
& 'STUPLO V1.30 plot seismic time series (SFF format)')
parameter(creator='1996 by Thomas Forbriger (IfG Stuttgart)')
c parameter definitions
integer maxsamples, maxselect, lu, maxtraces, maxchain, maxstyle
......@@ -115,9 +119,9 @@ c here is the one big array to contain all seismic traces
c and this big array will hold real and integer data together
c the way we do this both real and integer type variables
c must allocate 4 bytes of memory each!
real data(maxsamples)
real fdata(maxsamples)
integer idata(maxsamples)
equivalence (idata, data)
equivalence (idata, fdata)
c arras to hold information on data
integer nsamples(maxtraces), firstsample(maxtraces)
integer traceinfile(maxtraces)
......@@ -132,7 +136,7 @@ c arras to hold information on data
character*1 loccs(maxtraces)
real locc1(maxtraces), locc2(maxtraces)
real sectime(maxtraces), dt(maxtraces)
real maxval(maxtraces), average(maxtraces), minval(maxtraces)
real maxsval(maxtraces), average(maxtraces), minsval(maxtraces)
c file reading variables
character*200 infile
logical moretraces
......@@ -424,7 +428,7 @@ c first read the commandline
if ((xrfac+xlfac).ge.1.)
& stop 'ERROR: check setting of -R and -L (nothing will be left)'
if (debug) print *,'DEBUG: debug messages are switched on'
if (debug) call checkmem(idata, data, maxsamples)
if (debug) call checkmem(idata, fdata, maxsamples)
optmarker=optset(18)
if (optmarker) read(optarg(18), *, end=96, err=97) xmark
verbose=optset(19)
......@@ -504,7 +508,7 @@ c start a new chain with this trace
& maxsamples, maxtraces, filename, dt, timeax,
& firstsample, nsamples, firstfree, date,
& time, sectime, station, channel, auxid,
& instype, data, idata, maxval, average, minval,
& instype, fdata, idata, maxsval, average, minsval,
& optabstime, verbose, partimeoff,
& loccs, locc1, locc2)
if (debug) then
......@@ -519,8 +523,8 @@ c start a new chain with this trace
& ' last sample:',(firstsample(trace)-1+
& nsamples(trace)),
& ' samples:',nsamples(trace)
print *,'DEBUG: maxval:',maxval(trace),
& ' minval:',minval(trace),
print *,'DEBUG: maxval:',maxsval(trace),
& ' minval:',minsval(trace),
& ' average:',average(trace)
endif
else
......@@ -554,13 +558,13 @@ c calculate axis range
c
xminp=timeax(firstsample(1))
xmaxp=timeax(firstsample(1)-1+nsamples(1))
yminp=minval(1)
ymaxp=maxval(1)
yminp=minsval(1)
ymaxp=maxsval(1)
do trace=1,ntraces
xminp=min(xminp,timeax(firstsample(trace)))
xmaxp=max(xmaxp,timeax(firstsample(trace)-1+nsamples(trace)))
yminp=min(yminp,minval(trace))
ymaxp=max(ymaxp,maxval(trace))
yminp=min(yminp,minsval(trace))
ymaxp=max(ymaxp,maxsval(trace))
enddo
c
c determine fractioning of surface
......@@ -692,7 +696,7 @@ c or skip if only first is selcted
endif
elseif(captionsel(i:i).eq.'m') then
write(line,'("min/max:",e12.3,"/",e12.3)')
& minval(trace),maxval(trace)
& minsval(trace),maxsval(trace)
elseif(captionsel(i:i).eq.'F') then
line=firstfree(trace)
else
......@@ -734,16 +738,16 @@ c
trace=firstic(ichain)-1+ipanel
xmint=timeax(firstsample(trace))
xmaxt=timeax(firstsample(trace)-1+nsamples(trace))
ymint=minval(trace)
ymaxt=maxval(trace)
ymint=minsval(trace)
ymaxt=maxsval(trace)
do ichain=1,nchain
c is there a trace to plot in this chain?
if (ipanel.le.tracesic(ichain)) then
trace=firstic(ichain)-1+ipanel
xmint=min(xmint,timeax(firstsample(trace)))
xmaxt=max(xmaxt,timeax(firstsample(trace)-1+nsamples(trace)))
ymint=min(ymint,minval(trace))
ymaxt=max(ymaxt,maxval(trace))
ymint=min(ymint,minsval(trace))
ymaxt=max(ymaxt,maxsval(trace))
endif
c enddo ichain
enddo
......@@ -962,7 +966,7 @@ c is there a trace to plot in this chain?
trace=firstic(ichain)-1+ipanel
call pgline(nsamples(trace),
& timeax(firstsample(trace)),
& data(firstsample(trace)))
& fdata(firstsample(trace)))
call pgupdt
endif
c enddo ichain
......@@ -1030,10 +1034,10 @@ c
c check whether integer and real variables use the same
c amount of bytes in memory
c
subroutine checkmem(idata, data, maxsamples)
subroutine checkmem(idata, fdata, maxsamples)
c declare parameters
integer maxsamples
real data(maxsamples)
real fdata(maxsamples)
integer idata(maxsamples)
c declare variables
integer i,n
......@@ -1046,14 +1050,14 @@ c go
write(6,'(6(i10,1x))') (idata(i), i=1,n)
print *,' '
do i=1,n
data(i)=float(idata(i))
fdata(i)=float(idata(i))
enddo
write(6,'(6(f10.2,1x))') (data(i), i=1,n)
write(6,'(6(f10.2,1x))') (fdata(i), i=1,n)
print *,' '
write(6,'(6(i10,1x))') (idata(i), i=1,n)
print *,' '
do i=1,n
idata(i)=int(data(i))
idata(i)=int(fdata(i))
enddo
write(6,'(6(i10,1x))') (idata(i), i=1,n)
print *,'CHECKMEM: ------ END ------'
......@@ -1118,7 +1122,7 @@ c
& maxsamples, maxtraces, filename, dt, timeax,
& firstsample, nsamples, firstfree, date,
& time, sectime, station, channel, auxid,
& instype, data, idata, maxval, average, minval,
& instype, fdata, idata, maxsval, average, minsval,
& optabstime, verbose, timeshift,
& loccs, locc1, locc2)
c declare parameters
......@@ -1136,8 +1140,8 @@ c declare parameters
character*1 loccs(maxtraces)
real locc1(maxtraces), locc2(maxtraces)
real sectime(maxtraces), dt(maxtraces)
real maxval(maxtraces), average(maxtraces), minval(maxtraces)
real data(maxsamples), value, minv, maxv, timeax(maxsamples)
real maxsval(maxtraces), average(maxtraces), minsval(maxtraces)
real fdata(maxsamples), value, minv, maxv, timeax(maxsamples)
integer idata(maxsamples), nsamp
double precision avg
logical verbose
......@@ -1145,7 +1149,7 @@ c declare parameters
c declare variables
integer sample, ierr, i, ntrim, nstack
character wid2line*132, code*20, line*80
real ampfac, stime, c3
real stime, c3
logical last
integer maxfree, nfree, mfreelen
parameter(maxfree=50)
......@@ -1164,7 +1168,7 @@ c read trace
if (debug) print *,'(DEBUG): call sff_RTraceI'
call sff_RTraceFI(lu, sectime(trace), dt(trace),
& wid2line, nsamp,
& data(firstsample(trace)),
& fdata(firstsample(trace)),
& idata(firstsample(trace)),
& code, last,
& nfree, freelines, maxfree, mfreelen,
......@@ -1179,7 +1183,7 @@ c read trace
firstfree(trace)=' '
if (nfree.gt.0) firstfree(trace)=freelines(1)
c translate data from integer to real
minv=float(idata(firstsample(trace)))*ampfac
minv=fdata(firstsample(trace))
maxv=minv
avg=0.d0
if (optabstime) then
......@@ -1189,16 +1193,16 @@ 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=data(sample)
value=fdata(sample)
timeax(sample)=stime+dt(trace)*float(sample-firstsample(trace))+
& timeshift
avg=avg+dble(value)
maxv=max(maxv,value)
minv=min(minv,value)
enddo
average(trace)=sngl(avg)
maxval(trace)=maxv
minval(trace)=minv
average(trace)=sngl(avg)/nsamples(trace)
maxsval(trace)=maxv
minsval(trace)=minv
if (debug) print *,'DEBUG: minv:',minv,' maxv:',maxv,' avg:',avg
c extract information from wid2line
date(trace)=wid2line(6:15)
......
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