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

added line source

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: 2994
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent a5365980
c this is <gresy.f>
c------------------------------------------------------------------------------
c $Id: gresy.f,v 1.18 2010-01-18 09:05:45 tforb Exp $
c $Id: gresy.f,v 1.19 2010-02-26 13:02:03 tforb Exp $
c
c 26/06/97 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -28,12 +28,13 @@ c gresy receives coordinates in km where they should be
c in m (rcv-file specifies 0.003, gresy receives 30km)
c I introduced verbose output and checked the program
c the problem disappeared for unkown reason...
c 26/02/10 V1.12 introduced line-source mode
c
c==============================================================================
c
program gresy
character*79 version
parameter(version='GRESY V1.11 GREens function SYnthetics')
parameter(version='GRESY V1.12 GREens function SYnthetics')
c dimensions
integer maxtr, maxsamp, maxom, maxu
parameter(maxu=4500, maxtr=maxu, maxom=4100, maxsamp=maxom*2)
......@@ -70,13 +71,13 @@ c seismogram trace to sff file
real dt
c commandline
integer maxopt, lastarg, iargc
parameter(maxopt=10)
parameter(maxopt=11)
character*2 optid(maxopt)
character*80 optarg(maxopt)
logical optset(maxopt), opthasarg(maxopt)
c options
logical debug, optlambda, optnew, optresponse, hankel1, hankel2
logical suppress, radial, verbose
logical suppress, radial, verbose, linesource
real lambdalim, tapfrac
character*80 respfile
c taper
......@@ -96,9 +97,9 @@ c functions
real*8 tf_dj0, tf_dy0
real*8 tf_dj1, tf_dy1
c here are the keys to our commandline options
data optid/'-d','-l','-o','-t','-r','-S','-1','-2','-R','-v'/
data opthasarg/.FALSE.,.TRUE.,.FALSE.,2*.TRUE.,5*.FALSE./
data optarg/'-','1.','-','10.','junk',5*'-'/
data optid/'-d','-l','-o','-t','-r','-S','-1','-2','-R','-v','-L'/
data opthasarg/.FALSE.,.TRUE.,.FALSE.,2*.TRUE.,6*.FALSE./
data optarg/'-','1.','-','10.','junk',6*'-'/
c----------------------------------------------------------------------
c
c read commandline
......@@ -106,7 +107,7 @@ c
print *,version
print *,'Usage: gresy greenfile seisfile rcvfile [-l lambda] [-o]'
print *,' [-t frac] [-r respfile] [-S] [-1] [-2] [-R]'
print *,' [-v] [-d]'
print *,' [-v] [-d] [-L]'
print *,'or gresy -help'
if (iargc().lt.1) stop 'ERROR: no arguments'
call getarg(1, greenname)
......@@ -133,6 +134,7 @@ 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 *,'-L simulate seismograms from line source (2D)'
print *,'-R calculate radial component'
print *,' '
print *,'Input file units:'
......@@ -142,7 +144,7 @@ c
print *,' amplitude unit: m**3/s if spectrum represents displacement'
print *,' waveform in m'
print *,' '
print *,'$Id: gresy.f,v 1.18 2010-01-18 09:05:45 tforb Exp $'
print *,'$Id: gresy.f,v 1.19 2010-02-26 13:02:03 tforb Exp $'
print *,' '
call refmet_rcvinf
stop
......@@ -169,6 +171,7 @@ c
hankel2=optset(8)
radial=optset(9)
verbose=optset(10)
linesource=optset(11)
c
pi2=8.d0*datan(1.d0)
c----------------------------------------------------------------------
......@@ -338,6 +341,8 @@ c
print *,'I will use the first Hankel function'
elseif (hankel2) then
print *,'I will use the second Hankel function'
elseif (linesource) then
print *,'I will use the cosine expansion (line-source, 2D)'
else
print *,'I will use the Bessel function'
endif
......@@ -396,6 +401,16 @@ c set slowness taper
endif
enddo
sdata(io)=0.5d0*sdata(io)
elseif (linesource) then
do iu=1,rtap
arg=slo(iu)*om(io)*r(i)
if (radial) then
stop 'ERROR: radial component not defined for 2D'
else
sdata(io)=0.5d0*sdata(io)+green(io,iu)*
& cos(arg)*du*tf_costap(iu,0,0,ltap,rtap)
endif
enddo
else
do iu=1,rtap
arg=slo(iu)*om(io)*r(i)
......
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