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

Binary file not shown.

View File

@ -101,6 +101,19 @@
real maxnorm
real threshold,threshold0
! FOR MODEL VARIATION
!------------------------------------------------
integer idx
integer counte
real stdvs
integer numrand
real,allocatable,dimension(:,:)::modstat
real,allocatable,dimension(:)::modsig
real gaussian
external gaussian
integer modest
counte=0
! OPEN FILES FIRST TO OUTPUT THE PROCESS
open(34,file='IterVel.out')
nout=36
@ -115,10 +128,10 @@
! READ INPUT FILE
if (iargc() < 1) then
write(*,*) 'input file [SurfTomo.in(default)]:'
write(*,*) 'input file [DSurfTomo.in(default)]:'
read(*,'(a)') inputfile
if (len_trim(inputfile) <=1 ) then
inputfile = 'SurfTomo.in'
inputfile = 'DSurfTomo.in'
else
inputfile = inputfile(1:len_trim(inputfile))
endif
@ -205,6 +218,8 @@
read(10,*)ifsyn
read(10,*)noiselevel
read(10,*) threshold0
read(10,*) modest
read(10,*) numrand
close(10)
nrc=nsrc
kmax=kmaxRc+kmaxRg+kmaxLc+kmaxLg
@ -286,6 +301,10 @@
allocate(norm(maxvp), stat=checkstat)
allocate(vsf(nx,ny,nz), stat=checkstat)
allocate(vsftrue(nx,ny,nz), stat=checkstat)
! FOR MODEL VARIATION
!------------------------------------------------
allocate(modstat(numrand,maxvp))
allocate(modsig(maxvp))
allocate(rw(maxnar), stat=checkstat)
if(checkstat > 0)then
@ -487,6 +506,10 @@
if(istop==3) print*,'istop = 3, large condition number'
do i =1,dall
cbst(i)=cbst(i)/datweight(i)
enddo
mean = sum(cbst(1:dall))/dall
std_devs = sqrt(sum(cbst(1:dall)**2)/dall - mean**2)
write(*,'(i2,a)'),iter,'th iteration...'
@ -520,7 +543,7 @@
enddo
enddo
enddo
write(34,*)',OUTPUT S VELOCITY AT ITERATION',iter
write(34,*)'OUTPUT S VELOCITY AT ITERATION',iter
do k=1,nz
do j=1,ny
write(34,'(100f7.3)') (vsf(i,j,k),i=1,nx)
@ -547,8 +570,8 @@
do k=1,nz-1
do j=1,ny-2
do i=1,nx-2
write(65,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsftrue(i,j,k)
write(63,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsf(i,j,k)
write(65,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsftrue(i+1,j+1,k)
write(63,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsf(i+1,j+1,k)
enddo
enddo
enddo
@ -568,7 +591,7 @@
do k=1,nz-1
do j=1,ny-2
do i=1,nx-2
write(64,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsf(i,j,k)
write(64,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),vsf(i+1,j+1,k)
enddo
enddo
enddo
@ -583,6 +606,73 @@
close(40)
close(nout) !close lsmr.txt
close(66) !close surf_tomo.log
! USE RANDOM MODEL TO OBTAIN THE MODEL VARIATION
!modest = 1
if (modest ==1) then
write(*,*) 'model variation estimation begin...'
do iter = 1,numrand
call init_random_seed()
vsftrue=vsf
DO K=1,NZ-1
DO J=2,NY-1
DO I=2,NX-1
idx = (k-1)*(ny-2)*(nx-2)+(j-2)*(nx-2)+i-1
dv(idx) = 0.1/EXP(2*NORM(idx)/maxnorm)*gaussian()
VSFTRUE(I,J,K) = VSF(I,J,K)+dv(idx)
ENDDO
ENDDO
ENDDO
write(*,*),'maximum and minimum velocity variation',maxval(dv),minval(dv)
call synthetic(nx,ny,nz,maxvp,vsftrue,dsyn,&
goxd,gozd,dvxd,dvzd,kmaxRc,kmaxRg,kmaxLc,kmaxLg,&
tRc,tRg,tLc,tLg,wavetype,igrt,periods,depz,minthk,&
scxf,sczf,rcxf,rczf,nrc1,nsrc1,kmax,&
nsrc,nrc,0.0)
do i = 1,dall
cbst(i) = obst(i) - dsyn(i)
enddo
write(*,*), dnrm2(dall,cbst,1)/sqrt(real(dall)), 1.05*std_devs
if (dnrm2(dall,cbst,1)/sqrt(real(dall)) < 1.05*std_devs) then
counte = counte + 1
modstat(counte,:) = dv
endif
enddo ! iteration for random models
write(*,*),'number of of models satisfy requirements',counte
modsig = 1.0
if (counte>0) then
do i=1,maxvp
!statis
!mean = sum(cbst(1:dall))/dall
!std_devs = sqrt(sum(cbst(1:dall)**2)/dall - mean**2)
mean = sum(modstat(1:counte,i))/counte
stdvs = sqrt(sum(modstat(1:counte,i)**2)/counte-mean**2)
modsig(i) = stdvs
enddo
endif
write(*,*),'write model variation to "model_variation.dat"'
open (64,file='model_variation.dat')
do k=1,nz-1
do j=1,ny-2
do i=1,nx-2
idx = (k-1)*(ny-2)*(nx-2)+(j-1)*(nx-2)+i
write(64,'(5f8.4)') gozd+(j-1)*dvzd,goxd-(i-1)*dvxd,depz(k),modsig(idx)
enddo
enddo
enddo
close(64)
write(*,*) 'finishing model variation estimation'
endif
deallocate(obst)
deallocate(dsyn)
deallocate(dist)
@ -612,3 +702,20 @@
endif
end program
!-----------------------------------------------------------------------
! Generate seed for random number generator of fortran
! Note: only need to be called once inside one program
!-----------------------------------------------------------------------
subroutine init_random_seed()
integer :: i,n,clock
integer,dimension(:),allocatable :: seed
call random_seed(size=n)
allocate(seed(n))
call system_clock(count=clock)
seed=clock+37*(/(i-1,i=1,n)/)
call random_seed(PUT=seed)
deallocate(seed)
end subroutine