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

solved factor 1000. problem when reading offsets

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.
the problem appeared and disappeared for unkown reason - both


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 2957
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent a48617f8
c this is <gresy.f>
c------------------------------------------------------------------------------
c $Id: gresy.f,v 1.17 2008-09-15 16:01:38 tforb Exp $
c $Id: gresy.f,v 1.18 2010-01-18 09:05:45 tforb Exp $
c
c 26/06/97 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -23,12 +23,17 @@ c 09/01/03 V1.9 be not too strict when checking frequencies fread
c from response file. Check against frequency and not
c against frequency interval.
c 05/07/07 V1.10 check slowness sampling interval
c 18/01/10 V1.11 there is a problem:
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
c==============================================================================
c
program gresy
character*79 version
parameter(version='GRESY V1.10 GREens function SYnthetics')
parameter(version='GRESY V1.11 GREens function SYnthetics')
c dimensions
integer maxtr, maxsamp, maxom, maxu
parameter(maxu=4500, maxtr=maxu, maxom=4100, maxsamp=maxom*2)
......@@ -65,13 +70,13 @@ c seismogram trace to sff file
real dt
c commandline
integer maxopt, lastarg, iargc
parameter(maxopt=9)
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, radial
logical suppress, radial, verbose
real lambdalim, tapfrac
character*80 respfile
c taper
......@@ -91,9 +96,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/2h-d,2h-l,2h-o,2h-t,2h-r,2h-S,2h-1,2h-2,2h-R/
data opthasarg/.FALSE.,.TRUE.,.FALSE.,2*.TRUE.,4*.FALSE./
data optarg/1h-,2h1.,1h-,3h10.,4hjunk,4*1h-/
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*'-'/
c----------------------------------------------------------------------
c
c read commandline
......@@ -101,6 +106,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 *,'or gresy -help'
if (iargc().lt.1) stop 'ERROR: no arguments'
call getarg(1, greenname)
......@@ -112,6 +118,9 @@ c
print *,' produced by ''syg'' or ''greda'')'
print *,'seisfile output file to contain seismograms'
print *,'rcvfile receiver definition (refmet format)'
print *,' '
print *,'-v produce verbose output'
print *,'-d produce debug output'
print *,'-l lambda limits the used slowness range by a minimum'
print *,' wavelength in meters'
print *,' (default: ',optarg(2)(1:4),')'
......@@ -133,7 +142,7 @@ c
print *,' amplitude unit: m**3/s if spectrum represents displacement'
print *,' waveform in m'
print *,' '
print *,'$Id: gresy.f,v 1.17 2008-09-15 16:01:38 tforb Exp $'
print *,'$Id: gresy.f,v 1.18 2010-01-18 09:05:45 tforb Exp $'
print *,' '
call refmet_rcvinf
stop
......@@ -159,6 +168,7 @@ c
hankel1=optset(7)
hankel2=optset(8)
radial=optset(9)
verbose=optset(10)
c
pi2=8.d0*datan(1.d0)
c----------------------------------------------------------------------
......@@ -178,6 +188,12 @@ c
& print *,'WARNING: left time shift will be ignored'
if (abs(rcvtre).gt.0.)
& print *,'WARNING: right time shift will be ignored'
if (verbose) then
print *,'calculate seismograms for ',ntr,' receivers at'
do i=1,ntr
print *,r(i),' km ',phi(i),' deg'
enddo
endif
c
call greenread(greenname, debug,
& maxu, maxom, slo, om,
......@@ -281,6 +297,10 @@ c scale down epicentral distances to meters
do i=1,ntr
r(i)=r(i)*1000.
enddo
if (debug) then
print *,'DEBUG: receiver offsets after scaling to meters:'
print *,(r(i),i=1,ntr)
endif
c check stepwidth
dom=om(2)-om(1)
do io=2,nom
......
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