add model uncertainty estimation

add model uncertainty estimation with random models, also indent all the
code to make them a little bit easy to read
bug fix about shift when output the velocity model
This commit is contained in:
Hongjian Fang 2016-08-07 20:05:49 +02:00
parent 851eb3418f
commit 4f2f7cbce5
7 changed files with 3316 additions and 3207 deletions

View File

@ -5,7 +5,7 @@ surfdataTB.dat c: data file
18 18 9 c: nx ny nz (grid number in lat lon and depth direction)
25.2 121.35 c: goxd gozd (upper left point,[lat,lon])
0.015 0.017 c: dvxd dvzd (grid interval in lat and lon direction)
449 c: nsrc*maxf
25i c: nsrc*maxf
4.0 0.0 c: weight damp
3 c: nsublayer (numbers of sublayers for each grid interval:grid --> layer)
0.5 2.8 c: minimum velocity, maximum velocity
@ -19,3 +19,5 @@ surfdataTB.dat c: data file
0 c: synthetic flag(0:real data,1:synthetic)
0.02 c: noiselevel
2.5 c: threshold
1 c: modest (1: estimate model variation, 0: no estimation)
30 c: number of random models

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@ -4,57 +4,57 @@
!c Version for use with sparse matrix specified by
!c output of subroutine sparse for use with LSQR
subroutine aprod(mode, m, n, x, y, leniw, lenrw, iw, rw)
subroutine aprod(mode, m, n, x, y, leniw, lenrw, iw, rw)
implicit none
implicit none
!c Parameters:
integer mode ! ==1: Compute y = y + a*x
! y is altered without changing x
! ==2: Compute x = x + a(transpose)*y
! x is altered without changing y
integer m, n ! Row and column dimensions of a
real x(n), y(m) ! Input vectors
integer :: leniw
integer lenrw
integer iw(leniw) ! Integer work vector containing:
! iw[1] Number of non-zero elements in a
! iw[2:iw[1]+1] Row indices of non-zero elements
! iw[iw[1]+2:2*iw[1]+1] Column indices
real rw(lenrw) ! [1..iw[1]] Non-zero elements of a
!c Parameters:
integer mode ! ==1: Compute y = y + a*x
! y is altered without changing x
! ==2: Compute x = x + a(transpose)*y
! x is altered without changing y
integer m, n ! Row and column dimensions of a
real x(n), y(m) ! Input vectors
integer :: leniw
integer lenrw
integer iw(leniw) ! Integer work vector containing:
! iw[1] Number of non-zero elements in a
! iw[2:iw[1]+1] Row indices of non-zero elements
! iw[iw[1]+2:2*iw[1]+1] Column indices
real rw(lenrw) ! [1..iw[1]] Non-zero elements of a
!c Local variables:
integer i1
integer j1
integer k
integer kk
!c Local variables:
integer i1
integer j1
integer k
integer kk
!c set the ranges the indices in vector iw
!c set the ranges the indices in vector iw
kk=iw(1)
i1=1
j1=kk+1
kk=iw(1)
i1=1
j1=kk+1
!c main iteration loop
!c main iteration loop
do k = 1,kk
do k = 1,kk
if (mode.eq.1) then
if (mode.eq.1) then
!c compute y = y + a*x
!c compute y = y + a*x
y(iw(i1+k)) = y(iw(i1+k)) + rw(k)*x(iw(j1+k))
y(iw(i1+k)) = y(iw(i1+k)) + rw(k)*x(iw(j1+k))
else
else
!c compute x = x + a(transpose)*y
!c compute x = x + a(transpose)*y
x(iw(j1+k)) = x(iw(j1+k)) + rw(k)*y(iw(i1+k))
x(iw(j1+k)) = x(iw(j1+k)) + rw(k)*y(iw(i1+k))
endif
enddo
endif
enddo
! 100 continue
! 100 continue
return
end
return
end

View File

@ -1,28 +1,28 @@
subroutine delsph(flat1,flon1,flat2,flon2,del)
implicit none
real,parameter:: R=6371.0
REAL,parameter:: pi=3.1415926535898
real flat1,flat2
real flon1,flon2
real del
implicit none
real,parameter:: R=6371.0
REAL,parameter:: pi=3.1415926535898
real flat1,flat2
real flon1,flon2
real del
real dlat
real dlon
real lat1
real lat2
real a
real c
real dlat
real dlon
real lat1
real lat2
real a
real c
!dlat=(flat2-flat1)*pi/180
!dlon=(flon2-flon1)*pi/180
!lat1=flat1*pi/180
!lat2=flat2*pi/180
dlat=flat2-flat1
dlon=flon2-flon1
lat1=pi/2-flat1
lat2=pi/2-flat2
a=sin(dlat/2)*sin(dlat/2)+sin(dlon/2)*sin(dlon/2)*cos(lat1)*cos(lat2)
c=2*atan2(sqrt(a),sqrt(1-a))
del=R*c
!dlat=(flat2-flat1)*pi/180
!dlon=(flon2-flon1)*pi/180
!lat1=flat1*pi/180
!lat2=flat2*pi/180
dlat=flat2-flat1
dlon=flon2-flon1
lat1=pi/2-flat1
lat2=pi/2-flat2
a=sin(dlat/2)*sin(dlat/2)+sin(dlon/2)*sin(dlon/2)*cos(lat1)*cos(lat2)
c=2*atan2(sqrt(a),sqrt(1-a))
del=R*c
end subroutine

View File

@ -1,31 +1,31 @@
real function gaussian()
implicit none
! real rd
real x1,x2,w,y1
real y2
real n1,n2
integer use_last
integer ii,jj
real function gaussian()
implicit none
! real rd
use_last=0
y2=0
w=2.0
if(use_last.ne.0) then
y1=y2
use_last=0
else
do while (w.ge.1.0)
call random_number(n1)
call random_number(n2)
x1=2.0*n1-1.0
x2=2.0*n2-1.0
w = x1 * x1 + x2 * x2
enddo
w=((-2.0*log(w))/w)**0.5
y1=x1*w
y2=x2*w
use_last=1
endif
gaussian=y1
end function
real x1,x2,w,y1
real y2
real n1,n2
integer use_last
integer ii,jj
use_last=0
y2=0
w=2.0
if(use_last.ne.0) then
y1=y2
use_last=0
else
do while (w.ge.1.0)
call random_number(n1)
call random_number(n2)
x1=2.0*n1-1.0
x2=2.0*n2-1.0
w = x1 * x1 + x2 * x2
enddo
w=((-2.0*log(w))/w)**0.5
y1=x1*w
y2=x2*w
use_last=1
endif
gaussian=y1
end function

File diff suppressed because it is too large Load Diff