/************************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*/
int main(int argc, char **argv) /*argc, argv - the arguments to the main() function*/
{
int nt; /*number of time samples*/
int nz; /*number of migrated depth samples*/
int nx; /*number of midpoints (traces)*/
int ix;
int iz;
float dt; /*time sampling interval*/
float dx; /*spatial sampling interval*/
float dz; /*migrated depth sampling interval*/
float **data; /*input seismic data*/
complex **image; /*migrated image*/
float **rimage; /*migrated image*/
float **v; /*velocity model*/
FILE *vfp;
char *vfile=""; /*name of velocity file*/
int verbose=1;
char *tmpdir; /* directory path for tmp files*/
cwp_Bool istmpdir=cwp_false; /* true for user-given path*/
/******************************* Intialize *********************************************/
initargs(argc,argv);
requestdoc(1);
/********************************* Get parameters **************************************/
/*get info from first trace*/
if (!gettr(&tr)) err("can't get first trace"); /*fgettr: get a fixed-length segy trace from a file by file pointer*/
nt = tr.ns; /*nt*/ /*gettr: macro using fgettr to get a trace from stdin*/
if (!getparfloat("dt", &dt)) { /*dt*/
if (tr.dt) {
dt = ((double) tr.dt)/1000000.0;
}
else {err("dt is not set");}
}
if (!getparfloat("dx", &dx)) { /*dx*/
if (tr.d2) {
dx = tr.d2;
}
else {
err("dx is not set");
}
}
/*get optional parameters*/
if (!getparint("nz",&nz)) err("nz must be specified");
if (!getparfloat("dz",&dz)) err("dz must be specified");
if (!getparstring("vfile", &vfile)) err("velocity file must be specified");
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();
/**************************** Count trace number nx ******************************/
/* store traces and headers in tempfiles while getting a count */
if (STREQ(tmpdir,"")) {
tracefp = etmpfile();
headerfp = etmpfile();
if (verbose) warn("using tmpfile() call");
}
else { /* user-supplied tmpdir */
char directory[BUFSIZ];
strcpy(directory, tmpdir);
strcpy(tracefile, temporary_filename(directory));
strcpy(headerfile, 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+");
headerfp = efopen(headerfile, "w+");
istmpdir=cwp_true;
if (verbose) warn("putting temporary files in %s", directory);
}
nx = 0;
do {
++nx; /*get the number of traces nx*/
efwrite(&tr,HDRBYTES,1,headerfp);
efwrite(tr.data, FSIZE, nt, tracefp);
} while (gettr(&tr));
erewind(tracefp); /*Set position of stream to the beginning*/
erewind(headerfp);
/******************************************************************************************/
/*allocate memory*/
data = alloc2float(nt,nx); /*2D array nx by nt*/
image = alloc2complex(nz,nx); /*2D array nx by nz*/
rimage = alloc2float(nz,nx); /*2D array nx by nz*/
v= alloc2float(nz,nx); /*2D array, in Fortran the velocity model is nz by nx 2D array*/
/*in binary, it is actually 1D*/
/* load traces into the zero-offset array and close tmpfile */
efread(*data, FSIZE, nt*nx, tracefp); /*read traces to data*/
efclose(tracefp);
/*load velicoty file*/
vfp=efopen(vfile,"r");
efread(v[0],FSIZE,nz*nx,vfp); /*load velocity*/
efclose(vfp);
/***********************finish reading data*************************************************/
/* call pspi migration function*/
pspimig(data,image,v,nt,nx,nz,dt,dx,dz);
/*get real part of image*/
for (iz=0;iz<nz;iz++){
for (ix=0;ix<nx;ix++){
rimage[ix][iz] = image[ix][iz].r;
}
}
/* restore header fields and write output */
for (ix=0; ix<nx; ix++) {
efread(&tr,HDRBYTES,1,headerfp);
tr.ns = nz;
tr.d1 = dz;
memcpy( (void *) tr.data, (const void *) rimage[ix],nz*FSIZE);
puttr(&tr);
}
/* Clean up */
efclose(headerfp);
if (istmpdir) eremove(headerfile);
if (istmpdir) eremove(tracefile);
return(CWP_Exit());
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int ntau; /* number of migrated time samples */
int nx; /* number of midpoints */
int ik,ix,it,itau,itmig;/* loop counters */
int nxfft; /* fft size */
int nk; /* number of wave numbers */
int ntmig,nvmig;
float dt; /* time sampling interval */
float ft; /* first time sample */
float dtau; /* migrated time sampling interval */
float ftau; /* first migrated time value */
float dk; /* wave number sampling interval */
float fk; /* first wave number */
float Q, ceil; /* quality factor, ceiling of amplitude */
float t,k; /* time,wave number */
float *tmig, *vmig; /* arrays of time, interval velocities */
float dx; /* spatial sampling interval */
float *vt; /* velocity v(t) */
float **p,**q; /* input, output data */
complex **cp,**cq; /* complex input,output */
char *vfile=""; /* name of file containing velocities */
int verbose=0; /* flag for echoing info */
char *tmpdir; /* directory path for tmp files */
cwp_Bool istmpdir=cwp_false;/* true for user-given path */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* 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");
}
}
/* get optional parameters */
if (!getparfloat("ft",&ft)) ft = 0.0;
if (!getparint("ntau",&ntau)) ntau = nt; CHECK_NT("ntau",ntau);
if (!getparfloat("dtau",&dtau)) dtau = dt;
if (!getparfloat("ftau",&ftau)) ftau = ft;
if (!getparfloat("Q",&Q)) Q = 1.0e6;
if (!getparfloat("ceil",&ceil)) ceil = 1.0e6;
if (verbose)warn("Q=%f ceil=%f",Q,ceil);
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);
/* store traces and headers in tempfiles while getting a count */
if (STREQ(tmpdir,"")) {
tracefp = etmpfile();
headerfp = etmpfile();
if (verbose) warn("using tmpfile() call");
} else { /* user-supplied tmpdir */
char directory[BUFSIZ];
strcpy(directory, tmpdir);
strcpy(tracefile, temporary_filename(directory));
strcpy(headerfile, 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+");
headerfp = efopen(headerfile, "w+");
istmpdir=cwp_true;
if (verbose) warn("putting temporary files in %s", directory);
}
nx = 0;
do {
++nx;
efwrite(&tr,HDRBYTES,1,headerfp);
efwrite(tr.data, FSIZE, nt, tracefp);
} while (gettr(&tr));
erewind(tracefp);
erewind(headerfp);
/* determine wavenumber sampling (for real to complex FFT) */
nxfft = npfar(nx);
nk = nxfft/2+1;
dk = 2.0*PI/(nxfft*dx);
fk = 0.0;
/* allocate space */
p = alloc2float(nt,nxfft);
q = alloc2float(ntau,nxfft);
cp = alloc2complex(nt,nk);
cq = alloc2complex(ntau,nk);
/* load traces into the zero-offset array and close tmpfile */
efread(*p, FSIZE, nt*nx, tracefp);
efclose(tracefp);
/* determine velocity function v(t) */
vt = ealloc1float(ntau);
if (!getparstring("vfile",&vfile)) {
ntmig = countparval("tmig");
if (ntmig==0) ntmig = 1;
tmig = ealloc1float(ntmig);
if (!getparfloat("tmig",tmig)) tmig[0] = 0.0;
nvmig = countparval("vmig");
if (nvmig==0) nvmig = 1;
if (nvmig!=ntmig) err("number of tmig and vmig must be equal");
vmig = ealloc1float(nvmig);
if (!getparfloat("vmig",vmig)) vmig[0] = 1500.0;
for (itmig=1; itmig<ntmig; ++itmig)
if (tmig[itmig]<=tmig[itmig-1])
err("tmig must increase monotonically");
for (it=0,t=0.0; it<ntau; ++it,t+=dt)
intlin(ntmig,tmig,vmig,vmig[0],vmig[ntmig-1],
1,&t,&vt[it]);
} else {
if (fread(vt,sizeof(float),nt,fopen(vfile,"r"))!=nt)
err("cannot read %d velocities from file %s",nt,vfile);
}
checkpars();
/* pad with zeros and Fourier transform x to k */
for (ix=nx; ix<nxfft; ix++)
for (it=0; it<nt; it++)
p[ix][it] = 0.0;
pfa2rc(-1,2,nt,nxfft,p[0],cp[0]);
/* migrate each wavenumber */
for (ik=0,k=fk; ik<nk; ik++,k+=dk)
gazdagvt(k,nt,dt,ft,ntau,dtau,ftau,vt,cp[ik],cq[ik], Q, ceil);
/* Fourier transform k to x (including FFT scaling) */
pfa2cr(1,2,ntau,nxfft,cq[0],q[0]);
for (ix=0; ix<nx; ix++)
for (itau=0; itau<ntau; itau++)
q[ix][itau] /= nxfft;
/* restore header fields and write output */
for (ix=0; ix<nx; ++ix) {
efread(&tr,HDRBYTES,1,headerfp);
tr.ns = ntau ;
tr.dt = dtau * 1000000.0 ;
tr.delrt = ftau * 1000.0 ;
memcpy( (void *) tr.data, (const void *) q[ix],ntau*FSIZE);
puttr(&tr);
}
/* Clean up */
efclose(headerfp);
if (istmpdir) eremove(headerfile);
if (istmpdir) eremove(tracefile);
return(CWP_Exit());
}
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());
}
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 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());
}
main(int argc, char **argv)
{
int nt,nx; /* numbers of samples */
float dt,dx; /* sampling intervals */
float d1,d2; /* output intervals in F, K */
float f1,f2; /* output first samples in F, K */
int it,ix; /* sample indices */
int ntfft,nxfft; /* dimensions after padding for FFT */
int nF,nK; /* transform (output) dimensions */
int iF,iK; /* transform sample indices */
register complex **ct; /* complex FFT workspace */
register float **rt; /* float FFT workspace */
FILE *tracefp; /* temp file to hold traces */
/* Hook up getpar to handle the parameters */
initargs(argc,argv);
askdoc(1);
/* Get info from first trace */
if (!gettr(&intrace)) err("can't get first trace");
nt = intrace.ns;
/* dt is used only to set output header value d1 */
if (!getparfloat("dt", &dt)) {
if (intrace.dt) { /* is dt field set? */
dt = (float) intrace.dt / 1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (intrace.d2) { /* is d2 field set? */
dx = intrace.d2;
} else {
dx = 1.0;
warn("tr.d2 not set, assuming d2=1.0");
}
}
/* Store traces in tmpfile while getting a count */
/*tracefp = etmpfile();*/
tracefp = etempfile(NULL);
nx = 0;
do {
++nx;
efwrite(intrace.data, FSIZE, nt, tracefp);
} while (gettr(&intrace));
/* Determine lengths for prime-factor FFTs */
ntfft = npfar(nt);
nxfft = npfa(nx);
if (ntfft >= MIN(SU_NFLTS, PFA_MAX)) err("Padded nt=%d--too big",ntfft);
if (nxfft >= MIN(SU_NFLTS, PFA_MAX)) err("Padded nx=%d--too big",nxfft);
/* Determine output header values */
d1 = 1.0/(ntfft*dt);
d2 = 1.0/(nxfft*dx);
f1 = 0.0;
f2 = -1.0/(2*dx);
/* Determine complex transform sizes */
nF = ntfft/2+1;
nK = nxfft;
/* Allocate space */
ct = alloc2complex(nF, nK);
rt = alloc2float(ntfft, nxfft);
/* Load traces into fft arrays and close tmpfile */
rewind(tracefp);
for (ix=0; ix<nx; ++ix) {
efread(rt[ix], FSIZE, nt, tracefp);
/* if ix odd, negate to center transform of dimension 2 */
if (ISODD(ix))
for (it=0; it<nt; ++it) rt[ix][it] = -rt[ix][it];
/* pad dimension 1 with zeros */
for (it=nt; it<ntfft; ++it) rt[ix][it] = 0.0;
}
efclose(tracefp);
/* Pad dimension 2 with zeros */
for (ix=nx; ix<nxfft; ++ix)
for (it=0; it<ntfft; ++it) rt[ix][it] = 0.0;
/* Fourier transform dimension 1 */
pfa2rc(1,1,ntfft,nx,rt[0],ct[0]);
/* Fourier transform dimension 2 */
pfa2cc(-1,2,nF,nxfft,ct[0]);
/* Compute and output amplitude spectrum */
for (iK=0; iK<nK; ++iK) {
for (iF=0; iF<nF; ++iF) outtrace.data[iF] = fcabs(ct[iK][iF]);
/* set header values */
outtrace.tracl = iK + 1;
outtrace.ns = nF;
outtrace.dt = 0; /* d1 is now the relevant step size */
outtrace.trid = KOMEGA;
outtrace.d1 = d1;
outtrace.f1 = f1;
outtrace.d2 = d2;
outtrace.f2 = f2;
puttr(&outtrace);
}
}
void slopefilter (int nslopes, float slopes[], float amps[], float bias,
int nt, float dt, int nx, float dx, FILE *tracefp)
/******************************************************************************
apply slope filter in frequency-wavenumber domain
*******************************************************************************
Input:
nslopes number of slopes (and amplitudes) specified
slopes slopes at which amplitudes are specified (see notes below)
amps amplitudes corresponding to slopes (see notes below)
bias linear moveout slope before and after filtering
nt number of time samples
dt time sampling interval
nx number of traces
dx trace space (spatial sampling interval)
tracefp file pointer to data to be filtered
Output:
tracefp file pointer to filtered data
*******************************************************************************
Notes:
Linear interpolation and constant extrapolation are used to
determine amplitudes for slopes that are not specified.
******************************************************************************/
{
int ntfft; /* nt after padding for FFT */
int nxfft; /* nx after padding for FFT */
float sfft; /* scale factor for FFT */
int nw; /* number of frequencies */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
int nk; /* number of wavenumbers */
float dk; /* wavenumber sampling interval */
float w,k; /* frequency and wavenumber */
int it,ix,iw,ik; /* sample indices */
float slope,amp; /* slope and amplitude for particular w,k */
complex **cpfft; /* complex FFT workspace */
float **pfft; /* float FFT workspace */
float phase; /* phase shift for bias */
complex cshift; /* complex phase shifter for bias */
/* determine lengths and scale factors for prime-factor FFTs */
ntfft = npfar(nt);
nxfft = npfa(nx);
sfft = 1.0/(ntfft*nxfft);
/* determine frequency and wavenumber sampling */
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
fw = 0.000001*dw; /* non-zero to avoid divide by zero w */
nk = nxfft;
dk = 2.0*PI/(nxfft*dx);
/* allocate real and complex workspace for FFTs */
cpfft = alloc2complex(nw,nk);
pfft = alloc2float(ntfft,nxfft);
/* copy data from input to FFT array and pad with zeros */
rewind(tracefp);
for (ix=0; ix<nx; ix++) {
efread(pfft[ix], FSIZE, nt, tracefp);
for (it=nt; it<ntfft; it++)
pfft[ix][it] = 0.0;
}
for (ix=nx; ix<nxfft; ix++)
for (it=0; it<ntfft; it++)
pfft[ix][it] = 0.0;
/* Fourier transform t to w */
pfa2rc(1,1,ntfft,nx,pfft[0],cpfft[0]);
/* do linear moveout bias via phase shift */
for (ix=0; ix<nx; ix++) {
for (iw=0,w=0.0; iw<nw; iw++,w+=dw) {
phase = -ix*dx*w*bias;
cshift = cmplx(cos(phase),sin(phase));
cpfft[ix][iw] = cmul(cpfft[ix][iw],cshift);
}
}
/* Fourier transform x to k */
pfa2cc(-1,2,nw,nxfft,cpfft[0]);
/* loop over wavenumbers */
for (ik=0; ik<nk; ik++) {
/* determine wavenumber */
k = (ik<=nk/2) ? ik*dk : (ik-nk)*dk;
/* loop over frequencies */
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
/* determine biased slope */
slope = k/w+bias;
/* linearly interpolate to find amplitude */
intlin(nslopes,slopes,amps,amps[0],amps[nslopes-1],
1,&slope,&);
/* include fft scaling */
amp *= sfft;
/* filter real and imaginary parts */
cpfft[ik][iw].r *= amp;
cpfft[ik][iw].i *= amp;
}
}
/* Fourier transform k to x */
pfa2cc(1,2,nw,nxfft,cpfft[0]);
/* undo linear moveout bias via phase shift */
for (ix=0; ix<nx; ix++) {
for (iw=0,w=0.0; iw<nw; iw++,w+=dw) {
phase = ix*dx*w*bias;
cshift = cmplx(cos(phase),sin(phase));
cpfft[ix][iw] = cmul(cpfft[ix][iw],cshift);
}
}
/* Fourier transform w to t */
pfa2cr(-1,1,ntfft,nx,cpfft[0],pfft[0]);
/* copy filtered data from FFT array to output */
rewind(tracefp);
for (ix=0; ix<nx; ix++)
efwrite(pfft[ix], FSIZE, nt, tracefp);
/* free workspace */
free2complex(cpfft);
free2float(pfft);
}
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());
}
void gradient(float *grad)
{
/* declaration of variables */
int i, iF, iR, iProc, iDer, iL, iU, offset;
/* counters */
int FReceived; /* number of frequencies processed */
int die; /* die processor flag */
int apl_pid; /* PVM process id control */
int pid; /* process id */
int masterId; /* master id */
int processControl; /* monitoring PVM start */
int FInfo[2]; /* frequency delimiters */
float wallcpu; /* wall clock time */
float *gradPart; /* partition of gradients */
complex **resCDPart; /* partition of resCD */
/* Clean up log files */
CleanLog();
/* Reseting synchronization flags */
for (i = 0; i < nFreqPart; i++)
{
statusFreq[i][2] = 0;
}
/* allocating some memory */
gradPart = alloc1float(numberPar * limRange);
for (i = 0; i < numberPar * limRange; i++)
{
grad[i] = 0;
}
fprintf(stderr, "Starting communication with PVM for derivatives\n");
/* starting communication with PVM */
if ((apl_pid = pvm_mytid()) < 0)
{
pvm_perror("Error enrolling master process");
exit(-1);
}
processControl = CreateSlaves(processes, PROCESS_FRECHET, 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 Frechet %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;
/* and sending the appropriate correlation chunk */
/* allocating some memory */
resCDPart = alloc2complex(FInfo[1] - FInfo[0] + 1, info->nR);
for (iR = 0; iR < info->nR; iR++)
{
for (i = 0, iF = FInfo[0]; iF <= FInfo[1]; iF++, i++)
{
resCDPart[iR][i] = resCD[iR][iF - initF];
/* fprintf(stderr, "iR %d iF %d [%f %f]\n",
iR, iF, resCDPart[iR][i].r, resCDPart[iR][i].i);*/
}
}
/* sending frequency partition to the slave process */
SendCplx(resCDPart[0], (FInfo[1] - FInfo[0] + 1) * info->nR,
processes[iProc], COVARIANCE_PARTITION);
free2complex(resCDPart);
}
/* 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 = RecvFloat(gradPart, info->numberPar * info->limRange, -1,
PARTIAL_GRADIENT);
/* 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++;
/* stacking gradient */
for (i = 0; i < info->numberPar * info->limRange; i++)
{
grad[i] += gradPart[i];
/* DD
fprintf(stderr, "i %d grad %f gradPart %f\n", i, grad[i], gradPart[i]);*/
}
/* 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;
/* sending covariance partition */
/* allocating some memory */
resCDPart = alloc2complex(FInfo[1] - FInfo[0] + 1, info->nR);
for (iR = 0; iR < info->nR; iR++)
{
for (i = 0, iF = FInfo[0]; iF <= FInfo[1]; iF++, i++)
{
resCDPart[iR][i] = resCD[iR][iF - initF];
}
}
/* sending frequency partition to the slave process */
SendCplx(resCDPart[0], (FInfo[1] - FInfo[0] + 1) * info->nR,
processes[iProc], COVARIANCE_PARTITION);
free2complex(resCDPart);
}
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;
}
/* getting elapsed time */
wallcpu = walltime() - wallcpu;
fprintf(stderr, "Frechet derivative wall clock time = %f seconds\n\n",
wallcpu);
/* back to impedances*/
if (IMPEDANCE)
{
for (i = 0; i < info->nL + 1; i++)
{
alpha[i] *= rho[i];
beta[i] *= rho[i];
}
}
/* finally the gradient, the 2 is due Parseval */
for (iDer = 0; iDer < numberPar * limRange; iDer++)
{
grad[iDer] *= 2 / (float) (nTotalSamples * oFNorm);
}
/* getting gradient in impedance domain */
if (IMPEDANCE)
{
offset = 0;
for (i = lim[0], iL = 0; iL < limRange; iL++, i++)
{
if (vpFrechet)
{
grad[iL] /= rho[i];
offset = limRange;
}
if (vsFrechet)
{
grad[iL + offset] /= rho[i];
offset += limRange;
}
if (rhoFrechet)
{
grad[iL + offset] = - alpha[i] * grad[iL] -
beta[i] * grad[iL + limRange] + grad[iL + 2 * limRange];
}
}
}
if (PRIOR)
{
auxm1 = 1. / (float) (numberPar * limRange); /* normalization */
/* considering the regularization or model covariance term */
for (i = 0; i < limRange; i++)
{
for (offset = i, iL = 0; iL < limRange; iL++)
{
iU = 0;
if (vpFrechet)
{
grad[iL] += (alpha[i + lim[0]] - alphaMean[i + lim[0]]) *
CMvP[offset] * auxm1;
iU = limRange; /* used as offset in gradient vector */
}
if (vsFrechet)
{
grad[iL + iU] += (beta[i + lim[0]] - betaMean[i + lim[0]]) *
CMvS[offset] * auxm1;
iU += limRange;
}
if (rhoFrechet)
{
grad[iL + iU] += (rho[i + lim[0]] - rhoMean[i + lim[0]]) *
CMrho[offset] * auxm1;
}
offset += MAX(SGN0(i - iL) * (limRange - 1 - iL), 1);
}
}
}
/* normalizing gradient
normalize(grad, numberPar * limRange);*/
/* freeing memory */
free1float(gradPart);
}
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 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);
}
/************************ end self doc ***********************************/
void main (int argc, char **argv)
{
/* declaration of variables */
FILE *fp, *gp; /* file pointers */
char *orientation = " "; /* orientation of recordings */
char *recFile = " "; /* receiver location file */
char *postFile = " "; /* posteriori file */
char *modelFile = " "; /* elastic model file */
char *corrDataFile = " "; /* data covariance file */
char *corrModelFile[3]; /* model covariance file */
char *frechetFile = " "; /* frechet derivative file */
int verbose; /* verbose flag */
int noFrechet; /* if 1 don't store Frechet derivatives */
int i, j, k, iU, iParam, offset, iR, shift;
/* counters */
int wL; /* taper length */
int nParam; /* number of parameters altogether */
int numberParImp; /* number of distinct parameters in */
/* impedance inversion */
float dZ; /* layer thickness within target zone */
float F1, F2, F3; /* source components */
float depth; /* current depth used in defining limits */
/* for Frechet derivatives */
float fR; /* reference frequency */
float percU; /* amount of slowness windowing */
float percW; /* amount of frequency windowing */
float limZ[2]; /* target interval (Km) */
float tMod; /* maximum modeling time */
float phi; /* azimuth angle */
float *buffer1, *buffer2; /* auxiliary buffers */
float **CmPost; /* posteriori model covariance */
float **CmPostInv; /* posteriori model covariance - inverse */
/* allocing for orientation */
orientation = malloc(1);
/* complex Zero */
zeroC = cmplx(0, 0);
/* getting input parameters */
initargs(argc, argv);
requestdoc(0);
/* seismic data and model parameters */
if (!getparstring("model", &modelFile)) modelFile = "model";
if (!getparstring("postfile", &postFile)) postFile = "posteriori";
if (!getparstring("corrData", &corrDataFile)) corrDataFile = "corrdata";
if (!getparint("impedance", &IMPEDANCE)) IMPEDANCE = 0;
if (!getparstring("frechetfile", &frechetFile)) noFrechet = 0;
else noFrechet = 1;
if (!getparint("prior", &PRIOR)) PRIOR = 1;
if (IMPEDANCE)
{
if (!getparint("p", &ipFrechet)) vpFrechet = 1;
if (!getparint("s", &isFrechet)) vsFrechet = 1;
if (!getparint("r", &rhoFrechet)) rhoFrechet = 1;
}
else
{
if (!getparint("p", &vpFrechet)) vpFrechet = 1;
if (!getparint("s", &vsFrechet)) vsFrechet = 1;
if (!getparint("rho", &rhoFrechet)) rhoFrechet = 1;
}
/* a couple of things to use later in chain rule */
if (!IMPEDANCE)
{
ipFrechet = 0; isFrechet = 0;
}
else
{
if (ipFrechet && !isFrechet)
{
vpFrechet = 1; vsFrechet = 0;
}
if (!ipFrechet && isFrechet)
{
vpFrechet = 0; vsFrechet = 1;
}
if (!ipFrechet && !isFrechet)
{
vpFrechet = 0; vsFrechet = 0;
}
if (ipFrechet && isFrechet)
{
vpFrechet = 1; vsFrechet = 1;
}
if (rhoFrechet)
{
vpFrechet = 1; vsFrechet = 1; rhoFrechet = 1;
}
}
if (!ipFrechet && ! isFrechet && !rhoFrechet && !vpFrechet && !vsFrechet)
err("No inverse unknowns to work with!\n");
numberPar = vpFrechet + vsFrechet + rhoFrechet;
numberParImp = ipFrechet + isFrechet + rhoFrechet;
if (PRIOR)
{
if (vpFrechet || ipFrechet)
{
if (!getparstring("corrP", &corrModelFile[0]))
corrModelFile[0] = "covP";
}
if (vsFrechet || isFrechet)
{
if (!getparstring("corrS", &corrModelFile[1]))
corrModelFile[1] = "covS";
}
if (rhoFrechet)
{
if (!getparstring("corrR", &corrModelFile[2]))
corrModelFile[2] = "covR";
}
}
if (!getparstring("orientation", &orientation)) orientation[0] = 'Z';
if (orientation[0] == 'z' || orientation[0] == 'Z')
{
VERTICAL = 1; RADIAL = 0;
}
else
{
VERTICAL = 0; RADIAL = 1;
}
if (!getparfloat("dz", &dZ)) dZ = .5;
if (!getparfloat("targetbeg", &limZ[0])) limZ[0] = 0.5;
if (!getparfloat("targetend", &limZ[1])) limZ[1] = 1.0;
/* geometry */
if (!getparfloat("r1", &r1)) r1 = 0.25;
if (!getparint("nr", &nR)) nR = 48;
if (!getparfloat("dr", &dR)) dR = .025;
if (!getparfloat("zs", &zs)) zs = .001;
if (!getparfloat("F1", &F1)) F1 = 0;
if (!getparfloat("F2", &F2)) F2 = 0;
if (!getparfloat("F3", &F3)) F3 = 1;
/* modeling */
if (!getparstring("receiverfile", &recFile)) recFile = " ";
if (!getparfloat("u1", &u1)) u1 = 0.0;
if (!getparfloat("u2", &u2)) u2 = 1.;
if (!getparint("directwave", &directWave)) directWave = 1;
if (!getparfloat("tau", &tau)) err("Specify tau!\n");
if (!getparint("nu", &nU)) nU = 1000;
if (!getparfloat("f1", &f1)) f1 = 2;
if (!getparfloat("f2", &f2)) f2 = 50;
if (!getparfloat("dt", &dt)) dt = 0.004;
if (!getparfloat("tmod", &tMod)) tMod = 8;
if (!getparfloat("t1", &t1)) t1 = 0;
if (!getparfloat("t2", &t2)) t2 = tMod;
if (!getparint("hanning", &hanningFlag)) hanningFlag = 1;
if (!getparfloat("wu", &percU)) percU = 10; percU /= 100;
if (!getparfloat("ww", &percW)) percW = 25; percW /= 100;
/* dialogue */
if (!getparint("verbose", &verbose)) verbose = 0;
/* checking number of receivers */
fp = fopen(recFile, "r");
if (fp != NULL)
{
nR = 0;
while (fscanf(fp, "%f\n", &auxm1) != EOF) nR++;
}
fclose(fp);
/* some hard-coded parameters */
fR = 1; wR = 2 * PI * fR; /* reference frequency */
/* how many layers */
fp = fopen(modelFile,"r");
if (fp == NULL)
err("No model file!\n");
nL = 0;
depth = 0;
while (fscanf(fp, "%f %f %f %f %f %f\n",
&aux, &aux, &aux, &aux, &aux, &aux) != EOF)
nL++;
nL--;
/* considering the unknown layers */
limRange = NINT((limZ[1] - limZ[0]) / dZ);
if (verbose)
{
fprintf(stderr,"Number of layers: %d\n", nL + 1);
fprintf(stderr,"Number of layers in target zone: %d\n", limRange);
}
if (IMPEDANCE)
{
nParam = numberParImp * limRange;
}
else
{
nParam = numberPar * limRange;
}
/* basic time-frequency stuff */
nSamples = NINT(tMod / dt) + 1;
nSamples = npfar(nSamples);
/* length of time misfit */
nDM = NINT((t2 - t1) / dt) + 1;
/* maximum time for modeling */
tMod = dt * (nSamples - 1);
dF = 1. / (tMod);
/* adjusting f1 and f2 */
aux = dF;
while (aux < f1)
aux += dF;
f1 = aux;
while (aux < f2)
aux += dF;
f2 = aux;
nF = NINT((f2 - f1) / dF);
if (nF%2 == 0)
{
f2 += dF;
nF++;
}
/* memory allocation */
alpha = alloc1float(nL + 1);
beta = alloc1float(nL + 1);
rho = alloc1float(nL + 1);
qP = alloc1float(nL + 1);
qS = alloc1float(nL + 1);
thick = alloc1float(nL + 1);
recArray = alloc1float(nR);
PSlowness = alloc2complex(2, nL + 1);
SSlowness = alloc2complex(2, nL + 1);
S2Velocity = alloc2complex(2, nL + 1);
CD = alloc1float(nDM * (nDM + 1) / 2);
if (PRIOR)
{
if(vpFrechet || ipFrechet)
CMP = alloc1float(limRange * (limRange + 1) / 2);
if(vsFrechet || isFrechet)
CMS = alloc1float(limRange * (limRange + 1) / 2);
if(rhoFrechet)
CMrho = alloc1float(limRange * (limRange + 1) / 2);
}
/* FRECHET derivative operator F */
F = alloc2float(nR * nDM, numberPar * limRange);
if (IMPEDANCE)
CmPostInv =
alloc2float(numberParImp * limRange, numberParImp * limRange);
else
CmPostInv = alloc2float(numberPar * limRange, numberPar * limRange);
v1 = alloc2complex(2, numberPar * limRange + 1);
v2 = alloc2complex(2, numberPar * limRange + 1);
DmB = alloc3complex(4, numberPar * (limRange + 2), nL);
derFactor = alloc2complex(2, nL + 1);
aux11 = alloc2complex(nR, numberPar * limRange);
aux12 = alloc2complex(nR, numberPar * limRange);
aux21 = alloc2complex(nR, numberPar * limRange);
aux22 = alloc2complex(nR, numberPar * limRange);
aux11Old = alloc2complex(nR, numberPar * limRange);
aux12Old = alloc2complex(nR, numberPar * limRange);
aux21Old = alloc2complex(nR, numberPar * limRange);
aux22Old = alloc2complex(nR, numberPar * limRange);
/* reading receiver configuration */
fp = fopen(recFile, "r");
if (fp == NULL)
{
/* standard end-on */
if (verbose) fprintf(stderr, "No receiver file available\n");
for (i = 0; i < nR; i++)
{
recArray[i] = r1 + i * dR;
}
}
else
{
if (verbose) fprintf(stderr, "Reading receiver file %s\n", recFile);
for (i = 0; i < nR; i++)
{
fscanf(fp, "%f\n", &recArray[i]);
}
}
fclose(fp);
/* reading the model file */
fp = fopen(modelFile,"r");
if (verbose)
fprintf(stderr," Thickness rho vP qP vS qS\n");
for (k = 0; k < nL + 1; k++)
{
fscanf(fp, "%f %f %f %f %f %f\n", &thick[k], &rho[k], &alpha[k],
&qP[k], &beta[k], &qS[k]);
if (verbose)
fprintf(stderr," %7.4f %4.3f %3.2f %5.1f %3.2f %5.1f\n",
thick[k], rho[k], alpha[k], qP[k], beta[k], qS[k]);
}
fclose(fp);
/* setting lim[0] and lim[1] */
for (depth = thick[0], i = 1; i <= nL; depth += thick[i], i++)
{
if (NINT(depth / dZ) <= NINT(limZ[0] / dZ)) lim[0] = i;
if (NINT(depth / dZ) < NINT(limZ[1] / dZ)) lim[1] = i;
}
lim[1]++;
/* some modeling parameters */
/* slowness increment */
dU = (u2 - u1) / (float) nU;
/* computing the window length for the slowness domain */
epslon1 = (u2 - u1) * percU;
wL = NINT(epslon1 / dU);
wL = 2 * wL + 1;
u2 += epslon1;
nU = NINT((u2 - u1) / dU); /* new nU to preserve last slowness */
/* w/o being windowed */
taper = alloc1float(nU);
/* building window for slowness integration */
for (i = (wL - 1) / 2, iU = 0; iU < nU; iU++)
{
taper[iU] = 1;
if (iU >= nU - (wL - 1) / 2)
{
i++;
taper[iU] =
.42 - .5 * cos(2 * PI * (float) i / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) i / ((float) (wL - 1)));
}
}
/* filtering in frequency domain */
filter(percW);
/* building frequency filtering */
/* I will assume that the receivers are in line (at z = 0) so phi = 0 */
phi = 0;
epslon1 = F3;
epslon2 = F1 * cos(phi) + F2 * sin(phi);
/* correction for the 1st layer */
thick[0] -= zs;
/* imaginary part of frequency for damping wrap-around */
tau = log(tau) / tMod;
if (tau > TAUMAX)
tau = TAUMAX;
/* normalization for the complex slowness */
if (f1 > 7.5)
wRef = f1 * 2 * PI;
else
wRef = 7.5 * 2 * PI;
/* reading data and model covariance matrixes */
inputCovar(corrDataFile, corrModelFile);
/* starting inverse procedure */
/* FRECHET derivative matrix */
gradient();
if (!noFrechet)
{
fp = fopen(frechetFile, "w");
for (i = 0; i < numberPar * limRange; i++)
{
fwrite(&F[i][0], sizeof(float), nR * nDM, fp);
}
fclose(fp);
}
/* building a-posteriori model covariance matrix */
/* prior information is used */
buffer1 = alloc1float(nDM);
buffer2 = alloc1float(nDM * nR);
if (verbose) fprintf(stderr, "Building posteriori covariance...\n");
for (iParam = 0; iParam < nParam; iParam++)
{
for (i = 0; i < nDM; i++)
{
for (offset = i, k = 0; k < nDM; k++)
{
buffer1[k] = CD[offset];
offset += MAX(SGN0(i - k) * (nDM - 1 - k), 1);
}
/* doing the product CD F */
for (iR = 0; iR < nR; iR++)
{
buffer2[iR * nDM + i] = 0;
for (k = 0; k < nDM; k++)
{
buffer2[iR * nDM + i] += buffer1[k] *
F[iParam][iR * nDM + k];
}
}
}
for (j = 0; j < nParam; j++)
{
CmPostInv[j][iParam] = 0;
for (k = 0; k < nDM * nR; k++)
{
CmPostInv[j][iParam] += buffer2[k] * F[j][k];
}
}
}
if (verbose)
fprintf(stderr, "Posteriori covariance built. Including prior...\n");
free1float(buffer1);
buffer1 = alloc1float(nParam);
/* including prior covariance matrix */
if (PRIOR)
{
shift = 0;
if (IMPEDANCE)
{
if (ipFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMP[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam][k] += buffer1[k];
}
}
shift += limRange;
}
}
else
{
if (vpFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMP[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam][k] += buffer1[k];
}
}
shift += limRange;
}
}
if (IMPEDANCE)
{
if (isFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMS[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
shift += limRange;
}
}
else
{
if (vsFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMS[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
shift += limRange;
}
}
if (rhoFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMrho[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
}
}
if (verbose) fprintf(stderr, "Prior included. Inverting matrix...\n");
/* freeing memory */
free1float(buffer1);
free1float(buffer2);
free1float(alpha);
free1float(beta);
free1float(rho);
free1float(qP);
free1float(qS);
free1float(thick);
free2complex(PSlowness);
free2complex(SSlowness);
free2complex(S2Velocity);
free1float(CD);
free1float(CMP);
free1float(CMS);
free1float(CMrho);
free2float(F);
free2complex(v1);
free2complex(v2);
free3complex(DmB);
free2complex(derFactor);
free2complex(aux11);
free2complex(aux12);
free2complex(aux21);
free2complex(aux22);
free2complex(aux11Old);
free2complex(aux12Old);
free2complex(aux21Old);
free2complex(aux22Old);
/* inverting the matrix */
CmPost = alloc2float(nParam, nParam);
for (i = 0; i < nParam; i++) for (j = 0; j < nParam; j++)
CmPostInv[i][j] = CmPost[i][j];
inverse_matrix(nParam, CmPostInv);
if (verbose) fprintf(stderr, "Done with inverse matrix routine.\n");
buffer1 = alloc1float(nParam);
gp = fopen(postFile, "w");
for (i = 0; i < nParam; i++)
{
fwrite(CmPostInv[i], sizeof(float), nParam, gp);
}
fclose(fp);
}
main (int argc, char **argv)
{
/* declaration of variables */
FILE *fp; /* file pointer */
char *auxChar; /* auxiliar character */
char *modelFile = " "; /* elastic model file */
/* THICK - RHO - VP - QP - VS - QS */
int i, k, iProc, iR; /* counters */
int initF, lastF; /* initial and final frequencies */
int apl_pid; /* PVM process id control */
int nSamplesOrig; /* time series length */
int die; /* flag used to kill processes */
int pid; /* process id */
int nProc; /* number of processes */
int processControl; /* monitoring PVM start */
int *processes; /* array with process ids */
int FReceived; /* number of frequencies processed */
int nFreqProc; /* number of frequencies per process */
int nFreqPart; /* number of frequency partitions */
int **statusFreq; /* monitors processed frequencies */
int FInfo[2]; /* frequency delimiters */
int **procInfo; /* frequency limits for each processor */
float wallcpu; /* wall clock time */
float dt; /* time sampling interval */
float f; /* current frequency */
float fR; /* reference frequency */
float tMax; /* maximum recording time */
float *thick, *alpha, *beta,
*rho, *qP, *qS; /* elastic constants and thickness */
complex **freqPart; /* frequency arrays sent by the slaves */
complex **uRF, **uZF; /* final frequency components */
INFO info[1]; /* basic information for slaves */
/* Logging information */
/* CleanLog(); */
/* getting input */
initargs(argc, argv);
requestdoc(0);
if (!getparstring("model", &modelFile)) modelFile = "model";
if (!getparstring("recfile", &auxChar)) auxChar = " ";
sprintf(info->recFile, "%s", auxChar);
if (!getparint("directwave", &info->directWave)) info->directWave = 1;
if (!getparfloat("r1", &info->r1)) info->r1 = 0;
if (!getparint("nr", &info->nR)) info->nR = 148;
if (!getparfloat("dr", &info->dR)) info->dR = .025;
if (!getparfloat("zs", &info->zs)) info->zs = 0.001;
if (info->zs <= 0) info->zs = 0.001;
if (!getparfloat("u1", &info->u1)) info->u1 = 0.0002;
if (!getparfloat("u2", &info->u2)) info->u2 = 1.;
if (!getparint("nu", &info->nU)) info->nU = 1000;
if (!getparfloat("f1", &info->f1)) info->f1 = 2;
if (!getparfloat("f2", &info->f2)) info->f2 = 50;
if (!getparfloat("dt", &dt)) dt = 0.004;
if (!getparfloat("tmax", &tMax)) tMax = 8;
if (!getparfloat("F1", &info->F1)) info->F1 = 0;
if (!getparfloat("F2", &info->F2)) info->F2 = 0;
if (!getparfloat("F3", &info->F3)) info->F3 = 1;
if (!getparint("hanning", &info->hanningFlag)) info->hanningFlag = 0;
if (!getparfloat("wu", &info->percU)) info->percU = 5; info->percU /= 100;
if (!getparfloat("ww", &info->percW)) info->percW = 5; info->percW /= 100;
if (!getparfloat("fr", &fR)) fR = 1; info->wR = 2 * PI * fR;
if (!getparfloat("tau", &info->tau)) info->tau = 50;
if (!getparint("nproc", &nProc)) nProc = 1;
if (!getparint("nfreqproc", &nFreqProc) || nProc == 1) nFreqProc = 0;
if (!getparint("verbose", &info->verbose)) info->verbose = 0;
/* how many layers */
fp = fopen(modelFile,"r");
if (fp == NULL)
err("No model file!\n");
info->nL = 0;
while (fscanf(fp, "%f %f %f %f %f %f\n",
&f, &f, &f, &f, &f, &f) != EOF)
info->nL++;
info->nL--;
fclose(fp);
if (info->verbose)
fprintf(stderr,"Number of layers in model %s : %d\n",
modelFile, info->nL + 1);
/* if specific geometry, count number of receivers */
fp = fopen(info->recFile, "r");
if (fp != NULL)
{
info->nR = 0;
while (fscanf(fp, "%f\n", &f) != EOF)
info->nR++;
}
fclose(fp);
/* memory allocation */
alpha = alloc1float(info->nL + 1);
beta = alloc1float(info->nL + 1);
rho = alloc1float(info->nL + 1);
qP = alloc1float(info->nL + 1);
qS = alloc1float(info->nL + 1);
thick = alloc1float(info->nL + 1);
processes = alloc1int(nProc);
procInfo = alloc2int(2, nProc);
/* reading the file */
fp = fopen(modelFile,"r");
if (info->verbose)
fprintf(stderr,"Thickness rho vP qP vS qS\n");
for (i = 0; i < info->nL + 1; i++)
{
fscanf(fp, "%f %f %f %f %f %f\n", &thick[i], &rho[i], &alpha[i],
&qP[i], &beta[i], &qS[i]);
if (info->verbose)
fprintf(stderr," %7.4f %4.3f %3.2f %5.1f %3.2f %5.1f\n",
thick[i], rho[i], alpha[i], qP[i], beta[i], qS[i]);
}
fclose(fp);
/* computing frequency interval */
info->nSamples = NINT(tMax / dt) + 1;
nSamplesOrig = info->nSamples;
info->nSamples = npfar(info->nSamples);
/* slowness increment */
info->dU = (info->u2 - info->u1) / (float) info->nU;
/* computing more frequency related quatities */
tMax = dt * (info->nSamples - 1);
info->dF = 1. / (tMax);
f = info->dF;
while (f < info->f1) f += info->dF;
info->f1 = f;
while (f < info->f2) f += info->dF;
info->f2 = f;
initF = NINT(info->f1 / info->dF);
lastF = NINT(info->f2 / info->dF);
info->nF = lastF - initF + 1;
if (info->nF%2 == 0)
{
info->nF++;
lastF++;
}
/* attenuation of wrap-around */
info->tau = log(info->tau) / tMax;
if (info->tau > TAUMAX)
info->tau = TAUMAX;
if (info->verbose)
fprintf(stderr, "Discrete frequency range to model: [%d, %d]\n",
initF, lastF);
if (nFreqProc == 0)
nFreqProc = NINT((float) info->nF / (float) nProc + .5);
else
while (nFreqProc > info->nF) nFreqProc /= 2;
nFreqPart = NINT((float) info->nF / (float) nFreqProc + .5);
/* memory allocation for frequency arrays */
uRF = alloc2complex(info->nSamples / 2 + 1, info->nR);
uZF = alloc2complex(info->nSamples / 2 + 1, info->nR);
freqPart = alloc2complex(nFreqProc, info->nR);
statusFreq = alloc2int(3, nFreqPart);
/* defining frequency partitions */
for (k = initF, i = 0; i < nFreqPart; i++, k += nFreqProc)
{
statusFreq[i][0] = k;
statusFreq[i][1] = MIN(k + nFreqProc - 1, lastF);
statusFreq[i][2] = 0;
}
if (info->verbose)
fprintf(stderr, "Starting communication with PVM\n");
/* starting communication with PVM */
if ((apl_pid = pvm_mytid()) < 0)
{
err("Error enrolling master process");
/* exit(-1); */
}
fprintf(stderr, "Starting %d slaves ... ", nProc);
processControl = CreateSlaves(processes, PROCESS, nProc);
if (processControl != nProc)
{
err("Problem starting Slaves (%s)\n", PROCESS);
/* exit(-1); */
}
fprintf(stderr, " Ready \n");
info->nFreqProc = nFreqProc;
/* Broadcasting all processes common information */
BroadINFO(info, 1, processes, nProc, GENERAL_INFORMATION);
if (info->verbose) {
fprintf(stderr, "Broadcasting model information to all slaves\n");
fflush(stderr);
}
/* 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, ALPHA);
BroadFloat(qP, info->nL + 1, processes, nProc, QALPHA);
BroadFloat(beta, info->nL + 1, processes, nProc, BETA);
BroadFloat(qS, info->nL + 1, processes, nProc, QBETA);
/* freeing memory */
free1float(thick);
free1float(rho);
free1float(alpha);
free1float(qP);
free1float(beta);
free1float(qS);
/* 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 %d [id:%d]\n"
,FInfo[0], FInfo[1], info->nF, iProc, processes[iProc]);
fflush(stderr);
}
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 * nFreqProc, -1,
FREQUENCY_PARTITION_VERTICAL);
/* finding the frequency limits of this process */
iProc = 0;
while (pid != processes[iProc])
iProc++;
/* 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++)
{
uZF[iR][i] = freqPart[iR][k];
}
}
pid = RecvCplx(freqPart[0], info->nR * nFreqProc, -1,
FREQUENCY_PARTITION_RADIAL);
/* finding the frequency limits of this process */
iProc = 0;
while (pid != processes[iProc])
iProc++;
/* 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++)
{
uRF[iR][i] = 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);
/* if (FReceived >= info->nF) break; */
/* defining new frequency limits */
i = 0;
while (i < nFreqPart && statusFreq[i][2])
i++;
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;
}
if (info->verbose)
fprintf(stderr, "Master ''killing'' remaining slaves\n");
/* getting elapsed time */
wallcpu = walltime() - wallcpu;
fprintf(stderr, "Wall clock time = %f seconds\n", wallcpu);
/* going to time domain */
memset( (void *) &trZ, (int) '\0', sizeof(trZ));
memset( (void *) &trR, (int) '\0', sizeof(trR));
trZ.dt = dt * 1000000;
trZ.ns = nSamplesOrig;
trR.dt = dt * 1000000;
trR.ns = nSamplesOrig;
/* z component */
for (iR = 0; iR < info->nR; iR++)
{
trZ.tracl = iR + 1;
/* inverse FFT */
pfacr(1, info->nSamples, uZF[iR], trZ.data);
for (i = 0; i < info->nSamples; i++)
{
/* compensating for the complex frequency */
trZ.data[i] *= exp(info->tau * i * dt);
}
puttr(&trZ);
}
/* r component */
for (iR = 0; iR < info->nR; iR++)
{
trR.tracl = info->nR + iR + 1;
/* inverse FFT */
pfacr(1, info->nSamples, uRF[iR], trR.data);
for (i = 0; i < info->nSamples; i++)
{
/* compensating for the complex frequency */
trR.data[i] *= exp(info->tau * i * dt);
}
puttr(&trR);
}
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());
}