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

proceding

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: 2276
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 71339bbc
c this is <gresynoise.f>
c ----------------------------------------------------------------------------
c ($Id: gresynoise.f,v 1.3 2007-05-10 08:06:05 tforb Exp $)
c ($Id: gresynoise.f,v 1.4 2007-05-11 08:44:02 tforb Exp $)
c
c Copyright (c) 2007 by Thomas Forbriger (BFO Schiltach)
c
......@@ -11,6 +11,7 @@ c
c REVISIONS and CHANGES
c 09/05/2007 V1.0 Thomas Forbriger
c 10/05/2007 V1.1 introduced randomization
c 11/05/2007 V1.2 allow selection of number of output samples
c
c ============================================================================
c
......@@ -18,14 +19,15 @@ c
c
character*(*) version
parameter(version=
&'GRESYNOISE V1.0 calculate noise seismograms')
&'GRESYNOISE V1.2 calculate noise seismograms')
character*(*) GRESYNOISE_CVS_ID
parameter(GRESYNOISE_CVS_ID=
&'$Id: gresynoise.f,v 1.3 2007-05-10 08:06:05 tforb Exp $')
&'$Id: gresynoise.f,v 1.4 2007-05-11 08:44:02 tforb Exp $')
c
c dimensions
integer maxtr, maxsamp, maxom, maxu
parameter(maxu=1000, maxtr=10000, maxom=4100, maxsamp=maxom*2)
c parameter(maxu=1000, maxtr=10000, maxom=4100, maxsamp=maxom*2)
parameter(maxu=5000, maxtr=10000, maxom=4100, maxsamp=100000)
integer ntr, nsamp, Znom, Znu, Rnom, Rnu
c greens function
character*78 greenname, Rgreenname
......@@ -63,16 +65,6 @@ c seismogram trace to sff file
character*132 wid2line
logical last
real dt
c commandline
integer maxopt, lastarg, iargc
parameter(maxopt=10)
character*2 optid(maxopt)
character*80 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c options
logical debug, optlambda, optnew, optresponse, hankel1, hankel2
logical suppress, optrndscale
real lambdalim, tapfrac, scalexp
c taper
real tf_costap
integer ltap, rtap
......@@ -87,11 +79,23 @@ c any
c functions
real*8 tf_dj0, tf_dy0
real*8 tf_dj1, tf_dy1
c options
logical debug, optlambda, optnew, optresponse, hankel1, hankel2
logical suppress, optrndscale, optnsamp
real lambdalim, tapfrac, scalexp
integer argnsamp
c commandline
integer maxopt, lastarg, iargc
parameter(maxopt=11)
character*2 optid(maxopt)
character*80 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c here are the keys to our commandline options
data optid/2h-d,2h-l,2h-o,2h-t,2h-i,2h-S,2h-1,2h-2,2h-e,2h-r/
data optid/2h-d,2h-l,2h-o,2h-t,2h-i,2h-S,2h-1,2h-2,2h-e,
& 2h-r,2h-n/
data opthasarg/.FALSE.,.TRUE.,.FALSE.,.TRUE.,4*.FALSE.,
& .TRUE.,.FALSE./
data optarg/1h-,2h1.,1h-,3h10.,4*1h-,2h0.,1h-/
& .TRUE.,.FALSE.,.TRUE./
data optarg/1h-,2h1.,1h-,3h10.,4*1h-,2h0.,2*1h-/
c------------------------------------------------------------------------------
c basic information
c
......@@ -135,6 +139,8 @@ c
print *,'-S suppress zero frequency and zero slowness'
print *,'-1 use Hankel 1 instead of Bessel'
print *,'-2 use Hankel 2 instead of Bessel'
print *,'-n n set number of output samples to largest'
print *,' possible value, if possible larger than n'
print *,' '
print *,'Input file units:'
print *,' '
......@@ -169,6 +175,8 @@ c
hankel2=optset(8)
read (optarg(9), *, err=99) scalexp
optrndscale=optset(10)
optnsamp=optset(11)
if (optnsamp) read (optarg(11), *, err=99) argnsamp
c
pi2=2.d0*pi
c----------------------------------------------------------------------
......@@ -270,11 +278,13 @@ c
& stop 'ERROR: I assume the first frequency to be 0.Hz!'
c we have got all frequencies now and are going to fit them to
c a power of 2 number
if (.not.optnsamp) argnsamp=2*maxom
pown=0
1 continue
pown=pown+1
nsamp=2**pown
if (nsamp.lt.maxom) goto 1
if (nsamp.lt.argnsamp) goto 1
if (nsamp.lt.(2*Znom)) stop 'ERROR: cannot use enough samples'
c calculate sampling interval
dt=pi2/(nsamp*dom)
print *,'traces will have ',nsamp,' samples at ',dt,
......
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