main()
{
int n1,n2,j;
float scale,sumz,sume;
for (n1=1,n2=npfa(n1+1); n2<NMAX; n1=n2,n2=npfa(n1+1)) {
for (j=0; j<n1*n2; j++)
c[j] = z[j] = cmplx(franuni(),franuni());
pfamcc(1,n1,n2,1,n1,z);
pfamcc(1,n2,n1,n1,1,z);
pfamcc(-1,n1,n2,1,n1,z);
pfamcc(-1,n2,n1,n1,1,z);
scale = 1.0/(float)(n1*n2);
for (j=0; j<n1*n2; j++)
z[j] = crmul(z[j],scale);
for (j=0,sumz=sume=0.0; j<n1*n2; j++) {
sumz += fcabs(z[j]);
sume += fcabs(csub(z[j],c[j]));
}
printf("n1 = %d n2 = %d sume/sumz = %0.10f\n",
n1,n2,sume/sumz);
if (sume/sumz>1.0e-6) printf("!!! warning !!!\n");
}
}
static void evolve(dcomplex u0[NZ][NY][NX], dcomplex u1[NZ][NY][NX],
int t, int indexmap[NZ][NY][NX], int d[3]) {
/*--------------------------------------------------------------------
c-------------------------------------------------------------------*/
/*--------------------------------------------------------------------
c evolve u0 -> u1 (t time steps) in fourier space
c-------------------------------------------------------------------*/
int i, j, k;
#pragma omp for
for (k = 0; k < d[2]; k++) {
for (j = 0; j < d[1]; j++) {
for (i = 0; i < d[0]; i++) {
crmul(u1[k][j][i], u0[k][j][i], ex[t*indexmap[k][j][i]]);
}
}
}
}
void bandpass(float *data, int nt, int nfft, int nfreq,
float *filterj, float *ftracej)
{
float *rt;
complex *ct;
int i;
rt = ealloc1float(nfft);
ct = ealloc1complex(nfreq);
/* Load trace into rt (zero-padded) */
memcpy((char*) rt, (char*) data, nt*FSIZE);
bzero(rt + nt, (nfft-nt)*FSIZE);
/* FFT, filter, inverse FFT */
pfarc(1, nfft, rt, ct);
for (i = 0; i < nfreq; ++i) ct[i] = crmul(ct[i], filterj[i]);
pfacr(-1, nfft, ct, rt);
/* Load traces back in, recall filter had nfft factor */
for (i = 0; i < nt; ++i) ftracej[i] = rt[i]; /* ftracej = rt ?? */
free(rt);
free(ct);
}
int
main(int argc, char **argv)
{
float phase; /* phase shift = phasefac*PI */
float power; /* phase shift = phasefac*PI */
register float *rt; /* real trace */
register complex *ct; /* complex transformed trace */
complex *filt; /* complex power */
int nt; /* number of points on input trace */
size_t ntsize; /* nt in bytes */
int ncdp; /* number of cdps specified */
int icdp; /* index into cdp array */
long oldoffset; /* offset of previous trace */
long oldcdp; /* cdp of previous trace */
int newsloth; /* if non-zero, new sloth function was computed */
int jcdp; /* index into cdp array */
float dt; /* sample spacing (secs) on input trace */
float tn; /* sample spacing (secs) on input trace */
float omega; /* circular frequency */
float domega; /* circular frequency spacing (from dt) */
int nfft; /* number of points in nfft */
int ntnmo; /* number of tnmos specified */
float *cdp; /* array[ncdp] of cdps */
float *vnmo; /* array[nvnmo] of vnmos */
float *ovvt; /* array[nvnmo] of vnmos */
int nvnmo; /* number of tnmos specified */
float *fnmo; /* array[ntnmo] of tnmos */
float **ovv; /* array[nf] of fnmos */
float doffs; /* offset */
float acdp; /* temporary used to sort cdp array */
float *aovv; /* temporary used to sort ovv array */
int invert; /* if non-zero, do invers DLMO */
int cm; /* if non-zero, the offset in cm */
int nf; /* number of frequencies (incl Nyq) */
int it; /* number of frequencies (incl Nyq) */
float onfft; /* 1 / nfft */
float v; /* velocity */
size_t nzeros; /* number of padded zeroes in bytes */
/* Initialize */
initargs(argc, argv);
requestdoc(1);
/* Set parameters */
power=0.0;
/* Get info from first trace*/
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
if (!getparfloat("dt", &dt)) dt = ((double) tr.dt)/1000000.0;
if (!dt) err("dt field is zero and not getparred");
ntsize = nt * FSIZE;
if (!getparint("invert",&invert)) invert = 0;
if (!getparint("cm",&cm)) cm = 0;
/* Set up for fft */
nfft = npfaro(nt, LOOKFAC * nt);
if (nfft >= SU_NFLTS || nfft >= PFA_MAX)
err("Padded nt=%d -- too big", nfft);
nf = nfft/2 + 1;
onfft = 1.0 / nfft;
nzeros = (nfft - nt) * FSIZE;
domega = TWOPI * onfft / dt;
/* get velocity functions, linearly interpolated in frequency */
ncdp = countparval("cdp");
if (ncdp>0) {
if (countparname("vnmo")!=ncdp)
err("a vnmo array must be specified for each cdp");
if (countparname("fnmo")!=ncdp)
err("a tnmo array must be specified for each cdp");
} else {
ncdp = 1;
if (countparname("vnmo")>1)
err("only one (or no) vnmo array must be specified");
if (countparname("fnmo")>1)
err("only one (or no) tnmo array must be specified");
}
cdp = ealloc1float(ncdp);
if (!getparfloat("cdp",cdp)) cdp[0] = tr.cdp;
ovv = ealloc2float(nf,ncdp);
for (icdp=0; icdp<ncdp; ++icdp) {
nvnmo = countnparval(icdp+1,"vnmo");
ntnmo = countnparval(icdp+1,"fnmo");
if (nvnmo!=ntnmo && !(ncdp==1 && nvnmo==1 && ntnmo==0))
err("number of vnmo and tnmo values must be equal");
if (nvnmo==0) nvnmo = 1;
if (ntnmo==0) ntnmo = nvnmo;
/* equal numbers of parameters vnmo, fnmo */
vnmo = ealloc1float(nvnmo);
fnmo = ealloc1float(nvnmo);
if (!getnparfloat(icdp+1,"vnmo",vnmo)) vnmo[0] = 400.0;
if (!getnparfloat(icdp+1,"fnmo",fnmo)) fnmo[0] = 0.0;
for (it=0; it<ntnmo; ++it)
fnmo[it]*=TWOPI;
for (it=1; it<ntnmo; ++it)
if (fnmo[it]<=fnmo[it-1])
err("tnmo values must increase monotonically");
for (it=0,tn=0; it<nf; ++it,tn+=domega) {
intlin(ntnmo,fnmo,vnmo,vnmo[0],vnmo[nvnmo-1],1,&tn,&v);
ovv[icdp][it] = 1.0/(v);
}
free1float(vnmo);
free1float(fnmo);
}
/* sort (by insertion) sloth and anis functions by increasing cdp */
for (jcdp=1; jcdp<ncdp; ++jcdp) {
acdp = cdp[jcdp];
aovv = ovv[jcdp];
for (icdp=jcdp-1; icdp>=0 && cdp[icdp]>acdp; --icdp) {
cdp[icdp+1] = cdp[icdp];
ovv[icdp+1] = ovv[icdp];
}
cdp[icdp+1] = acdp;
ovv[icdp+1] = aovv;
}
/* allocate workspace */
ovvt = ealloc1float(nf);
/* interpolate sloth and anis function for first trace */
interpovv(nf,ncdp,cdp,ovv,(float)tr.cdp,ovvt);
/* set old cdp and old offset for first trace */
oldcdp = tr.cdp;
oldoffset = tr.offset-1;
/* Allocate fft arrays */
rt = ealloc1float(nfft);
ct = ealloc1complex(nf);
filt = ealloc1complex(nf);
/* Loop over traces */
do {
/* if necessary, compute new sloth and anis function */
if (tr.cdp!=oldcdp && ncdp>1) {
interpovv(nt,ncdp,cdp,ovv,(float)tr.cdp,
ovvt);
newsloth = 1;
} else {
newsloth = 0;
}
/* if sloth and anis function or offset has changed */
if (newsloth || tr.offset!=oldoffset) {
doffs = (fabs)((float)(tr.offset));
if (cm==1) doffs/=100;
/* Load trace into rt (zero-padded) */
memcpy( (void *) rt, (const void *) tr.data, ntsize);
memset((void *) (rt + nt), (int) '\0', nzeros);
/* FFT */
pfarc(1, nfft, rt, ct);
/* Apply filter */
{ register int i;
for (i = 0; i < nf; ++i){
omega = i * domega;
if (power < 0 && i == 0) omega = FLT_MAX;
if (invert==0)
phase = -1.0*omega*ovvt[i]*doffs;
else
phase = 1.0*omega*ovvt[i]*doffs;
/* filt[i] = cmplx(cos(phase),sin(phase)); */
filt[i] = cwp_cexp(crmul(I,phase));
filt[i] = crmul(filt[i], onfft);
ct[i] = cmul(ct[i], filt[i]);
}
}
}
/* Invert */
pfacr(-1, nfft, ct, rt);
/* Load traces back in, recall filter had nfft factor */
{ register int i;
for (i = 0; i < nt; ++i) tr.data[i] = rt[i];
}
puttr(&tr);
} while (gettr(&tr));
return EXIT_SUCCESS;
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx; /* number of horizontal samples */
int nxshot; /* number of shots to be migrated */
/*int nxshot_orig;*/ /* first value of nxshot */
int iz,iw,ix,it; /* loop counters */
int igx; /* integerized gx value */
int ntfft; /* fft size */
int nw,truenw; /* number of wave numbers */
int dip=79; /* 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 isx=0,nxo; /* index for source and geophone */
int oldisx=0; /* old value of source index */
int oldigx=0; /* old value of integerized gx value */
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 and depth sampling interval */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
float w; /* frequency */
float dx; /* spatial sampling interval */
float **p=NULL; /* input data */
float **cresult=NULL; /* output result */
float v1; /* average velocity */
double kz2;
float **v=NULL,**vp=NULL;/* pointers for the velocity profile */
complex cshift2;
complex *wlsp=NULL; /* complex input,output */
complex **cp=NULL; /* ... */
complex **cp1=NULL; /* ... */
complex **cq=NULL; /* ... */
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);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile",&vfile);
MUSTGETPARINT("nxshot",&nxshot);
/* 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=79;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocating space */
cresult = alloc2float(nz,nxo);
vp = alloc2float(nxo,nz);
/* load velicoty 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;
if(verbose) 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;
if(verbose) warn("tr.d2 not set, assuming d2=1.0");
}
}
checkpars();
oldisx=0;
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 frequencies 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);
/* fourier transform wl array */
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;
oldigx=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 = NINT(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=NINT(oldsx/dx);
ixshot=isx;
if (isx==oldisx)
warn("repeated isx!!! check dx or scalco value!!!");
oldisx=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=NINT(oldsx/dx);
ix2=NINT(gxmin/dx);
ix3=NINT(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;
/* 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);
/* 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 average velocity */
v1=0.0;
for(ix=0;ix<nx;++ix)
v1+=v[iz][ix]/nx;
/* compute time-invariant wavefield */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw) {
kz2=-(1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
/* wave-propagation using finite-difference method */
fdmig(cp, nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
fdmig(cp1,nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
/* apply thin lens term here */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
kz2=-(1.0/v[iz][ix]-1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
}
free2complex(cp);
free2complex(cp1);
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 fdmig( complex **cp, int nx, int nw, float *v,float fw,float
dw,float dz,float dx,float dt,int dip)
{
int iw,ix,step=1;
float *s1,*s2,w,coefa[5],coefb[5],v1,vn,trick=0.1;
complex cp2,cp3,cpnm1,cpnm2;
complex a1,a2,b1,b2;
complex endl,endr;
complex *data,*d,*a,*b,*c;
s1=alloc1float(nx);
s2=alloc1float(nx);
data=alloc1complex(nx);
d=alloc1complex(nx);
a=alloc1complex(nx);
b=alloc1complex(nx);
c=alloc1complex(nx);
if(dip==45){
coefa[0]=0.5;coefb[0]=0.25;
step=1;
}
if(dip==65){
coefa[0]=0.478242060;coefb[0]=0.376369527;
step=1;
}
if(dip==79){
coefa[0]=coefb[0]=0.4575;
step=1;
}
if(dip==80){
coefa[1]=0.040315157;coefb[1]=0.873981642;
coefa[0]=0.457289566;coefb[0]=0.222691983;
step=2;
}
if(dip==87){
coefa[2]=0.00421042;coefb[2]=0.972926132;
coefa[1]=0.081312882;coefb[1]=0.744418059;
coefa[0]=0.414236605;coefb[0]=0.150843924;
step=3;
}
if(dip==89){
coefa[3]=0.000523275;coefb[3]=0.994065088;
coefa[2]=0.014853510;coefb[2]=0.919432661;
coefa[1]=0.117592008;coefb[1]=0.614520676;
coefa[0]=0.367013245;coefb[0]=0.105756624;
step=4;
}
if(dip==90){
coefa[4]=0.000153427;coefb[4]=0.997370236;
coefa[3]=0.004172967;coefb[3]=0.964827992;
coefa[2]=0.033860918;coefb[2]=0.824918565;
coefa[1]=0.143798076;coefb[1]=0.483340757;
coefa[0]=0.318013812;coefb[0]=0.073588213;
step=5;
}
v1=v[0];vn=v[nx-1];
do {
step--;
for(iw=0,w=fw;iw<nw;iw++,w+=dw){
if(fabs(w)<=1.0e-10)w=1.0e-10/dt;
for(ix=0;ix<nx;ix++){
s1[ix]=(v[ix]*v[ix])*coefb[step]/(dx*dx*w*w)+trick;
s2[ix]=-v[ix]*dz*coefa[step]/(w*dx*dx)*0.5;
}
for(ix=0;ix<nx;ix++){
data[ix]=cp[iw][ix];
}
cp2=data[1];
cp3=data[2];
cpnm1=data[nx-2];
cpnm2=data[nx-3];
a1=crmul(cmul(cp2,conjg(cp3)),2.0);
b1=cadd(cmul(cp2,conjg(cp2)),cmul(cp3,conjg(cp3)));
if(b1.r==0.0 && b1.i==0.0)
a1=cwp_cexp(cmplx(0.0,-w*dx*0.5/v1));
else
a1=cdiv(a1,b1);
if(a1.i>0.0)a1=cwp_cexp(cmplx(0.0,-w*dx*0.5/v1));
a2=crmul(cmul(cpnm1,conjg(cpnm2)),2.0);
b2=cadd(cmul(cpnm1,conjg(cpnm1)),cmul(cpnm2,conjg(cpnm2)));
if(b2.r==0.0 && b2.i==0.0)
a2=cwp_cexp(cmplx(0.0,-w*dx*0.5/vn));
else
a2=cdiv(a2,b2);
if(a2.i>0.0)a2=cwp_cexp(cmplx(0.0,-w*dx*0.5/vn));
for(ix=0;ix<nx;ix++){
a[ix]=cmplx(s1[ix],s2[ix]);
b[ix]=cmplx(1.0-2.0*s1[ix],-2.0*s2[ix]);
}
for(ix=1;ix<nx-1;ix++){
d[ix]=cadd(cadd(cmul(data[ix+1],a[ix+1]),cmul(data[ix-1],a[ix-1])),
cmul(data[ix],b[ix]));
}
d[0]=cadd(cmul(cadd(b[0],cmul(a[0],a1)),data[0]),cmul(data[1],a[1]));
d[nx-1]=cadd(cmul(cadd(b[nx-1],cmul(a[nx-1],a2)),data[nx-1]),
cmul(data[nx-2],a[nx-2]));
for(ix=0;ix<nx;ix++){
data[ix]=cmplx(s1[ix],-s2[ix]);
b[ix]=cmplx(1.0-2.0*s1[ix],2.0*s2[ix]);
}
endl=cadd(b[0],cmul(data[0],a1));
endr=cadd(b[nx-1],cmul(data[nx-1],a2));
for(ix=1;ix<nx-1;ix++){
a[ix]=data[ix+1];
c[ix]=data[ix-1];
}
a[0]=data[1];
c[nx-1]=data[nx-2];
retris(data,a,c,b,endl,endr,nx,d);
for(ix=0;ix<nx;ix++){
cp[iw][ix]=data[ix];
}
}
}while(step);
free1complex(data);
free1complex(d);
free1complex(b);
free1complex(c);
free1complex(a);
free1float(s1);
free1float(s2);
return;
}
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,shotgathers, the folds in a shot
gather */
int flag=1; /*flag to use ft or meter as the unit*/
int dip=65; /*maximum dip angle to migrate*/
int iz,iw,ix,it,oldsx; /* loop counters*/
int ntfft; /* fft size*/
int nw; /* number of wave numbers */
int mytid,tids[NNTASKS],msgtype,rc,i;/*variable for PVM function*/
int nw1,task;
int lpad=9999,rpad=9999; /*zero-traces padded on left and right sides*/
float f1,f2,f3,f4; /*frequencies to build the Hamming window*/
int nf1,nf2,nf3,nf4; /*the index for above frequencies*/
int NTASKS=0; /*number of slave tasks to start*/
char cpu_name[NNTASKS][80]; /*strings to store the computers' name*/
int flag_cpu=0; /*flag to control if using NTASKS variable*/
float sx,gxmin,gxmax; /*location of geophone and receivers*/
int isx,nxo,ifx=0; /*index for geophone and receivers*/
int ix1,ix2,ix3,il,ir; /*dummy index*/
float *wl,*wtmp; /*pointers for the souce function*/
float Fmax=25; /*peak frequency to make the Ricker wavelet*/
int ntw,truenw; /*number of frequencies to be migrated*/
float dt=0.004,dz; /*time, depth sampling interval*/
float ft; /*first time sample*/
float dw; /*frequency sampling interval*/
float fw; /*first frequency*/
float dx; /*spatial sampling interval*/
float **p,**cresult,**result_tmp; /* input, output data*/
float **v; /*double pointer direct to velocity structure*/
complex *wlsp,**cp,**cq,**cq1; /*pointers for internal usage*/
char *vfile=""; /* name of file containing velocities */
char *cpufile=""; /* name of file containing CPU name */
FILE *vfp,*cpu_fp;
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get optional parameters */
if (!getparfloat("ft",&ft)) ft = 0.0;
if (!getparint("nz",&nz)) err("nz must be specified");
if (!getparfloat("dz",&dz)) err("dz must be specified");
if (!getparstring("vfile", &vfile)) err("vfile must be specified");
if (!getparint("nxo",&nxo)) err("nxo must be specified");
if (!getparint("nxshot",&nxshot)) err("nshot must be specified");
if (!getparfloat("Fmax",&Fmax)) err("Fmax must be specified");
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("flag",&flag)) flag=1;
if (!getparint("dip",&dip)) dip=65;
if (getparstring("cpufile", &cpufile)){
cpu_fp=fopen(cpufile,"r");
NTASKS=0;
while(!feof(cpu_fp)){
fscanf(cpu_fp,"%s",cpu_name[NTASKS]);
NTASKS++;
}
NTASKS-=1;
flag_cpu=1;
}
else /*if cpufile not specified, the use NTASKS*/
if (!getparint("NTASKS",&NTASKS)) err("No CPUfile specified, NTASKS must be specified");
/*allocate space for the velocity profile*/
tshot=nxshot;
v=alloc2float(nxo,nz);
/*load velicoty file*/
vfp=efopen(vfile,"r");
efread(v[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/*PVM communication starts here*/
mytid=pvm_mytid(); /*get my pid*/
task=NTASKS;
warn("\n %d",task);
rc=0;
/*spawn slave processes here*/
if(!flag_cpu){
rc=pvm_spawn(child,NULL,PvmTaskDefault,"",task,tids);
}
else{
for(i=0;i<NTASKS;i++){
rc+=pvm_spawn(child,NULL,PvmTaskHost,cpu_name[i],1,&tids[i]);
}
}
/*show the pid of slaves if*/
for(i=0;i<NTASKS;i++){
if(tids[i]<0)warn("\n %d",tids[i]);
else warn("\nt%x\t",tids[i]);
}
/*if not all the slaves start, then quit*/
if(rc<NTASKS){ warn("error");pvm_exit();exit(1);}
/*broadcast the global parameters nxo,nz,dip to all slaves*/
pvm_initsend(PvmDataDefault);
rc=pvm_pkint(&nxo,1,1);
rc=pvm_pkint(&nz,1,1);
rc=pvm_pkint(&dip,1,1);
msgtype=PARA_MSGTYPE;
task=NTASKS;
rc=pvm_mcast(tids,task,msgtype);
/*broadcast the velocity profile to all slaves*/
pvm_initsend(PvmDataDefault);
rc=pvm_pkfloat(v[0],nxo*nz,1);
msgtype=VEL_MSGTYPE;
rc=pvm_mcast(tids,task,msgtype);
/*free the space for velocity profile*/
free2float(v);
/*loop over shot gathers begin here*/
loop:
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
/* 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");
}
}
sx=tr.sx;
isx=sx/dx;
gxmin=gxmax=tr.gx;
oldsx=sx;
/* 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;
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
fw=0.0;
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/*generate the Ricker wavelet*/
wtmp=ricker(Fmax,dt,&ntw);
for(it=0;it<ntfft;it++)
wl[it]=0.0;
for(it=0;it<ntw-12;it++)
wl[it]=wtmp[it+12];
free1float( wtmp);
/*Fourier transform the Ricker wavelet to frequency domain*/
pfarc(-1,ntfft,wl,wlsp);
/* allocate space */
p = alloc2float(ntfft,nxo);
cp = alloc2complex(nw,nxo);
for (ix=0; ix<nxo; ix++)
for (it=0; it<ntfft; it++)
p[ix][it] = 0.0;
/*read in a single shot gather*/
ix=tr.gx/dx;
memcpy( (void *) p[ix], (const void *) tr.data,nt*FSIZE);
nx = 0;
while(gettr(&tr)){
int igx;
if(tr.sx!=oldsx){ fseek(stdin,(long)(-240-nt*4),SEEK_CUR); break;}
igx=tr.gx/dx;
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
if(gxmin>tr.gx)gxmin=tr.gx;
if(gxmax<tr.gx)gxmax=tr.gx;
nx++;
oldsx=tr.sx;
}
warn("\nnx= %d",nx);
warn("sx %f , gxmin %f gxmax %f",sx,gxmin,gxmax);
/*transform the shot gather from time to frequency domain*/
pfa2rc(1,1,ntfft,nxo,p[0],cp[0]);
/*compute the most left and right index for the migrated section*/
ix1=sx/dx;
ix2=gxmin/dx;
ix3=gxmax/dx;
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
il=ix2;
ir=ix3;
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;
/*allocate space*/
cq = alloc2complex(nx,nw);
cq1 = 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||iw>nf4)
cq[iw][ix]=cmplx(0.0,0.0);
else{
if(iw>=nf1&&iw<=nf2){tmpp=PI/(nf2-nf1);tmppp=tmpp*(iw-nf1)-PI;tmpp=0.54+0.46*cos(tmppp);
cq[iw][ix]=crmul(cp[ix+ix2][iw],tmpp);}
else{
if(iw>=nf3&&iw<=nf4){tmpp=PI/(nf4-nf3);tmppp=tmpp*(iw-nf3);tmpp=0.54+0.46*cos(tmppp);
cq[iw][ix]=crmul(cp[ix+ix2][iw],tmpp);}
else
{cq[iw][ix]=cp[ix+ix2][iw];}
}
}
cq[iw][ix]=cp[ix+ix2][iw];
cq1[iw][ix]=cmplx(0.0,0.0);
}
ix=sx/dx-ifx;
warn("ix %d",ix);
for(iw=0;iw<nw;iw++){
cq1[iw][ix-ix2]=wlsp[iw];
}
free2float(p);
free2complex(cp);
free1float(wl);
free1complex(wlsp);
/*if the horizontal spacing interval is in feet, convert it to meter*/
if(!flag)
dx*=0.3048;
/*start of the timing function*/
time(&t1);
/* send local parameters to all slaves*/
pvm_initsend(PvmDataDefault);
ix=15;
rc=pvm_pkint(&ix,1,1);
rc=pvm_pkint(&ntfft,1,1);
rc=pvm_pkint(&ix2,1,1);
rc=pvm_pkint(&ix3,1,1);
rc=pvm_pkint(&isx,1,1);
rc=pvm_pkint(&il,1,1);
rc=pvm_pkint(&ir,1,1);
rc=pvm_pkfloat(&dx,1,1);
rc=pvm_pkfloat(&dz,1,1);
rc=pvm_pkfloat(&dw,1,1);
rc=pvm_pkfloat(&dt,1,1);
msgtype=PARA_MSGTYPE;
task=NTASKS;
rc=pvm_mcast(tids,task,msgtype);
/* send all the frequency to slaves*/
count=NTASKS*5; /*count is the number of frequency components in a shot
gather*/
nw=truenw;
nw1=nw/(count);
if(nw1==0)nw1=1;
total=count=ceil(nw*1.0/nw1);
/* if it is the first shot gather, send equal data to all the slaves, then for
the following shot gathers, only send data when slave requests*/
if(nxshot==tshot){
for(i=0;i<NTASKS;i++){
float *tmpp;
float fw1;
int nww,byte,nwww;
pvm_initsend(PvmDataDefault);
nww=nf1+i*nw1;fw1=fw+nww*dw;
nwww=nw1;
byte=UnDone;
rc=pvm_pkint(&byte,1,1);
rc=pvm_pkfloat(&fw1,1,1);
rc=pvm_pkint(&nwww,1,1);
rc=pvm_pkfloat((float *)cq[nww],nx*nwww*2,1);
rc=pvm_pkfloat((float *)cq1[nww],nx*nwww*2,1);
msgtype=DATA_MSGTYPE;
pvm_send(tids[i],msgtype);
}
count-=NTASKS;
}
while(count){
int tid0,bufid;
float *tmpp;
float fw1;
int nww,byte,nwww;
int i;
i=total-count;
msgtype=COM_MSGTYPE;
bufid=pvm_recv(-1,msgtype);
rc=pvm_upkint(&tid0,1,1);
pvm_freebuf(bufid);
pvm_initsend(PvmDataDefault);
nww=nf1+i*nw1;fw1=fw+nww*dw;
if(i==total-1)nwww=nw-nw1*i;
else nwww=nw1;
byte=UnDone;
rc=pvm_pkint(&byte,1,1);
rc=pvm_pkfloat(&fw1,1,1);
rc=pvm_pkint(&nwww,1,1);
rc=pvm_pkfloat((float *)cq[nww],nx*nwww*2,1);
rc=pvm_pkfloat((float *)cq1[nww],nx*nwww*2,1);
msgtype=DATA_MSGTYPE;
pvm_send(tid0,msgtype);
count--;
}
ix=Done;
pvm_initsend(PvmDataDefault);
rc=pvm_pkint(&ix,1,1);
msgtype=DATA_MSGTYPE;
pvm_mcast(tids,task,msgtype);
free2complex(cq);
free2complex(cq1);
time(&t2);
warn("\n %d shot been finished in %f seconds, Ntask=%d",nxshot,difftime(t2,t1),NTASKS);
nxshot--;
if(nxshot)goto loop;
/*when all the shot gathers done, send signal to all slaves to request the
partial imaging*/
ix=FinalDone;
pvm_initsend(PvmDataDefault);
rc=pvm_pkint(&ix,1,1);
msgtype=PARA_MSGTYPE;
pvm_mcast(tids,task,msgtype);
/*allocate space for the final image*/
cresult = alloc2float(nz,nxo);
for(ix=0;ix<nxo;ix++)
for(iz=0;iz<nz;iz++)
{ cresult[ix][iz]=0.0;
}
result_tmp= alloc2float(nz,nxo);
/*receive partial image from all the slaves*/
msgtype=RESULT_MSGTYPE;
i=0;
while(i<NTASKS){
int bufid;
bufid=pvm_recv(-1,msgtype);
rc=pvm_upkfloat(result_tmp[0],nxo*nz,1);
pvm_freebuf(bufid);
for(ix=0;ix<nxo;ix++)
for(iz=0;iz<nz;iz++)
{
cresult[ix][iz]+=result_tmp[ix][iz];
}
i=i+1;
warn("\n i=%d been received",i);
}
/*send signal to all slaves to kill themselves*/
pvm_initsend(PvmDataDefault);
pvm_mcast(tids,task,COM_MSGTYPE);
/*output the final image*/
for(ix=0; ix<nxo; ix++){
tr.ns = nz ;
tr.dt = dz*1000000.0 ;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
pvm_exit();
return EXIT_SUCCESS;
}
int
main(int argc, char **argv)
{
//int nt; /* number of frequency samples per trace */
int nfft; /* For computing the FFT */
//float dw; /* time sampling interval */
//int i1; /* time sample index */
//int log; /* Check if the trace has had a log applied (for mie scattering) */
int j; /* Other indices */
const double eps = 1.e-32;
kiss_fftr_cfg forw, invs;
/* Variables for Jons example */
float *spectrum = NULL;
float *rspectrum = NULL;
complex *fft = NULL;
int n = 64;
int nw = n/2+1;
float o1 = -M_PI/2;
float d1 = M_PI/n;
nfft = n;
/* hook up getpar */
initargs(argc, argv);
//requestdoc(1);
requestdoc(0); // For now (testing), stdin is not used
/* Allocating memory */
spectrum = ealloc1float((n+1));
rspectrum = ealloc1float((n/2+1));
fft = alloc1complex(nfft/2+1);
forw = kiss_fftr_alloc(nfft,0,NULL,NULL);
invs = kiss_fftr_alloc(nfft,1,NULL,NULL);
if(NULL == forw || NULL == invs)
err("KISS FFT allocation error");
memset( (void *) tr.data, 0, (n+1) * FSIZE);
tr.dt = d1;
tr.f1 = o1;
tr.ns = n;
create_spectrum(n, o1, d1, spectrum);
/* Squaring the spectrum */
j = n/2;
for(int i = 0; i < nw; i++, j++) {
rspectrum[i] = spectrum[j]*spectrum[j];
tr.data[i] = rspectrum[i];
}
fprintf(stderr, "Created input: \n");
for(int i = 0; i < nw; i++) {
fprintf(stderr, "i=%d input=%f\n",i,rspectrum[i]);
}
fprintf(stderr, "\n");
// Take the log and create a complex type
//fprintf(stderr, "Log of spectrum: \n");
for(int i = 0; i < nw; i++) {
fft[i] = cmplx(log(rspectrum[i]+eps)/nfft,0.);
}
//for(int i = 0; i < nw; i++) {
// fprintf(stderr, "i=%d real=%f imag=%f\n",i,fft[i].r,fft[i].i);
//}
//fprintf(stderr, "\n");
// Find the inverse FFT
kiss_fftri(invs,(const kiss_fft_cpx *) fft, tr.data);
tr.data[0] *= 0.5;
tr.data[nfft/2] *= 0.5;
for(int i=1+nfft/2; i < nfft; i++) {
tr.data[i] = 0;
}
kiss_fftr(forw, tr.data, (kiss_fft_cpx *) fft);
for(int i=0; i < nw; i++) {
fft[i] = crmul(cwp_cexp(fft[i]),1./nfft);
}
kiss_fftri(invs,(const kiss_fft_cpx *) fft, tr.data);
float dt = 0.004;
for(int i = 0; i < nfft; i++) {
fprintf(stderr, "i=%d t=%f output=%f\n", i, o1+dt*i, tr.data[i]);
}
puttr(&tr);
return(CWP_Exit());
}
int
main(int argc, char **argv)
{
FILE *headerfp=NULL; /* temporary file for trace header */
/* ... (1st trace of ensemble); */
char *key=NULL; /* header key word from segy.h */
char *type=NULL; /* ... its type */
int index; /* ... its index */
Value val; /* ... its value */
float fval = 0; /* ... its value cast to float */
float prevfval; /* ... its value of the previous trace */
complex *ct=NULL; /* complex trace */
complex *psct=NULL; /* phase-stack data array */
float *data=NULL; /* input data array */
float *hdata=NULL; /* array of Hilbert transformed input data */
float *stdata=NULL; /* stacked data ("ordinary" stack) */
float *psdata; /* phase-stack data array (real weights for PWS)*/
float a; /* inst. amplitude */
float dt; /* time sample spacing in seconds */
float pwr; /* raise phase stack to power pwr */
float sl; /* smoothing window length in seconds */
int gottrace; /* flag: set to 1, if trace is read from stdin */
int i; /* loop index */
int isl; /* smoothing window length in samples */
int nt; /* number of points on input trace */
int ntr; /* trace counter */
int ps; /* flag: output is PWS (0) or phase stack (1) */
int verbose; /* verbose flag */
cwp_Bool pws_and_cdp=cwp_false; /* are PWS and CDP set? */
/* Initialize */
initargs(argc, argv);
requestdoc(1);
/* Get info from first trace */
if(!gettr(&intr)) err("can't get first trace");
nt = intr.ns;
/* Get parameters */
if (!getparstring("key", &key)) key="cdp";
if (!getparfloat("pwr", &pwr)) pwr = 1.0;
if (!getparfloat("dt", &dt)) dt = ((double) intr.dt)/1000000.0;
if (!getparfloat("sl", &sl)) sl = 0.0;
if (!getparint("ps", &ps)) ps = 0;
if (!getparint("verbose", &verbose)) verbose = 0;
if (STREQ(key, "cdp") && !(ps))
pws_and_cdp = cwp_true;
/* convert seconds to samples (necessary only for smoothing) */
if (!dt) {
dt = 0.004;
warn("dt not set, assuming dt=0.004");
}
/* integerized smoothing window length */
isl = NINT(fabs(sl)/dt);
if (isl>nt)
err("sl=%g too long for trace", fabs(sl));
/* diagnostic print */
if (verbose && isl)
warn("smoothing window = %d samples", isl);
/* initialize flag */
gottrace = 1;
/* get key type and index */
type = hdtype(key);
index = getindex(key);
/* Get value of key and convert to float */
prevfval = fval;
gethval(&intr, index, &val);
fval = vtof(type,val);
/* remember previous value of key */
prevfval = fval;
/* allocate space for data, hilbert transformed data, */
/* phase-stacked data and complex trace */
data = ealloc1float(nt);
hdata = ealloc1float(nt);
stdata = ealloc1float(nt);
psdata = ealloc1float(nt);
psct = ealloc1complex(nt);
ct = ealloc1complex(nt);
/* zero out accumulators */
memset( (void *) stdata, 0, nt*FSIZE);
memset( (void *) psct, 0, nt*(sizeof(complex)));
/* open temporary file for trace header */
headerfp = etmpfile();
/* store trace header in temporary file and read data */
efwrite(&intr, HDRBYTES, 1, headerfp);
/* loop over input traces */
ntr=0;
while (gottrace|(~gottrace) ) { /* middle exit loop */
/* if got a trace */
if (gottrace) {
/* get value of key */
gethval(&intr, index, &val);
fval = vtof(type,val);
/* get data */
memcpy((void *) data, (const void *) intr.data,
nt*FSIZE);
}
/* construct quadrature trace with hilbert transform */
hilbert(nt, data, hdata);
/* build the complex trace and get rid of amplitude */
for (i=0; i<nt; i++) {
ct[i] = cmplx(data[i],hdata[i]);
a = (rcabs(ct[i])) ? 1.0 / rcabs(ct[i]) : 0.0;
ct[i] = crmul(ct[i], a);
}
/* stacking */
if (fval==prevfval && gottrace) {
++ntr;
for (i=0; i<nt; ++i) {
stdata[i] += data[i];
psct[i] = cadd(psct[i],ct[i]);
}
}
/* if key-value has changed or no more input traces */
if (fval!=prevfval || !gottrace) {
/* diagnostic print */
if (verbose)
warn("%s=%g, fold=%d\n", key, prevfval, ntr);
/* convert complex phase stack to real weights */
for (i=0; i<nt; ++i) {
psdata[i] = rcabs(psct[i]) / (float) ntr;
psdata[i] = pow(psdata[i], pwr);
}
/* smooth phase-stack (weights) */
if (isl) do_smooth(psdata,nt,isl);
/* apply weights to "ordinary" stack (do PWS) */
if (!ps) {
for (i=0; i<nt; ++i) {
stdata[i] *= psdata[i] / (float) ntr;
}
}
/* set header and write PS trace or */
/* PWS trace to stdout */
erewind(headerfp);
efread(&outtr, 1, HDRBYTES, headerfp);
outtr.nhs=ntr;
if (ps) {
memcpy((void *) outtr.data,
(const void *) psdata, nt*FSIZE);
} else {
memcpy((void *) outtr.data,
(const void *) stdata, nt*FSIZE);
}
/* zero offset field if a pws and cdp stack */
if (pws_and_cdp) outtr.offset = 0;
puttr(&outtr);
/* if no more input traces, break input trace loop* */
if (!gottrace) break;
/* remember previous value of key */
prevfval = fval;
/* zero out accumulators */
ntr=0;
memset( (void *) stdata, 0, nt*FSIZE);
memset( (void *) psct, 0, nt*(sizeof(complex)));
/* stacking */
if (gottrace) {
++ntr;
for (i=0; i<nt; ++i) {
stdata[i] += data[i];
psct[i] = cadd(psct[i],ct[i]);
}
}
/* save trace header for output trace */
erewind(headerfp);
efwrite(&intr, HDRBYTES, 1, headerfp);
}
/* get next trace (if there is one) */
if (!gettr(&intr)) gottrace = 0;
} /* end loop over traces */
return(CWP_Exit());
}
/************************PSPI migration************************/
void pspimig(float **data,complex **image,float **v,int nt,int nx,int nz,float dt,float dx, float dz)
{
int ntfft; /*number of samples of the zero padded trace*/
int nxfft;
int nw; /*number of temporal freqs.*/
int it; /*loop index over time sample*/
int ix; /*loop index over midpoint sample*/
int iw; /*loop index over frequency*/
int ik; /*loop index over wavenumber*/
int iz; /*loop index over migrated depth samples*/
int iv; /*loop index over reference velocities*/
int nvref_max=8; /*number of reference velocities in each layer*/
int nvref;
int i1; /*nearest reference velocity*/
int i2;
int iw1;
int iw2;
float **vref; /*2D reference velocity array*/
float w0; /*first frequency sample*/
float w; /*frequency*/
float dw; /*frequency sampling interval*/
float k0; /*first wavenumber*/
float k;
float dk; /*wave number sampling interval in x*/
float dv; /*velocity interval*/
float *in; /*input 1D data in FFTW*/
float **cpdata;
float phase;
float wv;
float vmin;
float vmax;
float f1 = 1.0;
float f2 = 35.0;
complex *out; /*output of 1D FFT using FFTW*/
complex **datawx; /*data in frequency-wavenumber domain*/
complex *in2;
complex *out2;
complex *in3;
complex *out3;
complex **Pkv; /*wavefield in k-v*/
complex **Pxv; /*wavefield in x-v*/
complex **Pwx; /*wavefield in w-x*/
complex cshift;
complex tmp_a;
complex tmp_b;
fftwf_plan p1;
fftwf_plan p2;
fftwf_plan p3;
/*allocate memory of reference velocities*/
vref = alloc2float(nz,nvref_max); /*allocate 2D array for reference velocity to avoid changing memory of vector*/
/*nz by nvref_max*/
for (ix=0;ix<nx;ix++){
for (iz=0;iz<nz;iz++){
image[ix][iz] = cmplx(0.0,0.0); /*nz by nz*/
}
}
/*devide velocity by 2 for downward continuation*/
for (iz=0;iz<nz;iz++){
for (ix=0;ix<nx;ix++){
v[ix][iz]=v[ix][iz]/2.0;
}
}
/*fprintf(stderr,"nx=%d nz=%d",nx,nz);
FILE *Fvp = fopen("vel.bin", "wb");
fwrite(v[0],1,4*nx*nz,Fvp);
fclose(Fvp);*/
/*zero padding in termporal direction*/
ntfft = 1.0*exp2(ceil(log2(nt))); /*number of zero padded trace in FFT*/
nw = ntfft/2+1; /*number of points of frequency axis after FFTW*/
cpdata = alloc2float(ntfft,nx); /*data after zero padding*/
for (ix=0;ix<nx;ix++){
for (it=0;it<ntfft;it++){
if(it<=nt) cpdata[ix][it] = data[ix][it];
else {cpdata[ix][it] = 0.0;
}
}
}
/*allocate memory for w-x domain data*/
datawx = alloc2complex(nw,nx); /*w-x data nx by nw*/
iw1 = floor(f1*dt*ntfft)+1;
iw2 = floor(f2*dt*ntfft)+1;
/*define plans for FFT using FFTW*/
/*plan 1 from t-x to w-x*/
in = alloc1float(ntfft);
out = alloc1complex(nw);
p1 = fftwf_plan_dft_r2c_1d(ntfft,in,(fftwf_complex*)out,FFTW_ESTIMATE); /*real to complex*/
/*plan 2 from w-x to w-k*/
nxfft = 1.0*exp2(ceil(log2(nx)));
in2 = alloc1complex(nxfft);
out2 = alloc1complex(nxfft);
p2 = fftwf_plan_dft_1d(nxfft,(fftwf_complex*)in2,(fftwf_complex*)out2,FFTW_FORWARD,FFTW_ESTIMATE);
/*plan 3 from w-k to w-x*/
in3 = alloc1complex(nxfft);
out3 = alloc1complex(nxfft);
p3 = fftwf_plan_dft_1d(nxfft,(fftwf_complex*)in3,(fftwf_complex*)out3,FFTW_BACKWARD,FFTW_ESTIMATE);
Pxv = alloc2complex(nvref_max,nxfft);
Pkv = alloc2complex(nvref_max,nxfft);
Pwx = alloc2complex(nw,nxfft);
/*apply first 1-D Fourier transform on data from t-x to w-x using FFTW package*/
for (ix=0;ix<nx;ix++){
for(it=0;it<ntfft;it++){
in[it] = cpdata[ix][it]; /*assign one trace to a vector*/
}
fftwf_execute(p1);
for(iw=0;iw<nw;iw++){
datawx[ix][iw] = cdiv(out[iw], cmplx(sqrt(ntfft), 0.0));
} /*w*/
} /*x*/
fftwf_destroy_plan(p1);
/*determine frequency and wavenumber axis*/
dw = 2.0*PI/(ntfft*dt); /*frequency sampling interval*/
w0 = 0.0; /*first frequency sample*/
dk = 2.0*PI/(nxfft*dx); /*wavenumber sampling interval*/
k0 = 0.0; /*first wavenumber sample*/
/*initialization of downward wavefield*/
for (iw=0;iw<nw;iw++){
for (ix=0;ix<nxfft;ix++){
if (ix<nx){Pwx[ix][iw] = datawx[ix][iw];}
else{Pwx[ix][iw] = cmplx(0.0,0.0);}
}
}
/*loop over depth z*/
for (iz=0;iz<nz;iz++){
fprintf(stderr,"depth sample %d\n",iz);
/*calculate reference velocities of each layer*/
vmin = v[0][iz];
vmax = v[0][iz];
for (ix=0;ix<nx;ix++){
if(v[ix][iz]>=vmax) vmax=v[ix][iz]; /*get the maximum velocity*/
if(v[ix][iz]<=vmin) vmin=v[ix][iz]; /*get the minimum velocity*/
}
dv = (vmax-vmin)/(nvref_max-1);
if(dv/vmax<=0.001){
nvref = 1;
vref[0][iz]=(vmin+vmax)/2;
}
else
{
nvref = nvref_max;
for (iv=0;iv<nvref_max;iv++)
{
vref[iv][iz] = vmin+dv*iv;
}
}
/*loop over frequencies*/
w = w0;
for (iw=iw1;iw<=iw2;iw++){
w = w0 + iw*dw; /*frequency axis (important)*/
/*apply phase-shift in w-x (optional)*/
/*datawx*/
/*Apply second FFT to tranform w-x data to w-k domain using FFTW*/
for (ix=0;ix<nxfft;ix++){
in2[ix] = Pwx[ix][iw];
}
fftwf_execute(p2);
for (ik=0;ik<nxfft;ik++){
out2[ik] = cdiv(out2[ik], cmplx(sqrt(nxfft), 0.0));
}
/*loop over wavenumbers*/
k = k0;
for (ik=0;ik<nxfft;ik++){
if (ik<=nxfft/2){
k = ik*dk; /*wavenumber axis (important)*/
}
else{
k = (ik-nxfft)*dk;
}
/*loop over reference velocities*/
for (iv=0;iv<nvref;iv++){
wv = w/vref[iv][iz];
if(wv>fabs(k)){ /*note that k can be negative*/
phase = sqrt(wv*wv-k*k)*dz;
cshift = cmplx(cos(phase),sin(phase));
}
else{
cshift = cmplx(0.0,0.0);
}
Pkv[ik][iv] = cmul(out2[ik],cshift);
} /*end for v*/
} /*end for k*/
/*from w-k go back to w-x domain*/
for (iv=0;iv<nvref;iv++){ /*inverse FFT for each velocity*/
for (ik=0;ik<nxfft;ik++){
in3[ik] = Pkv[ik][iv];
} /*end for k*/
fftwf_execute(p3);
for (ix=0;ix<nxfft;ix++){
Pxv[ix][iv] = cdiv(out3[ix], cmplx(sqrt(nxfft), 0.0));
} /*end for x*/
} /*end for v*/ /*Pxv ix by iv*/
/*interpolation of wavefield in w-x*/
if (nvref==1){
for (ix=0;ix<nx;ix++){
Pwx[ix][iw] = Pxv[ix][0];
}
}
else
{
for (ix=0;ix<nx;ix++){
if (v[ix][iz]==vmax){i1=(v[ix][iz]-vmin)/dv-1;}
else
{i1 = (v[ix][iz]-vmin)/dv;} /*find nearest reference velocity and wavefield*/
i2 = i1+1;
tmp_a = cadd(crmul(Pxv[ix][i1], vref[i2][iz]-v[ix][iz]) , crmul(Pxv[ix][i2], v[ix][iz]-vref[i1][iz]));
tmp_b = cmplx(vref[i2][iz]-vref[i1][iz], 0.0);
Pwx[ix][iw] = cdiv(tmp_a,tmp_b);
} /*interpolate wavefield*/
} /*end else*/
/*imaging condition*/
for (ix=0;ix<nx;ix++){
image[ix][iz] = cadd(image[ix][iz],Pwx[ix][iw]);
}
/*zero padding*/
for (ix=nx;ix<nxfft;ix++){
Pwx[ix][iw] = cmplx(0.0,0.0);
}
} /*w*/
} /*z*/
fftwf_destroy_plan(p2);
fftwf_destroy_plan(p3);
} /*end pspimig migration function*/
void fdmig( complex **cp, int nx, int nw, float *v,float fw,float
dw,float dz,float dx,float dt,float vc,int dip)
{
int iw,ix;
float *p,*s1,*s2,w,coefa,coefb,v1,vn,trick=0.1;
complex cp2,cp3,cpnm1,cpnm2;
complex a1,a2,b1,b2;
complex endl,endr;
complex *data,*d,*a,*b,*c;
p=alloc1float(nx);
s1=alloc1float(nx);
s2=alloc1float(nx);
data=alloc1complex(nx);
d=alloc1complex(nx);
a=alloc1complex(nx);
b=alloc1complex(nx);
c=alloc1complex(nx);
for(ix=0;ix<nx;ix++){
p[ix]=vc/v[ix];
p[ix]=(p[ix]*p[ix]+p[ix]+1.0);
}
if(dip!=65){
coefa=0.5;coefb=0.25;
} else {
coefa=0.4784689;
coefb=0.37607656;
}
v1=v[0];
vn=v[nx-1];
for(iw=0,w=fw;iw<nw;iw++,w+=dw){
if(fabs(w)<=1.0e-10)w=1.0e-10/dt;
for(ix=0;ix<nx;ix++){
s1[ix]=(v[ix]*v[ix])*p[ix]*coefb/(dx*dx*w*w)+trick;
s2[ix]=-(1-vc/v[ix])*v[ix]*dz*coefa/(w*dx*dx)*0.5;
}
for(ix=0;ix<nx;ix++){
data[ix]=cp[iw][ix];
}
cp2=data[1];
cp3=data[2];
cpnm1=data[nx-2];
cpnm2=data[nx-3];
a1=crmul(cmul(cp2,conjg(cp3)),2.0);
b1=cadd(cmul(cp2,conjg(cp2)),cmul(cp3,conjg(cp3)));
if(b1.r==0.0 && b1.i==0.0)
a1=cwp_cexp(cmplx(0.0,-w*dx*0.5/v1));
else
a1=cdiv(a1,b1);
if(a1.i>0.0)
a1=cwp_cexp(cmplx(0.0,-w*dx*0.5/v1));
a2=crmul(cmul(cpnm1,conjg(cpnm2)),2.0);
b2=cadd(cmul(cpnm1,conjg(cpnm1)),cmul(cpnm2,conjg(cpnm2)));
if(b2.r==0.0 && b2.i==0.0)
a2=cwp_cexp(cmplx(0.0,-w*dx*0.5/vn));
else
a2=cdiv(a2,b2);
if(a2.i>0.0)
a2=cwp_cexp(cmplx(0.0,-w*dx*0.5/vn));
for(ix=0;ix<nx;ix++){
a[ix]=cmplx(s1[ix],s2[ix]);
b[ix]=cmplx(1.0-2.0*s1[ix],-2.0*s2[ix]);
}
for(ix=1;ix<nx-1;ix++){
d[ix]=cadd(cadd(cmul(data[ix+1],a[ix+1]),
cmul(data[ix-1],a[ix-1])),
cmul(data[ix],b[ix]));
}
d[0]=cadd(cmul(cadd(b[0],cmul(a[0],a1)),
data[0]),cmul(data[1],a[1]));
d[nx-1]=cadd(cmul(cadd(b[nx-1],
cmul(a[nx-1],a2)),data[nx-1]),
cmul(data[nx-2],a[nx-2]));
for(ix=0;ix<nx;ix++){
data[ix]=cmplx(s1[ix],-s2[ix]);
b[ix]=cmplx(1.0-2.0*s1[ix],2.0*s2[ix]);
}
endl=cadd(b[0],cmul(data[0],a1));
endr=cadd(b[nx-1],cmul(data[nx-1],a2));
for(ix=1;ix<nx-1;ix++){
a[ix]=data[ix+1];
c[ix]=data[ix-1];
}
a[0]=data[1];
c[nx-1]=data[nx-2];
retris(data,a,c,b,endl,endr,nx,d);
for(ix=0;ix<nx;ix++){
cp[iw][ix]=data[ix];
}
}
free1complex(data);
free1float(p);
free1complex(d);
free1complex(b);
free1complex(c);
free1complex(a);
free1float(s1);
free1float(s2);
return;
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx; /* number of horizontal samples */
int nxshot; /* number of shots to be migrated */
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 numbers */
int dip=65; /* dip angle */
int oldigx=0; /* old value of integerized gx value */
int oldisx=0; /* old value of integerized sx value */
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 isx=0,nxo; /* index for source and geophone */
int ix1,ix2,ix3,ixshot,il=0,ir=0; /* 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 and depth sampling interval */
float dw,dk; /* wavenumber and frequency sampling interval */
float fw,fk; /* first wavenumber and frequency */
float w,k; /* wavenumber and frequency */
float dx; /* spatial sampling interval */
float **p=NULL;
float **cresult=NULL; /* input, output data */
float v1,vmin;
double kz1,kz2;
double phase1;
float **v=NULL;
float **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 optional parameters */
MUSTGETPARINT("nz",&nz);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile", &vfile);
MUSTGETPARINT("nxo",&nxo);
MUSTGETPARINT("nxshot",&nxshot);
if (!getparfloat("fmax",&fmax)) fmax = 25. ;
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=65;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocate 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);
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
get_sx_gx(&sx,&gx);
min_sx_gx = MIN(sx,gx);
gxmin=gxmax=gx;
erewind(stdin);
/*
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");
}
}
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 frequencies 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];
}
*/
/* warn("%12i %12f \n",(it-ntw/2+ntfft) % ntfft,wtmp[it]); */
/* End of new code */
free1float(wtmp);
/* fourier transform wl array */
pfarc(-1,ntfft,wl,wlsp);
/* CS TEST: this was used to output the array wlsp
(the wavelet in the frequency domain) to the file CSinfo,
no longer needed and commented out */
/*
FILE *CSinfo;
CSinfo=fopen("CSinfo","w");
fprintf(CSinfo,"ntfft=%10i\n",ntfft);
fprintf(CSinfo,"ntw=%10i\n",ntw);
for(iw=0;iw<ntfft/2+1;iw++)
fprintf(CSinfo,"%12f %12f \n",wlsp[iw].r,wlsp[iw].i);
fclose(CSinfo);
*/
/* conclusion from the analysis of this info:
the wavelet (whose fourier transform is in wlsp)
is not zero phase!!!
so there is a timeshift error!!!
Conclusion obtained dec 11 2005 */
/* CS */
/* 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;
if (gx < 0 ) {
igx=gx/dx + nxo;
} else {
igx=gx/dx ;
}
oldigx=igx;
oldsx=sx;
oldgx=gx;
oldgxmax=gxmax;
oldgxmin=gxmin;
while(gettr(&tr)) { /* begin looping over traces within a shot gather */
/* get sx and gx */
get_sx_gx(&sx,&gx);
/*
warn("%d nx=%d", igx, nx);
sx = (sx - min_sx_gx);
gx = (gx - min_sx_gx);
*/
if (gx < 0 ) {
igx=gx/dx + nxo;
} else {
igx=gx/dx ;
}
if (igx==oldigx)
warn("repeated igx!!! check dx or scalco value!!!");
oldigx = igx;
if(tr.sx!=oldsx){ efseeko(stdin,(off_t)(-240-nt*4),SEEK_CUR); break;}
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!");
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
++nx;
}
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;
il=ix2;
ir=ix3;
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);
/* allocating space */
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=0;
for(ix=il-ix2;ix<=ir-ix2;ix++){
vmin+=1.0/v[iz][ix]/(ir-il+1);
}
vmin=1.0/vmin;
/* compute the shifted 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 cq[][] cq1[][] */
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;
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);
}
}
}
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);
}
}
}
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());
}
int main (int argc, char **argv)
{
int Finish,dip=65;
int nz; /* number of migrated depth samples */
int nxo,nx; /* number of midpoints */
int iz,iw,ix,ix2,ix3,ixshot; /* loop counters*/
int ntfft; /* fft size*/
int nw; /* number of frequency*/
int mytid,msgtype,rc,parent_tid;
float dt=0.004,dz; /*time and depth sampling interval*/
float dw; /*frequency sampling interval */
float fw; /* first frequency*/
float w; /* frequency*/
float dx; /* spatial sampling interval*/
float **cresult; /*output data*/
float v1;
float para;
double kz2;
float **vp,**v;
complex cshift2;
complex **cp,**cp1; /* complex input,output */
/*get my and father pids*/
mytid=pvm_mytid();
parent_tid=pvm_parent();
/*receive global parameters*/
msgtype=PARA_MSGTYPE;
rc=pvm_recv(-1,msgtype);
rc=pvm_upkint(&nxo,1,1);
rc=pvm_upkint(&nz,1,1);
rc=pvm_upkint(&dip,1,1);
rc=pvm_upkfloat(¶,1,1);
/*allocate space for velocity profile and receive velocity from father*/
vp=alloc2float(nxo,nz);
msgtype=VEL_MSGTYPE;
rc=pvm_recv(-1,msgtype);
rc=pvm_upkfloat(vp[0],nxo*nz,1);
/*allocate space for the storage of partial image and zero it out now*/
cresult = alloc2float(nz,nxo);
for(ix=0;ix<nxo;ix++)
for(iz=0;iz<nz;iz++)
cresult[ix][iz]=0.0;
/*loop over shotgather*/
loop:
/*receive parameters for each shot gather*/
msgtype=PARA_MSGTYPE;
rc=pvm_recv(parent_tid,msgtype);
rc=pvm_upkint(&Finish,1,1);
if(Finish==FinalDone)goto end;
rc=pvm_upkint(&ntfft,1,1);
rc=pvm_upkint(&ix2,1,1);
rc=pvm_upkint(&ix3,1,1);
rc=pvm_upkint(&ixshot,1,1);
nx=ix3-ix2+1;
rc=pvm_upkfloat(&dx,1,1);
rc=pvm_upkfloat(&dz,1,1);
rc=pvm_upkfloat(&dw,1,1);
rc=pvm_upkfloat(&dt,1,1);
/*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];
}
while(1){
/*receive parameters and data for processing*/
msgtype=DATA_MSGTYPE;
rc=pvm_recv(parent_tid,msgtype);
rc=pvm_upkint(&Finish,1,1);
if(Finish==Done) {free2float(v);goto loop; }
rc=pvm_upkfloat(&fw,1,1);
rc=pvm_upkint(&nw,1,1);
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
rc=pvm_upkfloat((float *)cp[0],nx*nw*2,1);
rc=pvm_upkfloat((float *)cp1[0],nx*nw*2,1);
/* 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;
}
}
*/
/* anothe imaging condition, slightly different from the above one, but not quite
slow*/
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
float kk=0.0;
complex tmp;
float ratio=1.5;
if(dip<80)ratio=1.5;
else ratio=1.5;
for(ix=0;ix<nx;ix++){
kk+=(pow(cp1[iw][ix].i,2.0)+pow(cp1[iw][ix].r,2.0))/nx;
}
for(ix=0;ix<nx;ix++){
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=crmul(tmp,1.0/(kk+1.0e-10));
else tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/*get the average velocity*/
v1=0.0;
for(ix=0;ix<nx;++ix)
{v1+=v[iz][ix]/nx;}
/*compute time-invariant wavefield*/
/* for(ix=0;ix<nx;++ix)
for(iw=0,w=fw;iw<nw;w+=dw,++iw) {
kz2=-(1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
*/
/*wave-propagation using finite-difference method*/
fdmig( cp, nx, nw,v[iz],fw,dw,dz,dx,dt,dip,para);
fdmig( cp1,nx, nw,v[iz],fw,dw,dz,dx,dt,dip,para);
/*apply thin lens term here*/
for(ix=0;ix<nx;++ix)
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
float Wi=-dw;
kz2=-(1.0/v[iz][ix])*dz;
/* kz2=-(1.0/v[iz][ix]-1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));*/
cshift2=cexp(cmplx(-Wi*kz2,w*kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
/*finish a portion of the data, request more*/
pvm_initsend(PvmDataDefault);
pvm_pkint(&mytid,1,1);
msgtype=COM_MSGTYPE;
pvm_send(parent_tid,msgtype);
free2complex(cp);
free2complex(cp1);
}
end:
/*everything done,send back partial image and wait for signal to kill itself*/
pvm_initsend(PvmDataDefault);
pvm_pkfloat(cresult[0],nxo*nz,1);
msgtype=RESULT_MSGTYPE;
pvm_send(parent_tid,msgtype);
msgtype=COM_MSGTYPE;
pvm_recv(-1,msgtype);
pvm_exit();
exit(0);
}
main(int argc, char **argv)
{
register float *rt; /* real trace */
register complex *ct; /* complex transformed trace */
float *filter; /* filter array */
float f1; /* left lower corner frequency */
float f2; /* left upper corner frequency */
float f4; /* right lower corner frequency */
float f3; /* right upper corner frequency */
int if1,if2,if3,if4; /* integerizations of f1,f2,f3,f4 */
float dt; /* sample spacing */
float nyq; /* nyquist frequency */
int nt; /* number of points on input trace */
int nfft; /* number of points for fft trace */
int nf; /* number of frequencies (incl Nyq) */
int nfm1; /* nf-1 */
float onfft; /* reciprocal of nfft */
float df; /* frequency spacing (from dt) */
/* Initialize */
initargs(argc, argv);
askdoc(1);
/* Get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
if (tr.trid && tr.trid != TREAL)
err("input is not seismic data, trid=%d", tr.trid);
nt = tr.ns;
if (!getparfloat("dt", &dt)) dt = tr.dt/1000000.0;
if (!dt) err("dt field is zero and not getparred");
nyq = 0.5/dt;
/* Set up FFT parameters */
nfft = npfaro(nt, LOOKFAC * nt);
if (nfft >= MIN(SU_NFLTS, PFA_MAX))
err("Padded nt=%d -- too big", nfft);
nf = nfft/2 + 1;
nfm1 = nf - 1;
onfft = 1.0 / nfft;
/* Get corner frequencies */
if (!getparfloat("f1", &f1)) f1 = FRAC1 * nyq;
if (!getparfloat("f2", &f2)) f2 = FRAC2 * nyq;
if (!getparfloat("f3", &f3)) f3 = FRAC3 * nyq;
if (!getparfloat("f4", &f4)) f4 = FRAC4 * nyq;
if (f1 < 0.0 || f1 > f2 || f2 >= f3 || f3 > f4)
err("Bad filter parameters");
/* Allocate fft arrays */
rt = ealloc1float(nfft);
ct = ealloc1complex(nf);
filter = ealloc1float(nf);
/* Compute integer frequencies */
df = onfft / dt;
if1 = NINT(f1/df);
if2 = NINT(f2/df);
if3 = NINT(f3/df);
if (if3 > nfm1) if3 = nfm1;
if4 = NINT(f4/df);
if (if4 > nfm1) if4 = nfm1;
/* Make filter with scale for inverse transform */
{ register int i;
register float c = PIBY2 / (if2 - if1 + 2);
for (i = if1; i <= if2; ++i) {
register float s = sin(c*(i - if1 + 1));
filter[i] = s * s * onfft;
}
}
{ register int i;
register float c = PIBY2 / (if4 - if3 + 2);
for (i = if3; i <= if4; ++i) {
register float s = sin(c*(if4 - i + 1));
filter[i] = s * s * onfft;
}
}
{ register int i;
for (i = if2 + 1; i < if3; ++i) filter[i] = onfft;
for (i = 0; i < if1; ++i) filter[i] = 0.0;
for (i = if4 + 1; i < nf; ++i) filter[i] = 0.0;
}
/* Main loop over traces */
do {
register int i;
/* Load trace into rt (zero-padded) */
memcpy(rt, tr.data, nt*FSIZE);
bzero(rt + nt, (nfft-nt)*FSIZE);
/* FFT, filter, inverse FFT */
pfarc(1, nfft, rt, ct);
for (i = 0; i < nf; ++i) ct[i] = crmul(ct[i], filter[i]);
pfacr(-1, nfft, ct, rt);
/* Load traces back in, recall filter had nfft factor */
for (i = 0; i < nt; ++i) tr.data[i] = rt[i];
puttr(&tr);
} while (gettr(&tr));
return EXIT_SUCCESS;
}
int
main(int argc, char **argv)
{
int nt,nx; /* numbers of samples */
float dt; /* sampling intervals */
int it,ix; /* sample indices */
int ntfft; /* dimensions after padding for FFT */
int nF; /* transform (output) dimensions */
int iF; /* transform sample indices */
register complex **ct=NULL; /* complex FFT workspace */
register float **rt=NULL; /* float FFT workspace */
int verbose; /* flag for echoing information */
char *tmpdir=NULL; /* directory path for tmp files */
cwp_Bool istmpdir=cwp_false;/* true for user-given path */
float v,fv,dv; /* phase velocity, first, step */
float amp,oamp; /* temp vars for amplitude spectrum */
int nv,iv; /* number of phase vels, counter */
float x; /* offset */
float omega; /* circular frequency */
float domega; /* circular frequency spacing (from dt) */
float onfft; /* 1 / nfft */
float phi; /* omega/phase_velocity */
complex *cDisp=NULL; /* temp array for complex dispersion */
float arg; /* temp var for phase calculation */
complex cExp; /* temp vars for phase calculation */
float *offs=NULL; /* input data offsets */
float fmax; /* max freq to proc (Hz) */
int out; /* output real or abs v(f) spectrum */
int norm; /* normalization flag */
float xmax; /* maximum abs(offset) of input */
float twopi, f; /* constant and frequency (Hz) */
/* Hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(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 = ((double) intrace.dt)/ 1000000.0;
} else { /* dt not set, exit */
err("tr.dt not set, stop.");
}
}
warn("dt=%f",dt);
if (!getparfloat("fv",&fv)) fv = 330;
if (!getparfloat("dv",&dv)) dv = 25;
if (!getparint("nv",&nv)) nv = 100;
if (!getparint("out",&out)) out = 0;
if (!getparint("norm",&norm)) norm = 0;
if (!getparfloat("fmax",&fmax)) fmax = 50;
if (!getparint("verbose", &verbose)) verbose = 0;
/* Look for user-supplied tmpdir */
if (!getparstring("tmpdir",&tmpdir) &&
!(tmpdir = getenv("CWP_TMPDIR"))) tmpdir="";
if (!STREQ(tmpdir, "") && access(tmpdir, WRITE_OK))
err("you can't write in %s (or it doesn't exist)", tmpdir);
checkpars();
/* Set up tmpfile */
if (STREQ(tmpdir,"")) {
tracefp = etmpfile();
if (verbose) warn("using tmpfile() call");
} else { /* user-supplied tmpdir */
char directory[BUFSIZ];
strcpy(directory, tmpdir);
strcpy(tracefile, temporary_filename(directory));
/* Trap signals so can remove temp files */
signal(SIGINT, (void (*) (int)) closefiles);
signal(SIGQUIT, (void (*) (int)) closefiles);
signal(SIGHUP, (void (*) (int)) closefiles);
signal(SIGTERM, (void (*) (int)) closefiles);
tracefp = efopen(tracefile, "w+");
istmpdir=cwp_true;
if (verbose) warn("putting temporary files in %s", directory);
}
/* we have to allocate offs(nx) before we know nx */
offs = alloc1float(MAX_OFFS);
ix = 0;
nx = 0;
xmax = 0.0;
/* get nx and max abs(offset) */
do {
++nx;
efwrite(intrace.data, FSIZE, nt, tracefp);
offs[ix] = intrace.offset;
if ( abs(intrace.offset) > xmax ) xmax = abs(intrace.offset);
++ix;
} while (gettr(&intrace));
/* confirm that offsets are set */
if ( xmax == 0.0 ) err("tr.offset not set, stop.");
/* Determine lengths for prime-factor FFTs */
ntfft = npfar(nt);
if (ntfft >= SU_NFLTS || ntfft >= PFA_MAX)
err("Padded nt=%d--too big",ntfft);
/* Determine complex transform sizes */
nF = ntfft/2+1; /* must be this nF for fft */
onfft = 1.0 / ntfft;
twopi = 2.0 * PI;
domega = twopi * onfft / dt;
/* Allocate space */
ct = alloc2complex(nF,nx);
rt = alloc2float(ntfft,nx);
/* Load traces into fft arrays and close tmpfile */
erewind(tracefp);
for (ix=0; ix<nx; ++ix) {
efread(rt[ix], FSIZE, nt, tracefp);
/* pad dimension 1 with zeros */
for (it=nt; it<ntfft; ++it) rt[ix][it] = 0.0;
}
efclose(tracefp);
/* Fourier transform dimension 1 */
pfa2rc(1,1,ntfft,nx,rt[0],ct[0]);
/* set nF for processing */
if (fmax == 0) {
/* process to nyquist */
nF = ntfft/2+1;
} else {
/* process to given fmax */
nF = (int) (twopi * fmax / domega);
}
/* data now in (w,x) domain
allocate arrays */
cDisp = alloc1complex(nF);
/* if requested, normalize by amplitude spectrum
(normalizing by amplitude blows up aliasing and other artifacts) */
if (norm == 1) {
for (iF=0; iF<nF; ++iF) {
/* calc this frequency */
omega = iF * domega;
f = omega / twopi;
/* loop over traces */
for (ix=0; ix<nx; ++ix) {
/* calc amplitude at this (f,x) location */
amp = rcabs(ct[ix][iF]);
oamp = 1.0/amp;
/* scale field by amp spectrum */
ct[ix][iF] = crmul(ct[ix][iF],oamp);
}
}
}
/* set global output trace headers */
outtrace.ns = 2 * nF;
outtrace.dt = dt*1000000.;
outtrace.trid = FUNPACKNYQ;
outtrace.d1 = 1.0 / (ntfft * dt); /* Hz */
outtrace.f1 = 0;
outtrace.d2 = dv;
outtrace.f2 = fv;
/* loop over phase velocities */
for (iv=0; iv<nv; ++iv) {
/* this velocity */
v = fv + iv*dv;
/* loop over frequencies */
for (iF=0; iF<nF; ++iF) {
/* this frequency and phase */
omega = iF * domega;
f = omega / twopi;
phi = omega / v;
/* initialize */
cDisp[iF] = cmplx(0.0,0.0);
/* sum over abs offset (this is ok for 3D, too) */
for (ix=0; ix<nx; ++ix) {
/* get this x */
x = abs(offs[ix]);
/* target phase */
arg = - phi * x;
cExp = cwp_cexp(crmul(cmplx(0.0,1.0), arg));
/* phase vel profile for this frequency */
cDisp[iF] = cadd(cDisp[iF],cmul(ct[ix][iF],cExp));
}
}
/* set trace counter */
outtrace.tracl = iv + 1;
/* copy results to output trace
interleaved format like sufft.c */
for (iF = 0; iF < nF; ++iF) {
outtrace.data[2*iF] = cDisp[iF].r;
outtrace.data[2*iF+1] = cDisp[iF].i;
}
/* output freqs at this vel */
puttr(&outtrace);
} /* next frequency */
/* Clean up */
if (istmpdir) eremove(tracefile);
return(CWP_Exit());
}
void gazdagvt (float k,
int nt, float dt, float ft,
int ntau, float dtau, float ftau,
float *vt, complex *p, complex *q, float qual, float gainceil)
/*****************************************************************************
Gazdag's phase-shift zero-offset migration for one wavenumber
adapted to v(tau) velocity profile
******************************************************************************
Input:
k wavenumber
nt number of time samples
dt time sampling interval
ft first time sample
ntau number of migrated time samples
dtau migrated time sampling interval
ftau first migrated time sample
vt velocity v[tau]
p array[nt] containing data to be migrated
Output:
q array[ntau] containing migrated data
******************************************************************************/
{
int ntfft,nw,it,itau,iw;
float dw,fw,tmax,w,tau,phase,coss, *cumgain, gain, alpha;
complex cshift,*pp;
/* determine frequency sampling */
ntfft = npfa(nt);
nw = ntfft;
dw = 2.0*PI/(ntfft*dt);
fw = -PI/dt;
/* determine maximum time */
tmax = ft+(nt-1)*dt;
/* allocate workspace */
pp = alloc1complex(nw);
cumgain = alloc1float(nw);
for (iw=0; iw<nw; iw++)
cumgain[iw] = 1.0;
/* pad with zeros and Fourier transform t to w, with w centered */
for (it=0; it<nt; it++)
pp[it] = (it%2 ? cneg(p[it]) : p[it]);
for (it=nt; it<ntfft; it++)
pp[it] = cmplx(0.0,0.0);
pfacc(1,ntfft,pp);
/* account for non-zero ft and non-zero ftau */
for (itau=0 ; itau < ftau ; itau++){
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
if (w==0.0) w = 1e-10/dt;
coss = 1.0-pow(0.5 * vt[itau] * k/w,2.0);
if (coss>=pow(ftau/tmax,2.0)) {
phase = w*(ft-ftau*sqrt(coss));
cshift = cmplx(cos(phase),sin(phase));
pp[iw] = cmul(pp[iw],cshift);
} else {
pp[iw] = cmplx(0.0,0.0);
}
}
}
/* loop over migrated times tau */
for (itau=0,tau=ftau; itau<ntau; itau++,tau+=dtau) {
/* initialize migrated sample */
q[itau] = cmplx(0.0,0.0);
/* loop over frequencies w */
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
/* accumulate image (summed over frequency) */
q[itau] = cadd(q[itau],pp[iw]);
/* compute cosine squared of propagation angle */
if (w==0.0) w = 1e-10/dt;
coss = 1.0-pow(0.5 * vt[itau] * k/w,2.0);
/* if wave could have been recorded in time */
if (coss>=pow(tau/tmax,2.0)) {
/* extrapolate down one migrated time step */
phase = -w*dtau*sqrt(coss);
cshift = cmplx(cos(phase),sin(phase));
/* apply gain until gain ceiling is reached */
if (cumgain[iw] < gainceil) {
alpha = w/(2.0*vt[itau]*qual);
gain = exp(fabs(0.5*vt[itau]*dtau*alpha));
pp[iw] = cmul(pp[iw],crmul(cshift,gain));
cumgain[iw] *= gain;
} else {
pp[iw] = cmplx(0.0,0.0);
}
/* else, if wave couldn't have been recorded in time */
} else {
/* zero the wave */
pp[iw] = cmplx(0.0,0.0);
}
}
/* scale accumulated image just as we would for an FFT */
q[itau] = crmul(q[itau],1.0/nw);
}
/* free workspace */
free1complex(pp);
free1float(cumgain);
}
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 do_minphdec(float *tr,int nt, float *filter,int fnl,int fnr,float prw)
{
float *rtr;
float *rtx;
complex *f;
complex *w;
complex a;
int iamp;
float amp;
float ampm=-1.0e+20;
float amps;
float *am;
float *ph;
float mean=0.0;
float sum=0.0;
int nfftc;
int nf;
int i,j; /* counter */
float snfftc;
/* Set up pfa fft */
nfftc = npfao(nt,LOOKFAC*nt);
if (nfftc >= SU_NFLTS || nfftc >= PFA_MAX)
err("Padded nt=%d--too big", nfftc);
nf = nfftc/2 + 1;
snfftc=1.0/nfftc;
rtr = ealloc1float(nfftc);
rtx = ealloc1float(nf);
f = ealloc1complex(nfftc);
w = ealloc1complex(nfftc);
am = ealloc1float(nf);
ph = ealloc1float(nf);
/* clean the arrays */
memset( (void *) w, (int) '\0', nfftc*sizeof(complex));
memset( (void *) rtr, (int) '\0', nfftc*FSIZE);
/* Cross correlation */
xcor(nt,0,tr,nt,0,tr,nf,0,rtr);
/* FFT */
pfarc(1, nfftc,rtr,w);
/* stabilize */
for(i=0;i<nf;i++) {
am[i] += am[i]*prw;
}
/* Normalize */
for(i=0;i<nf;i++) {
a=w[i];
am[i]= sqrt(a.r*a.r+a.i*a.i);
sum += am[i];
if(am[i]!=0) ph[i] = atan2(a.i,a.r);
else ph[i]=0;
}
sum *= 1.0/nf;
sum = 1.0/sum;
sscal(nf,sum,am,1);
/* Smooth the apmlitude spectra */
if(fnl!=0) conv (fnl+fnr+1,-fnl,filter,nf,0,am,nf,0,am);
fprintf(stderr," %f\n",sum);
for(i=0;i<nf;i++) {
w[i].r = am[i]*cos(ph[i]);
w[i].i = am[i]*sin(ph[i]);
}
for(i=nf,j=nf-1;i<nfftc;i++,j--) {
w[i].r = am[j]*cos(ph[j]);
w[i].i = am[j]*sin(ph[j]);
}
/* log spectra */
for (i = 0; i < nfftc; ++i) w[i] =
crmul(clog(cmul(w[i],conjg(w[i]))),0.5);
/* Hilbert transform */
pfacc(-1,nfftc,w);
for (i=0; i<nfftc; ++i) {
w[i].r *=snfftc;
w[i].i *=snfftc;
}
for(i=1;i<nfftc/2;i++) w[i] = cadd(w[i],w[i]);
for(i=nfftc/2;i<nfftc;i++) w[i] = cmplx(0,0);
pfacc(1,nfftc,w);
/* end of Hilbert transform */
/* exponentiate */
for(i=0;i<nfftc;i++) w[i] = cexp(w[i]);
/* inverse filter */
for(i=0;i<nfftc;i++) f[i] = cdiv(cmplx(1.0,0),w[i]);
/* Load trace into tr (zero-padded) */
memset( (void *) w, (int) '\0',nfftc*sizeof(complex));
for(i=0;i<nt;i++) w[i].r = tr[i];
/* Trace to frequency domain */
pfacc(1,nfftc,w);
/* apply filter */
for(i=0;i<nfftc;i++) w[i] = cmul(w[i],f[i]);
/* Time domain */
pfacr(-1, nfftc,w,rtr);
for(i=0;i<nt;i++) rtr[i] *=snfftc;
memcpy( (void *) tr, (const void *) rtr, nt*FSIZE);
free1float(rtr);
free1float(am);
free1float(ph);
free1complex(f);
free1complex(w);
}
int
main(int argc, char **argv)
{
float c; /* speed */
float dt; /* sampling rate */
int nt; /* number of samples */
size_t ntsize; /* ... in bytes */
int nshot; /* number of shots */
int nrec; /* number of receivers */
float x0, y0, z0; /* point scatterer location */
float sxmin, symin, szmin; /* first shot location */
float gxmin, gymin, gzmin; /* first receiver location */
float dsx, dsy, dsz; /* step in shot location */
float dgx, dgy, dgz; /* step in receiver location */
float sx, sy, sz; /* shot location */
float gx, gy, gz; /* receiver location */
float rs; /* distance to shot */
float rg; /* distance to receiver */
float d; /* rs + rg */
float t; /* total travel time */
float k; /* constant part of response */
register float *rt; /* real trace */
register complex *ct; /* complex transformed trace */
int nfft; /* size of fft */
int nfby2; /* nfft/2 */
int nfby2p1; /* nfft/2 + 1 */
size_t nzeros; /* padded zeroes in bytes */
float spread; /* 3-D spreading factor */
register int i; /* counter */
register int s; /* shot counter */
register int g; /* receiver counter */
register int tracl; /* trace counter */
float amplitude[1]; /* amplitude */
float *tout; /* times[nt] for interpolation */
/* Initialize */
initargs(argc, argv);
requestdoc(0);
/* Get parameters */
if (!getparint("nshot", &nshot)) nshot = 1;
if (!getparint("nrec", &nrec)) nrec = 1;
if (!getparint("nt", &nt)) nt = 256;
if (!getparfloat("c", &c)) c = 5000.0;
if (!getparfloat("dt", &dt)) dt = 0.004;
if (!getparfloat("x0", &x0)) x0 = 1000.0;
if (!getparfloat("y0", &y0)) y0 = 0.0;
if (!getparfloat("z0", &z0)) z0 = 1000.0;
if (!getparfloat("sxmin", &sxmin)) sxmin = 0.0;
if (!getparfloat("symin", &symin)) symin = 0.0;
if (!getparfloat("szmin", &szmin)) szmin = 0.0;
if (!getparfloat("gxmin", &gxmin)) gxmin = 0.0;
if (!getparfloat("gymin", &gymin)) gymin = 0.0;
if (!getparfloat("gzmin", &gzmin)) gzmin = 0.0;
if (!getparfloat("dsx", &dsx)) dsx = 100.0;
if (!getparfloat("dsy", &dsy)) dsy = 0.0;
if (!getparfloat("dsz", &dsz)) dsz = 0.0;
if (!getparfloat("dgx", &dgx)) dgx = 100.0;
if (!getparfloat("dgy", &dgy)) dgy = 0.0;
if (!getparfloat("dgz", &dgz)) dgz = 0.0;
/* Set the constant header fields */
tr.ns = nt;
tr.dt = dt * 1000000.0;
ntsize = nt * FSIZE;
/* Set up for fft */
nfft = npfaro(nt, LOOKFAC * nt);
if (nfft >= SU_NFLTS || nfft >= PFA_MAX)
err("Padded nt=%d -- too big", nfft);
nfby2 = nfft / 2;
nfby2p1 = nfby2 + 1;
nzeros = (nfft - nt) * FSIZE;
/* Allocate fft arrays */
rt = ealloc1float(nfft);
ct = ealloc1complex(nfby2p1);
/* Set the constant in the response amplitude
including scale for inverse fft below */
k = 1.0 / (4.0 * c * c * dt * dt * dt * nfft * nfft * nfft);
/* Compute output times for interpolation */
tout = ealloc1float(nt);
for (i=0; i<nt; i++) tout[i]=i*dt;
/* Create the traces */
tracl = 0;
for (s = 0; s < nshot; ++s) { /* loop over shots */
sx = sxmin + s * dsx;
sy = symin + s * dsy;
sz = szmin + s * dsz;
rs = sqrt((sx - x0)*(sx - x0) + (sy - y0)*(sy - y0) +
(sz - z0)*(sz - z0));
for (g = 0; g < nrec; ++g) { /* loop over receivers */
memset( (void *) tr.data, 0, ntsize);
gx = gxmin + g * dgx;
gy = gymin + g * dgy;
gz = gzmin + g * dgz;
rg = sqrt((gx - x0)*(gx - x0) + (gy - y0)*(gy - y0) +
(gz - z0)*(gz - z0));
d = rs + rg;
t = d/c;
spread = rs*rg;
amplitude[0] = k/spread;
/* Distribute response over full trace */
ints8r(1,dt,t,amplitude,0,0,nt,tout,tr.data);
/* Load trace into rt (zero-padded) */
memcpy( (void *) rt, (const void *) tr.data, ntsize);
memset( (void *) (rt + nt), 0, nzeros);
/* FFT */
pfarc(1, nfft, rt, ct);
/* Multiply by omega^2 */
for (i = 0; i < nfby2p1; ++i)
ct[i] = crmul(ct[i], i*i);
/* Invert and take real part */
pfacr(-1, nfft, ct, rt);
/* Load traces back in */
memcpy( (void *) tr.data, (const void *) rt, ntsize);
/* Set header fields---shot fields set above */
tr.tracl = tr.tracr = ++tracl;
tr.fldr = 1 + s;
tr.tracf = 1 + g;
tr.sx = NINT(sx);
tr.sy = NINT(sy);
tr.selev = -NINT(sz); /* above sea level > 0 */
tr.gx = NINT(gx);
tr.gy = NINT(gy);
tr.gelev = -NINT(gz); /* above sea level > 0 */
/* If along a coordinate axis, use a signed offset */
tr.offset = sqrt((sx - gx)*(sx - gx) +
(sy - gy)*(sy - gy) +
(sz - gz)*(sz - gz));
if (dgy == 0 && dgz == 0)
tr.offset = NINT(dsx > 0 ? gx - sx : sx - gx);
if (dgx == 0 && dgz == 0)
tr.offset = NINT(dsy > 0 ? gy - sy : sy - gy);
if (dgx == 0 && dgy == 0)
tr.offset = NINT(dsz > 0 ? gz - sz : sz - gz);
puttr(&tr);
} /* end loop on receivers */
} /* end loop on shots */
return(CWP_Exit());
}
int main( int argc, char *argv[] )
{
int ntr=0; /* number of traces */
int ntrv=0; /* number of traces */
int ns=0;
int nsv=0;
float dt;
float dtv;
cwp_String fs;
cwp_String fv;
FILE *fps;
FILE *fpv;
FILE *headerfp;
float *data; /* data matrix of the migration volume */
float *vel; /* velocity matrix */
float *velfi; /* velocity function interpolated to ns values*/
float *velf; /* velocity function */
float *vdt;
float *ddt;
float *ap; /* array of apperture values in m */
float apr; /* array of apperture values in m */
int *apt=NULL; /* array of apperture time limits in mig. gath*/
float r; /* maximum radius with a given apperture */
float ir2; /* r/d2 */
float ir3; /* r/d3 */
float d2; /* spatial sampling int. in dir 2. */
float d3; /* spatial sampling int. in dir 3. */
float **mgd=NULL; /* migration gather data */
float *migt; /* migrated data trace */
int **mgdnz=NULL; /* migration gather data non zero samples*/
float dm; /* migration gather spatial sample int. */
int im; /* number of traces in migration gather */
int *mtnz; /* migrated trace data non zero smaples */
char **dummyi; /* index array that the trace contains zeros only */
float fac; /* velocity scale factor */
int sphr; /* spherical divergence flag */
int imt; /* mute time sample of trace */
float tmp;
int imoff;
int **igtr=NULL;
int nigtr;
int n2;
int n3;
int verbose;
/* phase shift filter stuff */
float power; /* power of i omega applied to data */
float amp; /* amplitude associated with the power */
float arg; /* argument of power */
float phasefac; /* phase factor */
float phase; /* phase shift = phasefac*PI */
complex exparg; /* cexp(I arg) */
register float *rt; /* real trace */
register complex *ct; /* complex transformed trace */
complex *filt; /* complex power */
float omega; /* circular frequency */
float domega; /* circular frequency spacing (from dt) */
float sign; /* sign in front of i*omega default -1 */
int nfft; /* number of points in nfft */
int nf; /* number of frequencies (incl Nyq) */
float onfft; /* 1 / nfft */
size_t nzeros; /* number of padded zeroes in bytes */
initargs(argc, argv);
requestdoc(1);
MUSTGETPARSTRING("fs",&fs);
MUSTGETPARSTRING("fv",&fv);
MUSTGETPARINT("n2",&n2);
MUSTGETPARINT("n3",&n3);
MUSTGETPARFLOAT("d2",&d2);
MUSTGETPARFLOAT("d3",&d3);
if (!getparfloat("dm", &dm)) dm=(d2+d3)/2.0;
/* open datafile */
fps = efopen(fs,"r");
fpv = efopen(fv,"r");
/* Open tmpfile for headers */
headerfp = etmpfile();
/* get information from the first data trace */
ntr = fgettra(fps,&tr,0);
if(n2*n3!=ntr) err(" Number of traces in file %d not equal to n2*n3 %d \n",
ntr,n2*n3);
ns=tr.ns;
if (!getparfloat("dt", &dt)) dt = ((float) tr.dt)/1000000.0;
if (!dt) {
dt = .002;
warn("dt not set, assumed to be .002");
}
/* get information from the first velocity trace */
ntrv = fgettra(fpv,&trv,0);
if(ntrv!=ntr) err(" Number of traces in velocity file %d differ from %d \n",
ntrv,ntr);
nsv=trv.ns;
if (!getparfloat("dtv", &dtv)) dtv = ((float) trv.dt)/1000000.0;
if (!dtv) {
dtv = .002;
warn("dtv not set, assumed to be .002 for velocity");
}
if (!getparfloat("fac", &fac)) fac=2.0;
if (!getparint("verbose", &verbose)) verbose=0;
if (!getparint("sphr", &sphr)) sphr=0;
if (!getparfloat("apr", &apr)) apr=75;
apr*=3.141592653/180;
/* allocate arrays */
data = bmalloc(sizeof(float),ns,ntr);
vel = bmalloc(sizeof(float),nsv,ntr);
velf = ealloc1float(nsv);
velfi = ealloc1float(ns);
migt = ealloc1float(ns);
vdt = ealloc1float(nsv);
ddt = ealloc1float(ns);
ap = ealloc1float(ns);
mtnz = ealloc1int(ns);
dummyi = (char **) ealloc2(n2,n3,sizeof(char));
/* Times to do interpolation of velocity from sparse sampling */
/* to fine sampling of the data */
{ register int it;
for(it=0;it<nsv;it++) vdt[it]=it*dtv;
for(it=0;it<ns;it++) ddt[it]=it*dt;
}
/* Read traces into data */
/* Store headers in tmpfile */
ntr=0;
erewind(fps);
erewind(fpv);
{ register int i2,i3;
for(i3=0;i3<n3;i3++)
for(i2=0;i2<n2;i2++) {
fgettr(fps,&tr);
fgettr(fpv,&trv);
if(tr.trid > 2) dummyi[i3][i2]=1;
else dummyi[i3][i2]=0;
efwrite(&tr, 1, HDRBYTES, headerfp);
bmwrite(data,1,0,i3*n2+i2,ns,tr.data);
bmwrite(vel,1,0,i3*n2+i2,nsv,trv.data);
}
erewind(headerfp);
/* set up the phase filter */
power = 1.0;sign = 1.0;phasefac = 0.5;
phase = phasefac * PI;
/* Set up for fft */
nfft = npfaro(ns, LOOKFAC * ns);
if (nfft >= SU_NFLTS || nfft >= PFA_MAX)
err("Padded nt=%d -- too big", nfft);
nf = nfft/2 + 1;
onfft = 1.0 / nfft;
nzeros = (nfft - ns) * FSIZE;
domega = TWOPI * onfft / dt;
/* Allocate fft arrays */
rt = ealloc1float(nfft);
ct = ealloc1complex(nf);
filt = ealloc1complex(nf);
/* Set up args for complex power evaluation */
arg = sign * PIBY2 * power + phase;
exparg = cexp(crmul(I, arg));
{
register int i;
for (i = 0 ; i < nf; ++i) {
omega = i * domega;
/* kludge to handle omega=0 case for power < 0 */
if (power < 0 && i == 0) omega = FLT_MAX;
/* calculate filter */
amp = pow(omega, power) * onfft;
filt[i] = crmul(exparg, amp);
}
}
/* set up constants for migration */
if(verbose) fprintf(stderr," Setting up constants....\n");
r=0;
for(i3=0;i3<n3;i3++)
for(i2=0;i2<n2;i2++) {
if(dummyi[i3][i2] < 1) {
/* get the velocity function */
bmread(vel,1,0,i3*n2+i2,nsv,velf);
/* linear interpolation from nsv to ns values */
intlin(nsv,vdt,velf,velf[0],velf[nsv-1],ns,ddt,velfi);
/* Apply scale factor to velocity */
{ register int it;
for(it=0;it<ns;it++) velfi[it] *=fac;
}
/* compute maximum radius from apperture and velocity */
{ register int it;
for(it=0;it<ns;it++)
ap[it] = ddt[it]*velfi[it]*tan(apr)/2.0;
}
tmp = ap[isamax(ns,ap,1)];
if(tmp>r) r=tmp;
}
}
r=MIN(r,sqrt(SQR((n2-1)*d2)+SQR((n3-1)*d3)));
ir2 = (int)(2*r/d2)+1;
ir3 = (int)(2*r/d3)+1;
im = (int)(r/dm)+1;
/* allocate migration gather */
mgd = ealloc2float(ns,im);
mgdnz = ealloc2int(ns,im);
apt = ealloc1int(im);
/* set up the stencil for selecting traces */
igtr = ealloc2int(ir2*ir3,2);
stncl(r, d2, d3,igtr,&nigtr);
if(verbose) {
fprintf(stderr," Maximum radius %f\n",r);
fprintf(stderr," Maximum offset %f\n",
sqrt(SQR((n2-1)*d2)+SQR((n3-1)*d3)));
}
/* main processing loop */
for(i3=0;i3<n3;i3++)
for(i2=0;i2<n2;i2++) {
memset( (void *) tr.data, (int) '\0',ns*FSIZE);
if(dummyi[i3][i2] < 1) {
memset( (void *) mgd[0], (int) '\0',ns*im*FSIZE);
memset( (void *) mgdnz[0], (int) '\0',ns*im*ISIZE);
/* get the velocity function */
bmread(vel,1,0,i3*n2+i2,nsv,velf);
/* linear interpolation from nsv to ns values */
intlin(nsv,vdt,velf,velf[0],velf[nsv-1],ns,ddt,velfi);
/* Apply scale factor to velocity */
{ register int it;
for(it=0;it<ns;it++) velfi[it] *=fac;
}
/* create the migration gather */
{ register int itr,ist2,ist3;
for(itr=0;itr<nigtr;itr++) {
ist2=i2+igtr[0][itr];
ist3=i3+igtr[1][itr];
if(ist2 >= 0 && ist2 <n2)
if(ist3 >= 0 && ist3 <n3) {
if(dummyi[ist3][ist2] <1) {
imoff = (int) (
sqrt(SQR(igtr[0][itr]*d2)
+SQR(igtr[1][itr]*d3))/dm+0.5);
bmread(data,1,0,ist3*n2+ist2,ns,tr.data);
imoff=MIN(imoff,im-1);
{ register int it;
/* get the mute time for this
offset, apperture and velocity */
xindex(ns,ap,imoff*dm,&imt);
for(it=imt;it<ns;it++)
if(tr.data[it]!=0) {
mgd[imoff][it]+=tr.data[it];
mgdnz[imoff][it]+=1;
}
}
}
}
}
}
/* normalize the gather */
{ register int ix,it;
for(ix=0;ix<im;ix++)
for(it=0;it<ns;it++)
if(mgdnz[ix][it] > 1) mgd[ix][it] /=(float) mgdnz[ix][it];
}
memset( (void *) tr.data, (int) '\0',ns*FSIZE);
memset( (void *) mtnz, (int) '\0',ns*ISIZE);
/* do a knmo */
{ register int ix,it;
for(ix=0;ix<im;ix++) {
/* get the mute time for this
offset, apperture and velocity */
xindex(ns,ap,ix*dm,&imt);
knmo(mgd[ix],migt,ns,velfi,0,ix*dm,dt,imt,sphr);
/* stack the gather */
for(it=0;it<ns;it++) {
if(migt[it]!=0.0) {
tr.data[it] += migt[it];
mtnz[it]++;
}
/* tr.data[it] += mgd[ix][it]; */
}
}
}
{ register int it;
for(it=0;it<ns;it++)
if(mtnz[it]>1) tr.data[it] /=(float)mtnz[it];
}
/*Do the phase filtering before the trace is released*/
/* Load trace into rt (zero-padded) */
memcpy( (void *) rt, (const void *) tr.data, ns*FSIZE);
memset((void *) (rt + ns), (int) '\0', nzeros);
pfarc(1, nfft, rt, ct);
{ register int i;
for (i = 0; i < nf; ++i) ct[i] = cmul(ct[i], filt[i]);
}
pfacr(-1, nfft, ct, rt);
memcpy( (void *) tr.data, (const void *) rt, ns*FSIZE);
} /* end of dummy if */
/* spit out the gather */
efread(&tr, 1, HDRBYTES, headerfp);
puttr(&tr);
if(verbose) fprintf(stderr," %d %d\n",i2,i3);
} /* end of i2 loop */
} /* end of i3 loop */
/* This should be the last thing */
efclose(headerfp);
/* Free memory */
free2int(igtr);
free2float(mgd);
free2int(mgdnz);
free1int(apt);
bmfree(data);
bmfree(vel);
free1float(velfi);
free1float(velf);
free1float(ddt);
free1float(vdt);
free1float(ap);
free1int(mtnz);
free1float(migt);
free1float(rt);
free1complex(ct);
free1complex(filt);
free2((void **) dummyi);
return EXIT_SUCCESS;
}