void phs_init(axa am_,
axa ah_,
axa aw_,
axa az_)
/*< initialize >*/
{
int im,ih;
int jm,jh;
float km,kh,k;
am = am_;
ah = ah_;
aw = aw_;
az = az_;
X2K(am,bm,0);
X2K(ah,bh,0);
fft2_init(bm.n,bh.n);
wk = sf_complexalloc2(bm.n,bh.n);
/* precompute wavenumbers */
ks= sf_floatalloc2(bm.n,bh.n);
kr= sf_floatalloc2(bm.n,bh.n);
for (im=0; im<bm.n; im++) {
jm = KMAP(im,bm.n);
km = bm.o + jm*bm.d;
for (ih=0; ih<bh.n; ih++) {
jh = KMAP(ih,bh.n);
kh = bh.o + jh*bh.d;
k = 0.5*(km-kh);
ks[ih][im] = k*k; /* ks^2 */
k = 0.5*(km+kh);
kr[ih][im] = k*k; /* kr^2 */
}
}
}
void dsr2_init(int nz1, float dz1 /* depth */,
int nh1, float dh1, float h01 /* half-offset */,
int nx1, float dx1, float x01 /* midpoint */,
int nu1, float du, float u0 /* slowness grid */,
int ntx, int nth /* taper size */,
int nr1 /* number of references */,
int npad /* padding on nh */)
/*< initialize >*/
{
int ix, ih, iu;
int jx, jh;
float x, h;
float kx, kh, k;
float dx, dh;
float x0, h0;
nz = nz1;
dz = dz1;
nx = nx1;
dx = 2.0*SF_PI/(nx*dx1);
x0 = -SF_PI/ dx1 ;
nh = nh1;
nh2 = nh+npad;
dh = 2.0*SF_PI/(nh2*dh1);
h0 = -SF_PI/ dh1 ;
nu = nu1;
nrmax = nr1;
fft2_init(nh2,nx);
/* allocate workspace */
sz = sf_floatalloc2 (nrmax,nz); /* reference slowness */
sm = sf_floatalloc2 (nrmax,nz); /* reference slowness squared*/
nr = sf_intalloc ( nz); /* number of reference slownesses */
qq = sf_floatalloc2 (nh,nu); /* image */
ks = sf_floatalloc2 (nh2,nx); /* source wavenumber */
kr = sf_floatalloc2 (nh2,nx); /* receiver wavenumber */
is = sf_intalloc2 (nh, nx); /* source reference */
ir = sf_intalloc2 (nh, nx); /* receiver reference */
ii = sf_intalloc (nx); /* midpoint reference */
pk = sf_complexalloc2 (nh2,nx); /* padded wavefield */
wx = sf_complexalloc2 (nh, nx); /* x wavefield */
wk = sf_complexalloc2 (nh2,nx); /* k wavefield */
ms = sf_intalloc2 (nh, nx); /* MRS map source */
mr = sf_intalloc2 (nh, nx); /* MRS map receiver */
ma = sf_floatalloc2 (nh, nx); /* MRS mask */
skip = sf_boolalloc3 (nrmax,nrmax,nz); /* skip slowness combination */
/* precompute wavenumbers */
for (ix=0; ix<nx; ix++) {
jx = (ix < nx/2)? ix + nx/2: ix - nx/2;
kx = x0 + jx*dx;
x = x01 + ix*dx1;
iu = 0.5+(x-u0)/du;
if (iu < 0) iu=0;
else if (iu >= nu) iu=nu-1;
ii[ix] = iu;
for (ih=0; ih<nh; ih++) {
h = h01 + ih*dh1;
iu = 0.5+(x-h-u0)/du;
if (iu < 0) iu=0;
else if (iu >= nu) iu=nu-1;
is[ix][ih] = iu;
iu = 0.5+(x+h-u0)/du;
if (iu < 0) iu=0;
else if (iu >= nu) iu=nu-1;
ir[ix][ih] = iu;
}
for (ih=0; ih<nh2; ih++) {
jh = (ih < nh2/2)? ih + nh2/2: ih - nh2/2;
kh = h0 + jh*dh;
k = 0.5*(kx-kh);
ks[ix][ih] = k*k;
k = 0.5*(kx+kh);
kr[ix][ih] = k*k;
}
}
/* precompute taper array */
taper2_init(nx,nh,ntx,nth,true,false);
mms = sf_fslice_init(nh*nx,nz,sizeof(int));
mmr = sf_fslice_init(nh*nx,nz,sizeof(int));
}
int main(int argc, char* argv[])
{
clock_t tstart, tend;
double duration;
/*Flag*/
bool verb, cmplx;
/*I/O*/
sf_file Fsrc,Fo,Frec; /* I/O files */
sf_file left, right; /*left/right matrix*/
sf_file Fvel, Fden, Ffft; /*Model*/
sf_axis at,az,ax; /* cube axes */
/* I/O arrays*/
float *src; /*point source, distributed source*/
float **lt, **rt;
float **vel, **den, **c11;
/* Grid index variables */
int it,iz,im,ik,ix,i,j;
int nt,nz,nx, m2, nk, nkx, nkz, nzx, nz2, nx2, nzx2, n1, n2, pad1;
float cx, cz;
float kx, kz, dkx, dkz, kx0, kz0;
float dx, dz, dt, d1, d2;
float ox, oz;
sf_complex *cwavex, *cwavez, *cwavemx, *cwavemz;
float **record;
float **wavex, **wavez;
float *curtxx, *pretxx;
float *curvx, *prevx, *curvz, *prevz;
/*source*/
spara sp={0};
int srcrange;
float srctrunc;
bool srcdecay;
float slx, slz;
int spx, spz;
/*options*/
float gdep;
int gp;
tstart = clock();
sf_init(argc,argv);
if(!sf_getbool("verb",&verb)) verb=false; /* verbosity */
Fvel = sf_input("vel");
Fden = sf_input("den");
/* setup I/O files */
Fsrc = sf_input ("in" );
Fo = sf_output("out");
Frec = sf_output("rec"); /*record*/
/* Read/Write axes */
at = sf_iaxa(Fsrc,1); nt = sf_n(at); dt = sf_d(at);
ax = sf_iaxa(Fvel,2); nx = sf_n(ax); dx = sf_d(ax); ox=sf_o(ax);
az = sf_iaxa(Fvel,1); nz = sf_n(az); dz = sf_d(az); oz=sf_o(az);
sf_oaxa(Fo,az,1);
sf_oaxa(Fo,ax,2);
sf_oaxa(Fo,at,3);
/*set for record*/
sf_oaxa(Frec, at, 1);
sf_oaxa(Frec, ax, 2);
if (!sf_getbool("cmplx",&cmplx)) cmplx=false; /* use complex FFT */
if (!sf_getint("pad1",&pad1)) pad1=1; /* padding factor on the first axis */
nk = fft2_init(cmplx,pad1,nz,nx,&nz2,&nx2);
nzx = nz*nx;
nzx2 = nz2*nx2;
/* propagator matrices */
left = sf_input("left");
right = sf_input("right");
if (!sf_histint(left,"n1",&n2) || n2 != nzx) sf_error("Need n1=%d in left",nzx);
if (!sf_histint(left,"n2",&m2)) sf_error("Need n2= in left");
if (!sf_histint(right,"n1",&n2) || n2 != m2) sf_error("Need n1=%d in right",m2);
if (!sf_histint(right,"n2",&n2) || n2 != nk) sf_error("Need n2=%d in right",nk);
lt = sf_floatalloc2(nzx,m2);
rt = sf_floatalloc2(m2,nk);
sf_floatread(lt[0],nzx*m2,left);
sf_floatread(rt[0],m2*nk,right);
/*model veloctiy & density*/
if (!sf_histint(Fvel,"n1", &n1) || n1 != nz) sf_error("Need n1=%d in vel", nz);
if (!sf_histfloat(Fvel,"d1", &d1) || d1 != dz) sf_error("Need d1=%d in vel", dz);
if (!sf_histint(Fvel,"n2", &n2) || n2 != nx) sf_error("Need n2=%d in vel", nx);
if (!sf_histfloat(Fvel,"d2", &d2) || d2 != dx) sf_error("Need d2=%d in vel", dx);
if (!sf_histint(Fden,"n1", &n1) || n1 != nz) sf_error("Need n1=%d in den", nz);
if (!sf_histfloat(Fden,"d1", &d1) || d1 != dz) sf_error("Need d1=%d in den", dz);
if (!sf_histint(Fden,"n2", &n2) || n2 != nx) sf_error("Need n2=%d in den", nx);
if (!sf_histfloat(Fden,"d2", &d2) || d2 != dx) sf_error("Need d2=%d in den", dx);
vel = sf_floatalloc2(nz, nx);
den = sf_floatalloc2(nz, nx);
c11 = sf_floatalloc2(nz, nx);
sf_floatread(vel[0], nzx, Fvel);
sf_floatread(den[0], nzx, Fden);
for (ix = 0; ix < nx; ix++) {
for (iz = 0; iz < nz; iz++) {
c11[ix][iz] = den[ix][iz]*vel[ix][iz]*vel[ix][iz];
}
}
/*parameters of fft*/
Ffft = sf_input("fft");
if (!sf_histint(Ffft,"n1", &nkz)) sf_error("Need n1 in fft");
if (!sf_histint(Ffft,"n2", &nkx)) sf_error("Need n2 in fft");
if ( nkx*nkz != nk ) sf_error("Need nk=nkx*nkz, nk=%d, nkx=%d, nkz=%d", nk, nkx, nkz);
if (!sf_histfloat(Ffft,"d1", &dkz)) sf_error("Need d1 in fft");
if (!sf_histfloat(Ffft,"d2", &dkx)) sf_error("Need d2 in fft");
if (!sf_histfloat(Ffft,"o1", &kz0)) sf_error("Need o1 in fft");
if (!sf_histfloat(Ffft,"o2", &kx0)) sf_error("Need o2 in fft");
/*parameters of geometry*/
if (!sf_getfloat("gdep", &gdep)) gdep = 0.0;
/*depth of geophone (meter)*/
if (gdep <0.0) sf_error("gdep need to be >=0.0");
/*source and receiver location*/
if (!sf_getfloat("slx", &slx)) slx=-1.0;
/*source location x */
if (!sf_getint("spx", &spx)) spx = -1;
/*source location x (index)*/
if((slx<0 && spx <0) || (slx>=0 && spx >=0 )) sf_error("Need src location");
if (slx >= 0 ) spx = (int)((slx-ox)/dx+0.5);
if (!sf_getfloat("slz", &slz)) slz = -1.0;
/* source location z */
if (!sf_getint("spz", &spz)) spz=-1;
/*source location z (index)*/
if((slz<0 && spz <0) || (slz>=0 && spz >=0 )) sf_error("Need src location");
if (slz >= 0 ) spz = (int)((slz-ox)/dz+0.5);
if (!sf_getfloat("gdep", &gdep)) gdep = -1.0;
/* recorder depth on grid*/
if (!sf_getint("gp", &gp)) gp=0;
/* recorder depth on index*/
if ( gdep>=oz) { gp = (int)((gdep-oz)/dz+0.5);}
if (gp < 0.0) sf_error("gdep need to be >=oz");
/*source and receiver location*/
if (!sf_getbool("srcdecay", &srcdecay)) srcdecay=false;
/*source decay*/
if (!sf_getint("srcrange", &srcrange)) srcrange=10;
/*source decay range*/
if (!sf_getfloat("srctrunc", &srctrunc)) srctrunc=100;
/*trunc source after srctrunc time (s)*/
/* read wavelet & reflectivity */
src = sf_floatalloc(nt);
sf_floatread(src,nt,Fsrc);
curtxx = sf_floatalloc(nzx2);
curvx = sf_floatalloc(nzx2);
curvz = sf_floatalloc(nzx2);
pretxx = sf_floatalloc(nzx);
prevx = sf_floatalloc(nzx);
prevz = sf_floatalloc(nzx);
cwavex = sf_complexalloc(nk);
cwavez = sf_complexalloc(nk);
cwavemx = sf_complexalloc(nk);
cwavemz = sf_complexalloc(nk);
wavex = sf_floatalloc2(nzx2,m2);
wavez = sf_floatalloc2(nzx2,m2);
record = sf_floatalloc2(nt,nx);
ifft2_allocate(cwavemx);
ifft2_allocate(cwavemz);
for (iz=0; iz < nzx; iz++) {
pretxx[iz]=0.;
prevx[iz] =0.;
prevz[iz] =0.;
}
for (iz=0; iz < nzx2; iz++) {
curtxx[iz]=0.;
curvx[iz]=0.;
curvz[iz]=0.;
}
/* Check parameters*/
if(verb) {
sf_warning("======================================");
#ifdef SF_HAS_FFTW
sf_warning("FFTW is defined");
#endif
#ifdef SF_HAS_COMPLEX_H
sf_warning("Complex is defined");
#endif
sf_warning("nx=%d nz=%d nzx=%d dx=%f dz=%f", nx, nz, nzx, dx, dz);
sf_warning("nkx=%d nkz=%d dkx=%f dkz=%f nk=%d", nkx, nkz, dkx, dkz, nk);
sf_warning("nx2=%d nz2=%d nzx2=%d", nx2, nz2, nzx2);
sf_warning("======================================");
}
/*set source*/
sp.trunc=srctrunc;
sp.srange=srcrange;
sp.alpha=0.5;
sp.decay=srcdecay?1:0;
/* MAIN LOOP */
for (it=0; it<nt; it++) {
if(verb) sf_warning("it=%d/%d;",it,nt-1);
/*vx, vz--- matrix multiplication */
fft2(curtxx,cwavex); /* P^(k,t) */
for (im = 0; im < m2; im++) {
for (ik = 0; ik < nk; ik++) {
kx = kx0+dkx*(ik/nkz);
kz = kz0+dkz*(ik%nkz);
#ifdef SF_HAS_COMPLEX_H
cwavemz[ik] = cwavex[ik]*rt[ik][im];
cwavemx[ik] = fplus(kx,dx)*cwavemz[ik];
cwavemz[ik] = fplus(kz,dz)*cwavemz[ik];
#else
cwavemz[ik] = sf_crmul(cwavex[ik],rt[ik][im]);
cwavemx[ik] = sf_cmul(fplus(kx,dx), cwavemz[ik]);
cwavemz[ik] = sf_cmul(fplus(kz,dz), cwavemz[ik]);
#endif
}
ifft2(wavex[im], cwavemx); /* dp/dx */
ifft2(wavez[im], cwavemz); /* dp/dz */
}
for (ix = 0; ix < nx; ix++) {
for (iz = 0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
cx = 0.0;
cz = 0.0;
for (im=0; im<m2; im++) {
cx += lt[im][i]*wavex[im][j];
cz += lt[im][i]*wavez[im][j];
}
curvx[j] = -1*dt/den[ix][iz]*cx + prevx[i];
/*vx(t+dt/2) = -dt/rho*dp/dx(t) + vx(t-dt/2) */
prevx[i] = curvx[j];
curvz[j] = -1*dt/den[ix][iz]*cz + prevz[i];
prevz[i] = curvz[j];
}
}
/*txx--- matrix multiplication */
fft2(curvx, cwavex);
fft2(curvz, cwavez);
for (im = 0; im < m2; im++) {
for (ik = 0; ik < nk; ik++ ) {
kx = kx0 + dkx*(ik/nkz);
kz = kz0 + dkz*(ik%nkz);
#ifdef SF_HAS_COMPLEX_H
cwavemz[ik] = cwavez[ik]*rt[ik][im];
cwavemx[ik] = cwavex[ik]*rt[ik][im];
cwavemx[ik] = fminu(kx,dx)*cwavemx[ik];
cwavemz[ik] = fminu(kz,dz)*cwavemz[ik];
#else
cwavemz[ik] = sf_crmul(cwavez[ik],rt[ik][im]);
cwavemx[ik] = sf_crmul(cwavex[ik],rt[ik][im]);
cwavemx[ik] = sf_cmul(fplus(kx,dx), cwavemx[ik]);
cwavemz[ik] = sf_cmul(fplus(kz,dz), cwavemz[ik]);
#endif
}
ifft2(wavex[im], cwavemx); /* dux/dx */
ifft2(wavez[im], cwavemz); /* duz/dz */
}
for (ix = 0; ix < nx; ix++) {
for (iz = 0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
cx = 0.0;
cz = 0.0;
for (im=0; im<m2; im++) {
cx += lt[im][i]*wavex[im][j];
cz += lt[im][i]*wavez[im][j];
}
curtxx[j] = -1*dt*c11[ix][iz]*(cx+cz) + pretxx[i];
}
}
if ((it*dt)<=sp.trunc ) {
curtxx[spz+spx*nz2] += src[it]*dt;
}
for (ix = 0; ix < nx; ix++) {
/* write wavefield to output */
sf_floatwrite(pretxx+ix*nz,nz,Fo);
}
/*record*/
for (ix = 0; ix < nx; ix++){
record[ix][it] = pretxx[ix*nz+gp];
}
for (ix = 0; ix < nx; ix++) {
for (iz = 0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
pretxx[i] = curtxx[j];
}
}
}/*End of MAIN LOOP*/
if(verb) sf_warning(".");
for ( ix = 0; ix < nx; ix++) {
sf_floatwrite(record[ix], nt, Frec);
}
tend = clock();
duration=(double)(tend-tstart)/CLOCKS_PER_SEC;
sf_warning(">> The CPU time of sfsglr is: %f seconds << ", duration);
exit (0);
}
int psp4(float **wvfld, float **wvfld0, float **dat, float **dat_v, float *vel, pspar par)
/*< pseudo-spectral wave extrapolation using wavefield injection >*/
{
/*survey parameters*/
int nx, nz;
float dx, dz;
int n_srcs;
int *spx, *spz;
int gpz, gpx, gpl;
int gpz_v, gpx_v, gpl_v;
int snap;
/*fft related*/
bool cmplx;
int pad1;
/*absorbing boundary*/
bool abc;
int nbt, nbb, nbl, nbr;
float ct,cb,cl,cr;
/*source parameters*/
int src; /*source type*/
int nt;
float dt,*f0,*t0,*A;
/*misc*/
bool verb, ps;
float vref;
int nx1, nz1; /*domain of interest*/
int it,iz,ik,ix,i,j; /* index variables */
int nk,nzx,nz2,nx2,nzx2,nkz,nth;
int it1, it2, its;
float dkx,dkz,kx0,kz0,vref2,kx,kz,k,t;
float c, old;
/*wave prop arrays*/
float *vv;
sf_complex *cwave,*cwavem;
float *wave,*curr,*prev,*lapl;
/*source*/
float **rick;
float freq;
int fft_size;
/*passing the parameters*/
nx = par->nx;
nz = par->nz;
dx = par->dx;
dz = par->dz;
n_srcs= par->n_srcs;
spx = par->spx;
spz = par->spz;
gpz = par->gpz;
gpx = par->gpx;
gpl = par->gpl;
gpz_v = par->gpz_v;
gpx_v = par->gpx_v;
gpl_v = par->gpl_v;
snap = par->snap;
cmplx = par->cmplx;
pad1 = par->pad1;
abc = par->abc;
nbt = par->nbt;
nbb = par->nbb;
nbl = par->nbl;
nbr = par->nbr;
ct = par->ct;
cb = par->cb;
cl = par->cl;
cr = par->cr;
src = par->src;
nt = par->nt;
dt = par->dt;
f0 = par->f0;
t0 = par->t0;
A = par->A;
verb = par->verb;
ps = par->ps;
vref = par->vref;
#ifdef _OPENMP
#pragma omp parallel
{
nth = omp_get_num_threads();
}
#else
nth = 1;
#endif
if (verb) sf_warning(">>>> Using %d threads <<<<<", nth);
nz1 = nz-nbt-nbb;
nx1 = nx-nbl-nbr;
nk = fft2_init(cmplx,pad1,nz,nx,&nz2,&nx2);
nzx = nz*nx;
nzx2 = nz2*nx2;
dkz = 1./(nz2*dz); kz0 = (cmplx)? -0.5/dz:0.;
dkx = 1./(nx2*dx); kx0 = -0.5/dx;
nkz = (cmplx)? nz2:(nz2/2+1);
if(nk!=nx2*nkz) sf_error("wavenumber dimension mismatch!");
sf_warning("dkz=%f,dkx=%f,kz0=%f,kx0=%f",dkz,dkx,kz0,kx0);
sf_warning("nk=%d,nkz=%d,nz2=%d,nx2=%d",nk,nkz,nz2,nx2);
if(abc)
abc_init(nz,nx,nz2,nx2,nbt,nbb,nbl,nbr,ct,cb,cl,cr);
/* allocate and read/initialize arrays */
vv = sf_floatalloc(nzx);
lapl = sf_floatalloc(nk);
wave = sf_floatalloc(nzx2);
curr = sf_floatalloc(nzx2);
prev = sf_floatalloc(nzx2);
cwave = sf_complexalloc(nk);
cwavem = sf_complexalloc(nk);
if (src==0) {
rick = sf_floatalloc2(nt,n_srcs);
for (i=0; i<n_srcs; i++) {
for (it=0; it<nt; it++) {
rick[i][it] = 0.f;
}
rick[i][(int)(t0[i]/dt)] = A[i]; /*time delay*/
freq = f0[i]*dt; /*peak frequency*/
fft_size = 2*kiss_fft_next_fast_size((nt+1)/2);
ricker_init(fft_size, freq, 0);
sf_freqfilt(nt,rick[i]);
ricker_close();
}
} else rick = NULL;
for (iz=0; iz < nzx; iz++) {
vv[iz] = vel[iz]*vel[iz]*dt*dt;
}
vref *= dt;
vref2 = vref*vref;
for (iz=0; iz < nzx2; iz++) {
curr[iz] = 0.;
prev[iz] = 0.;
}
/* constructing the pseudo-analytical op */
for (ix=0; ix < nx2; ix++) {
kx = kx0+ix*dkx;
for (iz=0; iz < nkz; iz++) {
kz = kz0+iz*dkz;
k = 2*SF_PI*hypot(kx,kz);
if (ps) lapl[iz+ix*nkz] = -k*k;
else lapl[iz+ix*nkz] = 2.*(cos(vref*k)-1.)/vref2;
}
}
/* modeling */
/* step forward in time */
it1 = 0;
it2 = nt;
its = +1;
/* MAIN LOOP */
for (it=it1; it!=it2; it+=its) {
if(verb) sf_warning("it=%d/%d;",it,nt);
/* matrix multiplication */
fft2(curr,cwave);
for (ik = 0; ik < nk; ik++) {
#ifdef SF_HAS_COMPLEX_H
cwavem[ik] = cwave[ik]*lapl[ik];
#else
cwavem[ik] = sf_cmul(cwave[ik],lapl[ik]);
#endif
}
ifft2(wave,cwavem);
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix,iz,i,j,old,c)
#endif
for (ix = 0; ix < nx; ix++) {
for (iz=0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
old = c = curr[j];
c += c - prev[j];
prev[j] = old;
c += wave[j]*vv[i];
curr[j] = c;
}
}
if (NULL!=wvfld0) { /* wavefield injection */
if (snap > 0 && it%snap==0) {
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix,iz,i,j,ik)
#endif
for (ix=0; ix<nx1; ix++) {
for (iz=0; iz<nz1; iz++) {
i = iz + nz1*ix;
j = iz+nbt + (ix+nbl)*nz2; /* padded grid */
ik = iz+nbt + (ix+nbl)*nz; /* padded grid */
curr[j] += vv[ik]*wvfld0[it/snap][i];
}
}
}
} else { /* source injection */
t = it*dt;
for (i=0; i<n_srcs; i++) {
for(ix=-1;ix<=1;ix++) {
for(iz=-1;iz<=1;iz++) {
ik = spz[i]+iz+nz*(spx[i]+ix);
j = spz[i]+iz+nz2*(spx[i]+ix);
if (src==0) {
curr[j] += vv[ik]*rick[i][it]/(abs(ix)+abs(iz)+1);
} else {
curr[j] += vv[ik]*Ricker(t, f0[i], t0[i], A[i])/(abs(ix)+abs(iz)+1);
}
}
}
}
}
/*apply abc*/
if (abc) {
abc_apply(curr);
abc_apply(prev);
}
/* record data */
if (NULL!=dat) {
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix)
#endif
for (ix = 0; ix < gpl; ix++) {
dat[ix][it] = curr[gpz+(ix+gpx)*nz2];
}
}
if (NULL!=dat_v) {
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(iz)
#endif
for (iz = 0; iz < gpl_v; iz++) {
dat_v[iz][it] = curr[gpz_v+iz+(gpx_v)*nz2];
}
}
/* save wavefield */
if (snap > 0 && it%snap==0) {
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix,iz,i,j)
#endif
for (ix=0; ix<nx1; ix++) {
for (iz=0; iz<nz1; iz++) {
i = iz + nz1*ix;
j = iz+nbt + (ix+nbl)*nz2; /* padded grid */
wvfld[it/snap][i] = curr[j];
}
}
}
}
if(verb) sf_warning(".");
/*free up memory*/
fft2_finalize();
if (abc) abc_close();
free(vv);
free(lapl);
free(wave);
free(curr);
free(prev);
free(cwave);
free(cwavem);
return 0;
}
int psp3(float **wvfld, float **wvfld1, float **dat, float **dat1, float *img, float *vel, pspar par)
/*< pseudo-spectral back propagation of two receiver wavefields >*/
{
/*survey parameters*/
int nx, nz;
float dx, dz;
int n_srcs;
int *spx, *spz;
int gpz, gpx, gpl;
int gpz_v, gpx_v, gpl_v;
int snap;
/*fft related*/
bool cmplx;
int pad1;
/*absorbing boundary*/
bool abc;
int nbt, nbb, nbl, nbr;
float ct,cb,cl,cr;
/*source parameters*/
int src; /*source type*/
int nt;
float dt,*f0,*t0,*A;
/*misc*/
bool verb, ps;
float vref;
int nx1, nz1; /*domain of interest*/
int it,iz,ik,ix,i,j; /* index variables */
int nk,nzx,nz2,nx2,nzx2,nkz,nth;
int it1, it2, its;
float dkx,dkz,kx0,kz0,vref2,kx,kz,k;
float c, old;
/*wave prop arrays*/
float *vv;
sf_complex *cwave,*cwavem;
float *wave,*curr,*curr1,*prev,*prev1,*lapl;
/*passing the parameters*/
nx = par->nx;
nz = par->nz;
dx = par->dx;
dz = par->dz;
n_srcs= par->n_srcs;
spx = par->spx;
spz = par->spz;
gpz = par->gpz;
gpx = par->gpx;
gpl = par->gpl;
gpz_v = par->gpz_v;
gpx_v = par->gpx_v;
gpl_v = par->gpl_v;
snap = par->snap;
cmplx = par->cmplx;
pad1 = par->pad1;
abc = par->abc;
nbt = par->nbt;
nbb = par->nbb;
nbl = par->nbl;
nbr = par->nbr;
ct = par->ct;
cb = par->cb;
cl = par->cl;
cr = par->cr;
src = par->src;
nt = par->nt;
dt = par->dt;
f0 = par->f0;
t0 = par->t0;
A = par->A;
verb = par->verb;
ps = par->ps;
vref = par->vref;
#ifdef _OPENMP
#pragma omp parallel
{
nth = omp_get_num_threads();
}
#else
nth = 1;
#endif
if (verb) sf_warning(">>>> Using %d threads <<<<<", nth);
nz1 = nz-nbt-nbb;
nx1 = nx-nbl-nbr;
nk = fft2_init(cmplx,pad1,nz,nx,&nz2,&nx2);
nzx = nz*nx;
nzx2 = nz2*nx2;
dkz = 1./(nz2*dz); kz0 = (cmplx)? -0.5/dz:0.;
dkx = 1./(nx2*dx); kx0 = -0.5/dx;
nkz = (cmplx)? nz2:(nz2/2+1);
if(nk!=nx2*nkz) sf_error("wavenumber dimension mismatch!");
sf_warning("dkz=%f,dkx=%f,kz0=%f,kx0=%f",dkz,dkx,kz0,kx0);
sf_warning("nk=%d,nkz=%d,nz2=%d,nx2=%d",nk,nkz,nz2,nx2);
if(abc)
abc_init(nz,nx,nz2,nx2,nbt,nbb,nbl,nbr,ct,cb,cl,cr);
/* allocate and read/initialize arrays */
vv = sf_floatalloc(nzx);
lapl = sf_floatalloc(nk);
wave = sf_floatalloc(nzx2);
curr = sf_floatalloc(nzx2);
curr1 = sf_floatalloc(nzx2);
prev = sf_floatalloc(nzx2);
prev1 = sf_floatalloc(nzx2);
cwave = sf_complexalloc(nk);
cwavem = sf_complexalloc(nk);
for (iz=0; iz < nzx; iz++) {
vv[iz] = vel[iz]*vel[iz]*dt*dt;
}
vref *= dt;
vref2 = vref*vref;
for (iz=0; iz < nzx2; iz++) {
curr[iz] = 0.;
curr1[iz] = 0.;
prev[iz] = 0.;
prev1[iz] = 0.;
}
for (iz=0; iz < nz1*nx1; iz++) {
img[iz] = 0.;
}
/* constructing the pseudo-analytical op */
for (ix=0; ix < nx2; ix++) {
kx = kx0+ix*dkx;
for (iz=0; iz < nkz; iz++) {
kz = kz0+iz*dkz;
k = 2*SF_PI*hypot(kx,kz);
if (ps) lapl[iz+ix*nkz] = -k*k;
else lapl[iz+ix*nkz] = 2.*(cos(vref*k)-1.)/vref2;
}
}
/* step backward in time */
it1 = nt-1;
it2 = -1;
its = -1;
/* MAIN LOOP */
for (it=it1; it!=it2; it+=its) {
if(verb) sf_warning("it=%d/%d;",it,nt);
/* first receiver wavefield */
/* matrix multiplication */
fft2(curr,cwave);
for (ik = 0; ik < nk; ik++) {
#ifdef SF_HAS_COMPLEX_H
cwavem[ik] = cwave[ik]*lapl[ik];
#else
cwavem[ik] = sf_cmul(cwave[ik],lapl[ik]);
#endif
}
ifft2(wave,cwavem);
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix,iz,i,j,old,c)
#endif
for (ix = 0; ix < nx; ix++) {
for (iz=0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
old = c = curr[j];
c += c - prev[j];
prev[j] = old;
c += wave[j]*vv[i];
curr[j] = c;
}
}
/* inject data */
if (NULL!=dat) {
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix)
#endif
for (ix = 0; ix < gpl; ix++) {
curr[gpz+(ix+gpx)*nz2] += vv[gpz+(ix+gpx)*nz]*dat[ix][it];
}
}
/*apply abc*/
if (abc) {
abc_apply(curr);
abc_apply(prev);
}
/* second receiver wavefield */
/* matrix multiplication */
fft2(curr1,cwave);
for (ik = 0; ik < nk; ik++) {
#ifdef SF_HAS_COMPLEX_H
cwavem[ik] = cwave[ik]*lapl[ik];
#else
cwavem[ik] = sf_cmul(cwave[ik],lapl[ik]);
#endif
}
ifft2(wave,cwavem);
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix,iz,i,j,old,c)
#endif
for (ix = 0; ix < nx; ix++) {
for (iz=0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
old = c = curr1[j];
c += c - prev1[j];
prev1[j] = old;
c += wave[j]*vv[i];
curr1[j] = c;
}
}
/* inject data */
if (NULL!=dat1) {
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix)
#endif
for (ix = 0; ix < gpl; ix++) {
curr1[gpz+(ix+gpx)*nz2] += vv[gpz+(ix+gpx)*nz]*dat1[ix][it];
}
}
/*apply abc*/
if (abc) {
abc_apply(curr1);
abc_apply(prev1);
}
/* cross-correlation imaging condition */
if (snap > 0 && it%snap==0) {
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix,iz,i,j)
#endif
for (ix = 0; ix < nx1; ix++) {
for (iz = 0; iz < nz1; iz++) {
i = iz + nz1*ix;
j = iz+nbt + (ix+nbl)*nz2; /* padded grid */
img[i] += curr[j]*curr1[j]; //!!!IMPORTANT!!!
}
}
}
/* save wavefield */
if (snap > 0 && it%snap==0) {
#ifdef _OPENMP
#pragma omp parallel for default(shared) private(ix,iz,i,j)
#endif
for (ix=0; ix<nx1; ix++) {
for (iz=0; iz<nz1; iz++) {
i = iz + nz1*ix;
j = iz+nbt + (ix+nbl)*nz2; /* padded grid */
wvfld[it/snap][i] = curr[j];
wvfld1[it/snap][i] = curr1[j];
}
}
}
}
if(verb) sf_warning(".");
/*free up memory*/
fft2_finalize();
if (abc) abc_close();
free(vv);
free(lapl);
free(wave);
free(curr);
free(curr1);
free(prev);
free(prev1);
free(cwave);
free(cwavem);
return 0;
}
int main(int argc, char* argv[])
{
int iz,im,ik,ix,i,j; /* index variables */
int nz,nx, m2, nk, nzx, nz2, nx2, nzx2, n2;
float c;
sf_complex *cwavem;
float **wave, *curr;
sf_complex **lt, **rt;
sf_file left, right, inp, mig;
sf_init(argc,argv);
inp = sf_input("in");
mig = sf_output("out");
if (SF_FLOAT != sf_gettype(inp)) sf_error("Need float input");
if (!sf_histint(inp,"n1",&nz)) sf_error("No n1= in input");
if (!sf_histint(inp,"n2",&nx)) sf_error("No n2= in input");
nk = fft2_init(false,1,nz,nx,&nz2,&nx2);
nzx = nz*nx;
nzx2 = nz2*nx2;
/* propagator matrices */
left = sf_input("left");
right = sf_input("right");
if (!sf_histint(left,"n1",&n2) || n2 != nzx) sf_error("Need n1=%d in left",nzx);
if (!sf_histint(left,"n2",&m2)) sf_error("Need n2= in left");
if (!sf_histint(right,"n1",&n2) || n2 != m2) sf_error("Need n1=%d in right",m2);
if (!sf_histint(right,"n2",&n2) || n2 != nk) sf_error("Need n2=%d in right",nk);
lt = sf_complexalloc2(nzx,m2);
rt = sf_complexalloc2(m2,nk);
sf_complexread(lt[0],nzx*m2,left);
sf_complexread(rt[0],m2*nk,right);
wave = sf_floatalloc2(nzx2,m2);
cwavem = sf_complexalloc(nk);
curr = sf_floatalloc(nz);
ifft2_allocate(cwavem);
for (im = 0; im < m2; im++) {
#ifdef _OPENMP
#pragma omp parallel for private(ik)
#endif
for (ik = 0; ik < nk; ik++) {
cwavem[ik] = rt[ik][im];
}
ifft2(wave[im],cwavem);
}
for (ix = 0; ix < nx; ix++) {
#ifdef _OPENMP
#pragma omp parallel for private(iz,i,j,c,im)
#endif
for (iz=0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
for (im = 0; im < m2; im++) {
c += crealf(lt[im][i])*wave[im][j];
}
curr[iz] = c;
}
sf_floatwrite(curr,nz,mig);
}
exit (0);
}
int main(int argc, char *argv[])
{
bool cmplx, abc, taper;
int ix, iz, it, itau, n2, m2;
int nx, nz, ntau, nt, pad1, nb, nx2, nz2, nzx2, fnx, fnz, fnzx, nk;
float dt, dtau, par, dz, dx, thresh;
float tau0, tau;
float **lt, **rt;
float *curr, *prev;
float ***dd, ***mm, **v0;
sf_axis ax, az, atau;
sf_file tgather, cgather, left, right;
int cpuid, numprocs, nth;
float *sendbuf, *recvbuf;
MPI_Comm comm=MPI_COMM_WORLD;
sf_init(argc, argv);
MPI_Init(&argc, &argv);
MPI_Comm_rank(comm, &cpuid);
MPI_Comm_size(comm, &numprocs);
#ifdef _OPENMP
#pragma omp parallel
{
nth=omp_get_num_threads();
}
sf_warning(">>> Using %d threads <<<", nth);
#endif
tgather=sf_input("--input");
cgather=sf_output("--output");
left=sf_input("left");
right=sf_input("right");
az=sf_iaxa(tgather, 1);
ax=sf_iaxa(tgather, 2);
atau=sf_iaxa(tgather, 3);
nz=sf_n(az); dz = sf_d(az);
nx=sf_n(ax); dx = sf_d(ax);
ntau=sf_n(atau); dtau=sf_d(atau); tau0=sf_o(atau);
if(cpuid==0){
sf_oaxa(cgather, az, 1);
sf_oaxa(cgather, ax, 2);
sf_oaxa(cgather, atau, 3);
}
if(!sf_getfloat("dt", &dt)) dt=0.001; /* time interval */
if(!sf_getint("nb", &nb)) nb=60; /* boundary width */
if(!sf_getfloat("par", &par)) par=0.01; /* absorbing boundary coefficient */
if(!sf_getbool("cmplx", &cmplx)) cmplx=false; /* use complex FFT */
if(!sf_getbool("abc", &abc)) abc=true; /* absorbing boundary condition */
if(!sf_getint("pad1", &pad1)) pad1=1; /* padding factor on the first axis */
if(!sf_getbool("taper", &taper)) taper=true; /* tapering */
if(!sf_getfloat("thresh", &thresh)) thresh=0.92; /* thresholding */
nx2=nx+2*nb;
nz2=nz+2*nb;
nk=fft2_init(cmplx,pad1,nz2,nx2,&fnz,&fnx);
nzx2=nz2*nx2;
fnzx=fnz*fnx;
if (!sf_histint(left,"n1",&n2) || n2 != nzx2) sf_error("Need n1=%d in left",nzx2);
if (!sf_histint(left,"n2",&m2)) sf_error("Need n2= in left");
if (!sf_histint(right,"n1",&n2) || n2 != m2) sf_error("Need n1=%d in right",m2);
if (!sf_histint(right,"n2",&n2) || n2 != nk) sf_error("Need n2=%d in right",nk);
lt = sf_floatalloc2(nzx2,m2);
rt = sf_floatalloc2(m2,nk);
sf_floatread(lt[0],nzx2*m2,left);
sf_floatread(rt[0],m2*nk,right);
dd=sf_floatalloc3(nz, nx, ntau);
mm=sf_floatalloc3(nz, nx, ntau);
v0=sf_floatalloc2(nz2, nx2);
curr=sf_floatalloc(fnzx);
prev=sf_floatalloc(fnzx);
/* broad cast input time-shift gather */
if(cpuid==0) sf_floatread(dd[0][0], ntau*nx*nz, tgather);
for(itau=0; itau<ntau; itau++){
MPI_Bcast(dd[itau][0], nx*nz, MPI_FLOAT, 0, comm);
}
/* initialize corrected time-shift gather */
#ifdef _OPENMP
#pragma omp parallel for private(itau, ix, iz)
#endif
for(itau=0; itau<ntau; itau++)
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
mm[itau][ix][iz]=0.;
/* initialize functions */
lrinit(nx2, nz2, m2, cmplx, pad1, nb, par, abc, lt, rt, taper, thresh, dz, dx);
/* tau loop */
for(itau=cpuid; itau<ntau; itau+=numprocs){
sf_warning("itau=%d/%d", itau+1, ntau);
tau=tau0+itau*dtau;
// tau=0
if(itau==(ntau-1)/2){
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
mm[itau][ix][iz]=dd[itau][ix][iz];
continue;
}
// calculate v0 (derivative with respect to tau)
zero2(v0, nz2, nx2);
if(itau==0){
for(ix=0; ix<nx; ix++){
for(iz=0; iz<nz; iz++){
v0[ix+nb][iz+nb]=(dd[1][ix][iz]-dd[0][ix][iz])/dtau;
}
}
} else if (itau==ntau-1){
for(ix=0; ix<nx; ix++){
for(iz=0; iz<nz; iz++){
v0[ix+nb][iz+nb]=(dd[ntau-1][ix][iz]-dd[ntau-2][ix][iz])/dtau;
}
}
} else {
#ifdef _OPENMP
#pragma omp parallel for private(ix, iz)
#endif
for(ix=0; ix<nx; ix++){
for(iz=0; iz<nz; iz++){
v0[ix+nb][iz+nb]=(dd[itau+1][ix][iz]-dd[itau-1][ix][iz])/dtau/2.0;
}
}
}
// calculate u1
zero1(curr, fnzx);
zero1(prev, fnzx);
#ifdef _OPENMP
#pragma omp parallel for private(ix, iz)
#endif
for(ix=0; ix<nx; ix++)
for(iz=0; iz<nz; iz++)
curr[(ix+nb)*fnz+iz+nb]=dd[itau][ix][iz];
// tau>0
if(itau>(ntau-1)/2){
// calculate u(t-lt)
for (ix=0; ix<nx2; ix++)
for (iz=0; iz<nz2; iz++)
prev[ix*fnz+iz]=2.*v0[ix][iz]*dt;
lrupdate(curr,prev);
for (ix=0; ix<fnzx; ix++)
curr[ix]=curr[ix]/2.;
// it loop
nt=tau/dt+0.5;
for(it=1; it<nt; it++){
// sf_warning("it=%d/%d;", it+1, nt);
lrupdate(curr,prev);
} //end of it
#ifdef _OPENMP
#pragma omp parallel for private(ix, iz)
#endif
for(ix=0; ix<nx; ix++){
for(iz=0; iz<nz; iz++){
mm[itau][ix][iz]=curr[(ix+nb)*fnz+iz+nb];
}
}
} // end of positive tau
// tau<0
if(itau<(ntau-1)/2){
//calculate u(t+lt)
for (ix=0; ix<nx2; ix++)
for(iz=0; iz<nz2; iz++)
prev[ix*fnz+iz]=-2.*v0[ix][iz]*dt;
lrupdate(curr, prev);
for (ix=0; ix<fnzx; ix++)
curr[ix]=curr[ix]/2.;
// it loop
nt=-tau/dt+0.5;
for(it=1; it<nt; it++){
//sf_warning("it=%d/%d;", it+1, nt);
lrupdate(curr, prev);
}//end of it
#ifdef _OPENMP
#pragma omp parallel for private(ix, iz)
#endif
for(ix=0; ix<nx; ix++){
for(iz=0; iz<nz; iz++){
mm[itau][ix][iz]=curr[(ix+nb)*fnz+iz+nb];
}
}
}// end of negative tau
} //end of itau
MPI_Barrier(comm);
/* corrected time-shift gather reduction */
for(itau=0; itau<ntau; itau++){
if(cpuid==0){
sendbuf=MPI_IN_PLACE;
recvbuf=mm[itau][0];
}else{
sendbuf=mm[itau][0];
recvbuf=NULL;
}
MPI_Reduce(sendbuf, recvbuf, nz*nx, MPI_FLOAT, MPI_SUM, 0, comm);
}
if(cpuid==0) sf_floatwrite(mm[0][0], ntau*nz*nx, cgather);
lrclose();
MPI_Finalize();
}
void split2_init(int nz1, float dz1 /* depth */,
int ny1, float dy1 /* in-line midpoint */,
int nx1, float dx1 /* cross-line midpoint */,
int ntx, int nty /* taper size */,
int padx, int pady /* padding */,
int nr1 /* maximum number of references */,
float dt /* time error */)
/*< initialize >*/
{
int ix, iy, jx, jy;
float x0, y0, dx, dy, kx, ky;
nz = nz1;
dz = dz1;
ds = dt/dz;
ds2 = ds*ds;
ds2 *= ds2;
nx = nx1;
nx2 = nx+padx;
dx = 2.0*SF_PI/(nx2*dx1);
x0 = (1==nx2)?0:-SF_PI/dx1;
ny = ny1;
ny2 = ny+pady;
dy = 2.0*SF_PI/(ny2*dy1);
y0 = (1==ny2)?0:-SF_PI/dy1;
nrmax = nr1;
fft2_init(ny2,nx2);
/* allocate workspace */
ss = sf_floatalloc2 (ny,nx); /* slowness */
sm = sf_floatalloc2 (nrmax,nz); /* reference slowness squared*/
nr = sf_intalloc ( nz); /* number of reference slownesses */
qq = sf_floatalloc2 (ny,nx); /* image */
kk = sf_floatalloc2 (ny2,nx2); /* wavenumber */
pp = sf_complexalloc2 (ny2,nx2); /* wavefield */
wx = sf_complexalloc2 (ny,nx); /* x wavefield */
wk = sf_complexalloc2 (ny2,nx2); /* k wavefield */
wt = sf_floatalloc2 (ny,nx);
ph = sf_floatalloc2 (ny2,nx2);
/* precompute wavenumbers */
for (ix=0; ix<nx2; ix++) {
jx = (ix < nx2/2)? ix + nx2/2: ix - nx2/2;
kx = x0 + jx*dx;
kx *= kx;
for (iy=0; iy<ny2; iy++) {
jy = (iy < ny2/2)? iy + ny2/2: iy - ny2/2;
ky = y0 + jy*dy;
kk[ix][iy] = ky*ky + kx;
}
}
/* tapering */
taper2_init(nx,ny,ntx,nty,true,true);
}