void freqfilt4pi_spec (const float* x /* input */, float** y /* spectrum */)
/*< compute 2-D spectrum >*/
{
int ik, iw;
for (ik=0; ik < m2; ik++) {
for (iw=0; iw < m1; iw++) {
trace[iw] = x[ik*m1+iw];
}
for (iw=m1; iw < nfft; iw++) {
trace[iw]=0.;
}
kiss_fftr (tfor,trace,ctrace);
for (iw=0; iw < nw; iw++) {
fft[ik][iw] = ik%2? sf_cneg(ctrace[iw]): ctrace[iw];
}
}
for (iw=0; iw < nw; iw++) {
kiss_fft_stride(xfor,fft[0]+iw,ctrace2,nw);
for (ik=0; ik < m2; ik++) {
y[iw][ik] = sf_cabsf(ctrace2[ik]); /* transpose */
}
}
}
void cfft2(sf_complex *inp /* [n1*n2] */,
sf_complex *out /* [nk*n2] */)
/*< 2-D FFT >*/
{
int i1, i2;
/* FFT centering */
#pragma omp parallel for private(i2,i1) default(shared)
for (i2=0; i2<local_n0; i2++) {
for (i1=0; i1<n1; i1++) {
#ifdef SF_HAS_COMPLEX_H
cc[i2*n1+i1] = (((i2+local_0_start)%2==0)==(i1%2==0))? inp[i2*n1+i1]:-inp[i2*n1+i1];
#else
cc[i2*n1+i1] = (((i2+local_0_start)%2==0)==(i1%2==0))? inp[i2*n1+i1]:sf_cneg(inp[i2*n1+i1]);
#endif
}
}
fftwf_execute(cfg);
#pragma omp parallel for private(i2,i1) default(shared)
for (i2=0; i2<local_n0; i2++) {
for (i1=0; i1<nk; i1++) {
out[i2*nk+i1]=dd[i2*nk+i1];
}
}
}
static void triple (int o, int d, int nx, int nb, const sf_complex* x, sf_complex* tmp, bool box)
{
int i;
float wt;
sf_complex xi;
for (i=0; i < nx + 2*nb; i++) {
tmp[i] = sf_cmplx(0.,0.);
}
if (box) {
wt = 1.0/(2*nb-1);
for (i=0; i < nx; i++) {
#ifdef SF_HAS_COMPLEX_H
xi = wt*x[o+i*d];
tmp[i+1] += xi;
tmp[i+2*nb] -= xi;
#else
xi = sf_crmul(x[o+i*d],wt);
tmp[i+1] = sf_cadd(tmp[i+1],xi);
tmp[i+2*nb] = sf_cadd(tmp[i+2*nb],sf_cneg(xi));
#endif
}
} else {
wt = 1.0/(nb*nb);
for (i=0; i < nx; i++) {
#ifdef SF_HAS_COMPLEX_H
xi = wt*x[o+i*d];
tmp[i] -= xi;
tmp[i+nb] += 2*xi;
tmp[i+2*nb] -= xi;
#else
xi = sf_crmul(x[o+i*d],wt);
tmp[i] = sf_cadd(tmp[i],sf_cneg(xi));
tmp[i+nb] = sf_cadd(tmp[i+nb],sf_crmul(xi,2.));
tmp[i+2*nb] = sf_cadd(tmp[i+2*nb],sf_cneg(xi));
#endif
}
}
}
void cfft2(sf_complex *inp /* [n1*local_n0] */,
sf_complex *out /* [nk*local_n0] */)
/*< 2-D FFT >*/
{
int i1, i2;
int ith=0;
/* FFT centering */
#pragma omp parallel for private(i2,i1) default(shared)
for (i2=0; i2<local_n0; i2++) {
for (i1=0; i1<n1; i1++) {
#ifdef SF_HAS_COMPLEX_H
cc[i2][i1] = (((i2+local_0_start)%2==0)==(i1%2==0))? inp[i2*n1+i1]:-inp[i2*n1+i1];
#else
cc[i2][i1] = (((i2+local_0_start)%2==0)==(i1%2==0))? inp[i2*n1+i1]:sf_cneg(inp[i2*n1+i1]);
#endif
}
}
#ifdef _OPENMP
#pragma omp parallel for private(i2,ith) default(shared)
#endif
for (i2=0; i2 < local_n0; i2++) {
#ifdef _OPENMP
ith = omp_get_thread_num();
#endif
kiss_fft_stride(cfg1[ith],(kiss_fft_cpx *) cc[i2],tmp+i2*nk,1);
}
fftwf_execute(cfg);
#ifdef _OPENMP
#pragma omp parallel for private(i1,i2,ith) default(shared)
#endif
for (i1=0; i1 < local_n1; i1++) {
#ifdef _OPENMP
ith = omp_get_thread_num();
#endif
kiss_fft_stride(cfg2[ith],tmp+i1*n2,ctrace2[ith],1);
for (i2=0; i2<n2; i2++) {
tmp[i1*n2+i2] = ctrace2[ith][i2];
}
}
fftwf_execute(icfg);
#ifdef _OPENMP
#pragma omp parallel for private(i1,i2) default(shared)
#endif
for (i2=0; i2<local_n0; i2++) {
for (i1=0; i1<nk; i1++) {
out[i2*nk+i1] = tmp2[i2*nk+i1];
}
}
}
void cfft2(sf_complex *inp /* [n1*n2] */,
sf_complex *out /* [nk*n2] */)
/*< 2-D FFT >*/
{
int i1, i2;
#ifdef SF_HAS_FFTW
if (NULL==cfg) {
cfg = fftwf_plan_dft_2d(n2,n1,
(fftwf_complex *) cc[0],
(fftwf_complex *) dd[0],
FFTW_FORWARD, FFTW_MEASURE);
if (NULL == cfg) sf_error("FFTW failure.");
}
#endif
/* FFT centering */
for (i2=0; i2<n2; i2++) {
for (i1=0; i1<n1; i1++) {
#ifdef SF_HAS_COMPLEX_H
cc[i2][i1] = ((i2%2==0)==(i1%2==0))? inp[i2*n1+i1]:-inp[i2*n1+i1];
#else
cc[i2][i1] = ((i2%2==0)==(i1%2==0))? inp[i2*n1+i1]:sf_cneg(inp[i2*n1+i1]);
#endif
/*
#ifdef SF_HAS_COMPLEX_H
cc[i2][i1] = ((i2%2==0)==(i1%2==0))? inp[i2*n1+i1]:(-1*inp[i2*n1+i1]);
#else
cc[i2][i1] = ((i2%2==0)==(i1%2==0))? inp[i2*n1+i1]:sf_cneg(inp[i2*n1+i1]);
#endif
*/
}
}
#ifdef SF_HAS_FFTW
fftwf_execute(cfg);
for (i2=0; i2<n2; i2++) {
for (i1=0; i1<nk; i1++) {
out[i2*nk+i1]=dd[i2][i1];
}
}
#else
for (i2=0; i2 < n2; i2++) {
kiss_fft_stride(cfg1,(kiss_fft_cpx *) cc[i2],tmp[i2],1);
}
for (i1=0; i1 < nk; i1++) {
kiss_fft_stride(cfg2,tmp[0]+i1,ctrace2,nk);
for (i2=0; i2<n2; i2++) {
out[i2*nk+i1] = trace2[i2];
}
}
#endif
}
/*------------------------------------------------------------*/
void cnt2(sf_complex **pp)
/*< apply centering >*/
{
int i1,i2;
for (i2=1; i2<n2; i2+=2) {
for(i1=1; i1<n1; i1+=2) {
#ifdef SF_HAS_COMPLEX_H
pp[i2][i1] = - pp[i2][i1];
#else
pp[i2][i1] = sf_cneg(pp[i2][i1]);
#endif
}
}
}
/*------------------------------------------------------------*/
void sf_cnt3a3(sf_complex ***pp,
sf_fft3d fft)
/*< apply centering on axis 3>*/
{
int i1,i2,i3;
for (i3=0; i3<fft->n3; i3+=2){
for (i2=1; i2<fft->n2; i2++) {
for(i1=0; i1<fft->n1; i1++) {
#ifdef SF_HAS_COMPLEX_H
pp[i3][i2][i1] = - pp[i3][i2][i1];
#else
pp[i3][i2][i1] = sf_cneg(pp[i3][i2][i1]);
#endif
}
}
}
}
void cfft2(sf_complex *inp /* [n1*n2] */,
sf_complex *out /* [nk*n2] */)
/*< 2-D FFT >*/
{
int i1, i2;
/* FFT centering */
#ifdef _OPENMP
#pragma omp parallel for private(i2,i1) default(shared)
#endif
for (i2=0; i2<n2; i2++) {
for (i1=0; i1<n1; i1++) {
#ifdef SF_HAS_COMPLEX_H
cc[i2][i1] = ((i2%2==0)==(i1%2==0))? inp[i2*n1+i1]:-inp[i2*n1+i1];
#else
cc[i2][i1] = ((i2%2==0)==(i1%2==0))? inp[i2*n1+i1]:sf_cneg(inp[i2*n1+i1]);
#endif
}
}
#ifdef SF_HAS_FFTW
fftwf_execute(cfg);
#ifdef _OPENMP
#pragma omp parallel for private(i2,i1) default(shared)
#endif
for (i2=0; i2<n2; i2++) {
for (i1=0; i1<nk; i1++) {
out[i2*nk+i1]=dd[i2][i1];
}
}
#else
for (i2=0; i2 < n2; i2++) {
kiss_fft_stride(cfg1,(kiss_fft_cpx *) cc[i2],tmp[i2],1);
}
for (i1=0; i1 < nk; i1++) {
kiss_fft_stride(cfg2,tmp[0]+i1,ctrace2,nk);
for (i2=0; i2<n2; i2++) {
out[i2*nk+i1] = trace2[i2];
}
}
#endif
}
void freqfilt4pi_lop (bool adj, bool add, int nx, int ny, float* x, float* y)
/*< linear filtering operator >*/
{
int iw, ik;
kiss_fft_cpx temp;
int verb; // just outputting values to check when I get zeroes
sf_adjnull(adj,add,nx,ny,x,y);
for (ik=0; ik < m2; ik++) {
for (iw=0; iw < m1; iw++) {
trace[iw] = adj? y[ik*m1+iw]: x[ik*m1+iw];
/*if(trace[iw] == 0.0){
sf_warning("trace[%d] = %f",iw,trace[iw]);
}*/
}
for (iw=m1; iw < nfft; iw++) {
trace[iw]=0.;
}
kiss_fftr (tfor,trace,ctrace);
for (iw=0; iw < nw; iw++) {
fft[ik][iw] = ik%2? sf_cneg(ctrace[iw]): ctrace[iw];
}
}
for (iw=0; iw < nw; iw++) {
kiss_fft_stride(xfor,fft[0]+iw,ctrace2,nw);
for (ik=0; ik < m2; ik++) {
//double creal( double complex z );
//transform to kiss fft cpx
//creal are double complex functions - what should we
//do when double complex is not supported???
if (adj){
temp.r = creal(shape[iw][ik]);
temp.i = (-1.0)*cimag(shape[iw][ik]);
} else {
temp.r = creal(shape[iw][ik]);
temp.i = cimag(shape[iw][ik]);
}
ctrace2[ik] = sf_cmul(ctrace2[ik],temp);
}
kiss_fft(xinv,ctrace2,ctrace2);
for (ik=0; ik < m2; ik++) {
fft[ik][iw] = ik%2? sf_cneg(ctrace2[ik]): ctrace2[ik];
}
}
for (ik=0; ik < m2; ik++) {
kiss_fftri (tinv,fft[ik],trace);
for (iw=0; iw < m1; iw++) {
if (adj) {
x[ik*m1+iw] += trace[iw];
} else {
y[ik*m1+iw] += trace[iw];
}
}
}
}
int main(int argc, char* argv[])
{
bool verb,complx,sub,os;
int it,iz,im,ik,ix,i,j; /* index variables */
int nt,nz,nx, m2, nk, nzx, nz2, nx2, nzx2, n2, pad1,nth;
sf_complex c,old;
int snap;
/* I/O arrays*/
sf_complex *ww,*curr,*prev,*cwave,*cwavem,**wave,**lt, **rt;
float *rcurr,*rr;
sf_file Fw,Fr,Fo; /* I/O files */
sf_axis at,az,ax; /* cube axes */
sf_file left, right;
sf_file snaps;
/*for tapering*/
float dt,dx,dz,dkx,dkz,kx0,kz0,kx,kz,ktmp,kx_trs,kz_trs,thresh;
float *ktp;
int taper;
sf_init(argc,argv);
if(!sf_getbool("verb",&verb)) verb=false; /* verbosity */
if(!sf_getbool("cmplx",&complx)) complx=true; /* outputs complex wavefield */
if(!sf_getbool("os",&os)) os=true; /* one-step flag */
if (os) {
sf_warning("One-step wave extrapolation");
if(!sf_getbool("sub",&sub)) sub=false; /* subtraction flag */
} else {
sf_warning("Two-step wave extrapolation");
if(!sf_getbool("sub",&sub)) sub=true; /* subtraction flag */
}
if (!sf_getint("taper",&taper)) taper=0; /* tapering in the frequency domain */
if (!sf_getfloat("thresh",&thresh)) thresh=0.92; /* tapering threshold */
/* setup I/O files */
Fw = sf_input ("in" );
Fo = sf_output("out");
Fr = sf_input ("ref");
if (SF_COMPLEX != sf_gettype(Fw)) sf_error("Need complex input");
if (SF_FLOAT != sf_gettype(Fr)) sf_error("Need float ref");
if(complx)
sf_settype(Fo,SF_COMPLEX);
else
sf_settype(Fo,SF_FLOAT);
/* Read/Write axes */
at = sf_iaxa(Fw,1); nt = sf_n(at); dt = sf_d(at);
az = sf_iaxa(Fr,1); nz = sf_n(az); dz = sf_d(az);
ax = sf_iaxa(Fr,2); nx = sf_n(ax); dx = sf_d(ax);
sf_oaxa(Fo,az,1);
sf_oaxa(Fo,ax,2);
if (!sf_getint("snap",&snap)) snap=0;
/* interval for snapshots */
if (snap > 0) {
snaps = sf_output("snaps");
/* (optional) snapshot file */
sf_oaxa(snaps,az,1);
sf_oaxa(snaps,ax,2);
sf_oaxa(snaps,at,3);
sf_putint(snaps,"n3",nt/snap);
sf_putfloat(snaps,"d3",dt*snap);
sf_putfloat(snaps,"o3",0.);
if(complx)
sf_settype(snaps,SF_COMPLEX);
else
sf_settype(snaps,SF_FLOAT);
} else {
snaps = NULL;
}
if (!sf_getint("pad1",&pad1)) pad1=1; /* padding factor on the first axis */
#ifdef _OPENMP
#pragma omp parallel
{
nth = omp_get_num_threads();
}
if (verb) sf_warning(">>>> Using %d threads <<<<<", nth);
#endif
nk = cfft2_init(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_complexalloc2(nzx,m2);
rt = sf_complexalloc2(m2,nk);
sf_complexread(lt[0],nzx*m2,left);
sf_complexread(rt[0],m2*nk,right);
sf_fileclose(left);
sf_fileclose(right);
/* read wavelet & reflectivity */
ww=sf_complexalloc(nt);
sf_complexread(ww,nt ,Fw);
rr=sf_floatalloc(nzx);
sf_floatread(rr,nzx,Fr);
curr = sf_complexalloc(nzx2);
if (!os) prev = sf_complexalloc(nzx2);
else prev = NULL;
if(!complx) rcurr = sf_floatalloc(nzx2);
else rcurr=NULL;
cwave = sf_complexalloc(nk);
cwavem = sf_complexalloc(nk);
wave = sf_complexalloc2(nzx2,m2);
/*icfft2_allocate(cwavem);*/
for (iz=0; iz < nzx2; iz++) {
curr[iz] = sf_cmplx(0.,0.);
if (!os) prev[iz] = sf_cmplx(0.,0.);
if(!complx) rcurr[iz]= 0.;
}
if (taper!=0) {
dkz = 1./(nz2*dz); kz0 = -0.5/dz;
dkx = 1./(nx2*dx); kx0 = -0.5/dx;
kx_trs = thresh*fabs(0.5/dx);
kz_trs = thresh*fabs(0.5/dz);
sf_warning("dkz=%f,dkx=%f,kz0=%f,kx0=%f",dkz,dkx,kz0,kx0);
sf_warning("nk=%d,nkz=%d,nkx=%d",nk,nz2,nx2);
sf_warning("Applying kz tapering below %f",kz_trs);
sf_warning("Applying kx tapering below %f",kx_trs);
ktp = sf_floatalloc(nk);
/* constructing the tapering op */
for (ix=0; ix < nx2; ix++) {
kx = kx0+ix*dkx;
for (iz=0; iz < nz2; iz++) {
kz = kz0+iz*dkz;
ktmp = 1.;
if (fabs(kx) > kx_trs)
ktmp *= (fabs(kx)>kx_trs)? powf((fabs(kx0)-fabs(kx)+kx_trs)/kx0,2) : 1.;
if (fabs(kz) > kz_trs)
ktmp *= (fabs(kz)>kz_trs)? powf((fabs(kz0)-fabs(kz)+kz_trs)/kz0,2) : 1.;
ktp[iz+ix*nz2] = ktmp;
}
}
}
/* MAIN LOOP */
for (it=0; it<nt; it++) {
if(verb) sf_warning("it=%d;",it);
/* matrix multiplication */
cfft2(curr,cwave);
for (im = 0; im < m2; im++) {
for (ik = 0; ik < nk; ik++) {
#ifdef SF_HAS_COMPLEX_H
cwavem[ik] = cwave[ik]*rt[ik][im];
#else
cwavem[ik] = sf_cmul(cwave[ik],rt[ik][im]); //complex multiplies complex
#endif
}
icfft2(wave[im],cwavem);
}
for (ix = 0; ix < nx; ix++) {
for (iz=0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
#ifdef SF_HAS_COMPLEX_H
c = ww[it] * rr[i]; // source term
#else
c = sf_crmul(ww[it], rr[i]); // source term
#endif
if (sub) c += curr[j];
if (!os) {
old = curr[j];
#ifdef SF_HAS_COMPLEX_H
c += sub? (old-prev[j]) : -prev[j];
#else
c = sf_cadd(c,sub? sf_csub(old,prev[j]) : sf_cneg(prev[j]));
#endif
prev[j] = old;
}
for (im = 0; im < m2; im++) {
#ifdef SF_HAS_COMPLEX_H
c += lt[im][i]*wave[im][j];
#else
c += sf_cmul(lt[im][i], wave[im][j]);
#endif
}
curr[j] = c;
if (!complx) rcurr[j] = crealf(c);
}
if (NULL != snaps && 0 == it%snap) {
/* write wavefield snapshots */
if (complx)
sf_complexwrite(curr+ix*nz2,nz,snaps);
else
sf_floatwrite(rcurr+ix*nz2,nz,snaps);
}
}
if (taper!=0) {
if (it%taper == 0) {
cfft2(curr,cwave);
for (ik = 0; ik < nk; ik++) {
#ifdef SF_HAS_COMPLEX_H
cwavem[ik] = cwave[ik]*ktp[ik];
#else
cwavem[ik] = sf_crmul(cwave[ik],ktp[ik]);
#endif
}
icfft2(curr,cwavem);
if (!os) {
cfft2(prev,cwave);
for (ik = 0; ik < nk; ik++) {
#ifdef SF_HAS_COMPLEX_H
cwavem[ik] = cwave[ik]*ktp[ik];
#else
cwavem[ik] = sf_crmul(cwave[ik],ktp[ik]);
#endif
}
icfft2(prev,cwavem);
}
}
}
}
if(verb) sf_warning(".");
/* write final wavefield to output */
for (ix = 0; ix < nx; ix++) {
if (complx)
sf_complexwrite(curr+ix*nz2,nz,Fo);
else
sf_floatwrite(rcurr+ix*nz2,nz,Fo);
}
cfft2_finalize();
exit (0);
}
int main(int argc, char* argv[])
{
bool impresp;
int nt,nx,nz,nw,init,i,padfactor,nfilt,nkol,it,ix,iz,iw;
float v,dx,dz,lambda,sixth,gamma,epsdamp,pi2,dw,dt, w,wov;
sf_complex wov2, a, b, c, d, cshift;
float ***ppp;
sf_complex *pp, *qq;
cfilter aa, fac1, fac2;
sf_file out, imp=NULL;
sf_init(argc,argv);
out = sf_output("out");
sf_setformat(out,"native_float");
if (!sf_getint("nz",&nz)) nz=96;
if (!sf_getint("nx",&nx)) nx=48;
if (!sf_getint("nt",&nt)) nt=12;
if (!sf_getint("nw",&nw)) nw=2;
if (!sf_getint("init",&init)) init=1;
if (!sf_getfloat("v",&v)) v=1.;
if (!sf_getfloat("dz",&dz)) dz=1.;
if (!sf_getfloat("dx",&dx)) dx=2.;
if (!sf_getfloat("lambda",&lambda)) lambda=nz*dz/4.;
sf_putint(out,"n1",nz);
sf_putint(out,"n2",nx);
sf_putint(out,"n3",nt);
aa = allocatechelix(9);
if (!sf_getfloat("sixth",&sixth)) sixth=0.0833;
if (!sf_getfloat("gamma",&gamma)) gamma=0.667;
if (!sf_getfloat("epsdamp",&epsdamp)) epsdamp=0.01;
if (!sf_getint("padfactor",&padfactor)) padfactor=1024;
if (!sf_getint("nfilt",&nfilt)) nfilt=nx+2;
if (!sf_getbool("impresp",&impresp)) impresp=false;
if (impresp) {
imp = sf_output("imp");
sf_setformat(imp,"native_complex");
sf_putint(imp,"n1",2*nx);
sf_putint(imp,"n2",2);
}
ppp = sf_floatalloc3(nz,nx,nt);
pp = sf_complexalloc(nx*nz);
qq = sf_complexalloc(nx*nz);
pi2 = 2.*SF_PI;
dw = v*pi2/lambda;
dt = pi2/(nt*dw);
nkol=pad2(padfactor*nx);
/* dkol=pi2/nkol; */
for (it=0; it < nt; it++) {
for (ix=0; ix < nx; ix++) {
for (iz=0; iz < nz; iz++) {
ppp[it][ix][iz] = 0.;
}
}
}
fac1 = allocatechelix(nfilt);
fac2 = allocatechelix(nfilt);
helimakelag(fac1,nx,nz);
helimakelag(fac2,nx,nz);
xkolmog_init(nkol);
for (iw=0; iw < nw; iw++) { /* frequency loop */
w = (iw+1)*dw;
if (impresp) w=dw*nw/2;
wov = w/v;
wov2 = sf_cmplx(epsdamp,wov);
#ifdef SF_HAS_COMPLEX_H
wov2 = -wov2*wov2;
#else
wov2 = sf_cneg(sf_cmul(wov2,wov2));
#endif
sf_warning("%g %g (%d of %d)",crealf(wov2),cimagf(wov2),iw,nw);
init_wave(init,nx,dx,nz,dz,pp,wov,nw,iw);
for (iz=0; iz < nx*nz; iz++) {
qq[iz]=sf_cmplx(0.,0.);
}
/* isotropic laplacian = 5-point laplacian */
a= sf_cmplx(0.,0.);
#ifdef SF_HAS_COMPLEX_H
b= gamma*(1+sixth*wov2)* (-1./(dz*dz));
c= gamma*(1+sixth*wov2)* (-1./(dx*dx));
d= gamma*(1+sixth*wov2)* (2/(dx*dx) + 2/(dz*dz)) -wov2;
#else
b = sf_crmul(sf_cadd(sf_cmplx(1.,0.),sf_crmul(wov2,sixth)),
gamma*(-1./(dz*dz)));
c = sf_crmul(sf_cadd(sf_cmplx(1.,0.),sf_crmul(wov2,sixth)),
gamma*(-1./(dx*dx)));
d = sf_cadd(sf_crmul(sf_cadd(sf_cmplx(1.,0.),sf_crmul(wov2,sixth)),
gamma*(2/(dx*dx) + 2/(dz*dz))),sf_cneg(wov2));
#endif
/* + rotated 5-point laplacian */
#ifdef SF_HAS_COMPLEX_H
a += (1-gamma)*(1+sixth*wov2)* (-0.5/(dx*dz));
b += (1-gamma)*(1+sixth*wov2)*0.;
c += (1-gamma)*(1+sixth*wov2)*0.;
d += (1-gamma)*(1+sixth*wov2)* 2.0/(dx*dz);
#else
a = sf_cadd(a,sf_crmul(sf_cadd(sf_cmplx(1.0,0.0),
sf_crmul(wov2,sixth)),
(1-gamma)*(-0.5/(dx*dz))));
d = sf_cadd(d,sf_crmul(sf_cadd(sf_cmplx(1.0,0.0),
sf_crmul(wov2,sixth)),
(1-gamma)*(2.0/(dx*dz))));
#endif
aa->flt[0] = a; aa->lag[0] = -nx-1;
aa->flt[1] = b; aa->lag[1] = -nx;
aa->flt[2] = a; aa->lag[2] = -nx+1;
aa->flt[3] = c; aa->lag[3] = -1;
aa->flt[4] = d; aa->lag[4] = 0;
aa->flt[5] = c; aa->lag[5] = 1;
aa->flt[6] = a; aa->lag[6] = nx-1;
aa->flt[7] = b; aa->lag[7] = nx;
aa->flt[8] = a; aa->lag[8] = nx+1;
xkolmog_helix(aa,fac1,fac2);
for (i=0; i < nfilt; i++) {
#ifdef SF_HAS_COMPLEX_H
fac1->flt[i]=0.5*(fac2->flt[i]+conjf(fac1->flt[i]));
#else
fac1->flt[i]=sf_crmul(sf_cadd(fac2->flt[i],conjf(fac1->flt[i])),
0.5);
#endif
}
if (impresp) {
for (iz=0; iz < nx*nz; iz++) {
pp[iz]=sf_cmplx(0.,0.);
}
pp[nx/2-1]=sf_cmplx(1.,0.);
sf_complexwrite(pp,2*nx,imp);
}
cpolydiv_init(nx*nz,fac2);
cpolydiv_lop(false,false,nx*nz,nx*nz,pp,qq);
if (impresp) {
sf_complexwrite(qq,2*nx,imp);
break;
}
/* back to time domain */
for (it=0; it < nt; it++) {
cshift = cexpf(sf_cmplx( 0.,-w*it*dt));
for (ix=0; ix < nx; ix++) {
for (iz=0; iz < nz; iz++) {
#ifdef SF_HAS_COMPLEX_H
ppp[it][ix][iz] += crealf(qq[ix+iz*nx]*cshift);
#else
ppp[it][ix][iz] += crealf(sf_cmul(qq[ix+iz*nx],cshift));
#endif
}
}
}
} /* end frequency loop */
sf_floatwrite(ppp[0][0],nt*nx*nz,out);
exit(0);
}
void cburg_apply (sf_complex *x /* [n*nc] input data */,
sf_complex *a /* [nf] output prediction-error filter */)
/*< estimate PEF >*/
{
double den;
sf_complex fi, bi, ai, num, cj;
int j, ic, i;
for (ic=0; ic < nc; ic++) {
for (i=0; i < n; i++) {
b[ic][i] = f[ic][i] = x[ic*n+i];
}
}
a[0] = sf_cmplx(1.,0.);
for (j=1; j < nf; j++) {
num = sf_cmplx(0.,0.);
den = 0.;
for (ic=0; ic < nc; ic++) {
for (i=j; i < n; i++) {
fi = f[ic][i];
bi = b[ic][i-j];
#ifdef SF_HAS_COMPLEX_H
num += fi*conj(bi);
den += creal(fi*conj(fi) + bi*conj(bi));
#else
num = sf_cadd(num,sf_cmul(fi,conjf(bi)));
den += sf_crealf(sf_cadd(sf_cmul(fi,conjf(fi)),
sf_cmul(bi,conjf(bi))));
#endif
}
}
#ifdef SF_HAS_COMPLEX_H
cj = 2.*num/den;
#else
cj = sf_crmul(num,2./den);
#endif
for (ic=0; ic < nc; ic++) {
for (i=j; i < n; i++) {
fi = f[ic][i];
bi = b[ic][i-j];
#ifdef SF_HAS_COMPLEX_H
f[ic][i] -= cj*bi;
b[ic][i-j] -= conj(cj)*fi;
#else
f[ic][i] = sf_cadd(f[ic][i],sf_cneg(sf_cmul(cj,bi)));
b[ic][i-j] = sf_cadd(b[ic][i-j],
sf_cneg(sf_cmul(sf_conjf(cj),fi)));
#endif
}
}
for (i=1; i <= j/2; i++) {
#ifdef SF_HAS_COMPLEX_H
ai = a[j-i]-cj*conjf(a[i]);
a[i] -= cj*conjf(a[j-i]);
#else
ai = sf_cadd(a[j-i],sf_cneg(sf_cmul(cj,sf_conjf(a[i]))));
a[i] = sf_cadd(a[i],sf_cneg(sf_cmul(cj,sf_conjf(a[j-i]))));
#endif
a[j-i] = ai;
}
#ifdef SF_HAS_COMPLEX_H
a[j] = -cj;
#else
a[j] = sf_cneg(cj);
#endif
}
}
int main(int argc, char* argv[])
{
bool verb;
char *sort;
int j, k, n, m, i2, n2, niter, *map;
sf_complex **a, *e, *old;
float tol, dist, dk;
sf_file poly, root;
sf_init(argc,argv);
poly = sf_input("in");
root = sf_output("out");
if (SF_COMPLEX != sf_gettype(poly)) sf_error("Need complex input");
if (!sf_histint(poly,"n1",&n)) sf_error("No n1= in input");
n2 = sf_leftsize(poly,1);
if (!sf_getint("niter",&niter)) niter=10;
/* number of iterations */
if (!sf_getfloat("tol",&tol)) tol=1.0e-6;
/* tolerance for convergence */
if (!sf_getbool("verb",&verb)) verb=true;
/* verbosity flag */
if (NULL == (sort = sf_getstring("sort"))) sort="real";
/* attribute for sorting (phase,amplitude,real,imaginary) */
switch (sort[0]) {
case 'p':
func = cargf;
break;
case 'a':
func = cabsf;
break;
case 'i':
func = cimagf;
break;
case 'r':
default:
func = crealf;
break;
}
sf_putint(root,"n1",n-1);
a = sf_complexalloc2(n,n);
e = sf_complexalloc(n);
old = sf_complexalloc(n-1);
map = sf_intalloc(n-1);
ceig_init(verb,n);
for (i2=0; i2 < n2; i2++) {
sf_complexread(e,n,poly);
for (m = n; m > 0; m--) {
if (cabsf(e[m-1]) > FLT_EPSILON) break;
}
m--;
for (j=0; j < m; j++) {
for (k=0; k < m; k++) {
a[j][k] = sf_cmplx(0.,0.);
}
}
for (j=0; j < m-1; j++) {
a[j][j+1]=sf_cmplx(1.,0.);
}
for (j=0; j < m; j++) {
#ifdef SF_HAS_COMPLEX_H
a[m-1][j]=-e[j]/e[m];
#else
a[m-1][j]=sf_cneg(sf_cdiv(e[j],e[m]));
#endif
}
ceig(niter,tol,m,a,e);
if (0==i2) {
/* sort the first set of roots */
qsort(e,n-1,sizeof(sf_complex),compare);
for (j=0; j < n-1; j++) {
old[j]=e[j];
}
} else {
/* find nearest to previous */
for (j=0; j < n-1; j++) {
map[j] = -1;
}
/* loop through old roots */
for (j=0; j < n-1; j++) {
dist = SF_HUGE;
/* find nearest not taken */
for (k=0; k < n-1; k++) {
if (map[k] >= 0) continue;
/* Euclidean distance */
#ifdef SF_HAS_COMPLEX_H
dk = cabsf(old[j]-e[k]);
#else
dk = cabsf(sf_cadd(old[j],sf_crmul(e[k],-1.0)));
#endif
if (dk < dist) {
m = k;
dist = dk;
}
}
map[m] = j;
old[j] = e[m];
}
}
sf_complexwrite(old,n-1, root);
}
exit(0);
}
int main(int argc, char* argv[])
{
bool verb,sub,os;
int it,iz,im,ikx,ikz,ix,i,j; /* index variables */
int nt,nz,nx, m2, nk, nzx, nz2, nx2, nzx2, n2, pad1,nth;
sf_complex c,old;
/* I/O arrays*/
sf_complex *ww,*curr,*prev,*cwave,*cwavem,**wave,**lt, **rt;
sf_complex *snap;
float *rr;
sf_file Fw,Fr,Fo; /* I/O files */
sf_axis at,az,ax; /* cube axes */
sf_file left, right;
/*MPI related*/
int cpuid,numprocs;
int provided;
int n_local, o_local;
int ozx2;
sf_complex *sendbuf, *recvbuf;
int *rcounts, *displs;
//MPI_Init(&argc,&argv);
MPI_Init_thread(&argc,&argv,MPI_THREAD_FUNNELED,&provided);
threads_ok = provided >= MPI_THREAD_FUNNELED;
sf_init(argc,argv);
MPI_Comm_rank(MPI_COMM_WORLD, &cpuid);
MPI_Comm_size(MPI_COMM_WORLD, &numprocs);
if(!sf_getbool("verb",&verb)) verb=false; /* verbosity */
if(!sf_getbool("os",&os)) os=true; /* one-step flag */
if (os) {
sf_warning("One-step wave extrapolation");
if(!sf_getbool("sub",&sub)) sub=false; /* subtraction flag */
} else {
sf_warning("Two-step wave extrapolation");
if(!sf_getbool("sub",&sub)) sub=true; /* subtraction flag */
}
/* setup I/O files */
Fw = sf_input ("--input" );
Fo = sf_output("--output");
Fr = sf_input ("ref");
if (SF_COMPLEX != sf_gettype(Fw)) sf_error("Need complex input");
if (SF_FLOAT != sf_gettype(Fr)) sf_error("Need float ref");
sf_settype(Fo,SF_COMPLEX);
/* Read/Write axes */
at = sf_iaxa(Fw,1); nt = sf_n(at);
az = sf_iaxa(Fr,1); nz = sf_n(az);
ax = sf_iaxa(Fr,2); nx = sf_n(ax);
if (cpuid==0) {
sf_oaxa(Fo,az,1);
sf_oaxa(Fo,ax,2);
//sf_setn(at,1);
sf_oaxa(Fo,at,3);
}
if (!sf_getint("pad1",&pad1)) pad1=1; /* padding factor on the first axis */
#pragma omp parallel
{
nth = omp_get_num_threads();
}
if (verb) sf_warning(">>>> Using %d threads <<<<<", nth);
nk = cfft2_init(pad1,nz,nx,&nz2,&nx2,&n_local,&o_local);
sf_warning("Cpuid=%d,n0=%d,n1=%d,local_n0=%d,local_0_start=%d",cpuid,nz2,nx2,n_local,o_local);
nzx = nz*nx;
// nzx2 = nz2*nx2;
nzx2 = n_local*nz2;
ozx2 = o_local*nz2;
/* 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);
sf_fileclose(left);
sf_fileclose(right);
/* read wavelet & reflectivity */
ww=sf_complexalloc(nt);
sf_complexread(ww,nt ,Fw);
rr=sf_floatalloc(nzx);
sf_floatread(rr,nzx,Fr);
curr = sf_complexalloc(nzx2);
if (!os) prev = sf_complexalloc(nzx2);
else prev = NULL;
cwave = sf_complexalloc(nzx2);
cwavem = sf_complexalloc(nzx2);
wave = sf_complexalloc2(nzx2,m2);
for (iz=0; iz < nzx2; iz++) {
curr[iz] = sf_cmplx(0.,0.);
if (!os) prev[iz] = sf_cmplx(0.,0.);
}
sendbuf = curr;
if (cpuid==0) {
snap = sf_complexalloc(nz2*nx2);
recvbuf = snap;
rcounts = sf_intalloc(numprocs);
displs = sf_intalloc(numprocs);
} else {
snap = NULL;
recvbuf = NULL;
rcounts = NULL;
displs = NULL;
}
MPI_Gather(&nzx2, 1, MPI_INT, rcounts, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Gather(&ozx2, 1, MPI_INT, displs, 1, MPI_INT, 0, MPI_COMM_WORLD);
/* MAIN LOOP */
for (it=0; it<nt; it++) {
if(verb) sf_warning("it=%d;",it);
/* matrix multiplication */
cfft2(curr,cwave);
for (im = 0; im < m2; im++) {
//for (ik = 0; ik < nk; ik++) {
for (ikx = 0; ikx < n_local; ikx++) {
for (ikz = 0; ikz < nz2; ikz++) {
i = ikz + (o_local+ikx)*nz2;
j = ikz + ikx*nz2;
#ifdef SF_HAS_COMPLEX_H
cwavem[j] = cwave[j]*rt[i][im];
#else
cwavem[j] = sf_cmul(cwave[j],rt[i][im]);
#endif
}
}
icfft2(wave[im],cwavem);
}
for (ix = 0; ix < n_local && (ix+o_local)<nx ; ix++) {
for (iz=0; iz < nz; iz++) {
i = iz + (o_local+ix)*nz; /* original grid */
j = iz + ix*nz2; /* padded grid */
#ifdef SF_HAS_COMPLEX_H
c = ww[it] * rr[i]; // source term
#else
c = sf_crmul(ww[it], rr[i]); // source term
#endif
if (sub) c += curr[j];
if (!os) {
old = curr[j];
#ifdef SF_HAS_COMPLEX_H
c += sub? (old-prev[j]) : -prev[j];
#else
c = sf_cadd(c,sub? sf_csub(old,prev[j]) : sf_cneg(prev[j]));
#endif
prev[j] = old;
}
for (im = 0; im < m2; im++) {
#ifdef SF_HAS_COMPLEX_H
c += lt[im][i]*wave[im][j];
#else
c += sf_cmul(lt[im][i], wave[im][j]);
#endif
}
curr[j] = c;
}
}
/* write wavefield to output */
MPI_Gatherv(sendbuf, nzx2, MPI_COMPLEX, recvbuf, rcounts, displs, MPI_COMPLEX, 0, MPI_COMM_WORLD);
if (cpuid==0) {
for (ix = 0; ix < nx; ix++)
sf_complexwrite(snap+ix*nz2,nz,Fo);
}
}
if(verb) sf_warning(".");
cfft2_finalize();
MPI_Finalize();
exit (0);
}
int main (int argc, char **argv)
{
int n1, nx, n3, dim, n[SF_MAX_DIM]; /* dimensions */
int i1, ix, i3, j; /* loop counters */
int nk; /* number of wavenumbers */
int npad; /* padding */
float dx; /* space sampling interval */
float dk; /* wavenumber sampling interval */
float x0; /* staring space */
float k0; /* starting wavenumber */
float wt; /* Fourier scaling */
kiss_fft_cpx **cp; /* frequency-wavenumber */
bool inv; /* forward or inverse */
bool sym; /* symmetric scaling */
bool opt; /* optimal padding */
int sign; /* transform sign */
int axis; /* transform axis */
char varname[12]; /* variable name */
char *label; /* transformed axis label */
#ifdef SF_HAS_FFTW
fftwf_plan cfg;
#else
kiss_fft_cpx *ctrace;
kiss_fft_cfg cfg;
#endif
sf_file in=NULL, out=NULL;
sf_init(argc,argv);
in = sf_input ( "in");
out = sf_output("out");
if (SF_COMPLEX != sf_gettype(in)) sf_error ("Need complex input");
if (!sf_getbool("inv",&inv)) inv = false;
/* if y, perform inverse transform */
if (!sf_getbool("sym",&sym)) sym=false;
/* if y, apply symmetric scaling to make the FFT operator Hermitian */
if (!sf_getint("sign",&sign)) sign = inv? 1: 0;
/* transform sign (0 or 1) */
if (!sf_getbool("opt",&opt)) opt=true;
/* if y, determine optimal size for efficiency */
if (!sf_getint("axis",&axis)) axis=2;
/* Axis to transform */
dim = sf_filedims(in,n);
n1=n3=1;
for (j=0; j < dim; j++) {
if (j < axis-1) n1 *= n[j];
else if (j > axis-1) n3 *= n[j];
}
if (inv) {
sprintf(varname,"n%d",axis);
if (!sf_histint (in,varname,&nk)) sf_error("No %s= in input",varname);
sprintf(varname,"d%d",axis);
if (!sf_histfloat(in,varname,&dk)) sf_error("No %s= in input",varname);
sprintf(varname,"fft3_n%d",axis);
if (!sf_histint (in,varname,&nx)) nx=nk;
sprintf(varname,"fft3_o%d",axis);
if (!sf_histfloat(in,varname,&x0)) x0 = 0.;
sprintf(varname,"fft3_label%d",axis);
label = sf_histstring(in,varname);
dx = 1./(nk*dk);
sprintf(varname,"n%d",axis);
sf_putint (out,varname,nx);
sprintf(varname,"d%d",axis);
sf_putfloat (out,varname,dx);
sprintf(varname,"o%d",axis);
sf_putfloat (out,varname,x0);
sprintf(varname,"label%d",axis);
if (NULL != label) {
sf_putstring(out,varname,label);
} else if (NULL != (label = sf_histstring(in,varname))) {
(void) sf_fft_label(axis,label,out);
}
} else {
sprintf(varname,"n%d",axis);
if (!sf_histint (in,varname,&nx)) sf_error("No %s= in input",varname);
sprintf(varname,"d%d",axis);
if (!sf_histfloat(in,varname,&dx)) sf_error("No %s= in input",varname);
sprintf(varname,"o%d",axis);
if (!sf_histfloat(in,varname,&x0)) x0 = 0.;
sprintf(varname,"label%d",axis);
label = sf_histstring(in,varname);
sprintf(varname,"fft3_n%d",axis);
sf_putint(out,varname,nx);
sprintf(varname,"fft3_o%d",axis);
sf_putfloat(out,varname,x0);
if (NULL != label) {
sprintf(varname,"fft3_label%d",axis);
sf_putstring(out,varname,label);
}
if (!sf_getint("pad",&npad)) npad=2;
/* padding factor */
/* determine wavenumber sampling */
nk = opt? kiss_fft_next_fast_size(nx*npad): nx*npad;
if (nk != nx) sf_warning("padded to %d",nk);
dk = 1./(nk*dx);
k0 = -0.5/dx;
sprintf(varname,"n%d",axis);
sf_putint (out,varname,nk);
sprintf(varname,"d%d",axis);
sf_putfloat (out,varname,dk);
sprintf(varname,"o%d",axis);
sf_putfloat (out,varname,k0);
if (NULL != label && !sf_fft_label(axis,label,out)) {
sprintf(varname,"label%d",axis);
sf_putstring(out,varname,"Wavenumber");
}
}
sprintf(varname,"unit%d",axis);
sf_fft_unit(axis,sf_histstring(in,varname),out);
cp = (kiss_fft_cpx**) sf_complexalloc2(n1,nk);
#ifdef SF_HAS_FFTW
ix = nk;
cfg = fftwf_plan_many_dft(1, &ix, n1,
(fftwf_complex*) cp[0], NULL, n1, 1,
(fftwf_complex*) cp[0], NULL, n1, 1,
sign? FFTW_BACKWARD: FFTW_FORWARD,
FFTW_ESTIMATE);
if (NULL == cfg) sf_error("FFTW failure.");
#else
ctrace = (kiss_fft_cpx*) sf_complexalloc(nk);
cfg = kiss_fft_alloc(nk,sign,NULL,NULL);
#endif
/* FFT scaling */
wt = sym? 1./sqrtf((float) nk): 1./nk;
for (i3=0; i3<n3; i3++) {
if (inv) {
sf_floatread((float*) cp[0],n1*nk*2,in);
#ifdef SF_HAS_FFTW
fftwf_execute(cfg);
for (ix=0; ix<nx; ix++) {
for (i1=0; i1 < n1; i1++) {
cp[ix][i1] = sf_crmul(cp[ix][i1],ix%2? -wt: wt);
}
}
#else
for (i1=0; i1 < n1; i1++) {
/* Fourier transform k to x */
kiss_fft_stride(cfg,cp[0]+i1,ctrace,n1);
for (ix=0; ix<nx; ix++) {
cp[ix][i1] = sf_crmul(ctrace[ix],ix%2? -wt: wt);
}
}
#endif
sf_floatwrite((float*) cp[0],n1*nx*2,out);
} else {
sf_floatread((float*) cp[0],n1*nx*2,in);
/* FFT centering */
for (ix=1; ix<nx; ix+=2) {
for (i1=0; i1<n1; i1++) {
cp[ix][i1] = sf_cneg(cp[ix][i1]);
}
}
if (sym) {
for (ix=0; ix<nx; ix++) {
for (i1=0; i1 < n1; i1++) {
cp[ix][i1] = sf_crmul(cp[ix][i1],wt);
}
}
}
/* pad with zeros */
for (ix=nx; ix<nk; ix++) {
for (i1=0; i1<n1; i1++) {
cp[ix][i1].r = 0.;
cp[ix][i1].i = 0.;
}
}
#ifdef SF_HAS_FFTW
fftwf_execute(cfg);
#else
for (i1=0; i1 < n1; i1++) {
/* Fourier transform x to k */
kiss_fft_stride(cfg,cp[0]+i1,ctrace,n1);
/* Transpose */
for (ix=0; ix<nk; ix++) {
cp[ix][i1] = ctrace[ix];
}
}
#endif
sf_floatwrite((float*) cp[0],n1*nk*2,out);
}
}
exit (0);
}
int main(int argc, char* argv[])
{
bool verb,complx,sub,os;
int it,iz,im,ik,ix,i,j; /* index variables */
int nt,nz,nx, m2, nk, nzx, nz2, nx2, nzx2, n2, pad1,nth;
sf_complex c,old;
/* I/O arrays*/
sf_complex *ww,*curr,*prev,*cwave,*cwavem,**wave,**lt, **rt;
float *rcurr,*rr;
sf_file Fw,Fr,Fo; /* I/O files */
sf_axis at,az,ax; /* cube axes */
sf_file left, right;
sf_init(argc,argv);
if(!sf_getbool("verb",&verb)) verb=false; /* verbosity */
if(!sf_getbool("cmplx",&complx)) complx=true; /* outputs complex wavefield */
if(!sf_getbool("os",&os)) os=true; /* one-step flag */
if (os) {
sf_warning("One-step wave extrapolation");
if(!sf_getbool("sub",&sub)) sub=false; /* subtraction flag */
} else {
sf_warning("Two-step wave extrapolation");
if(!sf_getbool("sub",&sub)) sub=true; /* subtraction flag */
}
/* setup I/O files */
Fw = sf_input ("in" );
Fo = sf_output("out");
Fr = sf_input ("ref");
if (SF_COMPLEX != sf_gettype(Fw)) sf_error("Need complex input");
if (SF_FLOAT != sf_gettype(Fr)) sf_error("Need float ref");
if(complx)
sf_settype(Fo,SF_COMPLEX);
else
sf_settype(Fo,SF_FLOAT);
/* Read/Write axes */
at = sf_iaxa(Fw,1);
nt = sf_n(at);
az = sf_iaxa(Fr,1);
nz = sf_n(az);
ax = sf_iaxa(Fr,2);
nx = sf_n(ax);
sf_oaxa(Fo,az,1);
sf_oaxa(Fo,ax,2);
sf_oaxa(Fo,at,3);
if (!sf_getint("pad1",&pad1)) pad1=1; /* padding factor on the first axis */
#ifdef _OPENMP
#pragma omp parallel
{
nth = omp_get_num_threads();
}
if (verb) sf_warning(">>>> Using %d threads <<<<<", nth);
#endif
nk = cfft2_init(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_complexalloc2(nzx,m2);
rt = sf_complexalloc2(m2,nk);
sf_complexread(lt[0],nzx*m2,left);
sf_complexread(rt[0],m2*nk,right);
sf_fileclose(left);
sf_fileclose(right);
/* read wavelet & reflectivity */
ww=sf_complexalloc(nt);
sf_complexread(ww,nt ,Fw);
rr=sf_floatalloc(nzx);
sf_floatread(rr,nzx,Fr);
curr = sf_complexalloc(nzx2);
if (!os) prev = sf_complexalloc(nzx2);
else prev = NULL;
if(!complx) rcurr = sf_floatalloc(nzx2);
else rcurr=NULL;
cwave = sf_complexalloc(nk);
cwavem = sf_complexalloc(nk);
wave = sf_complexalloc2(nzx2,m2);
for (iz=0; iz < nzx2; iz++) {
curr[iz] = sf_cmplx(0.,0.);
if (!os) prev[iz] = sf_cmplx(0.,0.);
if(!complx) rcurr[iz]= 0.;
}
/* MAIN LOOP */
for (it=0; it<nt; it++) {
if(verb) sf_warning("it=%d;",it);
/* matrix multiplication */
cfft2(curr,cwave);
for (im = 0; im < m2; im++) {
for (ik = 0; ik < nk; ik++) {
#ifdef SF_HAS_COMPLEX_H
cwavem[ik] = cwave[ik]*rt[ik][im];
#else
cwavem[ik] = sf_cmul(cwave[ik],rt[ik][im]); //complex multiplies complex
#endif
}
icfft2(wave[im],cwavem);
}
for (ix = 0; ix < nx; ix++) {
for (iz=0; iz < nz; iz++) {
i = iz+ix*nz; /* original grid */
j = iz+ix*nz2; /* padded grid */
#ifdef SF_HAS_COMPLEX_H
c = ww[it] * rr[i]; // source term
#else
c = sf_crmul(ww[it], rr[i]); // source term
#endif
if (sub) c += curr[j];
if (!os) {
old = curr[j];
#ifdef SF_HAS_COMPLEX_H
c += sub? (old-prev[j]) : -prev[j];
#else
c = sf_cadd(c,sub? sf_csub(old,prev[j]) : sf_cneg(prev[j]));
#endif
prev[j] = old;
}
for (im = 0; im < m2; im++) {
#ifdef SF_HAS_COMPLEX_H
c += lt[im][i]*wave[im][j];
#else
c += sf_cmul(lt[im][i], wave[im][j]);
#endif
}
curr[j] = c;
if (!complx) rcurr[j] = crealf(c);
}
/* write wavefield to output */
if (complx)
sf_complexwrite(curr+ix*nz2,nz,Fo);
else
sf_floatwrite(rcurr+ix*nz2,nz,Fo);
}
}
if(verb) sf_warning(".");
cfft2_finalize();
exit (0);
}
int main(int argc, char* argv[])
{
int job;
float x,y, rads, theta;
sf_complex cs, cz;
const int nfat=1, ntheta= 271;
const float eps=0.1, k2=0.05;
vp_init();
for (job=0; job < 5; job++) {
vp_uorig ( -1.75-2.20*job, -1.5 );
vp_uclip (-1.,-1.,1.3,1.1);
vp_fat (nfat);
vp_umove (0.,-.9);
vp_udraw (0.,4.9);
vp_umove (-.5,0.);
vp_udraw (1.2,0.);
vp_utext( .1, .9, 4,0, "Im");
vp_utext( 1.05, -.2, 4,0, "Re");
switch (job) {
case 0:
vp_utext( .1, -.7 , 4,0, "\\F10 w=+p");
vp_utext( .1, .6 , 4,0, "\\F10 w=-p");
vp_utext( .1, .05, 4,0, "\\F10 w=0");
break;
case 1:
vp_utext( .4, -.65, 4,0, "\\F10 w=p/2");
vp_utext( .4, .55, 4,0, "\\F10 w=-p/2");
vp_utext( .1, .05, 4,0, "\\F10 w=0");
break;
default:
break;
}
vp_fat(0);
vp_penup();
for( theta = -180.; theta<180.1; theta += 360./ntheta ) {
rads = 2. * SF_PI * theta / 360.;
cz = cexpf( sf_cmplx(0.,rads) );
#ifdef SF_HAS_COMPLEX_H
cs = (1.+eps - cz )/2.;
#else
cs = sf_crmul(sf_cadd(sf_cmplx(1.+eps,0.),sf_cneg(cz)),0.5);
#endif
switch (job) {
case 0: cs = sf_cmplx( .05, .8*theta/180.); break;
case 1: break;
#ifdef SF_HAS_COMPLEX_H
case 2: cs *= cs; break;
case 3: cs = cs*cs + k2; break;
case 4: cs = csqrtf( cs*cs + k2 ); break;
#else
case 2: cs = sf_cmul(cs,cs);
break;
case 3: cs = sf_cadd(sf_cmul(cs,cs),sf_cmplx(k2,0.));
break;
case 4: cs = csqrtf(sf_cadd(sf_cmul(cs,cs),sf_cmplx(k2,0.)));
break;
#endif
default: break;
}
x = crealf( cs );
y = cimagf( cs );
vp_upendn ( x, -y);
}
}
return 0;
}
int main(int argc, char* argv[])
{
int nx, nt, nkx, nkz, ix, it, ikx, ikz, nz, iz, nbt, nbb, nbl, nbr, nxb, nzb, isx, isz;
float dt, dx, dkx, kx, dz, dkz, kz, tmpdt, pi=SF_PI, o1, o2, kx0, kz0;
float **nxt, **old, **cur, **ukr, **dercur, **derold, *wav;
float **vx, vx2, vx0, vx02, **vz, vz2, vz0, vz02, **yi, yi0, **se, se0;
float ***aa, dx2, dz2, dx4, dz4, ct, cb, cl, cr; //top, bottom, left, right
float w1, w10, w2, w20, w3, w30, h1, h10, h2, h20, h3, h30;
float cosg, cosg0, cosg2, cosg02, sing, sing0, sing2, sing02;
float vk, vk2, tmpvk, k2, err, dt2, kx1, kz1;
kiss_fft_cpx **uk, *ctracex, *ctracez;
kiss_fft_cfg cfgx, cfgxi, cfgz, cfgzi;
sf_file out, velx, velz, source, yita, seta;
bool opt; /* optimal padding */
// #ifdef _OPENMP
// int nth;
// #endif
sf_init(argc,argv);
out = sf_output("out");
velx = sf_input("velx"); /* velocity */
velz = sf_input("velz"); /* velocity */
yita = sf_input("yita"); /* anistropic parameter*/
source = sf_input("in"); /* source wavlet*/
seta = sf_input("seta"); /* TTI angle*/
// if (SF_FLOAT != sf_gettype(inp)) sf_error("Need float input");
if (SF_FLOAT != sf_gettype(velx)) sf_error("Need float input");
if (SF_FLOAT != sf_gettype(velz)) sf_error("Need float input");
if (SF_FLOAT != sf_gettype(source)) sf_error("Need float input");
if (SF_FLOAT != sf_gettype(seta)) sf_error("Need float input");
if (!sf_histint(velx,"n1",&nx)) sf_error("No n1= in input");
if (!sf_histfloat(velx,"d1",&dx)) sf_error("No d1= in input");
if (!sf_histint(velx,"n2",&nz)) sf_error("No n2= in input");
if (!sf_histfloat(velx,"d2",&dz)) sf_error("No d2= in input");
if (!sf_histfloat(velx,"o1",&o1)) o1=0.0;
if (!sf_histfloat(velx,"o2",&o2)) o2=0.0;
// if (!sf_histint(inp,"n2",&nt)) sf_error("No n2= in input");
// if (!sf_histfloat(inp,"d2",&dt)) sf_error("No d2= in input");
if (!sf_getbool("opt",&opt)) opt=true;
/* if y, determine optimal size for efficiency */
if (!sf_getfloat("dt",&dt)) sf_error("Need dt input");
if (!sf_getint("nt",&nt)) sf_error("Need nt input");
if (!sf_getint("isx",&isx)) sf_error("Need isx input");
if (!sf_getint("isz",&isz)) sf_error("Need isz input");
if (!sf_getfloat("err",&err)) err = 0.0001;
if (!sf_getint("nbt",&nbt)) nbt=44;
if (!sf_getint("nbb",&nbb)) nbb=44;
if (!sf_getint("nbl",&nbl)) nbl=44;
if (!sf_getint("nbr",&nbr)) nbr=44;
if (!sf_getfloat("ct",&ct)) ct = 0.01; /*decaying parameter*/
if (!sf_getfloat("cb",&cb)) cb = 0.01; /*decaying parameter*/
if (!sf_getfloat("cl",&cl)) cl = 0.01; /*decaying parameter*/
if (!sf_getfloat("cr",&cr)) cr = 0.01; /*decaying parameter*/
sf_putint(out,"n1",nx);
sf_putfloat(out,"d1",dx);
// sf_putfloat(out,"o1",x0);
sf_putint(out,"n2",nz);
sf_putfloat(out,"d2",dz);
sf_putint(out,"n3",nt);
sf_putfloat(out,"d3",dt);
sf_putfloat(out,"o1",o1);
sf_putfloat(out,"o2",o2);
sf_putfloat(out,"o3",0.0);
nxb = nx + nbl + nbr;
nzb = nz + nbt + nbb;
nkx = opt? kiss_fft_next_fast_size(nxb): nxb;
nkz = opt? kiss_fft_next_fast_size(nzb): nzb;
if (nkx != nxb) sf_warning("nkx padded to %d",nkx);
if (nkz != nzb) sf_warning("nkz padded to %d",nkz);
dkx = 1./(nkx*dx);
kx0 = -0.5/dx;
dkz = 1./(nkz*dz);
kz0 = -0.5/dz;
cfgx = kiss_fft_alloc(nkx,0,NULL,NULL);
cfgxi = kiss_fft_alloc(nkx,1,NULL,NULL);
cfgz = kiss_fft_alloc(nkz,0,NULL,NULL);
cfgzi = kiss_fft_alloc(nkz,1,NULL,NULL);
uk = (kiss_fft_cpx **) sf_complexalloc2(nkx,nkz);
ctracex = (kiss_fft_cpx *) sf_complexalloc(nkx);
ctracez = (kiss_fft_cpx *) sf_complexalloc(nkz);
wav = sf_floatalloc(nt);
sf_floatread(wav,nt,source);
old = sf_floatalloc2(nxb,nzb);
cur = sf_floatalloc2(nxb,nzb);
nxt = sf_floatalloc2(nxb,nzb);
ukr = sf_floatalloc2(nxb,nzb);
derold = sf_floatalloc2(nxb,nzb);
dercur = sf_floatalloc2(nxb,nzb);
aa = sf_floatalloc3(6,nxb,nzb);
bd_init(nx,nz,nbt,nbb,nbl,nbr,ct,cb,cl,cr);
vx = sf_floatalloc2(nxb,nzb);
vz = sf_floatalloc2(nxb,nzb);
/*input & extend velocity model*/
for (iz=nbt; iz<nz+nbt; iz++){
sf_floatread(vx[iz]+nbl,nx,velx);
sf_floatread(vz[iz]+nbl,nx,velz);
for (ix=0; ix<nbl; ix++){
vx[iz][ix] = vx[iz][nbl];
vz[iz][ix] = vz[iz][nbl];
}
for (ix=0; ix<nbr; ix++){
vx[iz][nx+nbl+ix] = vx[iz][nx+nbl-1];
vz[iz][nx+nbl+ix] = vz[iz][nx+nbl-1];
}
}
for (iz=0; iz<nbt; iz++){
for (ix=0; ix<nxb; ix++){
vx[iz][ix] = vx[nbt][ix];
vz[iz][ix] = vz[nbt][ix];
}
}
for (iz=0; iz<nbb; iz++){
for (ix=0; ix<nxb; ix++){
vx[nz+nbt+iz][ix] = vx[nz+nbt-1][ix];
vz[nz+nbt+iz][ix] = vz[nz+nbt-1][ix];
}
}
vx0 =0.0;
vz0 =0.0;
for (iz=0; iz < nzb; iz++) {
for (ix=0; ix < nxb; ix++) {
vx0 += vx[iz][ix]*vx[iz][ix];
vz0 += vz[iz][ix]*vz[iz][ix];
}
}
vx0 = sqrtf(vx0/(nxb*nzb));
vz0 = sqrtf(vz0/(nxb*nzb));
vx02=vx0*vx0;
vz02=vz0*vz0;
/*input & extend anistropic model*/
yi = sf_floatalloc2(nxb,nzb);
for (iz=nbt; iz<nz+nbt; iz++){
sf_floatread(yi[iz]+nbl,nx,yita);
for (ix=0; ix<nbl; ix++){
yi[iz][ix] = yi[iz][nbl];
}
for (ix=0; ix<nbr; ix++){
yi[iz][nx+nbl+ix] = yi[iz][nx+nbl-1];
}
}
for (iz=0; iz<nbt; iz++){
for (ix=0; ix<nxb; ix++){
yi[iz][ix] = yi[nbt][ix];
}
}
for (iz=0; iz<nbb; iz++){
for (ix=0; ix<nxb; ix++){
yi[nz+nbt+iz][ix] = yi[nz+nbt-1][ix];
}
}
yi0 = 0.0;
for (iz=0; iz < nzb; iz++) {
for (ix=0; ix < nxb; ix++) {
yi0+= yi[iz][ix]*yi[iz][ix];
}
}
yi0 = sqrtf(yi0/(nxb*nzb));
se = sf_floatalloc2(nxb,nzb);
for (iz=nbt; iz<nz+nbt; iz++){
sf_floatread(se[iz]+nbl,nx,seta);
for (ix=0; ix<nbl; ix++){
se[iz][ix] = se[iz][nbl];
}
for (ix=0; ix<nbr; ix++){
se[iz][nx+nbl+ix] = se[iz][nx+nbl-1];
}
}
for (iz=0; iz<nbt; iz++){
for (ix=0; ix<nxb; ix++){
se[iz][ix] = se[nbt][ix];
}
}
for (iz=0; iz<nbb; iz++){
for (ix=0; ix<nxb; ix++){
se[nz+nbt+iz][ix] = se[nz+nbt-1][ix];
}
}
se0 = 0.0;
for (iz=0; iz < nzb; iz++) {
for (ix=0; ix < nxb; ix++) {
se0+= se[iz][ix];
}
}
se0 /= (nxb*nzb);
se0 *= pi/180.0;
for (iz=0; iz < nzb; iz++) {
for (ix=0; ix < nxb; ix++) {
se[iz][ix] *= pi/180.0;
}
}
cosg0 = cosf(se0);
cosg02 = cosg0*cosg0;
sing0 = sinf(se0);
sing02 = sing0*sing0;
w10 = vx02*cosg02+vz02*sing02;
w20 = vz02*cosg02+vx02*sing02;
w30 = vx02+vz02+(vx02-vz02)*sinf(2.0*se0);
h10 = sqrtf(-8.0*yi0*vx02*vz02*cosg02*sing02/(1.0+2.0*yi0)+w10*w10);
h20 = sqrtf(-8.0*yi0*vx02*vz02*cosg02*sing02/(1.0+2.0*yi0)+w20*w20);
h30 = sqrtf(-2.0*yi0*vx02*vz02*cosf(2.0*se0)*cosf(2.0*se0)/(1.0+2.0*yi0)+0.25*w30*w30);
dt2 = dt*dt;
dx2 = dx*dx;
dx4 = dx2*dx2;
dz2 = dz*dz;
dz4 = dz2*dz2;
for (iz=0; iz < nzb; iz++){
for (ix=0; ix < nxb; ix++) {
vx2 = vx[iz][ix]*vx[iz][ix];
vz2 = vz[iz][ix]*vz[iz][ix];
cosg = cosf(se[iz][ix]);
sing = sinf(se[iz][ix]);
cosg2 = cosg*cosg;
sing2 = sing*sing;
w1 = vx2*cosg2+vz2*sing2;
w2 = vz2*cosg2+vx2*sing2;
w3 = vx2+vz2+(vx2-vz2)*sinf(2.0*se[iz][ix]);
h1 = sqrtf(-8.0*yi[iz][ix]*vx2*vz2*cosg2*sing2/(1.0+2.0*yi[iz][ix])+w1*w1);
h2 = sqrtf(-8.0*yi[iz][ix]*vx2*vz2*cosg2*sing2/(1.0+2.0*yi[iz][ix])+w2*w2);
h3 = sqrtf(-2.0*yi[iz][ix]*vx2*vz2*cosf(2.0*se[iz][ix])*cosf(2.0*se[iz][ix])/(1.0+2.0*yi[iz][ix])+0.25*w3*w3);
aa[iz][ix][4] = (w1+h1)*(dt2+(2.0*dx2-dt2*(w1+h1))/(w10+h10))/(24.0*dx4);
aa[iz][ix][5] = (w2+h2)*(dt2+(2.0*dz2-dt2*(w2+h2))/(w20+h20))/(24.0*dz4);
aa[iz][ix][3] = -aa[iz][ix][4]*dx2/dz2-aa[iz][ix][5]*dz2/dx2+(dt2*(w3+2.0*h3)+dx2*(w1+h1)/(w10+h10)+dz2*(w2+h2)/(w20+h20)-dt2*(w3+2.0*h3)*(w3+2.0*h3)/(w30+2.0*h30))/(12.0*dx2*dz2);
aa[iz][ix][1] = -2.0*aa[iz][ix][3]-4.0*aa[iz][ix][4]-(w1+h1)/(dx2*(w10+h10));
aa[iz][ix][2] = -2.0*aa[iz][ix][3]-4.0*aa[iz][ix][5]-(w2+h2)/(dz2*(w20+h20));
aa[iz][ix][0] = -2.0*aa[iz][ix][1]-2.0*aa[iz][ix][2]-4.0*aa[iz][ix][3]-2.0*aa[iz][ix][4]-2.0*aa[iz][ix][5];
}
}
for (iz=0; iz < nzb; iz++) {
for (ix=0; ix < nxb; ix++) {
cur[iz][ix] = 0.0;
}
}
cur[isz+nbt][isx+nbl] = wav[0];
for (iz=0; iz < nzb; iz++) {
for (ix=0; ix < nxb; ix++) {
old[iz][ix] = 0.0;
derold[iz][ix] =cur[iz][ix]/dt;
}
}
for (iz=nbt; iz<nz+nbt; iz++){
sf_floatwrite(cur[iz]+nbl,nx,out);
}
/*
#ifdef _OPENMP
#pragma omp parallel
{nth = omp_get_num_threads();}
sf_warning("using %d threads",nth);
#endif
*/
/* propagation in time */
for (it=1; it < nt; it++) {
for (iz=0; iz < nzb; iz++){
for (ix=0; ix < nxb; ix++){
nxt[iz][ix] = 0.0;
uk[iz][ix].r = cur[iz][ix];
uk[iz][ix].i = 0.0;
}
}
/* compute u(kx,kz) */
for (iz=0; iz < nzb; iz++){
/* Fourier transform x to kx */
for (ix=1; ix < nxb; ix+=2){
uk[iz][ix] = sf_cneg(uk[iz][ix]);
}
kiss_fft_stride(cfgx,uk[iz],ctracex,1);
for (ikx=0; ikx<nkx; ikx++) uk[iz][ikx] = ctracex[ikx];
}
for (ikx=0; ikx < nkx; ikx++){
/* Fourier transform z to kz */
for (ikz=1; ikz<nkz; ikz+=2){
uk[ikz][ikx] = sf_cneg(uk[ikz][ikx]);
}
kiss_fft_stride(cfgz,uk[0]+ikx,ctracez,nkx);
for (ikz=0; ikz<nkz; ikz++) uk[ikz][ikx] = ctracez[ikz];
}
/* #ifdef _OPENMP
#pragma omp parallel for private(ik,ix,x,k,tmp,tmpex,tmpdt)
#endif
*/
for (ikz=0; ikz < nkz; ikz++) {
kz1 = (kz0+ikz*dkz)*2.0*pi;
for (ikx=0; ikx < nkx; ikx++) {
kx1 = (kx0+ikx*dkx)*2.0*pi;
kx = kx1*cosg0+kz1*sing0;
kz = kz1*cosg0-kx1*sing0;
tmpvk = (vx02*kx*kx+vz02*kz*kz);
k2 = kx1*kx1+kz1*kz1;
vk2 = 0.5*tmpvk+0.5*sqrtf(tmpvk*tmpvk-8.0*yi0/(1.0+2.0*yi0)*vx02*vz02*kx*kx*kz*kz);
vk = sqrtf(vk2);
tmpdt = 2.0*(cosf(vk*dt)-1.0);
if(!k2)
tmpdt /=(k2+err);
else
tmpdt /= (k2);
uk[ikz][ikx] = sf_crmul(uk[ikz][ikx],tmpdt);
}
}
/* Inverse FFT*/
for (ikx=0; ikx < nkx; ikx++){
/* Inverse Fourier transform kz to z */
kiss_fft_stride(cfgzi,(kiss_fft_cpx *)uk[0]+ikx,(kiss_fft_cpx *)ctracez,nkx);
for (ikz=0; ikz < nkz; ikz++) uk[ikz][ikx] = sf_crmul(ctracez[ikz],ikz%2?-1.0:1.0);
}
for (ikz=0; ikz < nkz; ikz++){
/* Inverse Fourier transform kx to x */
kiss_fft_stride(cfgxi,(kiss_fft_cpx *)uk[ikz],(kiss_fft_cpx *)ctracex,1);
for (ikx=0; ikx < nkx; ikx++) uk[ikz][ikx] = sf_crmul(ctracex[ikx],ikx%2?-1.0:1.0);
}
for (iz=0; iz < nzb; iz++){
for (ix=0; ix < nxb; ix++){
ukr[iz][ix] = sf_crealf(uk[iz][ix]);
ukr[iz][ix] /= (nkx*nkz);
}
}
for (iz=2; iz < nzb-2; iz++) {
for (ix=2; ix < nxb-2; ix++) {
nxt[iz][ix] = ukr[iz][ix]*aa[iz][ix][0]
+ (ukr[iz][ix-1]+ukr[iz][ix+1])*aa[iz][ix][1]
+ (ukr[iz-1][ix]+ukr[iz+1][ix])*aa[iz][ix][2]
+ (ukr[iz-1][ix-1]+ukr[iz-1][ix+1]+ukr[iz+1][ix-1]+ukr[iz+1][ix+1])*aa[iz][ix][3]
+ (ukr[iz][ix-2]+ukr[iz][ix+2])*aa[iz][ix][4]
+ (ukr[iz-2][ix]+ukr[iz+2][ix])*aa[iz][ix][5];
}
}
/*
nxt[0][0] = uk[0][0]*aa[0][0][0] + uk[0][1]*aa[0][0][1] + uk[1][0]*aa[0][0][2];
nxt[0][nxb-1] = uk[0][nxb-1]*aa[0][nxb-1][0] + uk[0][nxb-2]*aa[0][nxb-1][1] + uk[1][nxb-1]*aa[0][nxb-1][2];
nxt[nzb-1][0] = uk[nzb-1][0]*aa[nzb-1][0][0] + uk[nzb-1][1]*aa[nzb-1][0][1] + uk[nzb-2][0]*aa[nzb-1][0][2];
nxt[nzb-1][nxb-1] = uk[nzb-1][nxb-1]*aa[nzb-1][nxb-1][0] + uk[nzb-1][nxb-2]*aa[nzb-1][nxb-1][1] + uk[nzb-2][nxb-1]*aa[nzb-1][nxb-1][2];
for (ix=1; ix < nxb-1; ix++) {
nxt[0][ix] = uk[0][ix]*aa[0][ix][0] + (uk[0][ix-1]+uk[0][ix+1])*aa[0][ix][1] + uk[1][ix]*aa[0][ix][2];
nxt[nz-1][ix] = uk[nz-1][ix]*aa[nz-1][ix][0] + (uk[nz-1][ix-1]+uk[nz-1][ix+1])*aa[nz-1][ix][1] + uk[nz-2][ix]*aa[nz-1][ix][2];
}
for (iz=1; iz < nzb-1; iz++) {
nxt[iz][0] = uk[iz][0]*aa[iz][0][0] + uk[iz][1]*aa[iz][0][1] + (uk[iz-1][0]+uk[iz+1][0])*aa[iz][0][2];
nxt[iz][nx-1] = uk[iz][nx-1]*aa[iz][nx-1][0] + uk[iz][nx-2]*aa[iz][nx-1][1] + (uk[iz-1][nx-1]+uk[iz+1][nx-1])*aa[iz][nx-1][2];
}
*/
// nxt[isz+nbt][isx+nbl] += wav[it];
for (iz=0; iz < nzb; iz++) {
for (ix=0; ix < nxb; ix++) {
dercur[iz][ix]= derold[iz][ix] + nxt[iz][ix]/dt;
nxt[iz][ix] = cur[iz][ix] + dercur[iz][ix]*dt;
// nxt[iz][ix] += 2.0*cur[iz][ix] -old[iz][ix];
}
}
nxt[isz+nbt][isx+nbl] += wav[it];
bd_decay(nxt);
bd_decay(dercur);
for (iz=0; iz < nzb; iz++) {
for(ix=0; ix < nxb; ix++) {
old[iz][ix] = cur[iz][ix];
cur[iz][ix] = nxt[iz][ix];
derold[iz][ix] = dercur[iz][ix];
}
}
for (iz=nbt; iz<nz+nbt; iz++){
sf_floatwrite(nxt[iz]+nbl,nx,out);
}
}
bd_close();
free(**aa);
free(*aa);
free(aa);
free(*vx);
free(*vz);
free(*yi);
free(*se);
free(*nxt);
free(*cur);
free(*old);
free(*dercur);
free(*derold);
free(*uk);
free(*ukr);
free(vx);
free(vz);
free(yi);
free(se);
free(nxt);
free(cur);
free(old);
free(dercur);
free(derold);
free(uk);
free(ukr);
// sf_fileclose(vel);
// sf_fileclose(inp);
// sf_fileclose(out);
exit(0);
}
void mcfft3(sf_complex *inp /* [n1*n2*n3] */,
sf_complex *out /* [nk*n2*n3] */)
/*< 3-D FFT >*/
{
int i1, i2, i3;
/* FFT centering */
#pragma omp parallel for private(i3,i2,i1) default(shared)
for (i3=0; i3<local_n0; i3++) {
for (i2=0; i2<n2; i2++) {
for (i1=0; i1<n1; i1++) {
#ifdef SF_HAS_COMPLEX_H
cc[(i3*n2+i2)*n1+i1] = ((((i3+local_0_start)%2==0)==(i2%2==0))==(i1%2==0))? inp[(i3*n2+i2)*n1+i1]:-inp[(i3*n2+i2)*n1+i1];
#else
cc[(i3*n2+i2)*n1+i1] = ((((i3+local_0_start)%2==0)==(i2%2==0))==(i1%2==0))? inp[(i3*n2+i2)*n1+i1]:sf_cneg(inp[(i3*n2+i2)*n1+i1]);
#endif
}
}
}
fftwf_execute(cfg);
#pragma omp parallel for private(i3,i2,i1) default(shared)
for (i3=0; i3<local_n0; i3++)
for (i2=0; i2<n2; i2++)
for (i1=0; i1<nk; i1++)
out[(i3*n2+i2)*n1+i1]=cc[(i3*n2+i2)*n1+i1];
}
void cfft3(sf_complex *inp /* [n1*n2*n3] */,
sf_complex *out /* [nk*n2*n3] */)
/*< 3-D FFT >*/
{
int i1, i2, i3;
sf_complex f;
#ifdef SF_HAS_FFTW
if (NULL==cfg) {
cfg = fftwf_plan_dft_3d(n3,n2,n1,
(fftwf_complex *) cc[0][0],
(fftwf_complex *) out,
FFTW_FORWARD, FFTW_MEASURE);
if (NULL == cfg) sf_error("FFTW failure.");
}
#endif
/* FFT centering */
for (i3=0; i3<n3; i3++) {
for (i2=0; i2<n2; i2++) {
for (i1=0; i1<n1; i1++) {
f = inp[(i3*n2+i2)*n1+i1];
#ifdef SF_HAS_COMPLEX_H
cc[i3][i2][i1] = (((i3%2==0)==(i2%2==0))==(i1%2==0))? f:-f;
#else
cc[i3][i2][i1] = (((i3%2==0)==(i2%2==0))==(i1%2==0))? f:sf_cneg(f);
#endif
}
}
}
#ifdef SF_HAS_FFTW
fftwf_execute(cfg);
#else
/* FFT over first axis */
for (i3=0; i3 < n3; i3++) {
for (i2=0; i2 < n2; i2++) {
kiss_fft_stride(cfg1,(kiss_fft_cpx *) cc[i3][i2],tmp[i3][i2],1);
}
}
/* FFT over second axis */
for (i3=0; i3 < n3; i3++) {
for (i1=0; i1 < nk; i1++) {
kiss_fft_stride(cfg2,tmp[i3][0]+i1,ctrace2,nk);
for (i2=0; i2 < n2; i2++) {
tmp[i3][i2][i1]=ctrace2[i2];
}
}
}
/* FFT over third axis */
for (i2=0; i2 < n2; i2++) {
for (i1=0; i1 < nk; i1++) {
kiss_fft_stride(cfg3,tmp[0][0]+i2*nk+i1,ctrace3,nk*n2);
for (i3=0; i3<n3; i3++) {
out[(i3*n2+i2)*nk+i1] = trace3[i3];
}
}
}
#endif
}
void mcfft3(sf_complex *inp /* [n1*n2*n3] */,
sf_complex *out /* [nk*n2*n3] */)
/*< 3-D FFT >*/
{
int i1, i2, i3, ith=0;
/* FFT centering */
#pragma omp parallel for private(i3,i2,i1) default(shared)
for (i3=0; i3<local_n0; i3++) {
for (i2=0; i2<n2; i2++) {
for (i1=0; i1<n1; i1++) {
#ifdef SF_HAS_COMPLEX_H
cc[(i3*n2+i2)*n1+i1] = ((((i3+local_0_start)%2==0)==(i2%2==0))==(i1%2==0))? inp[(i3*n2+i2)*n1+i1]:-inp[(i3*n2+i2)*n1+i1];
#else
cc[(i3*n2+i2)*n1+i1] = ((((i3+local_0_start)%2==0)==(i2%2==0))==(i1%2==0))? inp[(i3*n2+i2)*n1+i1]:sf_cneg(inp[(i3*n2+i2)*n1+i1]);
#endif
}
}
}
/* FFT over first axis */
#ifdef _OPENMP
#pragma omp parallel for private(i3,i2,ith) default(shared)
#endif
for (i3=0; i3 < local_n0; i3++) {
#ifdef _OPENMP
ith = omp_get_thread_num();
#endif
for (i2=0; i2 < n2; i2++) {
kiss_fft_stride(cfg1[ith],(kiss_fft_cpx *) cc+(i3*n2+i2)*nk,tmp+(i3*n2+i2)*nk,1);
}
}
/* FFT over second axis */
#ifdef _OPENMP
#pragma omp parallel for private(i3,i2,i1,ith) default(shared)
#endif
for (i3=0; i3 < local_n0; i3++) {
#ifdef _OPENMP
ith = omp_get_thread_num();
#endif
for (i1=0; i1 < nk; i1++) {
kiss_fft_stride(cfg2[ith],tmp+i3*n2*nk+i1,ctrace2[ith],nk);
for (i2=0; i2 < n2; i2++) {
tmp[(i3*n2+i2)*nk+i1]=ctrace2[ith][i2];
}
}
}
/* parallel transpose from n1*n2 * n3 to n3 * n1*n2 */
fftwf_execute(cfg);
/* FFT over third axis */
#ifdef _OPENMP
#pragma omp parallel for private(i3,i1,ith) default(shared)
#endif
for (i1=0; i1 < local_n1; i1++) {
#ifdef _OPENMP
ith = omp_get_thread_num();
#endif
kiss_fft_stride(cfg3[ith],tmp+i1*n3,ctrace3[ith],1);
for (i3=0; i3<n3; i3++) {
tmp[i1*n3+i3] = ctrace3[ith][i3];
}
}
fftwf_execute(icfg);
#pragma omp parallel for private(i3,i2,i1) default(shared)
for (i3=0; i3<local_n0; i3++)
for (i2=0; i2<n2; i2++)
for (i1=0; i1<nk; i1++)
out[(i3*n2+i2)*n1+i1]=tmp2[(i3*n2+i2)*n1+i1];
}