zhangyiss/DSurfTomo
1
0
Fork 0
mirror of https://github.com/HongjianFang/DSurfTomo.git synced 2025-05-05 22:31:14 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

fix bug

Browse Source 
bug caused by severly varied layer depth, 'minthk' = layerthick / sublayernum, can be 1, 2 ,3
This commit is contained in:
Hongjian Fang 2016-04-28 17:21:37 +02:00
parent fb7b81711f
commit b25529e2b2
2 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
srcsmooth/CalSurfG.f90
View File

@ -2263,7 +2263,7 @@ ENDDO
END SUBROUTINE bilinear
subroutine refineGrid2LayerMdl(minthk,mmax,dep,vp,vs,rho,&
subroutine refineGrid2LayerMdl(minthk0,mmax,dep,vp,vs,rho,&
rmax,rdep,rvp,rvs,rrho,rthk)
!!--------------------------------------------------------------------c
!!refine grid based model to layerd based model
@ -2277,6 +2277,7 @@ END SUBROUTINE bilinear
integer NL
parameter (NL=200)
integer mmax,rmax
real minthk0
real minthk
real dep(*),vp(*),vs(*),rho(*)
real rdep(NL),rvp(NL),rvs(NL),rrho(NL),rthk(NL)
@ -2288,6 +2289,7 @@ END SUBROUTINE bilinear
initdep = 0.0
do i = 1, mmax-1
thk = dep(i+1)-dep(i)
minthk = thk/minthk0
nsublay(i) = int((thk+1.0e-4)/minthk) + 1
ngrid = nsublay(i)+1
newthk = thk/nsublay(i)

4
srcsparsity/CalSurfG.f90
View File

@ -2266,7 +2266,7 @@ ENDDO
END SUBROUTINE bilinear
subroutine refineGrid2LayerMdl(minthk,mmax,dep,vp,vs,rho,&
subroutine refineGrid2LayerMdl(minthk0,mmax,dep,vp,vs,rho,&
rmax,rdep,rvp,rvs,rrho,rthk)
!!--------------------------------------------------------------------c
!!refine grid based model to layerd based model
@ -2281,6 +2281,7 @@ END SUBROUTINE bilinear
parameter (NL=200)
integer mmax,rmax
real minthk
real minthk0
real dep(*),vp(*),vs(*),rho(*)
real rdep(NL),rvp(NL),rvs(NL),rrho(NL),rthk(NL)
integer nsublay(NL)
@ -2291,6 +2292,7 @@ END SUBROUTINE bilinear
initdep = 0.0
do i = 1, mmax-1
thk = dep(i+1)-dep(i)
minthk = thk/minthk0
nsublay(i) = int((thk+1.0e-4)/minthk) + 1
ngrid = nsublay(i)+1
newthk = thk/nsublay(i)