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

coded adaptive scaling along time axis

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: 2128
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 43681f5e
c this is file <grepg.f>
c======================================================================
c $Id: grepg.f,v 1.33 2006-06-02 11:26:25 tforb Exp $
c $Id: grepg.f,v 1.34 2006-06-02 11:51:27 tforb Exp $
c
c GREPG.F
c
......@@ -114,7 +114,7 @@ c program version:
character*120 CVS_VERSION
parameter(CVS_VERSION=
& '$Id: grepg.f,v 1.33 2006-06-02 11:26:25 tforb Exp $')
& '$Id: grepg.f,v 1.34 2006-06-02 11:51:27 tforb Exp $')
c declare variables for io
character*80 filename
......@@ -144,6 +144,8 @@ c declare internal variables
real du, pi2
character*120 title, xlabel, ylabel
real transform(6)
c number of elements used in scaling array
integer nscaling
c lower limit for plot values
double precision lowlimit
parameter(lowlimit=1.e-20)
......@@ -287,7 +289,8 @@ c give basic information
print *,' '
print *,' -s scale frequencies individually'
print *,' using maximum amplitude value'
print *,' -st scale individually, but use time axis'
print *,' -st apply adaptive scaling along time axis'
print *,' rather than frequency axis'
print *,' (useful for gabor plots)'
print *,' -N c,w Use a gaussian taper when calculating'
print *,' normalization factors in order to scale'
......@@ -531,6 +534,7 @@ c
if (optset(6)) read(optarg(6), *, err=99, end=98) tenpower
if (optset(7)) grid=.TRUE.
read(optarg(8), *, err=99, end=98) setlinewidth
c option -s
scale=optset(10)
implot=optset(11)
replot=optset(12)
......@@ -545,6 +549,7 @@ c campatibility to version prior V2.23
read(optarg(18), *, err=99, end=98) charheight
readpickfile=optset(19)
pickfile=optarg(19)
c option -N
norm_on=optset(21)
read(optarg(21), *, err=99, end=98) norm_center, norm_width
deftitle=optset(22)
......@@ -554,6 +559,7 @@ c campatibility to version prior V2.23
xlabelstring=optarg(24)
defylab=optset(25)
ylabelstring=optarg(25)
c option -n
normalize=optset(26)
read(optarg(26), *, err=99, end=98) normvalue
wedgestring=optarg(27)
......@@ -565,6 +571,7 @@ c campatibility to version prior V2.23
grayify=max(0.,min(1.,grayify))
conlab=optset(32)
read(optarg(32), *, err=99, end=98) cl_intval,cl_minint,cl_signif
c option -f
moveavg=optset(33)
read(optarg(33), *, err=99, end=98) avglength
avglength=max(2,avglength)
......@@ -605,6 +612,7 @@ c covariances
if (replot) implot=.false.
if (phasecolor) phaseswitch=.false.
if (norm_on) scale=.true.
if (adaptivetimescaling) scale=.true.
c
if (verbose) print *,'verbose mode'
c
......@@ -734,46 +742,89 @@ c
enddo
enddo
endif
c
c
c (option -s)
if (scale) then
print *,'scale each frequency...'
print *,' scaling with respect to values greater than ',
& scalingslim,'s/km'
print *,' setup scaling function...'
if (norm_on) then
print *,' use normalizing taper...'
c distinguish between scaling along frequency and time axis
if (adaptivetimescaling) then
c
if (verbose) then
print *,'adaptive scaling will be applied along time axis'
print *,' setup scaling function...'
endif
c check required size of scaling array
nscaling=nslo
if (nscaling.gt.maxfreq)
& stop 'ERROR: too many time samples for adaptive scaling'
c (option -N)
if (norm_on) then
print *,' use normalizing taper...'
c taper function is f(s)=exp(-ln(10)*((c-s)/w)**2)
c with c=norm_center and w=norm_width
c maxvalue here means normvalue
do ifreq=1,nfreq
maxvalue=0.
do islo=1,nslo
slp=mins+du*(islo-1)
if (slp.ge.scalingslim) maxvalue=maxvalue+
& abs(data(islo,ifreq))*du*exp(-log(10.)*
& ((norm_center-slp)/norm_width)**2)
maxvalue=0.
do ifreq=1,nfreq
maxvalue=maxvalue+
& abs(data(islo,ifreq))*du*exp(-log(10.)*
& ((norm_center-slp)/norm_width)**2)
enddo
maxvalue=max(maxvalue,lowlimit)
scaling(islo)=1./maxvalue
enddo
else
do islo=1,nslo
maxvalue=max(abs(data(nslo,ifreq)),lowlimit)
do ifreq=1,nfreq
maxvalue=max(maxvalue,abs(data(islo,ifreq)))
enddo
scaling(islo)=1./maxvalue
enddo
endif
else
c apply adaptive scaling along frequency axis
nscaling=nfreq
print *,'scale each frequency...'
print *,' scaling with respect to values greater than ',
& scalingslim,'s/km'
print *,' setup scaling function...'
c (option -N)
if (norm_on) then
print *,' use normalizing taper...'
c taper function is f(s)=exp(-ln(10)*((c-s)/w)**2)
c with c=norm_center and w=norm_width
c maxvalue here means normvalue
do ifreq=1,nfreq
maxvalue=0.
do islo=1,nslo
slp=mins+du*(islo-1)
if (slp.ge.scalingslim) maxvalue=maxvalue+
& abs(data(islo,ifreq))*du*exp(-log(10.)*
& ((norm_center-slp)/norm_width)**2)
c if ((verbose).and.(ifreq.eq.50)) then
c print *,islo,slp,exp(-log(10.)*
c & ((norm_center-slp)/norm_width)**2),
c & abs(data(islo,ifreq)),maxvalue
c endif
enddo
maxvalue=max(maxvalue,lowlimit)
scaling(ifreq)=1./maxvalue
enddo
maxvalue=max(maxvalue,lowlimit)
scaling(ifreq)=1./maxvalue
enddo
else
do ifreq=1,nfreq
maxvalue=max(abs(data(nslo,ifreq)),lowlimit)
do islo=1,nslo
slp=mins+du*(islo-1)
if (slp.ge.scalingslim) maxvalue=
& max(maxvalue,abs(data(islo,ifreq)))
else
do ifreq=1,nfreq
maxvalue=max(abs(data(nslo,ifreq)),lowlimit)
do islo=1,nslo
slp=mins+du*(islo-1)
if (slp.ge.scalingslim) maxvalue=
& max(maxvalue,abs(data(islo,ifreq)))
enddo
scaling(ifreq)=1./maxvalue
enddo
scaling(ifreq)=1./maxvalue
enddo
endif
endif
c
c moving average is applied when scaing frequencies independently
c (option -f)
if (moveavg) then
avglength=min(avglength,nfreq)
print *,' apply moving average of length ',avglength,
......@@ -822,7 +873,7 @@ c print *,'change ',ifreq,value,scaling(ifreq)
enddo
endif
c
c normalize total data
c normalize total data (option -n)
c
if (normalize) then
print *,'normalize total data to ',normvalue,'...'
......
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