# Extend a few traces off the end of a CDP gather using the vspray operator. # # <in.H Test np=6 eps=1. vspace=vspace > out.H # np is the number of padded traces off end, nx+1,...,nx+np # vspace is a space of slowness squared. # # keyword missing velocity # JFC #% integer nt, n2, n3, esize, nx, nv, np, nxp, niter from history: integer n1:nt, n2, n3, esize nx=n2 from par: integer nv=2*nx, np=6, niter=2 nxp = nx + np allocate: real xx(nt, nxp), vv(nt, nv), pp(nt, np)subroutine dumb( niter, nt, nx, np, nxp, nv, xx, vv, pp) integer it, nt, ix, nx, iv, nv, ip, np, nxp, iter, niter integer rect1, rect2 real xx(nt, nxp), vv(nt, nv), pp(nt, np) real t0, dt, x0, dx, s0, ds, p0, dp, sum, eps, smax temporary real dpp(nt,np), spp(nt,np) temporary real rr(nt,nv), dr (nt,nv), sr (nt,nv) temporary real ww(nt,nv) temporary real wr(nt,nv) temporary real rrr(nt,nv) from history: real o1:t0, d1:dt from history: real o2:x0, d2:dx from par: real eps=1. call sreed('in', xx, 4 * nt * nx) call hclose() smax= 1./ 1.0 **2 s0 = -smax / 5. ds = (smax-s0) / (nv-1.) dp = dx p0 = x0 + nx * dx do it=1,nt { do ip=1,np { xx(it,nx+ip) = 0. }} call vspray( 0, nt,dt,t0, nx,dx,x0, xx, nv,ds,s0, vv)
do it=1,nt { do iv=1,nv { ww(it,iv) = abs( vv(it,iv)) }} rect1 = nt/10 rect2 = 3 call triangle2( rect1, rect2, nt,nv, ww, ww) sum = 0. do it=1,nt { do iv=1,nv { sum = sum + ww(it,iv) }} do it=1,nt { do iv=1,nv { ww(it,iv) = 1. / (ww(it,iv)+eps*sum/(nt*nv)) }}
do it= 1, nt { do iv= 1, nv rr(it,iv) = - vv(it,iv) do ip= 1, np pp(it,ip) = 0. # padded data initialize }
do it=1,nt { do iv=1,nv { wr(it,iv) = rr(it,iv) * ww(it,iv) }}
do iter= 0, niter { do it=1,nt { do iv=1,nv { rrr(it,iv) = wr(it,iv) / ww(it,iv) }} do it=1,nt { do iv=1,nv { dr(it,iv) = wr(it,iv) * ww(it,iv) }} call vspray( 1, nt,dt,t0, np,dp,p0, dpp, nv,ds,s0, dr) call vspray( 0, nt,dt,t0, np,dp,p0, dpp, nv,ds,s0, dr) do it=1,nt { do iv=1,nv { dr(it,iv) = dr(it,iv) * ww(it,iv) }} call cgstep( iter, nt*np, pp, dpp, spp, nt*nv, wr, dr, sr ) do it= 1, nt do ip= 1, np xx(it,nx+ip) = pp(it,ip) } call srite('out', xx, 4 * nt * nxp) call srite('vspace',rrr, 4 * nt *nv) return; end
The subroutines appear in previous sep reports and perhaps in this one. The interactive report (if any) should have pushbuttons to bring up the relevant library subroutines here.