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

new option

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: 169
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 6d98358b
c this is <dig.f>
c------------------------------------------------------------------------------
c
c $Id: dig.f,v 1.2 2000-04-07 18:47:13 thof Exp $
c $Id: dig.f,v 1.3 2000-05-09 18:35:03 thof Exp $
c
c 26/11/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -12,6 +12,7 @@ c 26/11/98 V1.0 Thomas Forbriger
c took this code from syg
c 28/02/99 V1.1 no comes with optional mask mode
c 07/04/00 V1.2 introduced option -n
c 09/05/00 V1.3 fixe curve width
c
c==============================================================================
c
......@@ -19,7 +20,7 @@ c
c
c variables
character*79 version
parameter (version='DIG V1.2 DIspersion curves to Greens file')
parameter (version='DIG V1.3 DIspersion curves to Greens file')
c
integer mu, mom
parameter (mu=1000, mom=1000)
......@@ -35,7 +36,7 @@ c
parameter (lu=20)
c
character*80 curvename, lengthstr, greenname, line
real fmax, umax, length
real fmax, umax, length, fixom
real om(mom), u(mu)
c
integer i, j, iargc, index
......@@ -44,22 +45,22 @@ c
c
c commandline
integer maxopt, lastarg, iargc
parameter(maxopt=4)
parameter(maxopt=5)
character*2 optid(maxopt)
character*40 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c debugging
logical debug, verbose, maskmode, normalize
logical debug, verbose, maskmode, normalize, dofixom
double precision normval, maxval
c here are the keys to our commandline options
data optid/2h-d, 2h-v, 2h-M, 2h-n/
data opthasarg/3*.FALSE.,.TRUE./
data optarg/3*1h-,2h1./
data optid/2h-d, 2h-v, 2h-M, 2h-n, 2h-O/
data opthasarg/3*.FALSE.,2*.TRUE./
data optarg/3*1h-,2*2h1./
c
c go
print *,version
print *,'Usage: dig curves greenfile length'
print *,' -P nf,nu,fmax,umax | -F file [-M] [-n v]'
print *,' -P nf,nu,fmax,umax | -F file [-M] [-n v] [-O f]'
if (iargc().ge.5) then
call getarg(4, line)
else
......@@ -85,6 +86,9 @@ c go
print *,' rather than integral of one)'
print *,' '
print *,' -n v normalize maximum to v'
print *,' '
print *,' -O f always use angular frequency f to calculate'
print *,' curve width'
stop
endif
c
......@@ -97,6 +101,8 @@ c
maskmode=optset(3)
normalize=optset(4)
read(optarg(4), *) normval
dofixom=optset(5)
read(optarg(5), *) fixom
c
c get command line parameters
call getarg(1, curvename)
......@@ -169,7 +175,11 @@ c
c go through all frequencies and get the expansion coefficients
c which are the green matrix elements
c
call digvalue(om(j), u(i), length, thisgreen)
if (dofixom) then
call digvalue(om(j), u(i), length, thisgreen,fixom)
else
call digvalue(om(j), u(i), length, thisgreen,om(j))
endif
c scale from s/km to s/m units
green(j,i)=thisgreen
enddo
......@@ -371,22 +381,23 @@ c
c
c----------------------------------------------------------------------
c
subroutine digvalue(om,p,length,value)
subroutine digvalue(om,p,length,value,wom)
c
real om,p,length
real om,p,length,wom
real value
c
include 'dig.inc'
c
real pi,f,pc,pw,thisval
real pi,f,pc,pw,thisval,wf
integer i
parameter(pi=3.1415729)
c
f=0.5*om/pi
if (om.lt.1.e-10) then
wf=0.5*wom/pi
if (wom.lt.1.e-10) then
pw=1000./length
else
pw=1000./f/length
pw=1000./wf/length
endif
c
value=0.
......
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