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

new weight setting subroutine

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: 829
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent 149398f2
c this is <dat_dmode.f>
c------------------------------------------------------------------------------
c
c $Id: dat_dmode.f,v 1.4 2000-04-10 09:53:54 thof Exp $
c $Id: dat_dmode.f,v 1.5 2002-05-07 12:11:23 forbrig Exp $
c
c 24/03/98 by Thomas Forbriger (IfG Stuttgart)
c
c prepare data mode settings (data ranges, weights, green mode, etc.)
c
c read weights are taken from rgweight. inversion weights are calculated and
c stored in gweight.
c
c REVISIONS and CHANGES
c 24/03/98 V1.0 Thomas Forbriger
c 07/04/98 V1.1 introduced green error estimate
......
cS
c this is <dat_mmweights.f>
c ----------------------------------------------------------------------------
c ($Id: dat_mmweights.f,v 1.1 2002-05-07 12:11:23 forbrig Exp $)
c
c Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
c
c create data weights from misfit
c
c weights are calculated and written to rgweight and rtweights. subsequently
c dat_dmode is called to transfer weights to gweight and tweight.
c
c if
c
c d(j) is a data value and
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
c
c REVISIONS and CHANGES
c 07/05/2002 V1.0 Thomas Forbriger
c
c ============================================================================
c
subroutine dat_mmweights(thres1,thres2)
c
c parameters
c thresholds relative to error value
real thres1,thres2
c
c get common blocks
include 'glq_dim.inc'
include 'glq_data.inc'
include 'glq_verbose.inc'
include 'glq_para.inc'
c
cE
integer i,j
real ttth1,ttth2,gth1,gth2
c
ttth1=(thres1*tterror)**2
ttth2=(thres2*tterror)**2
gth1=(thres1*gerror)**2
gth2=(thres2*gerror)**2
c
c zero arrays
do i=1,glqd_mslo
do j=1,glqd_mfre
rgweight(i,j)=0.
enddo
enddo
c
do i=1,glqd_mtts
rtweight(i)=0.
enddo
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
& +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+
& aimag(green(i,j,di_mread))**2+
& real(green(i,j,di_mref))**2+
& aimag(green(i,j,di_mref))**2)+
& gth1)/(gth2+
& real(green(i,j,di_mread)-green(i,j,di_mref))**2+
& aimag(green(i,j,di_mread)-green(i,j,di_mref))**2)
enddo
enddo
c
call dat_dmode
c
return
end
c
c ----- END OF dat_mmweights.f -----
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