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

finished modification

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: 2130
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 2ba3a169
c this is file <grepg.f>
c======================================================================
c $Id: grepg.f,v 1.35 2006-06-02 11:53:15 tforb Exp $
c $Id: grepg.f,v 1.36 2006-06-02 15:37:00 tforb Exp $
c
c GREPG.F
c
......@@ -96,7 +96,8 @@ c create a master and copy array dimensions include file
c only the master is in CVS, but the copy is loaded here
c so we may change the current dimension without
c affecting the CVS
c V2.38 provide adaptive scaling over time axis
c V2.38 provide adaptive scaling along time axis
c (option -ts, flag adaptivetimescaling)
c
c======================================================================
program grepg
......@@ -114,7 +115,7 @@ c program version:
character*120 CVS_VERSION
parameter(CVS_VERSION=
& '$Id: grepg.f,v 1.35 2006-06-02 11:53:15 tforb Exp $')
& '$Id: grepg.f,v 1.36 2006-06-02 15:37:00 tforb Exp $')
c declare variables for io
character*80 filename
......@@ -831,49 +832,43 @@ c --------------------------------------------
c moving average is applied when scaing frequencies independently
c (option -f)
if (moveavg) then
avglength=min(avglength,nfreq)
avglength=min(avglength,nscaling)
print *,' apply moving average of length ',avglength,
& ' to scaling function...'
c we do it the easy way
c we do it with the reciprocal value as small data values will cause
c extremely large scaling values that would swamp their neighbours
do ifreq=1,nfreq
do ifreq=1,nscaling
avgsrc(ifreq)=1./scaling(ifreq)
enddo
avgsrc(0)=0.
avgsrc(nfreq+1)=0.
do ifreq=1,nfreq
avgsrc(nscaling+1)=0.
do ifreq=1,nscaling
ic1=ifreq-(avglength/2)
ic2=ifreq+(avglength/2)
c if (ic1.lt.1) then
c ic2=ic2+1-ic1
c ic1=1
c coslen=float(ic2-ifreq+1)
c endif
c if (ic2.gt.nfreq) then
c ic1=ic1-ic2+nfreq
c ic2=nfreq
c coslen=float(ifreq-ic1+1)
c endif
ic1=max(1,ic1)
ic2=min(nfreq,ic2)
ic2=min(nscaling,ic2)
coslen=float(ic2-ic1+1)
value=0.
ivalue=0.
do i=ic1,ic2
value=value+avgsrc(i)*(1.+cos(2.*pi*float(i-ifreq)/coslen))
value=value
& +avgsrc(i)*(1.+cos(2.*pi*float(i-ifreq)/coslen))
ivalue=ivalue+(1.+cos(2.*pi*float(i-ifreq)/coslen))
enddo
value=value/ivalue
c print *,coslen,value,ivalue
c print *,'change ',ifreq,value,scaling(ifreq)
scaling(ifreq)=1./value
enddo
endif
print *,' apply scaling function...'
do ifreq=1,nfreq
do islo=1,nslo
data(islo,ifreq)=data(islo,ifreq)*scaling(ifreq)
if (adaptivetimescaling) then
value=scaling(islo)
else
value=scaling(ifreq)
endif
data(islo,ifreq)=data(islo,ifreq)*value
enddo
enddo
endif
......
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