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

correction

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: 3003
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent afc27bed
c this is <gresy.f>
c------------------------------------------------------------------------------
c $Id: gresy.f,v 1.22 2010-03-02 13:36:45 tforb Exp $
c $Id: gresy.f,v 1.23 2010-03-03 09:07:07 tforb Exp $
c
c 26/06/97 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -146,7 +146,7 @@ c
print *,' amplitude unit: m**3/s if spectrum represents displacement'
print *,' waveform in m'
print *,' '
print *,'$Id: gresy.f,v 1.22 2010-03-02 13:36:45 tforb Exp $'
print *,'$Id: gresy.f,v 1.23 2010-03-03 09:07:07 tforb Exp $'
print *,' '
call refmet_rcvinf
stop
......@@ -410,10 +410,11 @@ c set slowness taper
stop 'ERROR: radial component not defined for 2D'
else
sdata(io)=sdata(io)+green(io,iu)*
& cos(arg)*du*tf_costap(iu,0,0,ltap,rtap)
& cos(arg)*
& du*tf_costap(iu,0,0,ltap,rtap)
endif
enddo
sdata(io)=2.d0*sdata(io)*om(io)
sdata(io)=2.d0*sdata(io)/min(1.d-50,om(io))
else
do iu=1,rtap
arg=slo(iu)*om(io)*r(i)
......
c this is <refmet.f> originally by J. Ungerer 1990
c======================================================================
c $Id: refmet.f,v 1.15 2010-03-03 09:02:49 tforb Exp $
c $Id: refmet.f,v 1.16 2010-03-03 09:05:11 tforb Exp $
c
c Reflectivity Method
c
......@@ -110,7 +110,7 @@ c======================================================================
character*70 version
parameter(version='REFMET V2.11 Reflectivity Method')
character*79 cvsid
parameter(cvsid='$Id: refmet.f,v 1.15 2010-03-03 09:02:49 tforb Exp $')
parameter(cvsid='$Id: refmet.f,v 1.16 2010-03-03 09:05:11 tforb Exp $')
c array dimension declaration
integer me, msl, mf, ms
......@@ -2101,7 +2101,7 @@ c no tangential component, no near field
else
if (cl_linesrc) then
c quick and dirty kernel substitution for line source
J0=cos(jarg)/min(1.d-50,w(f)*u)
J0=2.*cos(jarg)/min(1.d-50,w(f)*u)
J1=0.d0
J2=0.d0
else
......
......@@ -78,7 +78,7 @@ c
print *,' and only for vertical single forces and'
print *,' isotropic moment tensors. The Bessel-function'
print *,' kernels are simply replaced:'
print *,' J0(w*u*r) -> cos(w*u*r)/min(1.d-50,w*u)'
print *,' J0(w*u*r) -> 2.*cos(w*u*r)/min(1.d-50,w*u)'
print *,' J1(w*u*r) -> 0'
print *,' J2(w*u*r) -> 0'
print *,' '
......
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