main()
{
int n,nc,nr,i;
float *rz=(float*)cz;
float cpucc,cpurc;
for (nc=npfa(NMIN),nr=npfar(nc);
nc<NMAX && nr<NMAX;
nc=npfa(nc+1),nr=npfar(nc)) {
for (i=0; i<nc*nc; i++)
cz[i] = cmplx(0.0,0.0);
cpucc = cpusec();
pfa2cc(1,1,nc,nc,cz);
cpucc = cpusec()-cpucc;
for (i=0; i<nr*nr; i++)
rz[i] = 0.0;
cpurc = cpusec();
pfa2rc(1,1,nr,nr,rz,cz);
cpurc = cpusec()-cpurc;
printf("nc,nr,cc,rc,cc/rc = %d %d %f %f %f\n",
nc,nr,cpucc,cpurc,cpucc/cpurc);
}
}
int
main(int argc, char **argv)
{
int nx1,nx2; /* numbers of samples */
int ix1, ix2; /* sample indices */
float a1,a2; /* filter dimensions */
float pi; /* pi number */
float vmax; /* maximum value of the data */
float vfmax; /* scale factor after filtering */
float c1,c2;
float **v=NULL; /* array of velocities */
float *k1=NULL,*k2=NULL; /* wavenumber arrays */
float *kfilt1=NULL,*kfilt2=NULL;/* intermediate filter arrays */
float dk1,dk2; /* wavenumber interval */
float **kfilter=NULL; /* array of filter values */
int nx1fft,nx2fft; /* dimensions after padding for FFT */
int nK1,nK2; /* transform dimension */
int ik1,ik2; /* wavenumber indices */
register complex **ct=NULL; /* complex FFT workspace */
register float **rt=NULL; /* float FFT workspace */
FILE *tracefp=NULL; /* temp file to hold traces */
FILE *hfp=NULL; /* temp file to hold trace headers */
/* hook up getpar to handle the parameters */
initargs(argc, argv);
requestdoc(1);
/* Get parameters from command line */
if (!getparfloat("a1",&a1)) a1=0.;
if (!getparfloat("a2",&a2)) a2=0.;
/* Get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
if (tr.trid != TRID_DEPTH) warn("tr.trid=%d",tr.trid);
nx1=tr.ns;
/* Store traces in tmpfile while getting a count */
tracefp=etmpfile();
hfp=etmpfile();
nx2=0;
do {
++nx2;
efwrite(&tr,HDRBYTES, 1, hfp);
efwrite(tr.data, FSIZE, nx1, tracefp);
} while (gettr(&tr));
/* Determine number of wavenumbers in K1 and K2 */
nx1fft=npfaro(nx1, LOOKFAC*nx1);
nx2fft=npfa(nx2);
if (nx1fft >=SU_NFLTS || nx1fft >= PFA_MAX)
err("Padded nx1=%d--too big",nx1fft);
if (nx2fft >= PFA_MAX)
err("Padded nx2=%d--too big",nx2fft);
/* Determine number of wavenumbers in K1 and K2 */
nK1=nx1fft/2 + 1;
nK2=nx2fft/2 + 1;
/* Allocate space */
v=alloc2float(nx1,nx2);
rt=alloc2float(nx1fft,nx2fft);
ct=alloc2complex(nK1,nx2fft);
kfilter=alloc2float(nx1fft,nx2fft);
k1=alloc1float(nK1);
k2=alloc1float(nK2);
kfilt1= alloc1float(nK1);
kfilt2= alloc1float(nK2);
/* Zero all arrays */
memset((void *) rt[0], 0, nx1fft*nx2fft*FSIZE);
memset((void *) kfilter[0], 0, nx1fft*nx2fft*FSIZE);
memset((void *) ct[0], 0, nK1*nx2fft*sizeof(complex));
memset((void *) k1, 0, nK1*FSIZE);
memset((void *) k2, 0, nK2*FSIZE);
memset((void *) kfilt1, 0, nK1*FSIZE);
memset((void *) kfilt2, 0, nK2*FSIZE);
/* Determine wavenumber arrays for the filter */
pi=PI;
dk1=2*pi / nx1fft;
dk2=2*pi / nx2fft;
for (ik1=0; ik1<nK1; ++ik1) {
c1=a1*ik1*dk1/ 2;
kfilt1[ik1]= exp(-pow(c1,2));
}
for (ik2=0; ik2<nK2; ++ik2) {
c2= a2*ik2*dk2/2;
kfilt2[ik2]= exp(-pow(c2,2));
}
/* Build Gaussian filter */
/* positive k1, positive k2 */
for (ik2=0; ik2<nK2; ++ik2) {
for (ik1=0; ik1<nK1; ++ik1) {
kfilter[ik2][ik1]=kfilt2[ik2]*kfilt1[ik1];
}
}
/* positive k1, negative k2 */
for (ik2=nK2; ik2<nx2fft; ++ik2) {
for (ik1=0; ik1<nK1; ++ik1) {
kfilter[ik2][ik1]=kfilt2[nx2fft-ik2]*kfilt1[ik1];
}
}
/* Read velocities from temp file and determine maximum */
rewind(tracefp);
fread(v[0],sizeof(float),nx2*nx1,tracefp);
vmax=v[0][0];
for (ix2=0; ix2<nx2; ++ix2) {
for (ix1=0; ix1<nx1; ++ix1) {
vmax=MAX(vmax,v[ix2][ix1]);
}
}
/* Load data into FFT arrays */
rewind(tracefp);
for (ix2=0; ix2<nx2; ++ix2) {
efread(rt[ix2], FSIZE, nx1, tracefp);
}
/* Fourier transform dimension 1 */
pfa2rc(-1,1,nx1fft,nx2,rt[0],ct[0]);
/* Fourier transform dimension 2 */
pfa2cc(-1,2,nK1,nx2fft,ct[0]);
/* Apply filter to the data */
for (ik2=0; ik2<nx2fft; ++ik2) {
for (ik1=0; ik1<nK1; ++ik1) {
ct[ik2][ik1]=crmul(ct[ik2][ik1], kfilter[ik2][ik1]) ;
}
}
/* Inverse Fourier transformation dimension 2 */
pfa2cc(1,2,nK1,nx2fft,ct[0]);
/* Inverse Fourier transformation dimension 1 */
pfa2cr(1,1,nx1fft,nx2,ct[0],rt[0]);
/* Find maximum of filtered data */
vfmax=rt[0][0];
for (ix2=0; ix2<nx2; ++ix2) {
for (ix1=0; ix1<nx1; ++ix1) {
vfmax=MAX(vfmax,rt[ix2][ix1]);
}
}
/* Rescale and output filtered data */
erewind(hfp);
for (ix2=0; ix2<nx2; ++ix2) {
efread(&tr, HDRBYTES, 1, hfp);
for (ix1=0; ix1<nx1; ++ix1)
tr.data[ix1]=(rt[ix2][ix1]) * vmax / vfmax;
puttr(&tr);
}
efclose(hfp);
return(CWP_Exit());
}
void slopefilter (int nslopes, float slopes[], float amps[], float bias,
int nt, float dt, int nx, float dx, FILE *tracefp)
/******************************************************************************
apply slope filter in frequency-wavenumber domain
*******************************************************************************
Input:
nslopes number of slopes (and amplitudes) specified
slopes slopes at which amplitudes are specified (see notes below)
amps amplitudes corresponding to slopes (see notes below)
bias linear moveout slope before and after filtering
nt number of time samples
dt time sampling interval
nx number of traces
dx trace space (spatial sampling interval)
tracefp file pointer to data to be filtered
Output:
tracefp file pointer to filtered data
*******************************************************************************
Notes:
Linear interpolation and constant extrapolation are used to
determine amplitudes for slopes that are not specified.
******************************************************************************/
{
int ntfft; /* nt after padding for FFT */
int nxfft; /* nx after padding for FFT */
float sfft; /* scale factor for FFT */
int nw; /* number of frequencies */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
int nk; /* number of wavenumbers */
float dk; /* wavenumber sampling interval */
float w,k; /* frequency and wavenumber */
int it,ix,iw,ik; /* sample indices */
float slope,amp; /* slope and amplitude for particular w,k */
complex **cpfft; /* complex FFT workspace */
float **pfft; /* float FFT workspace */
float phase; /* phase shift for bias */
complex cshift; /* complex phase shifter for bias */
/* determine lengths and scale factors for prime-factor FFTs */
ntfft = npfar(nt);
nxfft = npfa(nx);
sfft = 1.0/(ntfft*nxfft);
/* determine frequency and wavenumber sampling */
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
fw = 0.000001*dw; /* non-zero to avoid divide by zero w */
nk = nxfft;
dk = 2.0*PI/(nxfft*dx);
/* allocate real and complex workspace for FFTs */
cpfft = alloc2complex(nw,nk);
pfft = alloc2float(ntfft,nxfft);
/* copy data from input to FFT array and pad with zeros */
rewind(tracefp);
for (ix=0; ix<nx; ix++) {
efread(pfft[ix], FSIZE, nt, tracefp);
for (it=nt; it<ntfft; it++)
pfft[ix][it] = 0.0;
}
for (ix=nx; ix<nxfft; ix++)
for (it=0; it<ntfft; it++)
pfft[ix][it] = 0.0;
/* Fourier transform t to w */
pfa2rc(1,1,ntfft,nx,pfft[0],cpfft[0]);
/* do linear moveout bias via phase shift */
for (ix=0; ix<nx; ix++) {
for (iw=0,w=0.0; iw<nw; iw++,w+=dw) {
phase = -ix*dx*w*bias;
cshift = cmplx(cos(phase),sin(phase));
cpfft[ix][iw] = cmul(cpfft[ix][iw],cshift);
}
}
/* Fourier transform x to k */
pfa2cc(-1,2,nw,nxfft,cpfft[0]);
/* loop over wavenumbers */
for (ik=0; ik<nk; ik++) {
/* determine wavenumber */
k = (ik<=nk/2) ? ik*dk : (ik-nk)*dk;
/* loop over frequencies */
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
/* determine biased slope */
slope = k/w+bias;
/* linearly interpolate to find amplitude */
intlin(nslopes,slopes,amps,amps[0],amps[nslopes-1],
1,&slope,&);
/* include fft scaling */
amp *= sfft;
/* filter real and imaginary parts */
cpfft[ik][iw].r *= amp;
cpfft[ik][iw].i *= amp;
}
}
/* Fourier transform k to x */
pfa2cc(1,2,nw,nxfft,cpfft[0]);
/* undo linear moveout bias via phase shift */
for (ix=0; ix<nx; ix++) {
for (iw=0,w=0.0; iw<nw; iw++,w+=dw) {
phase = ix*dx*w*bias;
cshift = cmplx(cos(phase),sin(phase));
cpfft[ix][iw] = cmul(cpfft[ix][iw],cshift);
}
}
/* Fourier transform w to t */
pfa2cr(-1,1,ntfft,nx,cpfft[0],pfft[0]);
/* copy filtered data from FFT array to output */
rewind(tracefp);
for (ix=0; ix<nx; ix++)
efwrite(pfft[ix], FSIZE, nt, tracefp);
/* free workspace */
free2complex(cpfft);
free2float(pfft);
}
main(int argc, char **argv)
{
int nt,nx; /* numbers of samples */
float dt,dx; /* sampling intervals */
float d1,d2; /* output intervals in F, K */
float f1,f2; /* output first samples in F, K */
int it,ix; /* sample indices */
int ntfft,nxfft; /* dimensions after padding for FFT */
int nF,nK; /* transform (output) dimensions */
int iF,iK; /* transform sample indices */
register complex **ct; /* complex FFT workspace */
register float **rt; /* float FFT workspace */
FILE *tracefp; /* temp file to hold traces */
/* Hook up getpar to handle the parameters */
initargs(argc,argv);
askdoc(1);
/* Get info from first trace */
if (!gettr(&intrace)) err("can't get first trace");
nt = intrace.ns;
/* dt is used only to set output header value d1 */
if (!getparfloat("dt", &dt)) {
if (intrace.dt) { /* is dt field set? */
dt = (float) intrace.dt / 1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (intrace.d2) { /* is d2 field set? */
dx = intrace.d2;
} else {
dx = 1.0;
warn("tr.d2 not set, assuming d2=1.0");
}
}
/* Store traces in tmpfile while getting a count */
/*tracefp = etmpfile();*/
tracefp = etempfile(NULL);
nx = 0;
do {
++nx;
efwrite(intrace.data, FSIZE, nt, tracefp);
} while (gettr(&intrace));
/* Determine lengths for prime-factor FFTs */
ntfft = npfar(nt);
nxfft = npfa(nx);
if (ntfft >= MIN(SU_NFLTS, PFA_MAX)) err("Padded nt=%d--too big",ntfft);
if (nxfft >= MIN(SU_NFLTS, PFA_MAX)) err("Padded nx=%d--too big",nxfft);
/* Determine output header values */
d1 = 1.0/(ntfft*dt);
d2 = 1.0/(nxfft*dx);
f1 = 0.0;
f2 = -1.0/(2*dx);
/* Determine complex transform sizes */
nF = ntfft/2+1;
nK = nxfft;
/* Allocate space */
ct = alloc2complex(nF, nK);
rt = alloc2float(ntfft, nxfft);
/* Load traces into fft arrays and close tmpfile */
rewind(tracefp);
for (ix=0; ix<nx; ++ix) {
efread(rt[ix], FSIZE, nt, tracefp);
/* if ix odd, negate to center transform of dimension 2 */
if (ISODD(ix))
for (it=0; it<nt; ++it) rt[ix][it] = -rt[ix][it];
/* pad dimension 1 with zeros */
for (it=nt; it<ntfft; ++it) rt[ix][it] = 0.0;
}
efclose(tracefp);
/* Pad dimension 2 with zeros */
for (ix=nx; ix<nxfft; ++ix)
for (it=0; it<ntfft; ++it) rt[ix][it] = 0.0;
/* Fourier transform dimension 1 */
pfa2rc(1,1,ntfft,nx,rt[0],ct[0]);
/* Fourier transform dimension 2 */
pfa2cc(-1,2,nF,nxfft,ct[0]);
/* Compute and output amplitude spectrum */
for (iK=0; iK<nK; ++iK) {
for (iF=0; iF<nF; ++iF) outtrace.data[iF] = fcabs(ct[iK][iF]);
/* set header values */
outtrace.tracl = iK + 1;
outtrace.ns = nF;
outtrace.dt = 0; /* d1 is now the relevant step size */
outtrace.trid = KOMEGA;
outtrace.d1 = d1;
outtrace.f1 = f1;
outtrace.d2 = d2;
outtrace.f2 = f2;
puttr(&outtrace);
}
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx,nxshot; /* number of midpoints */
int nxshot_orig; /* first value of nxshot */
int iz,iw,ix,it,ik; /* loop counters */
int igx; /* integerized gx value */
int ntfft,nxfft; /* fft size */
int nw,truenw,nk; /* number of wave number, frequency */
int dip=45; /* dip angle */
float sx,gx; /* x source and geophone location */
float gxmin=0.0,gxmax=0.0;/* x source and geophone location */
float min_sx_gx; /* min(sx,gx) */
float oldgx; /* old gx position */
float oldgxmin; /* old gx position */
float oldgxmax; /* old gx position */
float oldsx=0.0; /* old sx position */
int oldigx=0; /* old value of integerized gx value */
int oldisx=0; /* old value of integerized sx value */
int isx=0,nxo; /* index for source and geophone */
int ix1,ix2,ix3,ixshot; /* dummy index */
int lpad,rpad;/* padding on both sides of the migrated section */
float *wl=NULL,*wtmp=NULL;
float fmax;
float f1,f2,f3,f4;
int nf1,nf2,nf3,nf4;
int ntw;
float dt=0.004,dz; /* time sampling interval */
float dw,dk; /* wave number,frequency sampling interval*/
float fw,fk; /* first wave number and frequency */
float w,k; /* wave number and frequency */
float dx; /* spatial sampling interval */
float **p=NULL; /* input, output data */
float **cresult=NULL; /* input, output data */
float v1,vmin; /* average, min velocity */
double kz1,kz2;
double phase1;
float **v=NULL,**vp=NULL;
complex cshift1,cshift2;
complex *wlsp=NULL;
complex **cp=NULL;
complex **cp1=NULL;
complex **cq=NULL;
complex **cq1=NULL; /* complex input,output */
char *vfile=""; /* name of file containing velocities */
FILE *vfp=NULL;
int verbose; /* verbose flag */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get required parameters */
MUSTGETPARINT("nz",&nz);
MUSTGETPARINT("nxo",&nxo);
MUSTGETPARINT("nxshot",&nxshot);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile", &vfile);
/* get optional parameters */
if (!getparfloat("fmax",&fmax)) fmax = 25.0;
if (!getparfloat("f1",&f1)) f1 = 10.0;
if (!getparfloat("f2",&f2)) f2 = 20.0;
if (!getparfloat("f3",&f3)) f3 = 40.0;
if (!getparfloat("f4",&f4)) f4 = 50.0;
if (!getparint("lpad",&lpad)) lpad=9999;
if (!getparint("rpad",&rpad)) rpad=9999;
if (!getparint("dip",&dip)) dip=45;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocating space */
cresult = alloc2float(nz,nxo);
vp=alloc2float(nxo,nz);
/* load velocity file */
vfp=efopen(vfile,"r");
efread(vp[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/* zero out cresult array */
memset((void *) cresult[0],0, nxo*nz*FSIZE);
/* save value of nxshot */
nxshot_orig=nxshot;
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
get_sx_gx(&sx,&gx);
min_sx_gx = MIN(sx,gx);
sx = sx - min_sx_gx;
gx = gx - min_sx_gx;
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
warn("tr.d2 not set, assuming d2=1.0");
}
}
checkpars();
do { /* begin loop over shots */
/* determine frequency sampling interval */
ntfft = npfar(nt);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
/* compute the index of the frequency to be migrated */
fw=2.0*PI*f1;
nf1=fw/dw+0.5;
fw=2.0*PI*f2;
nf2=fw/dw+0.5;
fw=2.0*PI*f3;
nf3=fw/dw+0.5;
fw=2.0*PI*f4;
nf4=fw/dw+0.5;
/* the number of frequency to migrated */
truenw=nf4-nf1+1;
fw=0.0+nf1*dw;
if (verbose)
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/* generate the Ricker wavelet */
wtmp=ricker(fmax,dt,&ntw);
/* zero out wl[] array */
memset((void *) wl, 0, ntfft*FSIZE);
/* CHANGE BY CHRIS STOLK, Dec. 11, 2005 */
/* The next two lines are the old code, */
/* it is erroneous because the peak of */
/* the wavelet occurs at positive time */
/* instead of time zero. */
/*
for(it=0;it<ntw;it++)
wl[it]=wtmp[it];
*/
/* New code: we put in the wavelet in a centered fashion */
for(it=0;it<ntw;it++)
wl[(it-ntw/2+ntfft) % ntfft]=wtmp[it];
/* End of new code */
free1float(wtmp);
pfarc(-1,ntfft,wl,wlsp);
/* allocate space */
p = alloc2float(ntfft,nxo);
cq = alloc2complex(nw,nxo);
/* zero out p[][] array */
memset((void *) p[0], 0, ntfft*nxo*FSIZE);
/* initialize a number of items before looping over traces */
nx = 0;
igx=0;
oldsx=sx;
oldgx=gx;
oldgxmax=gxmax;
oldgxmin=gxmin;
do { /* begin looping over traces within a shot gather */
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
/* get sx and gx */
get_sx_gx(&sx,&gx);
sx = (sx - min_sx_gx);
gx = (gx - min_sx_gx);
igx = gx/dx;
if (igx==oldigx)
warn("repeated igx!!! check dx or scalco value!!!");
oldigx = igx;
if(gxmin>gx)gxmin=gx;
if(gxmax<gx)gxmax=gx;
if(verbose)
warn(" inside loop: min_sx_gx %f isx %d igx %d gx %f sx %f",min_sx_gx,isx,igx,gx,sx);
/* sx, gx must increase monotonically */
if (!(oldsx <= sx) )
err("sx field must be monotonically increasing!");
if (!(oldgx <= gx) )
err("gx field must be monotonically increasing!");
++nx;
} while(gettr(&tr) && sx==oldsx);
isx=oldsx/dx;
if (isx==oldisx)
warn("repeated isx!!! check dx or scalco value!!!");
oldisx=isx;
ixshot=isx;
if(verbose) {
warn("sx %f, gx %f , gxmin %f gxmax %f nx %d",sx,gx,gxmin,gxmax, nx);
warn("isx %d igx %d ixshot %d" ,isx,igx,ixshot);
}
/* transform the shot gather from time to frequency domain */
pfa2rc(1,1,ntfft,nxo,p[0],cq[0]);
/* compute the most left and right index for the migrated */
/* section */
ix1=oldsx/dx;
ix2=gxmin/dx;
ix3=gxmax/dx;
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
ix2-=lpad;
ix3+=rpad;
if(ix2<0)ix2=0;
if(ix3>nxo-1)ix3=nxo-1;
/* the total traces to be migrated */
nx=ix3-ix2+1;
nw=truenw;
/* determine wavenumber sampling (for complex to complex FFT) */
nxfft = npfa(nx);
nk = nxfft;
dk = 2.0*PI/(nxfft*dx);
fk = -PI/dx;
/* allocate space for velocity profile within the aperature */
v=alloc2float(nx,nz);
for(iz=0;iz<nz;iz++)
for(ix=0;ix<nx;ix++)
v[iz][ix]=vp[iz][ix+ix2];
/* allocate space */
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
/* transpose the frequency domain data from */
/* data[ix][iw] to data[iw][ix] and apply a */
/* Hamming at the same time */
for (ix=0; ix<nx;++ix) {
for (iw=0; iw<nw; iw++){
float tmpp=0.0,tmppp=0.0;
if(iw>=(nf1-nf1)&&iw<=(nf2-nf1)){
tmpp=PI/(nf2-nf1);
tmppp=tmpp*(iw-nf1)-PI;
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
if(iw>=(nf3-nf1)&&iw<=(nf4-nf1)) {
tmpp=PI/(nf4-nf3);
tmppp=tmpp*(iw-nf3);
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
cp[iw][ix]=cq[ix+ix2][iw+nf1];
}
}
cp1[iw][ix]=cmplx(0.0,0.0);
}
}
for(iw=0;iw<nw;iw++) {
cp1[iw][ixshot-ix2]=wlsp[iw+nf1];
}
if(verbose) {
warn("ixshot %d ix %d ix1 %d ix2 %d ix3 %d",ixshot,ix,ix1,ix2,ix3);
warn("oldsx %f ",oldsx);
}
free2float(p);
free2complex(cq);
free1float(wl);
free1complex(wlsp);
cq=alloc2complex(nxfft,nw);
cq1=alloc2complex(nxfft,nw);
/* loops over depth */
for(iz=0;iz<nz;++iz){
/* the imaging condition */
for(ix=0;ix<nx;ix++){
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
complex tmp;
float ratio=10.0;
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
else
tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/* get the minimum velocity */
vmin=v[iz][0];
for(ix=0;ix<nx;ix++){
if(v[iz][ix]<vmin)vmin=v[iz][ix];
}
/* compute time-invariant wavefield */
for (ik=0;ik<nx;++ik) {
for (iw=0; iw<nw; ++iw) {
cq[iw][ik] = ik%2 ? cneg(cp[iw][ik]) : cp[iw][ik];
cq1[iw][ik] = ik%2 ? cneg(cp1[iw][ik]) : cp1[iw][ik];
}
}
/* zero out parts of the cq[][] and cq1[][] arrays */
for (ik=nx; ik<nk; ++ik) {
for (iw=0; iw<nw; ++iw) {
cq[iw][ik] = cmplx(0.0,0.0);
cq1[iw][ik] = cmplx(0.0,0.0);
}
}
/* FFT to W-K domain */
pfa2cc(-1,1,nk,nw,cq[0]);
pfa2cc(-1,1,nk,nw,cq1[0]);
v1=vmin;
/* apply phase shift */
for(ik=0,k=fk;ik<nk;++ik,k+=dk) {
for(iw=0,w=fw;iw<nw;++iw,w+=dw){
if(w==0.0)w=1.0e-10/dt;
kz1=1.0-pow(v1*k/w,2.0);
if(kz1>0.15){
phase1 = -w*sqrt(kz1)*dz/v1;
cshift1 = cmplx(cos(phase1), sin(phase1));
cq[iw][ik] = cmul(cq[iw][ik],cshift1);
cq1[iw][ik] = cmul(cq1[iw][ik],cshift1);
} else {
cq[iw][ik] = cq1[iw][ik] = cmplx(0.0,0.0);
}
}
}
/* fourier transform */
pfa2cc(1,1,nk,nw,cq[0]);
pfa2cc(1,1,nk,nw,cq1[0]);
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
float a=0.015,g=1.0;
int I=10;
if(ix<=I)
g=exp(-a*(I-ix)*(I-ix));
if(ix>=nx-I)
g=exp(-a*(-nx+I+ix)*(-nx+I+ix));
cq[iw][ix] = crmul( cq[iw][ix],1.0/nxfft);
cq[iw][ix] =ix%2 ? cneg(cq[iw][ix]) : cq[iw][ix];
kz2=(1.0/v1-1.0/v[iz][ix])*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cq[iw][ix],cshift2);
cq1[iw][ix] = crmul( cq1[iw][ix],1.0/nxfft);
cq1[iw][ix] =ix%2 ? cneg(cq1[iw][ix]) : cq1[iw][ix];
cp1[iw][ix]=cmul(cq1[iw][ix],cshift2);
}
}
/* apply fdmig algorithm */
fdmig( cp, nx, nw,v[iz],fw,dw,dz,dx,dt,v1,dip);
fdmig( cp1,nx, nw,v[iz],fw,dw,dz,dx,dt,v1,dip);
}
free2complex(cp);
free2complex(cp1);
free2complex(cq);
free2complex(cq1);
free2float(v);
--nxshot;
} while (nxshot);
/* restore header fields and write output */
for(ix=0; ix<nxo; ix++) {
tr.ns = nz;
tr.d1 = dz;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
return(CWP_Exit());
}
void pfa2rc (int isign, int idim, int n1, int n2, float rz[], complex cz[])
{
int i1,i2,j,k,it,jt,kt,n,nt,itmul,itinc;
float *z,*temp,tempr,tempi,sumr,sumi,difr,difi;
double wr,wi,wpr,wpi,wtemp,theta;
/* copy input to output while scaling */
z = (float*)cz;
for (i2=0,j=0; i2<n2; i2++)
for (i1=0; i1<n1; i1++,j++)
z[j] = 0.5*rz[j];
/* if transforming dimension 1 */
if (idim==1) {
/* transform as complex elements */
pfa2cc(isign,1,n1/2,n2,cz);
/* shift rows to make room for nyquist */
z = (float*)cz;
for (i2=n2-1; i2>0; i2--) {
jt = i2*n1+n1-1;
kt = jt+i2*2;
for (i1=n1-1,j=jt,k=kt; i1>=0; i1--,j--,k--)
z[k] = z[j];
}
/* set transform length, number of transforms and strides */
n = n1;
nt = n2;
itmul = 1;
itinc = n1+2;
/* else, if transforming dimension 2 */
} else {
/* merge even and odd vectors */
temp = z+n1*n2;
for (i2=0; i2<n2; i2+=2) {
for (i1=0,j=i2*n1; i1<n1; i1++,j++)
temp[i1] = z[j];
for (i1=0,j=(i2+1)*n1,k=i2*n1+1; i1<n1; i1++,j++,k+=2)
z[k] = z[j];
for (i1=0,j=i2*n1; i1<n1; i1++,j+=2)
z[j] = temp[i1];
}
/* transform as complex elements */
pfa2cc(isign,2,n1,n2/2,cz);
/* set transform length, number of transforms and strides */
n = n2;
nt = n1;
itmul = n1;
itinc = 2;
}
/* fix dc and nyquist for each transform */
for (it=0,j=0,k=n*itmul; it<nt; it++,j+=itinc,k+=itinc) {
z[k] = 2.0*(z[j]-z[j+1]);
z[j] = 2.0*(z[j]+z[j+1]);
z[k+1] = 0.0;
z[j+1] = 0.0;
}
/* initialize cosine-sine recurrence */
theta = 2.0*PI/(double)n;
if (isign<0) theta = -theta;
wtemp = sin(0.5*theta);
wpr = -2.0*wtemp*wtemp;
wpi = sin(theta);
wr = 1.0+wpr;
wi = wpi;
/* twiddle transforms simultaneously */
for (j=2,k=n-2; j<=n/2; j+=2,k-=2) {
jt = j*itmul;
kt = k*itmul;
for (it=0; it<nt; it++) {
sumr = z[jt]+z[kt];
sumi = z[jt+1]+z[kt+1];
difr = z[jt]-z[kt];
difi = z[jt+1]-z[kt+1];
tempr = wi*difr+wr*sumi;
tempi = wi*sumi-wr*difr;
z[jt] = sumr+tempr;
z[jt+1] = difi+tempi;
z[kt] = sumr-tempr;
z[kt+1] = tempi-difi;
jt += itinc;
kt += itinc;
}
wtemp = wr;
wr += wr*wpr-wi*wpi;
wi += wi*wpr+wtemp*wpi;
}
}
