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

modifications in calculation

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: 834
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent a687c081
c this is <gremlin.f>
c------------------------------------------------------------------------------
c $Id: gremlin.f,v 1.18 2002-05-07 16:46:46 forbrig Exp $
c $Id: gremlin.f,v 1.19 2002-05-07 17:02:31 forbrig Exp $
c
c 05/12/97 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -100,7 +100,7 @@ c
c program loop
logical hot, subs_exists
integer ival
real numin, numax, rval, rval2
real numin, numax, rval, rval2, rval3, rval4
c commandline
integer maxopt, lastarg, iargc
character*80 argument
......@@ -371,8 +371,9 @@ c call oldgremlin
call pg_fullset(.false.)
endif
elseif (argument(1:8).eq.'weights ') then
read(argument(9:80), *, err=98, end=98) rval, rval2
call dat_mmweights(rval,rval2)
read(argument(9:80), *, err=98, end=98)
& rval, rval2,rval3,rval4
call dat_mmweights(rval,rval2,rval3,rval4)
elseif (argument(1:5).eq.'term ') then
hot=.false.
elseif (argument(1:9).eq.'morehelp ') then
......
c this is <gremlin_help.f>
c------------------------------------------------------------------------------
c $Id: gremlin_help.f,v 1.6 2002-05-07 16:35:25 forbrig Exp $
c $Id: gremlin_help.f,v 1.7 2002-05-07 17:02:31 forbrig Exp $
c
c 25/03/98 by Thomas Forbriger (IfG Stuttgart)
c
......@@ -51,7 +51,7 @@ c
call gremhelp_subtit('set/display inversion parameters')
print *,' spa set various parameters'
print *,' dpa display all parameter settings'
print *,' weights th1,th2'
print *,' weights th1,th2,f1,f2'
print *,' calculate misfit-dependend data weights'
print *,' you are invited to have a look in'
print *,' subroutine dat_mmweights to learn about'
......
cS
c this is <dat_mmweights.f>
c ----------------------------------------------------------------------------
c ($Id: dat_mmweights.f,v 1.2 2002-05-07 16:40:58 forbrig Exp $)
c ($Id: dat_mmweights.f,v 1.3 2002-05-07 17:02:32 forbrig Exp $)
c
c Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
c
......@@ -17,24 +17,24 @@ c s(j) is the corresponding reference synthetic and
c e is the given error level (data tolerance), then
c w(j) is the weight value and is
c
c |d(j)|**2 + |s(j)|**2
c --------------------- + (thres1*e)**2
c 2
c w(j) = ---------------------------------------
c |d(j)-s(j)|**2 + (thres2*e)**2
c
c |d(j)|**2 + |s(j)|**2
c fac1,2**2 * --------------------- + (thres1*e)**2
c 2
c w(j) = ---------------------------------------------------
c |d(j)-s(j)|**2 + (thres2*e)**2
c
c where fac1 is used for traveltimes and fac2 is used for greens
c
c REVISIONS and CHANGES
c 07/05/2002 V1.0 Thomas Forbriger
c
c ============================================================================
c
subroutine dat_mmweights(thres1,thres2)
subroutine dat_mmweights(thres1,thres2,fac1,fac2)
c
c parameters
c thresholds relative to error value
real thres1,thres2
real thres1,thres2,fac1,fac2
c
c get common blocks
include 'glq_dim.inc'
......@@ -44,12 +44,14 @@ c get common blocks
c
cE
integer i,j
real ttth1,ttth2,gth1,gth2
real ttth1,ttth2,gth1,gth2,f1,f2
c
ttth1=(thres1*tterror)**2
ttth2=(thres2*tterror)**2
gth1=(thres1*gerror)**2
gth2=(thres2*gerror)**2
f1=fac1**2
f2=fac2**2
c
c zero arrays
do i=1,glqd_mslo
......@@ -64,14 +66,14 @@ c
c
c calculate weights from relative misfit
do i=1,rng_xmax
rtweight(i)=(0.5*travt(i,di_mread)**2+0.5*travt(i,di_mref)**2
rtweight(i)=(f1*0.5*(travt(i,di_mread)**2+travt(i,di_mref)**2)
& +ttth1)/((travt(i,di_mread)-travt(i,di_mref))**2
& +ttth2)
enddo
c
do i=rng_smin,rng_smax
do j=rng_fmin,rng_fmax
rgweight(i,j)=(0.5*(real(green(i,j,di_mread))**2+
rgweight(i,j)=(f2*0.5*(real(green(i,j,di_mread))**2+
& imag(green(i,j,di_mread))**2+
& real(green(i,j,di_mref))**2+
& imag(green(i,j,di_mref))**2)+
......
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