void retris(complex *data,complex *a,complex *c, complex *b,
complex endl,complex endr, int nx, complex *d)
{
int ix;
complex *e,den;
complex *f;
e=alloc1complex(nx);
f=alloc1complex(nx);
e[0]=cdiv(cneg(a[0]),endl);
f[0]=cdiv(d[0],endl);
for(ix=1;ix<nx-1;++ix){
den=cadd(b[ix],cmul(c[ix],e[ix-1]));
e[ix]=cdiv(cneg(a[ix]),den);
f[ix]=cdiv(csub(d[ix],cmul(f[ix-1],c[ix])),den);
}
data[nx-1]=cdiv(csub(d[nx-1],cmul(f[nx-2],c[nx-2])),cadd(endr,cmul(c[nx-2],e[nx-2])));
for(ix=nx-2;ix>-1;--ix)
data[ix]=cadd(cmul(data[ix+1],e[ix]),f[ix]);
free1complex(e);
free1complex(f);
return;
}
/************************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 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 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());
}
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;
}
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 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 SeisPipe2D(DsuTask *zz)
{
int nt,nx,nz,nw,ntpad,ntfft;
int it,ix,iz,izz,iw,iw0,iw1,iw2,iw3,iwmin,iwmax;
int nfreqs,verbose;
float dt,dx,dy,dz,dw;
float freqs[4],fw,w,scale,fftscl;
float *p, **v, *wdxov,*sx;
complex *cpx;
float **qx;
void *TabInfo;
eTable *et;
char msg[80];
int info, ToTid, MasterTid;
int sz, pz, pei;
int SeisIntPars[20];
float SeisFloPars[20];
/* Receive process control information */
MsgLog(zz, "Receiving Control info ... " );
MasterTid = RecvInt(SeisIntPars, 2, -1, MsgCntl);
pei = SeisIntPars[0];
ToTid = SeisIntPars[1];
MsgLog(zz, " Ready \n");
/* Receive: efile and other pars ... */
MsgLog(zz, "Receiving parameters ..." );
TabInfo = RecvBytes(-1, MsgTable);
RecvFI(SeisFloPars, 10, SeisIntPars, 10, -1, -1);
MsgLog(zz, " Ready \n" );
/* get integer parameters */
nt = SeisIntPars[0];
nx = SeisIntPars[1];
nz = SeisIntPars[2];
ntpad = SeisIntPars[3];
verbose = SeisIntPars[4];
sz = SeisIntPars[5];
pz = SeisIntPars[6];
/* get Floating point parameters */
dt = SeisFloPars[0];
dx = SeisFloPars[1];
dz = SeisFloPars[2];
freqs[0] = SeisFloPars[3];
freqs[1] = SeisFloPars[4];
freqs[2] = SeisFloPars[5];
freqs[3] = SeisFloPars[6];
sz = nz / pz;
if (pei == (pz - 1)) sz += nz % pz;
sprintf(msg, "Receiving Velocity info (pei = %d, sz = %d) ... ", pei, sz);
MsgLog(zz,msg);
v = alloc2float(nx, sz);
for (iz=0; iz<sz; ++iz)
RecvFloat(v[iz], nx, -1, MsgVel);
MsgLog(zz, " Ready \n" );
/* determine frequency w sampling */
ntfft = npfar(nt+ntpad);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
iwmin = MAX(0,MIN(nw-1,NINT(2.0*PI*freqs[0]/dw)));
iwmax = MAX(0,MIN(nw-1,NINT(2.0*PI*freqs[3]/dw)));
/* read extrapolator table */
et = ezread(TabInfo);
/* pret(zz -> fp_log, et); */
/* allocate workspace */
MsgLog(zz, "Allocating space ... ");
qx = alloc2float(nx,sz);
sx = alloc1float(nx);
wdxov = alloc1float(nx);
cpx = alloc1complex(nx);
MsgLog(zz, " Ready \n");
sprintf(msg, "Process (%d) starting loop on depth steps(%d,%d)\n",
pei, pei*(nz/pz), pei*(nz/pz) + sz);
MsgLog(zz, msg);
/* Cleanup qx */
for (iz=0; iz<sz; ++iz)
for (ix=0; ix<nx; ++ix)
qx[iz][ix] = 0.0;
/* loop over frequencies w */
for (iw=iwmin,w=iwmin*dw; iw<iwmax; ++iw,w+=dw) {
if (verbose && !(iw%1)) {
sprintf(msg, "\t%d/%d\n",iw,iwmax);
MsgLog(zz, msg);
}
/* load wavefield */
RecvCplx(cpx, nx, -1, MsgSlice);
/* loop over depth steps nz */
for (iz=0; iz<sz; ++iz) {
/* compute 2.0*dx/v(x) and zero migrated data */
for (ix=0; ix<nx; ix++)
sx[ix] = 2.0*dx/v[iz][ix];
/* make w*dx/v(x) */
for (ix=0; ix<nx; ++ix)
wdxov[ix] = w*sx[ix];
/* extrapolate wavefield */
etextrap(et,nx,wdxov,cpx);
/* accumulate migrated data */
for (ix=0; ix<nx; ++ix)
qx[iz][ix] += cpx[ix].r;
}
/* Send down the wavefield */
if ( pei != (pz -1))
SendCplx(cpx, nx, ToTid, MsgSlice);
} /* End of loop for iw */
for (iz=0; iz<sz; iz++) {
izz = pei*(nz/pz) + iz;
if (verbose) {
sprintf(msg, "Sending values for iz = %d\n",izz);
MsgLog(zz, msg);
}
SendFI(qx[iz], nx, &izz, 1, MasterTid, MsgDepth);
}
sprintf(msg, "End of processing for (%d)\n",pei);
MsgLog(zz, msg);
/* free workspace */
free1float(sx);
free1float(wdxov);
free2float(v);
free2float(qx);
free1complex(cpx);
pvm_exit();
return(0);
}
/* September 1995 */
#include "stratInv.h"
segy tr; /* reading data */
void inputData(char* dataFile)
{
/* declaration of variables */
int iS, iR, iF, iF1, iF2; /* generic counters */
int ns; /* # of samples */
int wL; /* window length */
float *buffer = NULL; /* to input data */
float window; /* windowing purposes */
complex *bufferC = NULL; /* to Fourier transform the input data */
FILE *fp; /* input file */
/* memory for bufferC */
bufferC = alloc1complex(info->nSamples / 2 + 1);
fp = fopen(dataFile,"r");
if (fp == NULL)
err("Can't open input data file!\n");
for (iR = 0; iR < info->nR; iR++)
{
fgettr(fp, &tr);
ns = tr.ns;
/* DD
fprintf(stderr, "ns %d\n", ns);*/
/* allocating memory */
if (iR == 0) buffer = alloc1float(MAX(ns, info->nSamples));
/* reseting */
for (iS = 0; iS < MAX(ns, info->nSamples); iS++) buffer[iS] = 0;
memcpy(buffer, tr.data, ns * FSIZE);
/* buffer -> dataObs and compensating for complex frequency */
for (iS = 0; iS < info->nSamples; iS++)
{
buffer[iS] *= exp(-info->tau * iS * dt);
/* DD
fprintf(stderr, "buffer[%d] : %f\n", iS, buffer[iS]);*/
}
/* going to the Fourier domain */
pfarc(-1, info->nSamples, buffer, bufferC);
/* windowing (PERC_WINDOW) spectrum */
iF1 = NINT(info->f1 / info->dF);
iF2 = NINT(info->f2 / info->dF);
wL = info->nF * PERC_WINDOW / 2;
wL = 2 * wL + 1;
for (iS = 0, iF = 0; iF < info->nSamples / 2 + 1; iF++)
{
window = 0;
if (iF < iF1 || iF >= iF2)
{
bufferC[iF] = cmplx(0, 0);
}
else if (iF - iF1 < (wL - 1) / 2)
{
window =
.42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferC[iF].r *= window; bufferC[iF].i *= window;
iS++;
}
else if (iF - iF1 >= info->nF - (wL - 1) / 2)
{
iS++;
window =
.42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferC[iF].r *= window; bufferC[iF].i *= window;
}
}
/* going back to time domain */
pfacr(1, info->nSamples, bufferC, buffer);
/* copying to dataObs within target window and scaling */
for (iF = 0, iS = NINT(t1 / dt); iS <= NINT(t2 / dt); iS++, iF++)
{
dataObs[iR][iF] = (scaleData * buffer[iS]) / (float) info->nSamples;
/* DD
fprintf(stderr, "%d %d %f %f %f %f\n", iR, iF, dataObs[iR][iF],
info->f1, info->f2, scaleData);*/
}
}
/* DD
fprintf(stderr, "energy %f\n", auxm1 / (nDM * info->nR));
fwrite(&dataObs[0][0], sizeof(float), nDM * info->nR, stdout);
exit(-1);*/
/* freeing memory */
free1float(buffer);
free1complex(bufferC);
fclose(fp);
}
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());
}
float modeling()
{
/* declaration of variables */
FILE *fp; /* to report results */
int iF, iF1, iR, offset, iT1, iT2, iS, iProc, i, k;
/* counters */
int wL; /* window length */
int die; /* die processor flag */
int FReceived; /* number of frequencies processed */
int apl_pid; /* PVM process id control */
int pid; /* process id */
int processControl; /* monitoring PVM start */
int FInfo[2]; /* frequency delimiters */
float wallcpu; /* wall clock time */
float oF; /* value of the objective function */
float residue; /* data residue */
float wdw; /* windowing purposes */
float *buffer, *bufferRCD; /* auxiliary buffers */
/* upgoing waves */
complex **dataS; /* synthethics in the frequency domain */
complex *bufferC; /* auxiliary buffer */
complex **freqPart; /* frequency arrays sent by the slaves */
/* Clean up log files */
CleanLog();
/* Reseting synchronization flags */
for (i = 0; i < nFreqPart; i++)
{
statusFreq[i][2] = 0;
}
/* allocating some memory */
dataS = alloc2complex(info->nF, info->nR);
buffer = alloc1float(info->nSamples);
bufferRCD = alloc1float(info->nSamples);
bufferC = alloc1complex(info->nSamples / 2 + 1);
freqPart = alloc2complex(info->nFreqProc, info->nR);
/* reseting */
for (iF = 0; iF < info->nSamples / 2 + 1; iF++)
bufferC[iF] = zeroC;
for (iS = 0; iS < info->nSamples; iS++)
{
buffer[iS] = 0; bufferRCD[iS] = 0;
}
/* DD
fprintf(stderr, "nF -> %d\n", info->nF);*/
fprintf(stderr, "Starting communication with PVM for modeling\n");
/* starting communication with PVM */
if ((apl_pid = pvm_mytid()) < 0)
{
pvm_perror("Error enrolling master process");
exit(-1);
}
processControl = CreateSlaves(processes, PROCESS_MODELING, nProc);
if (processControl != nProc)
{
fprintf(stderr,"Problem starting PVM daemons\n");
exit(-1);
}
/* converting to velocities */
if (IMPEDANCE)
{
for (i = 0; i < info->nL + 1; i++)
{
alpha[i] /= rho[i];
beta[i] /= rho[i];
}
}
/* Broadcasting all processes common information */
BroadINFO(info, 1, processes, nProc, GENERAL_INFORMATION);
/* sending all profiles */
BroadFloat(thick, info->nL + 1, processes, nProc, THICKNESS);
BroadFloat(rho, info->nL + 1, processes, nProc, DENSITY);
BroadFloat(alpha, info->nL + 1, processes, nProc, ALPHAS);
BroadFloat(qP, info->nL + 1, processes, nProc, QALPHA);
BroadFloat(beta, info->nL + 1, processes, nProc, BETAS);
BroadFloat(qS, info->nL + 1, processes, nProc, QBETA);
/* sending frequency partitions for each process */
for (iProc = 0; iProc < nProc; iProc++)
{
FInfo[0] = statusFreq[iProc][0];
FInfo[1] = statusFreq[iProc][1];
if (info->verbose)
fprintf(stderr,
"Master sending frequencies [%d, %d] out of %d to slave Modeling %d [id:%d]\n", FInfo[0], FInfo[1], info->nF, iProc, processes[iProc]);
procInfo[iProc][0] = FInfo[0];
procInfo[iProc][1] = FInfo[1];
SendInt(FInfo, 2, processes[iProc], FREQUENCY_LIMITS);
statusFreq[iProc][2] = 1;
}
/* waiting modelled frequencies */
/* master process will send more frequencies if there's more work to do */
/* measuring elapsed time */
wallcpu = walltime();
/* reseting frequency counter */
FReceived = 0;
while (FOREVER)
{
pid = RecvCplx(freqPart[0], info->nR * info->nFreqProc, -1,
FREQUENCY_PARTITION);
/* finding the frequency limits of this process */
/* DD
fprintf(stderr, "Master finding the frequency limits of this process\n");
*/
iProc = 0;
while (pid != processes[iProc])
iProc++;
/* DD
fprintf(stderr, "iProc %d pid %d\n", iProc, pid);*/
/* copying into proper place of the total frequency array */
for (iR = 0; iR < info->nR; iR++)
{
for (k = 0, i = procInfo[iProc][0]; i <= procInfo[iProc][1]; i++, k++)
{
dataS[iR][i - initF] = freqPart[iR][k];
}
}
/* summing frequencies that are done */
FReceived += procInfo[iProc][1] - procInfo[iProc][0] + 1;
if (info->verbose)
fprintf(stderr, "Master received %d frequencies, remaining %d\n",
FReceived, info->nF - FReceived);
/* defining new frequency limits */
i = 0;
while (i < nFreqPart && statusFreq[i][2])
i++;
/* DD
fprintf(stderr, "i %d nFreqPart %d\n", i, nFreqPart);*/
if (i < nFreqPart)
{
/* there is still more work to be done */
/* tell this process to not die */
die = 0;
SendInt(&die, 1, processes[iProc], DIE);
FInfo[0] = statusFreq[i][0];
FInfo[1] = statusFreq[i][1];
if (info->verbose)
fprintf(stderr, "Master sending frequencies [%d, %d] to slave %d\n", FInfo[0], FInfo[1], processes[iProc]);
procInfo[iProc][0] = FInfo[0];
procInfo[iProc][1] = FInfo[1];
SendInt(FInfo, 2, processes[iProc], FREQUENCY_LIMITS);
statusFreq[i][2] = 1;
}
else
{
/* tell this process to die since there is no more work to do */
if (info->verbose)
fprintf(stderr, "Master ''killing'' slave %d\n", processes[iProc]);
die = 1;
SendInt(&die, 1, processes[iProc], DIE);
}
/* a check to get out the loop */
if (FReceived >= info->nF) break;
}
/* quitting PVM */
EndOfMaster();
/* getting elapsed time */
wallcpu = walltime() - wallcpu;
fprintf(stderr, "Modeling wall clock time = %f seconds\n",
wallcpu);
/* back to impedances*/
if (IMPEDANCE)
{
for (i = 0; i < info->nL + 1; i++)
{
alpha[i] *= rho[i];
beta[i] *= rho[i];
}
}
/* computing the objective function for the time window */
for (oF = 0, residue = 0, iR = 0; iR < info->nR; iR++)
{
/* windowing as it was done to the input data */
iT1 = NINT(info->f1 / info->dF);
iT2 = NINT(info->f2 / info->dF);
wL = info->nF * PERC_WINDOW / 2;
wL = 2 * wL + 1;
for (iS = 0, iF = 0; iF < info->nSamples / 2 + 1; iF++)
{
if (iF < iT1 || iF >= iT2)
{
bufferC[iF] = cmplx(0, 0);
}
else if (iF - iT1 < (wL - 1) / 2)
{
wdw = .42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferC[iF].r = dataS[iR][iF - iT1].r * wdw;
bufferC[iF].i = dataS[iR][iF - iT1].i * wdw;
iS++;
}
else if (iF - iT1 >= info->nF - (wL - 1) / 2)
{
iS++;
wdw = .42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferC[iF].r = dataS[iR][iF - iT1].r * wdw;
bufferC[iF].i = dataS[iR][iF - iT1].i * wdw;
}
else
{
bufferC[iF] = dataS[iR][iF - iT1];
}
}
/* going to time domain */
/* DD
fprintf(stderr, "going to time domain \n");*/
pfacr(1, info->nSamples, bufferC, buffer);
/* muting ? */
if (MUTE)
{
for (iS = 0; iS <= NINT(t1Mute[iR] / dt); iS++)
{
buffer[iS] = 0;
}
}
/* and computing data misfit and likelihood function */
iS = NINT(t1 / dt);
for (iT1 = 0; iT1 < nDM; iT1++)
{
bufferRCD[iT1 + iS] = 0;
for (offset = iT1, iT2 = 0; iT2 < nDM; iT2++)
{
bufferRCD[iT1 + iS] +=
(buffer[iT2 + iS] - dataObs[iR][iT2]) * CD[offset];
offset += MAX(SGN0(iT1 - iT2) * (nDM - 1 - iT2), 1);
}
oF += (buffer[iT1 + iS] - dataObs[iR][iT1]) * bufferRCD[iT1 + iS];
residue += (buffer[iT1 + iS] - dataObs[iR][iT1]) *
(buffer[iT1 + iS] - dataObs[iR][iT1]);
/* DD
fprintf(stdout, "%d %f %f %f %f %f %d %f %f\n",
nTotalSamples, oF, dt, auxm1,
info->tau, residue, iT1, buffer[iT1],
dataObs[iR][iT1 - NINT(t1 / dt)]); */
}
/* windowing bufferRCD */
iT1 = NINT(t1 / dt);
iT2 = NINT(t2 / dt);
wL = nDM * PERC_WINDOW / 2;
wL = 2 * wL + 1;
for (iS = 0, iF = 0; iF < info->nSamples; iF++)
{
if (iF < iT1 || iF >= iT2)
{
bufferRCD[iF] = 0;
}
else if (iF - iT1 < (wL - 1) / 2)
{
wdw =
.42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferRCD[iF] *= wdw;
iS++;
}
else if (iF - iT1 >= nDM - (wL - 1) / 2)
{
iS++;
wdw =
.42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferRCD[iF] *= wdw;
}
}
/* going back to Fourier domain */
pfarc(-1, info->nSamples, bufferRCD, bufferC);
for (iF1 = 0, iF = NINT(info->f1 / info->dF);
iF <= NINT(info->f2 / info->dF); iF++, iF1++)
{
resCD[iR][iF1] = bufferC[iF];
}
}
/* considering the .5 factor of the exponent of the Gaussian */
/* and normalizing the likelihood by the number of samples */
oF /= (2 * nTotalSamples);
/* freeing some memory */
/* allocating some memory */
free2complex(dataS);
free1float(buffer);
free1float(bufferRCD);
free1complex(bufferC);
free2complex(freqPart);
/* considering the regularizaton or model covariance term */
if (PRIOR)
{
auxm1 = 1. / (float) (numberPar * limRange); /* normalization */
for (auxm2 = 0, iF = 0; iF < limRange; iF++)
{
for (offset = iF, iF1 = 0; iF1 < limRange; iF1++)
{
if (vpFrechet)
{
auxm2 += (alpha[iF + lim[0]] - alphaMean[iF + lim[0]]) *
CMvP[offset] * auxm1 *
(alpha[iF1 + lim[0]] - alphaMean[iF1 + lim[0]]);
}
if (vsFrechet)
{
auxm2 += (beta[iF + lim[0]] - betaMean[iF + lim[0]]) *
CMvS[offset] * auxm1 *
(beta[iF1 + lim[0]] - betaMean[iF1 + lim[0]]);
}
if (rhoFrechet)
{
auxm2 += (rho[iF + lim[0]] - rhoMean[iF + lim[0]]) *
CMrho[offset] * auxm1 *
(rho[iF1 + lim[0]] - rhoMean[iF1 + lim[0]]);
}
offset += MAX(SGN0(iF - iF1) * (limRange - 1 - iF1), 1);
}
}
}
/* getting normalization factor */
fp = fopen("report", "a");
fprintf(fp,"-----------------------\n");
if (modCount == 0)
{
oFNorm = oF;
fprintf(fp,">> Normalization constant for objective function: %f <<\n",
oFNorm);
}
/* normalizing residue */
residue /= (nTotalSamples);
if (!DATACOV && noiseVar == 0) noiseVar = residue / 10.;
if (PRIOR)
{
fprintf(fp,
"residue at iteration [%d] : Data residue variance %f , Noise variance %f , Likelihood %f , Prior %f\n",
modCount, residue, noiseVar, oF / oFNorm, auxm2 / oFNorm);
}
else
{
fprintf(fp,"residue at iteration [%d] : Data residue variance %f , Noise variance %f , Likelihood %f , No Prior\n", modCount, residue, noiseVar, oF / oFNorm);
}
/* checking if we reached noise variance with the data residue */
if (residue / noiseVar <= 1)
{
/* DATA IS FIT, stop the procedure */
fprintf(fp, "[][][][][][][][][][][][][][][][][][][][]\n");
fprintf(fp, "DATA WAS FIT UP TO 1 VARIANCE!\n");
fprintf(fp, "[][][][][][][][][][][][][][][][][][][][]\n");
exit(0);
}
/* adding Likelihood and Prior */
if (PRIOR) oF += auxm2 / 2;
fprintf(fp,"TOTAL residue at iteration [%d] : %f\n",
modCount, oF / oFNorm);
fprintf(fp,"-----------------------\n");
fclose(fp);
/* returning objective function value */
return(oF / oFNorm);
}
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());
}
