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

implemented new scaling option for scaling mode 3

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: 5302
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 68ca72f4
......@@ -29,7 +29,9 @@ c 29/07/00 V1.2 introduced opt_Tannotate
c 26/11/10 V1.3 support additional file formats
c 12/11/2012 V1.4 optionally do not apply additional travel time
c reduction to offset shifted traces
c 24/10/2013 V1.5 added ordinate switch
c 24/10/2013 V1.5 - added ordinate switch
c - added parameters to refer scaling mode 3 amplitude to
c an offset range
c
c==============================================================================
c
......@@ -61,9 +63,10 @@ c
c scaling
real opt_Sxmin, opt_Sxmax, opt_Stmin, opt_Stmax
real opt_Sexp, opt_Samp, opt_Sclip, opt_Svel, opt_Sminoff, opt_Sradius
real opt_Savgrefxmin, opt_Savgrefxmax
integer opt_Smode, opt_Sordinate
logical opt_Sinv, opt_Savg, opt_Sxrange, opt_Strange, opt_Sreduce
logical opt_Sosnoreduce
logical opt_Sosnoreduce, opt_Savgref
c
c common blocks
common /refract_optS/ opt_Ttitle, opt_Txlabel, opt_Tylabel,
......@@ -75,12 +78,13 @@ c common blocks
& opt_Sxmin, opt_Sxmax, opt_Stmin, opt_Stmax,
& opt_Sexp, opt_Samp, opt_Sclip, opt_Svel,
& opt_Sminoff, opt_Sradius, opt_Tmodx, opt_Tmodt,
& opt_Lttwidth, opt_Sordinate
& opt_Lttwidth, opt_Sordinate, opt_Savgrefxmin,
& opt_Savgrefxmax
common /refract_optL/ opt_Tmode, opt_Tlegend, opt_Tmodel, opt_Lcycle,
& opt_Ccycle, opt_Cswap, opt_Egrid, opt_Ewiggle,
& opt_Ebubble, opt_Epicks, opt_Ewave, opt_Ett,
& opt_ECpicks, opt_ECwave, opt_ECtt, opt_Sinv,
& opt_Savg, opt_Sxrange, opt_Strange, opt_Sreduce,
& opt_Sosnoreduce
& opt_Sosnoreduce, opt_Savgref
c
c ----- END OF refract_opt.inc -----
......@@ -30,6 +30,7 @@ c 09/09/2004 V1.3 introduced plflag_tracename
c 14/11/2011 V1.4 remember whether minoff is forced on command line
c 12/11/2012 V1.5 optionally do not time shift offset shifted traces
c 12/11/2012 V1.6 added frame parameter
c 24/10/2013 V1.7 added parameters for scaling mode -S3
c
c==============================================================================
c
......@@ -53,6 +54,9 @@ c minimum offset step to be taken as two different positions
real plpar_minoff
c true if plpar_minoff is forced by command line
logical plpar_forceminoff
c
logical plflag_m3avg
real plpar_m3avgxmin, plpar_m3avgxmax
c
c control modes
c -------------
......@@ -156,7 +160,8 @@ c common blocks
& plpar_pmmode, plflag_grid, plflag_picol,
& plflag_seistyle, plflag_ttstyle, plpar_radius,
& plflag_hypoffset, plflag_tracenum,
& plflag_tracename, plpar_forceminoff
& plflag_tracename, plpar_forceminoff,
& plflag_m3avg, plpar_m3avgxmin, plpar_m3avgxmax
common /refract_elem/ elem_modbox, elem_filenames, elem_version,
& elem_annot, elem_scales, elem_data,
& elem_syntt, elem_picks, plflag_subscale,
......
......@@ -36,7 +36,8 @@ c 14/11/2011 V1.8 remember whether minoff is forced
c 12/11/2012 V1.9 new option -Sn
c 13/11/2012 V1.10 new option -Ef and -TL
c 20/11/2012 V1.11 new option -Eu
c 24/10/2013 V1.12 new option -So
c 24/10/2013 V1.12 - new option -So
c - new option -S3
c
c==============================================================================
c
......@@ -66,7 +67,7 @@ c CVS Id
& '$Id$')
c commandline
integer maxopt
parameter(maxopt=65)
parameter(maxopt=66)
character*3 optid(maxopt)
character*120 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
......@@ -130,6 +131,9 @@ c seismograms scaling
data optid(65) /'-So'/
data opthasarg(65) /.TRUE./
data optarg(65) /'0'/
data optid(66) /'-S3'/
data opthasarg(66) /.TRUE./
data optarg(66) /'0.,100.'/
c
c additionals
data (optid(i), i=55,56) /'-Lt','-Ta'/
......@@ -214,6 +218,12 @@ c seismogram scaling
read(optarg(65), *) opt_Sordinate
if ((opt_Sordinate.lt.0).or.(opt_Sordinate.gt.3))
& stop 'ERROR: argument to -So is out of range'
opt_Savgref=optset(66)
read(optarg(66), *), opt_Savgrefxmin, opt_Savgrefxmax
if ((opt_Savgrefxmin.ge.opt_Savgrefxmax)
& .or.(opt_Savgrefxmin.lt.0.)
& .or.(opt_Savgrefxmax.lt.0.))
& stop 'ERROR: inappropriate values of argument to -S3'
c
c titles, label, legends
opt_Ttitle=version
......@@ -244,6 +254,7 @@ c
c override traditional options
c ============================
c
if (opt_Savgref) opt_Smode=3
if (optset(24)) plflag_linestyle=opt_Lcycle
if (optset(29)) plflag_color=opt_Ccycle
if (optset(46)) plpar_expo=opt_Sexp
......@@ -268,6 +279,10 @@ c
plflag_reduce=opt_Sreduce
plflag_osnoreduce=opt_Sosnoreduce
plpar_vred=opt_Svel
c
plflag_m3avg=opt_Savgref
plpar_m3avgxmin=opt_Savgrefxmin
plpar_m3avgxmax=opt_Savgrefxmax
c
plflag_grid=opt_Egrid
plflag_vara=opt_Ewiggle
......
......@@ -95,28 +95,58 @@ c ----------------------------------------------------------
elseif (plpar_mode.eq.3) then
c go for files
do i=1,nfiles
print *,'ifile ',i
if (plflag_m3avg) then
c refer scaling to amplitude average
navg=0
maxamp=0.
do j=1,ntraces
print *,'itrace ',j,' offset ',fieldoffset(j)
if ((fileindex(j).eq.i)
& .and.(fieldoffset(j).ge.plpar_m3avgxmin)
& .and.(fieldoffset(j).le.plpar_m3avgxmax)) then
navg=navg+1
if (plpar_remav) then
maxamp=maxamp+max(abs(maxval(j)-average(j)),
& abs(minval(j)-average(j)))
else
maxamp=maxamp+max(abs(maxval(j)),abs(minval(j)))
endif
endif
enddo
if (navg.lt.1) then
print *,'ERROR (mpc): ',
& 'file ',filename(i)(1:index(filename(i),' ')-1),
& ' has no traces in offset range selected by -S3'
stop 'aborting...'
endif
maxamp=maxamp/navg
else
c refer scaling to nearest offset trace
c find trace with least fieldoffset within file
tref=0
do j=1,ntraces
if (fileindex(j).eq.i) then
if (tref.eq.0) then
tref=j
trefoff=fieldoffset(j)
else
if (fieldoffset(j).lt.trefoff) then
tref=0
do j=1,ntraces
if (fileindex(j).eq.i) then
if (tref.eq.0) then
tref=j
trefoff=fieldoffset(j)
else
if (fieldoffset(j).lt.trefoff) then
tref=j
trefoff=fieldoffset(j)
endif
endif
endif
endif
enddo
if (debug) print *,'DEBUG: file ',i,' tref ',tref,' trefoff ',trefoff
enddo
if (debug) print *,'DEBUG: file ',i,' tref ',tref,
& ' trefoff ',trefoff
c calculate reference scale with respect to total reference
if (plpar_remav) then
maxamp=max(abs(maxval(tref)-average(tref)),
& abs(minval(tref)-average(tref)))
else
maxamp=max(abs(maxval(tref)),abs(minval(tref)))
if (plpar_remav) then
maxamp=max(abs(maxval(tref)-average(tref)),
& abs(minval(tref)-average(tref)))
else
maxamp=max(abs(maxval(tref)),abs(minval(tref)))
endif
endif
refmpc=plpar_amp/(maxamp*(fieldoffset(tref)**plpar_expo))
c set mpc factors within file
......
......@@ -35,7 +35,8 @@ c 12/11/2012 V1.7 new option -Sn
c 20/11/2012 V1.8 new file specific flag v:
c new option -Eu
c new file specific flag b:
c 24/10/2013 V1.9 new option -So
c 24/10/2013 V1.9 - new option -So
c - new option -S3
c
c==============================================================================
c
......@@ -188,8 +189,10 @@ c
print *,'-Sm mode set scaling mode'
print *,' 1: scale traces individually'
print *,' 2: scale all traces to first trace as reference'
print *,' 3: scale all traces to first trace of input'
print *,' dataset as reference'
print *,' 3: scale all traces to nearest offset'
print *,' trace of each dataset as reference'
print *,'-S3 min,max use scaling mode 3 but refer to average'
print *,' amplitude in offset range from min to max'
print *,'-Sr vel set traveltime reduction velocity'
print *,'-Sn do not align offset shifted traces along'
print *,' slope of reduced times'
......
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