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

allow destacking

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: 503
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 9f881148
......@@ -16,7 +16,8 @@ LIBSFF=-lf2cstuff -L$(SERVERLIBDIR)
GFLAG=
FIDAOBS=fidase.o fidase_readdata.o fidase_skipdata.o fidase_writedata.o \
fidase_readtaper.o fidase_evaltaper.o fidase_enfit.o fidase_resamp.o
fidase_readtaper.o fidase_evaltaper.o fidase_enfit.o fidase_resamp.o \
fidase_destack.o
-include make.incdep
......
c this is <fidase.f>
c------------------------------------------------------------------------------
c $Id: fidase.f,v 1.2 2001-10-23 20:59:42 forbrig Exp $
c
c 09/07/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -10,6 +11,7 @@ c 09/07/98 V1.0 Thomas Forbriger
c 12/08/98 V1.1 improved help text
c 25/11/98 V1.2 now does resampling
c 27/02/99 V1.3 scale energies offset dependent
c 23/10/01 V1.4 destack option
c
c==============================================================================
c
......@@ -17,13 +19,13 @@ c
c
character*79 version
parameter(version=
& 'FIDASE V1.3 FIt DAtaSets - make datasets homogeneous')
& 'FIDASE V1.4 FIt DAtaSets - make datasets homogeneous')
c
c common blocks
include 'fidase_para.inc'
include 'fidase_strings.inc'
c options
logical overwrite, opttaper, optenfit
logical overwrite, opttaper, optenfit, optdestack
c
real enfminoff, enfmindelta, enfexpo
logical optresamp
......@@ -35,14 +37,14 @@ c filenames
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=8)
parameter(maxopt=9)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c here are the keys to our commandline options
data optid/2h-D,2h-v,2h-o,2h-t,2h-e,2h-d,2h-r,2h-E/
data opthasarg/3*.FALSE.,.TRUE.,4*.TRUE./
data optarg/3*1h-,1h-,1h-,3hx11,1h-,2h1./
data optid/2h-D,2h-v,2h-o,2h-t,2h-e,2h-d,2h-r,2h-E,2h-s/
data opthasarg/3*.FALSE.,.TRUE.,4*.TRUE.,.FALSE./
data optarg/3*1h-,1h-,1h-,3hx11,1h-,2h1.,1h-/
c
c------------------------------------------------------------------------------
c basic information
......@@ -53,7 +55,7 @@ c
if ((argument(1:5).eq.'-help').or.(iargc().lt.1)) then
print *,version
print *,'Usage: fidase [-D] [-v] [-o] [-t file] [-e min,mind]'
print *,' [-d device] [-r n,dt] [-E exp]'
print *,' [-d device] [-r n,dt] [-E exp] [-s]'
print *,' file1 file2 ... target'
print *,' or: fidase -help'
if (iargc().lt.1) stop 'ERROR: missing arguments'
......@@ -78,6 +80,10 @@ c
print *,' sampling interval dt'
print *,'-E exp calculated energies will be scaled with'
print *,' offset**exp (default: ',optarg(8)(1:3),')'
print *,'-s destack traces'
print *,' samples values will be divided by the'
print *,' stack counter upon read and the stack'
print *,' counter will be reset to 1'
print *,' '
print *,'file? input datasets'
print *,'target filename for homogeneus output dataset'
......@@ -109,6 +115,7 @@ c
optresamp=optset(7)
if (optresamp) read (optarg(7), *, err=99) newsamppow,newdt
read(optarg(8), *, err=99) enfexpo
optdestack=optset(9)
c
if ((iargc()-lastarg).lt.2) stop 'ERROR: too few filenames'
c
......@@ -117,6 +124,8 @@ c
c------------------------------------------------------------------------------
c go
call readdata(lastarg)
c
if (optdestack) call destack
c
if (optresamp) call resamp(newsamppow, newdt)
c
......
c this is <fidase_data.inc>
c------------------------------------------------------------------------------
c $Id: fidase_data.inc,v 1.2 2001-10-23 20:59:42 forbrig Exp $
c
c 09/07/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -7,6 +8,7 @@ c data common block for fidase
c
c REVISIONS and CHANGES
c 09/07/98 V1.0 Thomas Forbriger
c 23/10/01 V1.1 hold stack counter for each trace
c
c==============================================================================
c
......@@ -22,6 +24,7 @@ c
character*3 channel(maxtraces)
character*4 auxid(maxtraces)
character*6 instype(maxtraces)
integer nstack(maxtraces)
real toffset(maxtraces), dt(maxtraces)
real roffset(maxtraces)
real maxval(maxtraces), average(maxtraces), minval(maxtraces)
......@@ -36,6 +39,6 @@ c
& toffset, roffset, dt, fileindex,
& maxval, average, minval, data, timeofsample,
& nfiles, ntraces, firstinchain, chain, revchain,
& firstinrevchain
& firstinrevchain, nstack
c
c ----- END OF fidase_data.inc -----
c this is <fidase_readdata.f>
c------------------------------------------------------------------------------
c $Id: fidase_readdata.f,v 1.3 2001-10-23 20:59:42 forbrig Exp $
c
c 09/07/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -8,6 +9,7 @@ c
c REVISIONS and CHANGES
c 09/07/98 V1.0 Thomas Forbriger
c 22/02/01 V1.1 wid2line was too short
c 23/10/01 V1.2 read stack counter to array
c
c==============================================================================
c
......@@ -49,7 +51,6 @@ c sff trace
logical last
character rcs*1, wid2line*132
real rc1, rc2, rc3, tanf
integer nstack
c
c functions
real sffu_offset, sffu_tfirst, ts_max, ts_min, ts_average
......@@ -125,7 +126,7 @@ c work on trace
call sff_RTraceI(lu, tanf, dt(ntraces),
& wid2line, nsamples(ntraces), data(firstsample(ntraces)),
& idata(firstsample(ntraces)), code, last,
& rcs, rc1, rc2, rc3, nstack, ierr)
& rcs, rc1, rc2, rc3, nstack(ntraces), ierr)
if (ierr.ne.0) stop 'ERROR (readdata): reading trace'
c
c extract info
......
c this is <fidase_writedata.f>
c------------------------------------------------------------------------------
c $Id: fidase_writedata.f,v 1.2 2001-10-23 20:59:42 forbrig Exp $
c
c 09/07/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -7,6 +8,7 @@ c write complete prepared dataset to disk
c
c REVISIONS and CHANGES
c 09/07/98 V1.0 Thomas Forbriger
c 23/10/01 V1.1 write stack counter
c
c==============================================================================
c
......@@ -93,7 +95,7 @@ c
call sff_WTraceFI(lu, wid2line, nsamples(i),
& data(firstsample(i)), idata(firstsample(i)), last,
& nfree, free,
& 'C', roffset(i), 0., 0., 0, ierr)
& 'C', roffset(i), 0., 0., nstack(i), ierr)
if (ierr.ne.0) stop 'ERROR (writedata): writing trace'
i=chain(i)
enddo
......
Supports Markdown
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