mirror of
https://github.com/HongjianFang/DSurfTomo.git
synced 2025-07-31 08:01:13 +08:00
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:
parent
851eb3418f
commit
4f2f7cbce5
@ -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
|
||||
|
5086
src/CalSurfG.f90
5086
src/CalSurfG.f90
File diff suppressed because it is too large
Load Diff
BIN
src/DSurfTomo
BIN
src/DSurfTomo
Binary file not shown.
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
1251
src/main.f90
1251
src/main.f90
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user