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

finished waterlevel

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: 2131
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent d58daa02
c this is <hivgabor.f>
c ----------------------------------------------------------------------------
c ($Id: hivgabor.f,v 1.1 2006-06-02 09:40:26 tforb Exp $)
c ($Id: hivgabor.f,v 1.2 2006-06-02 15:39:24 tforb Exp $)
c
c Copyright (c) 2006 by Thomas Forbriger (BFO Schiltach)
c
......@@ -17,7 +17,8 @@ c
parameter(version=
& 'HIVGABOR V1.0 Calculate H/V from gabor results')
character*(*) HIVGABOR_CVS_ID
parameter(HIVGABOR_CVS_ID='$Id: hivgabor.f,v 1.1 2006-06-02 09:40:26 tforb Exp $')
parameter(HIVGABOR_CVS_ID=
& '$Id: hivgabor.f,v 1.2 2006-06-02 15:39:24 tforb Exp $')
c
c datasets
character*80 hinfile, vinfile, outfile
......@@ -29,7 +30,7 @@ c magic number for binary file identification
parameter(cmagic='123G')
c greens function
integer maxsamples,maxom
parameter(maxsamples=300,maxom=maxsamples)
parameter(maxsamples=600,maxom=maxsamples)
complex hgabor(maxsamples, maxom)
complex vgabor(maxsamples, maxom)
complex hvgabor(maxsamples, maxom)
......@@ -41,22 +42,23 @@ c processing
integer hnsamples,hnom
integer vnsamples,vnom
integer hivnsamples,hivnom
logical overwrite
logical overwrite, waterlevel
real water, rms
c
integer i,j
c commandline
integer maxopt, lastarg, iargc
character*80 argument
parameter(maxopt=3)
parameter(maxopt=4)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c debugging
logical debug, verbose
c here are the keys to our commandline options
data optid/2h-d, 2h-v, 2h-o/
data opthasarg/3*.FALSE./
data optarg/3*1h-/
data optid/2h-d, 2h-v, 2h-o, 2h-w/
data opthasarg/3*.FALSE.,.true./
data optarg/3*1h-,2h1./
c
c------------------------------------------------------------------------------
c basic information
......@@ -66,7 +68,7 @@ c
if (iargc().eq.1) call getarg(1, argument)
if ((argument(1:5).eq.'-help').or.(iargc().lt.3)) then
print *,version
print *,'Usage: hivgabor [-v] [-o]'
print *,'Usage: hivgabor [-v] [-o] [-w val]'
print *,' Hinfile Vinfile outfile'
print *,' or: hivgabor -help'
if (argument(1:5).ne.'-help')
......@@ -83,6 +85,8 @@ c
print *,' '
print *,'-v be verbose'
print *,'-o overwrite existing output file'
print *,'-w val water level for denominator as a fraction'
print *,' of signal rms for a given time'
print *,' '
print *,HIVGABOR_CVS_ID
stop
......@@ -96,6 +100,8 @@ c
debug=optset(1)
verbose=optset(2)
overwrite=optset(3)
waterlevel=optset(4)
read (optarg(4), *) water
if (iargc().lt.(lastarg+3)) stop 'ERROR: missing filename!'
call getarg(lastarg+1, hinfile)
call getarg(lastarg+2, vinfile)
......@@ -137,10 +143,24 @@ c check consistency
enddo
c
c calculate ratio
do i=1,hivnom
do j=1,hivnsamples
hvgabor(j,i)=hgabor(j,i)/vgabor(j,i)
enddo
if (verbose.and.waterlevel)
& print *,'use waterlevel of ',water,' *rms'
do j=1,hivnsamples
if (waterlevel) then
rms=0.
do i=1,hivnom
rms=rms+abs(hgabor(j,i)*conjg(hgabor(j,i)))
rms=rms+abs(vgabor(j,i)*conjg(vgabor(j,i)))
enddo
rms=sqrt(rms)/(2.*hivnom)
do i=1,hivnom
hvgabor(j,i)=hgabor(j,i)/(vgabor(j,i)+water*rms)
enddo
else
do i=1,hivnom
hvgabor(j,i)=hgabor(j,i)/vgabor(j,i)
enddo
endif
enddo
c
c write gabor file (easy to use)
......
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