void abelfree (void *at)
/*****************************************************************************
free an Abel transformer
******************************************************************************
Input:
at pointer to Abel transformer (as returned by abelalloc)
******************************************************************************
Authors: Dave Hale and Lydia Deng, Colorado School of Mines, 06/01/90
******************************************************************************/
{
free2float(((abelt*)at)->a);
free2float(((abelt*)at)->b0);
free2float(((abelt*)at)->b1);
free(at);
}
static void dctiv_row(float **x, int n1, int n2, float **c)
/*****************************************************************************
in place IV-type DCT along the rows of a 2D array
******************************************************************************
x array[][] of the signal before and after transform
n1 length of the signal along the 1st dimension
n2 length of the signal along the 2nd dimension
c2 table for the 2nd dimension
*****************************************************************************
Notes: Internal subroutine to dctiv_2
*****************************************************************************
Author: Tong Chen, 03/16/95
*****************************************************************************/
{
float **tmp;
int i, j, k;
tmp = alloc2float(n1, n2);
/* forward transform */
for(i=0; i<n2; i++){
for(k=0; k<n1; k++) tmp[i][k] = 0.;
for(j=0; j<n2; j++)
for(k=0; k<n1; k++)
tmp[i][k] += x[j][k]*c[i][j];
}
for(i=0; i<n2; i++)
for(k=0; k<n1; k++)
x[i][k] = tmp[i][k];
/* free the spaces */
free2float(tmp);
}
int wavePack_2(float **x, float **y, waveFilter *filter1,
waveFilter *filter2, int twopow1, int twopow2,
int stage1, int stage2, int type)
/***************************************************************************
2D wavelet packet transform
****************************************************************************
x array[][] for the signal
y array[][] for the wavelet coefficients
filter1 wavelet filter structure for the faster dimension
filter2 wavelet filter structure for the slower dimension
twopow1 2^pow is the length of the signal for the faster dimension
twopow2 2^pow is the length of the signal for the slower dimension
stage1 stage of decomposition for the faster dimension
stage2 stage of decomposition for the slower dimension
type 0 for decomposition, 1 for reconstruction
****************************************************************************
Author: Tong Chen, 05/25/94
***************************************************************************/
{
int n1, n2, i, flag=1;
float **z;
if((stage1>twopow1)||(stage2>twopow2)) return 0;
n1 = 1<<twopow1;
n2 = 1<<twopow2;
z = alloc2float(n1,n2);
/* first transform along the faster dimension */
if(!type){
for(i=0;i<n2;i++)
if(wavePack_1(x[i],z[i],filter1,twopow1,stage1,type))
flag = flag && 1;
else flag = 0;
/* then along the slower dimension */
if(wavePack_row(z,y,filter2,twopow1,twopow2,stage2,type))
flag = flag && 1;
else flag = 0;
}
else{
for(i=0;i<n2;i++)
if(wavePack_1(z[i],y[i],filter1,twopow1,stage1,type))
flag = flag && 1;
else flag = 0;
/* then along the slower dimension */
if(wavePack_row(x,z,filter2,twopow1,twopow2,stage2,type))
flag = flag && 1;
else flag = 0;
}
free2float(z);
return flag;
}
/*************************************************************************
Subroutine to multiply the inverse of a square matrix and
by another matrix without computing the inverse
*************************************************************************/
void inverse_matrix_multiply (int nrows1, float **matrix1, int ncols2,
int nrows2, float **matrix2, float **out_matrix)
/*************************************************************************
Input Parameters:
nrows1 number of rows (and columns) of matrix to invert
matrix1 square matrix to invert
ncols2 number of coulmns of second matrix
nrows2 number of rows of second matrix
matrix second matrix (multiplicator)
Output Parameters:
out_matrix matrix containing the product of the inverse of the first
matrix by the second one.
Note:
matrix1 and matrix2 are not destroyed (not clobbered)
*************************************************************************
Credits:
Adapted from discussions in Numerical Recipes in C by Gabriel Alvarez (1995)
*************************************************************************/
{
int i,j; /* loop counters for rows and coulmns */
float d; /* to use in LU decomposition */
int *idx; /* to record permutations by partial pivoting*/
float **scratch1; /* array to hold input matrix1 */
float *scratch2; /* vector to hold column of input matrix2 */
/* allocate working space */
idx = alloc1int(nrows1);
scratch1 = alloc2float(nrows1,nrows1);
scratch2 = alloc1float(nrows2);
/* copy input matrix1 to scratch to avoid clobbering */
for (i=0; i<nrows1; i++)
for (j=0; j<nrows1; j++)
scratch1[i][j]=matrix1[i][j];
/* do the LU decomposition */
LU_decomposition (nrows1, scratch1, idx, &d);
/* find inverse by columns */
for (j=0; j<ncols2; j++) {
/* copy column of second input matrix to scratch vector */
for (i=0; i<nrows2; i++) scratch2[i]=matrix2[i][j];
/* do backward substitution */
backward_substitution (nrows1, scratch1, idx, scratch2);
/* copy results to output matrix */
for (i=0; i<nrows1; i++) out_matrix[i][j] = scratch2[i];
}
/* free allocated space */
free2float(scratch1);
free1float(scratch2);
}
void tabtrcoefs(int ninf, float *rho, float *v, float **theta,
float *dip, float *trcoefs)
/*****************************************************************************
table transmission coefficients
******************************************************************************
Input:
ninf x coordinate of source (must be within x samples)
xxxx
Output:
trcoefs array[1..ninf] containing transmission coefficients
******************************************************************************
Notes:
The parameters are exactly the same as in the main program.
This is a subroutine so that the temporary arrays may be disposed
of after exit. This routine is only called once.
******************************************************************************
Author: Brian Sumner, Colorado School of Mines, 1985
******************************************************************************/
{
/**
* Local variables:
* TEMP, TMP - temporary arrays
* I, J - loop variables
* T1, T2 - temporaries
* R, P - more temporaries
**/
int i,j;
float t1, t2, r, p, *temp, **tmp;
temp = ealloc1float(ninf+1);
tmp = ealloc2float(ninf+1, ninf+1);
for (i = 0; i <= ninf; ++i) temp[i] = rho[i]*v[i];
for (j = 1; j <= ninf; ++j) {
for (i = 1; i < j; ++i) {
t1 = temp[i]*cos(theta[j][i-1]+dip[i]);
t2 = temp[i-1]*cos(theta[j][i]+dip[i]);
r = (t1 - t2)/(t1 + t2);
tmp[j][i] = 1.0 - r*r;
}
}
for (j = 1; j <= ninf; ++j) {
t1 = temp[j];
t2 = temp[j-1];
p = (t1 - t2)/(t1 + t2);
for (i = 1; i < j; ++i) p *= tmp[j][i];
trcoefs[j] = p;
}
/* free space */
free1float(temp);
free2float(tmp);
}
/************************************************************************
Subroutine to invert a square non-singular matrix via LU
decomposition. The original matrix is clobbered with the inverse
************************************************************************/
void inverse_matrix (int nrows, float **matrix)
/************************************************************************
Input:
nrows number of rows (and columns) in matrix to invert
matrix square, non-singular matrix to invert
Output:
matrix inverted matrix
************************************************************************
Credits:
Adapted from discussions in Numerical Recipes by Gabriel Alvarez (1995)
************************************************************************/
{
int i,j; /* loop counters */
float d; /* +/-1 depending on row interchanges even/odd*/
int *idx; /* vector of row permutations */
float *column; /* unit vector for backward substitution*/
float **inverse; /* array to hold the inverse matrix */
/* allocate working space */
idx = alloc1int(nrows);
column = alloc1float(nrows);
inverse = alloc2float(nrows,nrows);
/* first, do the LU decomposition of input matrix */
LU_decomposition (nrows, matrix, idx, &d);
/* find inverse by columns */
for (j=0; j<nrows; j++) {
/* unit vector corresponding to current column */
for (i=0; i<nrows; i++) column[i]=0.0;
column[j]=1.0;
/* backward substitution column by column */
backward_substitution (nrows, matrix, idx, column);
/* compute inverse matrix column by column */
for (i=0; i<nrows; i++)
inverse[i][j]=column[i];
}
/* clobber original matrix with its inverse */
for (i=0; i<nrows; i++)
for (j=0; j<nrows; j++)
matrix[i][j]=inverse[i][j];
/* free allocated space */
free1int(idx);
free1float(column);
free2float(inverse);
}
void lh_direct_LS( float **G /* The Forward Operator */,
int Nr /* Row Of G */,
int Nc /* Column of G */,
float **Cd /* The Covariance Matrix of Data Cd[Nr][Nr] */,
float **Cm /* The Covariance Matrix of model Cm[Nc][Nc] */,
float *d /* Data */,
float *m_prior /* m prior */,
float *m_post /* m posterior */ )
/*< Solve the Least Square Optimization Problem directly Using Matrix Inverse >*/
{
float **Gt, **A, **B1, **B2, **B3, **B, *C1, *C, **AB;
Gt = alloc2float( Nr , Nc );
A = alloc2float( Nr , Nc );
B1 = alloc2float( Nc , Nr );
B2 = alloc2float( Nr , Nr );
B3 = alloc2float( Nr , Nr );
B = alloc2float( Nr , Nr );
C1 = alloc1float( Nr );
C = alloc1float( Nr );
AB = alloc2float( Nr , Nc );
zero2float( Gt , Nr , Nc );
zero2float( A , Nr , Nc );
zero2float( B1 , Nc , Nr );
zero2float( B2 , Nr , Nr );
zero2float( B3 , Nr , Nr );
zero2float( B , Nr , Nr );
zero1float( C1 , Nr );
zero1float( C , Nr );
zero2float( AB , Nr , Nc );
lh_matrix_transpose( G , Gt , Nr , Nc );
lh_matrix_mu_matrix( Cm , Gt , A , Nc , Nc , Nr );
lh_matrix_mu_matrix( G , Cm , B1 , Nr , Nc , Nc );
lh_matrix_mu_matrix( B1 , Gt , B2 , Nr , Nc , Nr );
lh_matrix_add_matrix( B2 , Cd , B3 , Nr , Nr );
lh_matrix_inverse( B3 , B , Nr );
lh_matrix_mu_vector( G , m_prior , C1 , Nr , Nc );
lh_vector_sub_vector( d , C1 , C , Nr );
lh_matrix_mu_matrix( A , B , AB , Nc , Nr , Nr );
lh_matrix_mu_vector( AB , C , m_post , Nc , Nr );
lh_vector_add_vector( m_prior , m_post , m_post , Nc );
free2float( Gt );
free2float( A );
free2float( B1 );
free2float( B2 );
free2float( B3 );
free2float( B );
free1float( C1 );
free1float( C );
free2float( AB );
}
void find_p(float *ym,float *yp,float *a,int *b,int n)
{
#define NP 1
float *y,**x;
int n_s;
int k;
float *res;
int jpvt[NP];
float qraux[NP];
float work[NP];
x = ealloc2float(n,1);
y = ealloc1float(n);
res = ealloc1float(n);
memcpy((void *) &x[0][0], (const void *) &ym[0], n*FSIZE);
memset((void *) y, (int) '\0', n*FSIZE);
/* Solve for shift */
xcor (n,0,ym,n,0,yp,n,-n/2,y);
/* pick the maximum */
*b = -max_index(n,y,1)+n/2;
n_s = n-abs(*b);
if (*b < 0) {
memcpy((void *) &x[0][0], (const void *) &ym[*b], n_s*FSIZE);
} else {
memcpy((void *) &x[0][*b], (const void *) &ym[0], n_s*FSIZE);
}
/* Solve for scaler */
sqrst(x, n_s, 1,yp,0.0,a,res,&k,&jpvt[0],&qraux[0],&work[0]);
free2float(x);
free1float(res);
free1float(y);
}
int wpcUncompress(void *w, float *f)
/************************************************************************
Input:
w pointer to the compressed data
Output:
f pointer to the uncompress 2D section
Return: consistency flag, 1 if wpcCompressed data, 0 otherwise
************************************************************************/
{
int tileszt, tileszx;
int istrip, nblock, nstrip, n1p, n2p, n2l;
int n1, n2;
float **strip, **block;
int i, j, it, istart;
int size, retval;
void *interblock=NULL;
wpcPTR *wpc = (wpcPTR *)w;
wpcCONFIG *config;
wpcBUFF *buff;
unsigned char *code;
n1 = wpc->n1;
n2 = wpc->n2;
size = wpc->size;
/* very quick consistency check */
if(n1>0 && n2>0 && size>0) retval = 1;
else return (0);
config = wpc->config;
code = wpc->code;
/* prepare for tiling */
tileszt = config->tileszt;
tileszx = config->tileszx;
/* # of strips */
nblock = (n1-1)/tileszt + 1;
nstrip = (n2-1)/tileszx + 1;
/* regular sizes */
n1p = nblock*tileszt;
n2p = nstrip*tileszx;
n2l = n2 - n2p + tileszx;
/* spaces */
strip = alloc2float (n1p, tileszx);
block = (float **) malloc(tileszx*sizeof(float *));
buff = (wpcBUFF *) malloc(sizeof(wpcBUFF));
/* init */
istart = 0;
buff->code = code;
buff->mbound = size;
buff->pos = 0;
for(istrip=0;istrip<nstrip-1;istrip++){
/* for each block in the strip */
for(it=0; it<n1p; it += tileszt){
/* get one block of memory */
for(i=0;i<tileszx;i++)
block[i] = strip[i] + it;
/* decode one block */
retval = wpcDecoder(block, config, buff, interblock);
/* if not consistent */
if(!retval) break;
}
/* if not consistent */
if(!retval) break;
/* write a strip of traces */
for(j=0; j<tileszx; j++){
memcpy(f+istart, strip[j], n1*sizeof(float));
istart += n1;
}
}
if(retval){
/* for the last strip */
for(it=0; it<n1p; it += tileszt){
/* get one block of memory */
for(i=0;i<tileszx;i++)
block[i] = strip[i] + it;
/* decoding */
retval = wpcDecoder(block, config, buff, interblock);
if(!retval) break;
}
if(retval){
for(j=0; j<n2l; j++){
/* write a strip of traces */
memcpy(f+istart, strip[j], n1*sizeof(float));
istart += n1;
}
}
}
free2float(strip);
free((void *)block);
free((void *)buff);
return (retval);
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx; /* number of horizontal samples */
int nxshot; /* number of shots to be migrated */
/*int nxshot_orig;*/ /* first value of nxshot */
int iz,iw,ix,it; /* loop counters */
int igx; /* integerized gx value */
int ntfft; /* fft size */
int nw,truenw; /* number of wave numbers */
int dip=79; /* dip angle */
float sx,gx; /* x source and geophone location */
float gxmin=0.0,gxmax=0.0; /* x source and geophone location */
float min_sx_gx; /* min(sx,gx) */
float oldgx; /* old gx position */
/* float oldgxmin; */ /* old gx position */
/* float oldgxmax; */ /* old gx position */
float oldsx=0.0; /* old sx position */
int isx=0,nxo; /* index for source and geophone */
int oldisx=0; /* old value of source index */
int oldigx=0; /* old value of integerized gx value */
int ix1,ix2,ix3,ixshot; /* dummy index */
int lpad,rpad; /* padding on both sides of the migrated section */
float *wl=NULL,*wtmp=NULL;
float fmax;
float f1,f2,f3,f4;
int nf1,nf2,nf3,nf4;
int ntw;
float dt=0.004,dz; /* time and depth sampling interval */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
float w; /* frequency */
float dx; /* spatial sampling interval */
float **p=NULL; /* input data */
float **cresult=NULL; /* output result */
float v1; /* average velocity */
double kz2;
float **v=NULL,**vp=NULL;/* pointers for the velocity profile */
complex cshift2;
complex *wlsp=NULL; /* complex input,output */
complex **cp=NULL; /* ... */
complex **cp1=NULL; /* ... */
complex **cq=NULL; /* ... */
char *vfile=""; /* name of file containing velocities */
FILE *vfp=NULL;
int verbose; /* verbose flag */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get required parameters */
MUSTGETPARINT("nz",&nz);
MUSTGETPARINT("nxo",&nxo);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile",&vfile);
MUSTGETPARINT("nxshot",&nxshot);
/* get optional parameters */
if (!getparfloat("fmax",&fmax)) fmax = 25.0;
if (!getparfloat("f1",&f1)) f1 = 10.0;
if (!getparfloat("f2",&f2)) f2 = 20.0;
if (!getparfloat("f3",&f3)) f3 = 40.0;
if (!getparfloat("f4",&f4)) f4 = 50.0;
if (!getparint("lpad",&lpad)) lpad=9999;
if (!getparint("rpad",&rpad)) rpad=9999;
if (!getparint("dip",&dip)) dip=79;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocating space */
cresult = alloc2float(nz,nxo);
vp = alloc2float(nxo,nz);
/* load velicoty file */
vfp=efopen(vfile,"r");
efread(vp[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/* zero out cresult array */
memset((void *) cresult[0], 0, nxo*nz*FSIZE);
/* save value of nxshot */
/* nxshot_orig=nxshot; */
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
get_sx_gx(&sx,&gx);
min_sx_gx = MIN(sx,gx);
sx = sx - min_sx_gx;
gx = gx - min_sx_gx;
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
if(verbose) warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
if(verbose) warn("tr.d2 not set, assuming d2=1.0");
}
}
checkpars();
oldisx=0;
do { /* begin loop over shots */
/* determine frequency sampling interval*/
ntfft = npfar(nt);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
/* compute the index of the frequency to be migrated*/
fw=2.0*PI*f1;
nf1=fw/dw+0.5;
fw=2.0*PI*f2;
nf2=fw/dw+0.5;
fw=2.0*PI*f3;
nf3=fw/dw+0.5;
fw=2.0*PI*f4;
nf4=fw/dw+0.5;
/* the number of frequencies to migrated*/
truenw=nf4-nf1+1;
fw=0.0+nf1*dw;
if(verbose)
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/* generate the Ricker wavelet */
wtmp=ricker(fmax,dt,&ntw);
/* zero out wl[] array */
memset((void *) wl, 0, ntfft*FSIZE);
/* CHANGE BY CHRIS STOLK, Dec. 11, 2005 */
/* The next two lines are the old code, */
/* it is erroneous because the peak of */
/* the wavelet occurs at positive time */
/* instead of time zero. */
/*
for(it=0;it<ntw;it++)
wl[it]=wtmp[it];
*/
/* New code: we put in the wavelet in a centered fashion */
for(it=0;it<ntw;it++)
wl[(it-ntw/2+ntfft) % ntfft]=wtmp[it];
/* End of new code */
free1float(wtmp);
/* fourier transform wl array */
pfarc(-1,ntfft,wl,wlsp);
/* allocate space */
p = alloc2float(ntfft,nxo);
cq = alloc2complex(nw,nxo);
/* zero out p[][] array */
memset((void *) p[0], 0, ntfft*nxo*FSIZE);
/* initialize a number of items before looping over traces */
nx = 0;
igx=0;
oldigx=0;
oldsx=sx;
oldgx=gx;
/* oldgxmax=gxmax; */
/* oldgxmin=gxmin; */
do { /* begin looping over traces within a shot gather */
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
/* get sx and gx */
get_sx_gx(&sx,&gx);
sx = (sx - min_sx_gx);
gx = (gx - min_sx_gx);
igx = NINT(gx/dx);
if (igx==oldigx)
warn("repeated igx!!! check dx or scalco value!!!");
oldigx = igx;
if(gxmin>gx)gxmin=gx;
if(gxmax<gx)gxmax=gx;
if(verbose)
warn(" inside loop: min_sx_gx %f isx %d igx %d gx %f sx %f",min_sx_gx,isx,igx,gx,sx);
/* sx, gx must increase monotonically */
if (!(oldsx <= sx) )
err("sx field must be monotonically increasing!");
if (!(oldgx <= gx) )
err("gx field must be monotonically increasing!");
++nx;
} while(gettr(&tr) && sx==oldsx);
isx=NINT(oldsx/dx);
ixshot=isx;
if (isx==oldisx)
warn("repeated isx!!! check dx or scalco value!!!");
oldisx=isx;
if(verbose) {
warn("sx %f, gx %f , gxmin %f gxmax %f nx %d",sx,gx,gxmin,gxmax, nx);
warn("isx %d igx %d ixshot %d" ,isx,igx,ixshot);
}
/* transform the shot gather from time to frequency domain */
pfa2rc(1,1,ntfft,nxo,p[0],cq[0]);
/* compute the most left and right index for the migrated */
/* section */
ix1=NINT(oldsx/dx);
ix2=NINT(gxmin/dx);
ix3=NINT(gxmax/dx);
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
ix2-=lpad;
ix3+=rpad;
if(ix2<0)ix2=0;
if(ix3>nxo-1)ix3=nxo-1;
/* the total traces to be migrated */
nx=ix3-ix2+1;
nw=truenw;
/* allocate space for velocity profile within the aperature */
v=alloc2float(nx,nz);
for(iz=0;iz<nz;iz++)
for(ix=0;ix<nx;ix++)
v[iz][ix]=vp[iz][ix+ix2];
/* allocate space */
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
/* transpose the frequency domain data from */
/* data[ix][iw] to data[iw][ix] and apply a */
/* Hamming at the same time */
for (ix=0; ix<nx; ++ix) {
for (iw=0; iw<nw; iw++){
float tmpp=0.0,tmppp=0.0;
if(iw>=(nf1-nf1)&&iw<=(nf2-nf1)){
tmpp=PI/(nf2-nf1);
tmppp=tmpp*(iw-nf1)-PI;
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
if(iw>=(nf3-nf1)&&iw<=(nf4-nf1)) {
tmpp=PI/(nf4-nf3);
tmppp=tmpp*(iw-nf3);
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
cp[iw][ix]=cq[ix+ix2][iw+nf1];
}
}
cp1[iw][ix]=cmplx(0.0,0.0);
}
}
for(iw=0;iw<nw;iw++){
cp1[iw][ixshot-ix2]=wlsp[iw+nf1];
}
if(verbose) {
warn("ixshot %d ix %d ix1 %d ix2 %d ix3 %d",ixshot,ix,ix1,ix2,ix3);
warn("oldsx %f ",oldsx);
}
free2float(p);
free2complex(cq);
free1float(wl);
free1complex(wlsp);
/* loops over depth */
for(iz=0; iz<nz; ++iz) {
/* the imaging condition */
for(ix=0; ix<nx; ++ix){
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
complex tmp;
float ratio=10.0;
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
else
tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/* get the average velocity */
v1=0.0;
for(ix=0;ix<nx;++ix)
v1+=v[iz][ix]/nx;
/* compute time-invariant wavefield */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw) {
kz2=-(1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
/* wave-propagation using finite-difference method */
fdmig(cp, nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
fdmig(cp1,nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
/* apply thin lens term here */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
kz2=-(1.0/v[iz][ix]-1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
}
free2complex(cp);
free2complex(cp1);
free2float(v);
--nxshot;
} while(nxshot);
/* restore header fields and write output */
for(ix=0; ix<nxo; ix++){
tr.ns = nz;
tr.d1 = dz;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
return(CWP_Exit());
}
int main( int argc , char* argv[] )
{
sf_init( argc , argv );
sf_axis at, ax, ay, aw, at_wave, aw_wave;
/*
* @Define AXIS for DATASETS
*/
sf_file FD1, FD2, FD3, FD4, FW1, FW2, FW3, FW4, FPR1, FPR2, FPR3, FPR4, FPR5, FPO1, FPO2, FPO3, FPO4, FPO5;
/*
* @Define File Interfaces for Datasets
*/
int ix, nx, nx_s, NX, iy, ny, ny_s, NY, iw, nw, nw_s, NW, it, jt, nt, nt_s, NT, nwave;
/*
* @Define the Dimension of the Input Data & Inversion
* @it : index of time axis
* @nx : Dimension of Inversion in Inline Direction
* @nx_s: Starting place of Inline Direction
* @NX : Dimension of Input Data
* @NY,ny,ny_s: Parameters in Crossline Direction
* @NT,nt,nt_s: Parameters in time direction
* @nwave: length of the wavelet
*/
float sita1, sita2, sita3, sita4;
/*
* @ Angle Values of NearOffset, Mid1, Mid2 and TeleOffset, respectively!
*/
float w0, crange, corder, var_e;
int wsft;
/*
* @ Parameters of Inversion, w0 is the reference frequency of the Q model
* @ crange and corder are the parameters of Gaussian Shaped Window function
* @ var_e is the level of noise estimated
* @ wsft is the wave shift of the wavelet to the original point
*/
int dim, num_dim[SF_MAX_DIM];
/*
* @ Detect the Dimension of the DATASETS Using the Interior Function
*/
float dt, ot, dw, ow;
/*
* @ PARAMETER of the DATASETS
* @ dt is the time interval, ot is the starting time value
*/
float **NearWave, **Mid1Wave, **Mid2Wave, **TeleWave;
/*
* @ Input Wavelet file in different frequency and Offset
*/
float *d, *M_prior, **Cm, **Cn, **A, **W, **D, **WA, **G, *M_post, ****MPOST;
/*
* @
* @
* @Cm is the covariance matrix of the model
* @Cn is the covariance matrix of the noise
*/
int ipara, jpara;
float vpvsratio;
/*
* @auxiliary variable in calculating the coefficient in AKI-RICHARD formulae
*/
if(!sf_getint( "nw_start" , &nw_s )) sf_error( "Missing Frequency Start!\n" );
/* Input Parameter: the starting frequency in inversion */
if(!sf_getint( "nw_inv" , &nw )) sf_error( "Missing the Number of Frequency used!\n" );
/* Input Parameter: the number of frequency in inversion */
if(!sf_getint( "ninline_start" , &nx_s )) sf_error( "Missing inline Direction Starting Value !\n" );
/* Input Parameter: the Starting value in inline direction in Inversion */
if(!sf_getint( "ninline_inv" , &nx )) sf_error( "Missing Number of CDPS in inline direction!\n" );
/* Input Parameter: the number of CDPS in inline direction */
if(!sf_getint( "ncrossline_start" , &ny_s )) sf_error( "Missing crossline Direction Starting Value!\n" );
/* Input Paramter: the starting Value in crossline direction in Inversion */
if(!sf_getint( "ncrossline_inv" , &ny )) sf_error( "Missing Number of inlines in Crossline direction!\n" );
/* Input Parameter: the number of INLINES in crossline direction */
if(!sf_getfloat( "nearsita" , &sita1 )) sf_error( "Missing the Near Offset angle Value!\n" );
/* Input Parameter: the Angle Value of Near Offset Trace Gather */
if(!sf_getfloat( "mid1sita" , &sita2 )) sf_error( "Missing the Mid1 Offset angle Value!\n" );
/* Input Parameter: the Angle Value of Mid1 Offset Trace Gather */
if(!sf_getfloat( "mid2sita" , &sita3 )) sf_error( "Missing the Mid2 Offset angle Value!\n" );
/* Input Parameter: the Angle Value of Mid2 Offset Trace Gather */
if(!sf_getfloat( "telesita" , &sita4 )) sf_error( "Missing the Tele Offset angle Value!\n" );
/* Input Parameter: the Angle Value of Tele Offset Trace Gather */
if(!sf_getfloat( "w0" , &w0 )) sf_error( "Missing w0!\n" );
/* Input Parameter: Reference Frequency in Inversion */
if(!sf_getint( "wave_shift" , &wsft )) sf_error( "Missing the Shift of Wavelet!\n" );
/* Input Parameter: Wave Shift in Inversion */
if(!sf_getfloat( "correlation_range" , &crange ))sf_error( "Missing the Correlation Range in Inversion!\n" );
/* Input Parameter: COrrelation range in Inversion */
if(!sf_getfloat( "correlation_order" , &corder ))sf_error( "Missing the Correlation Order in Inversion!\n" );
/* Input Parameter: Correlation Order in Inversion */
if(!sf_getfloat( "variance_noise" , &var_e )) sf_error( "Missing the Variance of Noise in Inversion!\n" );
/* Input Parameter: Variance of Noise in Inversion */
FD1 = sf_input( "NearOffsetGather" );
FD2 = sf_input( "Mid1OffsetGather" );
FD3 = sf_input( "Mid2OffsetGather" );
FD4 = sf_input( "TeleOffsetGather" );
/*
* @ Input DATASETs
*/
FW1 = sf_input( "NearWavelet" );
FW2 = sf_input( "Mid1Wavelet" );
FW3 = sf_input( "Mid2Wavelet" );
FW4 = sf_input( "TeleWavelet" );
/*
* @ Input WAVELETs
*/
FPR1= sf_input( "vp_prior" );
FPR2= sf_input( "vs_prior" );
FPR3= sf_input( "ro_prior" );
FPR4= sf_input( "qp_prior" );
FPR5= sf_input( "qs_prior" );
/*
* @ Input a Prior Models
*/
FPO1= sf_output( "vp_post" );
FPO2= sf_output( "vs_post" );
FPO3= sf_output( "ro_post" );
FPO4= sf_output( "qp_post" );
FPO5= sf_output( "qs_post" );
/*
* @ Output Post MODELs by Bayesian Inversion
*/
dim = sf_filedims( FD1 , num_dim );
if( dim==3 )
{
at = sf_iaxa( FD1 , 1 );
NT = sf_n( at );
dt = sf_d( at );
ot = sf_o( at );
aw = sf_iaxa( FD1 , 2 );
NW = sf_n( aw );
dw = sf_d( aw );
ow = sf_o( aw );
ax = sf_iaxa( FD1 , 3 );
NX = sf_n( ax );
NY = 1;
}
else if( dim==4 )
{
at = sf_iaxa( FD1 , 1 );
NT = sf_n( at );
dt = sf_d( at );
ot = sf_o( at );
aw = sf_iaxa( FD1 , 2 );
NW = sf_n( aw );
dw = sf_d( aw );
ow = sf_o( aw );
ax = sf_iaxa( FD1 , 3 );
NX = sf_n( ax );
ay = sf_iaxa( FD1 , 4 );
NY = sf_n( ay );
}
else
sf_error( "DATA DIMENSION FAULT!\n" );
/*
* @ Only Handle the problem owns at least an inline section
* @ dimension of the data MUST be 3 or 4!
*/
at_wave = sf_iaxa( FW1 , 1 );
aw_wave = sf_iaxa( FW1 , 2 );
nwave = sf_n( at_wave );
if( sf_n(aw_wave)!=NW ) sf_error( "The NW dimension of wavelet should equal to the one of the DATASETS!\n" );
if( sf_n(sf_iaxa( FPR1 , 1 ))!=NT+1 ) sf_error( "DATASETS UNMATCHED!\n" );
if( sf_n(sf_iaxa( FPR1 , 2 ))!=NX ) sf_error( "DATASETS UNMATCHED!\n" );
if( nw_s<0 || nw_s>=NW ) sf_error( "The nw_start is inappropriate!\n" );
if( nx_s<0 || nx_s>=NX ) sf_error( "The ninline start is inappropriate!\n" );
if( ny_s<0 || ny_s>=NY ) sf_error( "The ncrossline start is inappropriate!\n" );
if( nw_s+nw>NW ) sf_error( "The nw inversion is inappropriate!\n" );
if( nx_s+nx>NX ) sf_error( "The nx inversion is inappropriate!\n" );
if( ny_s+ny>NY ) sf_error( "The ny inversion is inappropriate!\n" );
/*
* @Read Parameter of Wavelet & Check Parameters
* @if occurs inappropriate parameter, the program breaks immediately
*/
NearWave = sf_floatalloc2( nwave , nw );
Mid1Wave = sf_floatalloc2( nwave , nw );
Mid2Wave = sf_floatalloc2( nwave , nw );
TeleWave = sf_floatalloc2( nwave , nw );
sf_seek( FW1 , sizeof(float)*nwave*nw_s , SEEK_SET );
sf_seek( FW2 , sizeof(float)*nwave*nw_s , SEEK_SET );
sf_seek( FW3 , sizeof(float)*nwave*nw_s , SEEK_SET );
sf_seek( FW4 , sizeof(float)*nwave*nw_s , SEEK_SET );
sf_floatread( &NearWave[0][0] , nwave*nw , FW1 );
sf_floatread( &Mid1Wave[0][0] , nwave*nw , FW2 );
sf_floatread( &Mid2Wave[0][0] , nwave*nw , FW3 );
sf_floatread( &TeleWave[0][0] , nwave*nw , FW4 );
/*
* @Clip the WAVELET DATASETS and Read Needed Wavelet
*/
MPOST = sf_floatalloc4( NT+1 , NX , NY , 5 );
zero4float( MPOST , NT+1 , NX , NY , 5 );
/*
* @ The MAP solution of all the PARAMETERS
*/
for( iy=0 ; iy<ny ; iy++ )
for( ix=0 ; ix<nx ; ix++ )
{
printf( "ix=%d\n" , ix );
nt = NT;
nt_s=0;
d = sf_floatalloc( 4*nw*nt );
M_prior = sf_floatalloc ( 5*(nt+1) );
M_post = sf_floatalloc ( 5*(nt+1) );
Cm = sf_floatalloc2( 5*(nt+1) , 5*(nt+1) );
Cn = sf_floatalloc2( 4*nw*nt , 4*nw*nt );
A = sf_floatalloc2( 5*nt , 4*nw*nt );
W = sf_floatalloc2( 4*nw*nt , 4*nw*nt );
D = sf_floatalloc2( 5*(nt+1) , 5*nt );
WA = sf_floatalloc2( 5*nt , 4*nw*nt );
G = sf_floatalloc2( 5*(nt+1) , 4*nw*nt );
/*
* @4 means 4 angle gather
* @5 means 5 parameter,
* @4 &5 could be set up in the parameter list if it's needed!
* @To keep simplicity, the two parameters are given explicitly
*/
for( iw=0 ; iw<nw ; iw++ )
{
sf_seek( FD1 , sizeof(float)*((ny_s+iy)*NX*NW*NT+(nx_s+ix)*NW*NT+(nw_s+iw)*NT+nt_s) , SEEK_SET );
sf_seek( FD2 , sizeof(float)*((ny_s+iy)*NX*NW*NT+(nx_s+ix)*NW*NT+(nw_s+iw)*NT+nt_s) , SEEK_SET );
sf_seek( FD3 , sizeof(float)*((ny_s+iy)*NX*NW*NT+(nx_s+ix)*NW*NT+(nw_s+iw)*NT+nt_s) , SEEK_SET );
sf_seek( FD4 , sizeof(float)*((ny_s+iy)*NX*NW*NT+(nx_s+ix)*NW*NT+(nw_s+iw)*NT+nt_s) , SEEK_SET );
sf_floatread( &d[(0*nw+iw)*nt] , nt , FD1 );
sf_floatread( &d[(1*nw+iw)*nt] , nt , FD2 );
sf_floatread( &d[(2*nw+iw)*nt] , nt , FD3 );
sf_floatread( &d[(3*nw+iw)*nt] , nt , FD4 );
}
sf_seek( FPR1 , sizeof(float)*((ny_s+iy)*NX*(NT+1)+(nx_s+ix)*(NT+1)+nt_s) , SEEK_SET );
sf_seek( FPR2 , sizeof(float)*((ny_s+iy)*NX*(NT+1)+(nx_s+ix)*(NT+1)+nt_s) , SEEK_SET );
sf_seek( FPR3 , sizeof(float)*((ny_s+iy)*NX*(NT+1)+(nx_s+ix)*(NT+1)+nt_s) , SEEK_SET );
sf_seek( FPR4 , sizeof(float)*((ny_s+iy)*NX*(NT+1)+(nx_s+ix)*(NT+1)+nt_s) , SEEK_SET );
sf_seek( FPR5 , sizeof(float)*((ny_s+iy)*NX*(NT+1)+(nx_s+ix)*(NT+1)+nt_s) , SEEK_SET );
sf_floatread( &M_prior[0*(nt+1)] , nt+1 , FPR1 );
sf_floatread( &M_prior[1*(nt+1)] , nt+1 , FPR2 );
sf_floatread( &M_prior[2*(nt+1)] , nt+1 , FPR3 );
sf_floatread( &M_prior[3*(nt+1)] , nt+1 , FPR4 );
sf_floatread( &M_prior[4*(nt+1)] , nt+1 , FPR5 );
/*
* @Read Angle freuquency Gather use FILE SEEK function
* @Read a Prior MODEL
*/
for( iw=0 ; iw<nw ; iw++ )
for( it=0 ; it<nt ; it++ )
{
vpvsratio = (M_prior[nt+1+it]+M_prior[nt+1+it+1])/(M_prior[it]+M_prior[it+1]);
A[0*nw*nt+iw*nt+it][it] = 0.5*(1.+tan(sita1*SF_PI/180.)*tan(sita1*SF_PI/180.));
A[0*nw*nt+iw*nt+it][nt+it] = -4.*sin(sita1*SF_PI/180.)*sin(sita1*SF_PI/180.)*pow(vpvsratio,2.);
A[0*nw*nt+iw*nt+it][2*nt+it] = 0.5*(1.-4.*sin(sita1*SF_PI/180.)*sin(sita1*SF_PI/180.)*pow(vpvsratio,2.));
A[0*nw*nt+iw*nt+it][3*nt+it] = A[0*nw*nt+iw*nt+it][it]*((1./SF_PI)*log((dw*(nw_s+iw)+ow)/w0));
A[0*nw*nt+iw*nt+it][4*nt+it] = A[0*nw*nt+iw*nt+it][nt+it]*((1./SF_PI)*log((dw*(nw_s+iw)+ow)/w0));
A[1*nw*nt+iw*nt+it][it] = 0.5*(1.+tan(sita2*SF_PI/180.)*tan(sita2*SF_PI/180.));
A[1*nw*nt+iw*nt+it][nt+it] = -4.*sin(sita2*SF_PI/180.)*sin(sita2*SF_PI/180.)*pow(vpvsratio,2.);
A[1*nw*nt+iw*nt+it][2*nt+it] = 0.5*(1.-4.*sin(sita2*SF_PI/180.)*sin(sita2*SF_PI/180.)*pow(vpvsratio,2.));
A[1*nw*nt+iw*nt+it][3*nt+it] = A[1*nw*nt+iw*nt+it][it]*((1./SF_PI)*log((dw*(nw_s+iw)+ow)/w0));
A[1*nw*nt+iw*nt+it][4*nt+it] = A[1*nw*nt+iw*nt+it][nt+it]*((1./SF_PI)*log((dw*(nw_s+iw)+ow)/w0));
A[2*nw*nt+iw*nt+it][it] = 0.5*(1.+tan(sita3*SF_PI/180.)*tan(sita3*SF_PI/180.));
A[2*nw*nt+iw*nt+it][nt+it] = -4.*sin(sita3*SF_PI/180.)*sin(sita3*SF_PI/180.)*pow(vpvsratio,2.);
A[2*nw*nt+iw*nt+it][2*nt+it] = 0.5*(1.-4.*sin(sita3*SF_PI/180.)*sin(sita3*SF_PI/180.)*pow(vpvsratio,2.));
A[2*nw*nt+iw*nt+it][3*nt+it] = A[2*nw*nt+iw*nt+it][it]*((1./SF_PI)*log((dw*(nw_s+iw)+ow)/w0));
A[2*nw*nt+iw*nt+it][4*nt+it] = A[2*nw*nt+iw*nt+it][nt+it]*((1./SF_PI)*log((dw*(nw_s+iw)+ow)/w0));
A[3*nw*nt+iw*nt+it][it] = 0.5*(1.+tan(sita4*SF_PI/180.)*tan(sita4*SF_PI/180.));
A[3*nw*nt+iw*nt+it][nt+it] = -4.*sin(sita4*SF_PI/180.)*sin(sita4*SF_PI/180.)*pow(vpvsratio,2.);
A[3*nw*nt+iw*nt+it][2*nt+it] = 0.5*(1.-4.*sin(sita4*SF_PI/180.)*sin(sita4*SF_PI/180.)*pow(vpvsratio,2.));
A[3*nw*nt+iw*nt+it][3*nt+it] = A[3*nw*nt+iw*nt+it][it]*((1./SF_PI)*log((dw*(nw_s+iw)+ow)/w0));
A[3*nw*nt+iw*nt+it][4*nt+it] = A[3*nw*nt+iw*nt+it][nt+it]*((1./SF_PI)*log((dw*(nw_s+iw)+ow)/w0));
}
for( iw=0; iw<nw; iw++ )
for( it=0; it<nt; it++ )
for( jt=0; jt<nt; jt++ )
{
if ( (it-jt)<=nwave-1-wsft && (it-jt)>=-wsft )
{
W[0*nw*nt+iw*nt+it][0*nw*nt+iw*nt+jt]= NearWave[iw][it-jt+wsft];
W[1*nw*nt+iw*nt+it][1*nw*nt+iw*nt+jt]= Mid1Wave[iw][it-jt+wsft];
W[2*nw*nt+iw*nt+it][2*nw*nt+iw*nt+jt]= Mid2Wave[iw][it-jt+wsft];
W[3*nw*nt+iw*nt+it][3*nw*nt+iw*nt+jt]= TeleWave[iw][it-jt+wsft];
}
else
{
W[0*nw*nt+iw*nt+it][0*nw*nt+iw*nt+jt]=0.;
W[1*nw*nt+iw*nt+it][1*nw*nt+iw*nt+jt]=0.;
W[2*nw*nt+iw*nt+it][2*nw*nt+iw*nt+jt]=0.;
W[3*nw*nt+iw*nt+it][3*nw*nt+iw*nt+jt]=0.;
}
}
for( ipara=0 ; ipara<5 ; ipara++ )
for( it=0 ; it<nt ; it++ )
{
D[ipara*nt+it][ipara*(nt+1)+it] = -1;
D[ipara*nt+it][ipara*(nt+1)+it+1] = 1;
}
/*
* @Build three essential Matrix, A,W,D
* @A is the coefficient Matrix in multiple angle(4) and multiple frequency form
* @W is the wavelet matrix
* @D is the difference matrix
* @the forward operator is G=WAD
*/
lh_matrix_mu_matrix( W , A , WA , 4*nw*nt , 4*nw*nt , 5*nt );
lh_matrix_mu_matrix( WA , D , G , 4*nw*nt , 5*nt , 5*(nt+1));
/*
* @ Build forward operator G, using W,A,D
*/
for( it=0 ; it<3*(nt+1) ; it++ )
{
M_prior[it] = log(M_prior[it]);
}
for( it=3*(nt+1) ; it<5*(nt+1) ; it++ )
{
M_prior[it] = 1./M_prior[it];
}
/*
* @ Revise the A Prior Model Into the expectation value of True Value
*/
for( it=0 ; it<nt+1 ; it++ )
for( jt=0 ; jt<nt+1 ; jt++ )
for( ipara=0 ; ipara<5 ; ipara++ )
for( jpara=0 ; jpara<5 ; jpara++ )
{
if( ipara==jpara )
Cm[ipara*(nt+1)+it][jpara*(nt+1)+jt] = lh_float_variance( &M_prior[ipara*(nt+1)] , nt+1 )
*exp(-1.*pow(fabs((it-jt)*dt/crange),corder));
else
Cm[ipara*(nt+1)+it][jpara*(nt+1)+jt] = lh_float_covariance( &M_prior[ipara*(nt+1)] , &M_prior[jpara*(nt+1)] , nt+1 )
*exp(-1.*pow(fabs((it-jt)*dt/crange),corder));
}
for( it=0 ; it<4*nw*nt ; it++ )
for( jt=0 ; jt<4*nw*nt ; jt++ )
{
if( it==jt )
Cn[it][jt] = var_e;
else
Cn[it][jt] = 0.;
}
/*
* @ Transfer the ELASTIC parameters into LOG value
* @ Transfer the ANELASTIC parameters into RECIPROCAL value
* @ Setup the variance of the MODEL and the NOISE,
* @ Cm Usually comes from welldata, here is given from MODELS
*/
lh_direct_LS( G , 4*nw*nt , 5*(nt+1) , Cn , Cm , d, M_prior, M_post );
/*
* @ Inversion Under Bayesian Framework, the formulae comes from Tarantola(2005) directly
*/
if( ix==0 )
{
lh_write_1d_float_bin( M_post , 5*(nt+1) , "M_post.bin" );
lh_write_1d_float_bin( M_prior, 5*(nt+1) , "M_prior.bin");
}
for( it=0 ; it<nt+1 ; it++ )
{
MPOST[0][iy+ny_s][ix+nx_s][nt_s+it] = exp(M_post[0*(nt+1)+it]);
MPOST[1][iy+ny_s][ix+nx_s][nt_s+it] = exp(M_post[1*(nt+1)+it]);
MPOST[2][iy+ny_s][ix+nx_s][nt_s+it] = exp(M_post[2*(nt+1)+it]);
MPOST[3][iy+ny_s][ix+nx_s][nt_s+it] = 1.0/M_post[3*(nt+1)+it];
MPOST[4][iy+ny_s][ix+nx_s][nt_s+it] = 1.0/M_post[4*(nt+1)+it];
}
free1float( d );
free1float( M_prior );
free1float( M_post );
free2float( Cm );
free2float( Cn );
free2float( A );
free2float( W );
free2float( D );
free2float( WA );
free2float( G );
}
if( dim==3 )
{
sf_oaxa( FPO1 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO2 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO3 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO4 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO5 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO1 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO2 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO3 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO4 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO5 , sf_maxa( NX , 0., 1 ) , 2 );
}
if( dim==4 )
{
sf_oaxa( FPO1 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO2 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO3 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO4 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO5 , sf_maxa( NT+1 , 0., dt ) , 1 );
sf_oaxa( FPO1 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO2 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO3 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO4 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO5 , sf_maxa( NX , 0., 1 ) , 2 );
sf_oaxa( FPO1 , sf_maxa( NY , 0., 1 ) , 3 );
sf_oaxa( FPO2 , sf_maxa( NY , 0., 1 ) , 3 );
sf_oaxa( FPO3 , sf_maxa( NY , 0., 1 ) , 3 );
sf_oaxa( FPO4 , sf_maxa( NY , 0., 1 ) , 3 );
sf_oaxa( FPO5 , sf_maxa( NY , 0., 1 ) , 3 );
}
sf_floatwrite( &MPOST[0][0][0][0] , (NT+1)*NX*NY , FPO1 );
sf_floatwrite( &MPOST[1][0][0][0] , (NT+1)*NX*NY , FPO2 );
sf_floatwrite( &MPOST[2][0][0][0] , (NT+1)*NX*NY , FPO3 );
sf_floatwrite( &MPOST[3][0][0][0] , (NT+1)*NX*NY , FPO4 );
sf_floatwrite( &MPOST[4][0][0][0] , (NT+1)*NX*NY , FPO5 );
free( MPOST );
exit( 0 );
}
/* functions defined and used internally */
void eiktam (float xs, float zs,
int nz, float dz, float fz, int nx, float dx, float fx, float **vel,
float **time, float **angle, float **sig, float **bet)
/*****************************************************************************
eiktam - Compute traveltimes t(x,z) and propagation angle a(x,z) via
eikonal equation, and ray_theoretic_sigma sig(x,z), incident angle bet(x,z)
via Crank-Nicolson Method
******************************************************************************
Input:
xs x coordinate of source (must be within x samples)
zs z coordinate of source (must be within z samples)
nz number of z samples
dz z sampling interval
fz first z sample
nx number of x samples
dx x sampling interval
fx first x sample
vel array[nx][nz] containing velocities
Output:
time array[nx][nz] containing first-arrival times
angle array[nx][nz] containing propagation angles
sig array[nx][nz] containing ray_theoretic_sigmas
bet array[nx][nz] containing ray_theoretic_betas
******************************************************************************
Notes:
The actual computation of times and ray_theoretic_sigmas is done in polar coordinates,
with bilinear interpolation used to map to/from rectangular coordinates.
******************************************************************************
Revisor: Zhenyue Liu, Colorado School of Mines, 7/8/92
******************************************************************************/
{
int ix,iz,ia,ir,na,nr;
float ss,a,r,da,dr,fa,fr,ex,ez,ea,rmax,rmaxs,
**s,**sp,**tp,**up,**wp,**ap;
/* shift coordinates so source is at (x=0,z=0) */
fx -= xs;
fz -= zs;
ex = fx+(nx-1)*dx;
ez = fz+(nz-1)*dz;
/* determine polar coordinate sampling */
rmaxs = fx*fx+fz*fz;
rmaxs = MAX(rmaxs,fx*fx+ez*ez);
rmaxs = MAX(rmaxs,ex*ex+ez*ez);
rmaxs = MAX(rmaxs,ex*ex+fz*fz);
rmax = sqrt(rmaxs);
dr = MIN(ABS(dx),ABS(dz));
nr = 1+NINT(rmax/dr);
dr = rmax/(nr-1);
fr = 0.0;
if (fx==0.0 && fz==0.0) {
fa = 0.0; ea = PI/2.0;
} else if (fx<0.0 && fz==0.0) {
fa = -PI/2.0; ea = PI/2.0;
} else if (fx==0.0 && fz<0.0) {
fa = 0.0; ea = PI;
} else {
fa = -PI; ea = PI;
}
da = dr/rmax;
na = 1+NINT((ea-fa)/da);
da = (ea-fa)/(na-1);
if (fa==-PI && ea==PI)
na = na-1;
/* allocate space */
s = alloc2float(nz,nx);
sp = alloc2float(na,nr);
tp = alloc2float(na,nr);
up = alloc2float(na,nr);
wp = alloc2float(na,nr);
ap = alloc2float(na,nr);
/* compute slownesses */
for (ix=0; ix<nx; ++ix)
for (iz=0; iz<nz; ++iz)
s[ix][iz] = 1.0/vel[ix][iz];
/* convert from rectangular to polar coordinates */
recttopolar(nz,dz,fz,nx,dx,fx,s,na,da,fa,nr,dr,fr,sp);
/* average the slownesses in source region */
for (ir=0,ss=0.0; ir<2; ++ir)
for (ia=0; ia<na; ++ia)
ss += sp[ir][ia];
ss /= 2*na;
/* compute traveltimes and derivatives in source region */
for (ir=0,r=0; ir<2; ++ir,r+=dr) {
for (ia=0; ia<na; ++ia) {
up[ir][ia] = ss;
wp[ir][ia] = 0.0;
tp[ir][ia] = r*ss;
}
}
/* tt=cpusec(); */
/* solve eikonal equation for remaining times and derivatives */
for (ir=1,r=dr; ir<nr-1; ++ir,r+=dr) {
eikpex(na,da,r,dr,
sp[ir],up[ir],wp[ir],tp[ir],
sp[ir+1],up[ir+1],wp[ir+1],tp[ir+1]);
}
/* convert times from polar to rectangular coordinates */
polartorect(na,da,fa,nr,dr,fr,tp,nz,dz,fz,nx,dx,fx,time);
/* fprintf(stderr,"\t CPU time for traveltimes= %f \n",cpusec()-tt);
tt=cpusec(); */
/* compute propagation angles in polar and convert */
for (ia=0,a=fa; ia<na; ++ia,a+=da)
ap[0][ia] = a;
for (ir=1,r=fr+dr; ir<nr; ++ir,r+=dr)
for (ia=0,a=fa; ia<na; ++ia,a+=da){
ap[ir][ia] = a+asin(wp[ir][ia]/(sp[ir][ia]*r));
}
polartorect(na,da,fa,nr,dr,fr,ap,nz,dz,fz,nx,dx,fx,angle);
/* fprintf(stderr,"\t CPU time for propagation angles= %f\n",
cpusec()-tt);
tt=cpusec(); */
/* compute ray_theoretic_sigmas for initial values */
for (ir=0,r=0; ir<2; ++ir,r+=dr)
for (ia=0; ia<na; ++ia) tp[ir][ia] = r/ss;
/* solve diffrence equation for remaining ray_theoretic_sigmas */
for (ir=1,r=dr; ir<nr-1; ++ir,r+=dr)
ray_theoretic_sigma(na,da,r,dr,up[ir],wp[ir],tp[ir],
up[ir+1],wp[ir+1],tp[ir+1]);
polartorect(na,da,fa,nr,dr,fr,tp,nz,dz,fz,nx,dx,fx,sig);
/* fprintf(stderr,"\t CPU time for sigmas= %f \n",cpusec()-tt);
tt=cpusec(); */
/* compute ray_theoretic_betas for initial values */
for (ir=0; ir<2; ++ir)
for (ia=0,a=fa; ia<na; ++ia,a+=da) tp[ir][ia] = a;
/* solve diffrence equation for remaining ray_theoretic_betas */
for (ir=1,r=dr; ir<nr-1; ++ir,r+=dr)
ray_theoretic_beta(na,da,r,dr,up[ir],wp[ir],tp[ir],
up[ir+1],wp[ir+1],tp[ir+1]);
polartorect(na,da,fa,nr,dr,fr,tp,nz,dz,fz,nx,dx,fx,bet);
/* fprintf(stderr,"\t CPU time for incident angles= %f \n",
cpusec()-tt); */
/* free space */
free2float(s);
free2float(sp);
free2float(tp);
free2float(up);
free2float(wp);
free2float(ap);
}
int
main(int argc, char **argv)
{
int nx,nz,ix,iz,verbose;
float tmp;
float **c11,**c13,**c33,**c44,**vp,**vs,**rho,**eps, **delta;
/* input files */
char *c11_file, *c13_file, *c33_file, *c44_file;
FILE *c11fp, *c13fp, *c33fp, *c44fp;
/* output files */
char *vp_file,*vs_file,*rho_file,*eps_file,*delta_file;
FILE *vpfp,*vsfp,*rhofp,*epsfp,*deltafp;
/* hook up getpar */
initargs(argc, argv);
requestdoc(1);
/* get required parameters */
MUSTGETPARINT("nx", &nx );
MUSTGETPARINT("nz", &nz );
/* get parameters */
if (!getparstring("rho_file", &rho_file)) rho_file="rho.bin";
if (!getparstring("c11_file", &c11_file)) c11_file="c11.bin";
if (!getparstring("c13_file", &c13_file)) c13_file="c13.bin";
if (!getparstring("c33_file", &c33_file)) c33_file="c33.bin";
if (!getparstring("c44_file", &c44_file)) c44_file="c44.bin";
if (!getparstring("vp_file", &vp_file)) vp_file="vp.bin";
if (!getparstring("vs_file", &vs_file)) vs_file="vs.bin";
if (!getparstring("eps_file", &eps_file)) eps_file="eps.bin";
if (!getparstring("delta_file", &delta_file)) delta_file="delta.bin";
if (!getparint("verbose", &verbose)) verbose = 1;
checkpars();
/* allocate space */
rho = alloc2float(nz,nx);
c11 = alloc2float(nz,nx);
c13 = alloc2float(nz,nx);
c33 = alloc2float(nz,nx);
c44 = alloc2float(nz,nx);
vp = alloc2float(nz,nx);
vs = alloc2float(nz,nx);
eps = alloc2float(nz,nx);
delta = alloc2float(nz,nx);
/* read mandatory input files */
rhofp = efopen(rho_file,"r");
if (efread(*rho, sizeof(float), nz*nx, rhofp)!=nz*nx)
err("error reading rho_file=%s!\n",rho_file);
c11fp = efopen(c11_file,"r");
if (efread(*c11, sizeof(float), nz*nx, c11fp)!=nz*nx)
err("error reading c11_file=%s!\n",c11_file);
c13fp = efopen(c13_file,"r");
if (efread(*c13, sizeof(float), nz*nx, c13fp)!=nz*nx)
err("error reading c13_file=%s!\n",c13_file);
c33fp = efopen(c33_file,"r");
if (efread(*c33, sizeof(float), nz*nx, c33fp)!=nz*nx)
err("error reading c33_file=%s!\n",c33_file);
c44fp = efopen(c44_file,"r");
if (efread(*c44, sizeof(float), nz*nx, c44fp)!=nz*nx)
err("error reading c44_file=%s!\n",c44_file);
fclose(rhofp);
fclose(c11fp);
fclose(c13fp);
fclose(c33fp);
fclose(c44fp);
/* open output file: */
vpfp = fopen(vp_file,"w");
vsfp = fopen(vs_file,"w");
epsfp = fopen(eps_file,"w");
deltafp = fopen(delta_file,"w");
/* loop over gridpoints and do calculations */
for(ix=0; ix<nx; ++ix){
for(iz=0; iz<nz; ++iz){
vp[ix][iz] = sqrt(c33[ix][iz]/rho[ix][iz]);
vs[ix][iz] = sqrt(c44[ix][iz]/rho[ix][iz]);
eps[ix][iz] = (c11[ix][iz]-c33[ix][iz])/(2*c33[ix][iz]);
tmp = (c13[ix][iz]+c44[ix][iz])*(c13[ix][iz]+c44[ix][iz]);
tmp = tmp - (c33[ix][iz]-c44[ix][iz])*(c33[ix][iz]-c44[ix][iz]);
delta[ix][iz] = tmp/(2*c33[ix][iz]*(c33[ix][iz]-c44[ix][iz]));
}
}
/* write the output files to disk */
efwrite(*vp,sizeof(float),nz*nx,vpfp);
efwrite(*vs,sizeof(float),nz*nx,vsfp);
efwrite(*eps,sizeof(float),nz*nx,epsfp);
efwrite(*delta,sizeof(float),nz*nx,deltafp);
if(verbose){
warn("Output file for vp : %s ",vp_file);
warn("Output file for vs : %s ",vs_file);
warn("Output file for epsilon : %s ",eps_file);
warn("Output file for delta : %s ",delta_file);
}
/* free workspace */
free2float(vp);
free2float(vs);
free2float(rho);
free2float(eps);
free2float(delta);
free2float(c11);
free2float(c13);
free2float(c33);
free2float(c44);
return(CWP_Exit());
}
int main(int argc, char **argv)
{
int i,ix,it; /* loop counters */
int wtype; /* =1 psv. =2 sh wavefields */
int wfield; /* =1 displcement =2 velocity =3 acceleration */
int stype; /* source type */
int int_type; /* =1 for trapezoidal rule. =2 for Filon */
int flt; /* =1 apply earth flattening correction */
int rand; /* =1 for random velocity layers */
int qopt; /* some flag ???? */
int vsp; /* =1 for vsp, =0 otherwise */
int win; /* =1 if frequency windowing required */
int verbose; /* flag to output processing information */
int nt; /* samples per trace in output traces */
int ntc; /* samples per trace in computed traces */
int nx; /* number of output traces */
int np; /* number of ray parameters */
int nlint=0; /* number of times layer interp is required */
int lsource; /* layer on top of which the source is located*/
int nw; /* number of frequencies */
int nor; /* number of receivers */
int nlayers; /* number of reflecting layers */
int layern;
int nrand_layers; /* maximum number of random layers permitted */
int nf; /* number of frequencies in output traces */
int *filters_phase=NULL; /* =0 for zero phase, =1 for minimum phase fil*/
int nfilters; /* number of required filters */
int wavelet_type; /* =1 spike =2 ricker1 =3 ricker2 =4 akb */
float dt; /* time sampling interval */
float tsec; /* trace length in seconds */
float fpeak; /* peak frequency for output wavelet */
float fref; /* first frequency */
float p2w; /* maximum ray parameter value */
float bp; /* smallest ray parameter (s/km) */
float bx; /* beginning of range in Kms. */
float fx; /* final range in Kms. */
float dx; /* range increment in Kms. */
float pw1,pw2,pw3,pw4; /* window ray parameters (to apply taper) */
float h1; /* horizontal linear part of the source */
float h2; /* vertical linear part of the source */
float m0; /* seismic moment */
float m1,m2,m3; /* components of the moment tensor */
float delta; /* dip */
float lambda; /* rake */
float phis; /* azimuth of the fault plane */
float phi; /* azimuth of the receiver location */
float sdcl,sdct; /* standar deviation for p and s-wave vels */
float z0=0.0; /* reference depth */
float zlayer; /* thickness of random layers */
int layer; /* layer over on top of which to compute rand*/
float tlag; /* time lag in output traces */
float red_vel; /* erducing velocity */
float w1=0.0; /* low end frequency cutoff for taper */
float w2=0.0; /* high end frequency cutoff for taper */
float wrefp; /* reference frequency for p-wave velocities */
float wrefs; /* reference frequency for s-wave velocities */
float epsp; /* .... for p-wave velocities */
float epss; /* .... for p-wave velocities */
float sigp; /* .... for p-wave velocities */
float sigs; /* .... for s-wave velocities */
float fs; /* sampling parameter, usually 0.07<fs<0.12 */
float decay; /* decay factor to avoid wraparound */
int *lobs; /* layers on top of which lay the receivers */
int *nintlayers=NULL; /* array of number of layers to interpolate */
int *filters_type; /* array of 1 lo cut, 2 hi cut, 3 notch */
float *dbpo=NULL; /* array of filter slopes in db/octave */
float *f1=NULL; /* array of lo frequencies for filters */
float *f2=NULL; /* array of high frequencies for filters */
float *cl; /* array of compressional wave velocities */
float *ql; /* array of compressional Q values */
float *ct; /* array of shear wave velocities */
float *qt; /* array of shear Q values */
float *rho; /* array of densities */
float *t; /* array of absolute layer thickness */
int *intlayers=NULL; /* array of layers to interpolate */
float *intlayth=NULL; /* array of thicknesses over which to interp */
float **wavefield1; /* array for pressure wavefield component */
float **wavefield2=NULL;/* array for radial wavefield component */
float **wavefield3=NULL;/* array for vertical wavefield component */
char *lobsfile=""; /* input file receiver layers */
char *clfile=""; /* input file of p-wave velocities */
char *qlfile=""; /* input file of compressional Q-values */
char *ctfile=""; /* input file of s-wave velocities */
char *qtfile=""; /* input file of shear Q-values */
char *rhofile=""; /* input file of density values */
char *tfile=""; /* input file of absolute layer thicknesses */
char *intlayfile=""; /* input file of layers to interpolate */
char *nintlayfile=""; /* input file of number of layers to interp */
char *intlaythfile=""; /*input file of layer thickness where to inter*/
char *filtypefile=""; /* input file of filter types to apply */
char *fphfile=""; /* input file of filters phases */
char *dbpofile=""; /* input file of filter slopes in db/octave */
char *f1file=""; /* input file of lo-end frequency */
char *f2file=""; /* input file of hi-end frequency */
char *wfp=""; /* output file of pressure */
char *wfr=""; /* output file of radial wavefield */
char *wfz=""; /* output file of vertical wavefield */
char *wft=""; /* output file of tangential wavefield */
char *outf=""; /* output file for processing information */
FILE *wfp_file; /* file pointer to output pressure */
FILE *wfr_file; /* file pointer to output radial wavefield */
FILE *wfz_file; /* file pointer to output vertical wavefield */
FILE *wft_file; /* file pointer to output tangential wavefield*/
FILE *outfp=NULL; /* file pointer to processing information */
FILE *infp; /* file pointer to input information */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(0); /* no input data */
/* get required parameter, seismic moment */
if (!getparfloat("m0",&m0))
err("error: the seismic moment, m0, is a required parameter\n");
/*********************************************************************/
/* get general flags and set their defaults */
if (!getparint("rand",&rand)) rand = 0;
if (!getparint("qopt",&qopt)) qopt = 0;
if (!getparint("stype",&stype)) stype = 1;
if (!getparint("wtype",&wtype)) wtype = 1;
if (!getparint("wfield",&wfield)) wfield = 1;
if (!getparint("int_type",&int_type)) int_type= 1;
if (!getparint("flt",&flt)) flt = 0;
if (!getparint("vsp",&vsp)) vsp = 0;
if (!getparint("win",&win)) win = 0;
if (!getparint("wavelet_type",&wavelet_type)) wavelet_type = 1;
if (!getparint("verbose",&verbose)) verbose = 0;
/* get model parameters and set their defaults */
if (!getparint("lsource",&lsource)) lsource = 0;
if (!getparfloat("fs",&fs)) fs = 0.07;
if (!getparfloat("decay",&decay)) decay = 50.0;
if (!getparfloat("tsec",&tsec)) tsec = 2.048;
/* get response parameters and set their defaults */
if (!getparfloat("fref",&fref)) fref = 1.0;
if (!getparint("nw",&nw)) nw = 100;
if (!getparint("nor",&nor)) nor = 100;
if (!getparint("np",&np)) np = 1300;
if (!getparfloat("p2w",&p2w)) p2w = 5.0;
if (!getparfloat("bx",&bx)) bx = 0.005;
if (!getparfloat("bp",&bp)) bp = 0.0;
if (!getparfloat("fx",&fx)) fx = 0.1;
if (!getparfloat("dx",&dx)) dx = 0.001;
if (!getparfloat("pw1",&pw1)) pw1 = 0.0;
if (!getparfloat("pw2",&pw2)) pw2 = 0.1;
if (!getparfloat("pw3",&pw3)) pw3 = 6.7;
if (!getparfloat("pw4",&pw4)) pw4 = 7.0;
if (!getparfloat("h1",&h1)) h1 = 1.0;
if (!getparfloat("h2",&h2)) h2 = 0.0;
/* get output parameters and set their defaults */
if (!getparint("nx",&nx)) nx = 100;
if (!getparfloat("dt",&dt)) dt = 0.004;
if (!getparint("nt",&nt)) nt = tsec/dt;
if (!getparint("nf",&nf)) nf = 50;
if (!getparfloat("red_vel",&red_vel)) red_vel = 5;
if (!getparfloat("fpeak",&fpeak)) fpeak = 25.;
if (!getparfloat("tlag",&tlag)) tlag = 0.;
/* get names of output files */
if (wtype==1) {
getparstring("wfp",&wfp);
getparstring("wfr",&wfr);
getparstring("wfz",&wfz);
} else if (wtype==2) {
getparstring("wft",&wft);
} else err ("wtype has to be zero or one");
/*********************************************************************/
/* get or compute moment tensor components */
if (stype==1) {
/* get source parameters */
if (!getparfloat("delta",&delta))
err("if stype==1, delta is a required parameter\n");
if (!getparfloat("lambda",&lambda))
err("if stype==1, lambda is a required parameter\n");
if (!getparfloat("phis",&phis))
err("if stype==1, phis is a required parameter\n");
if (!getparfloat("phi",&phi))
err("if stype==1, phi is a required parameter\n");
/* compute moment tensor components */
compute_moment_tensor (wtype, phi, lambda, delta, phis, m0,
&m1, &m2, &m3);
} else if (stype==2) {
/* get moment tensor components from input */
if (!getparfloat("m1",&m1))
err("if stype==2, m1 is a required parameter\n");
if (!getparfloat("m2",&m2))
err("if stype==2, m2 is a required parameter\n");
if (!getparfloat("m3",&m3))
err("if stype==2, m3 is a required parameter\n");
} else err("error, stype flag has to be one or two\n");
/*********************************************************************/
/* if q-option is not requesed, set corresponding parameters to zero */
if (!getparint("layern",&layern)) layern =0;
if (!getparfloat("wrefp",&wrefp)) wrefp =0.0;
if (!getparfloat("wrefs",&wrefs)) wrefs =0.0;
if (!getparfloat("epsp",&epsp)) epsp =0.0;
if (!getparfloat("epss",&epss)) epss =0.0;
if (!getparfloat("sigp",&sigp)) sigp =0.0;
if (!getparfloat("sigs",&sigs)) sigs =0.0;
/*********************************************************************/
/* get number of layers and check input parameters */
if (*clfile=='\0') { /* p-wave vels input from the comand line */
nlayers=countparval("cl");
} else { /* p-wave vels input from a file */
getparint("nlayers",&nlayers);
}
if (*ctfile=='\0') { /* s-wave vels input from the comand line */
if (nlayers !=countparval("cl"))
err("number of p-wave and s-wave velocities"
"has to be the same");
}
if (*qlfile=='\0') { /* compressional q-values from comand line */
if (nlayers !=countparval("ql"))
err("number of p-wave velocities and q-values"
"has to be the same");
}
if (*qtfile=='\0') { /* shear q-values input from comand line */
if (nlayers !=countparval("qt"))
err("number of p-wave velocities and shear q-values"
"has to be the same");
}
if (*rhofile=='\0') { /* densities input from comand line */
if (nlayers !=countparval("rho"))
err("number of p-wave velocities and densities"
"has to be the same");
}
if (*tfile=='\0') { /* layer thicknesses input from comand line */
if (nlayers !=countparval("t"))
err("number of p-wave velocities and thicknesses"
"has to be the same");
}
if (int_type!=1 && int_type!=2) err("int_type flag has to be one or two");
/*********************************************************************/
/* if layer interpolation is requested, get parameters */
if (*intlayfile !='\0') {
getparint("nlint",&nlint);
if ((infp=efopen(intlayfile,"r"))==NULL)
err("cannot open file of layer interp=%s\n",intlayfile);
intlayers=alloc1int(nlint);
fread (intlayers,sizeof(int),nlint,infp);
efclose(infp);
} else if (countparval("intlayers") !=0) {
nlint=countparval("intlayers");
intlayers=alloc1int(nlint);
getparint("intlayers",intlayers);
}
if (*nintlayfile !='\0') {
if ((infp=efopen(nintlayfile,"r"))==NULL)
err("cannot open file of layer inter=%s\n",nintlayfile);
nintlayers=alloc1int(nlint);
fread (nintlayers,sizeof(int),nlint,infp);
efclose(infp);
} else if (countparval("nintlayers") !=0) {
if (nlint !=countparval("nintlayers"))
err("number of values in intlay and nintlay not equal");
nintlayers=alloc1int(nlint);
getparint("nintlayers",nintlayers);
}
if (*intlaythfile !='\0') {
if ((infp=efopen(intlaythfile,"r"))==NULL)
err("cannot open file=%s\n",intlaythfile);
intlayth=alloc1float(nlint);
fread (intlayth,sizeof(int),nlint,infp);
efclose(infp);
} else if (countparval("intlayth") !=0) {
if (nlint !=countparval("intlayth"))
err("# of values in intlay and intlayth not equal");
intlayth=alloc1float(nlint);
getparfloat("intlayth",intlayth);
}
/* update total number of layers */
if (nlint!=0) {
for (i=0; i<nlint; i++) nlayers +=intlayers[i]-1;
}
/*********************************************************************/
/* if random velocity layers requested, get parameters */
if (rand==1) {
getparint("layer",&layer);
getparint("nrand_layers",&nrand_layers);
getparfloat("zlayer",&zlayer);
getparfloat("sdcl",&sdcl);
getparfloat("sdct",&sdct);
} else nrand_layers=0;
/*********************************************************************/
/* allocate space */
cl = alloc1float(nlayers+nrand_layers);
ct = alloc1float(nlayers+nrand_layers);
ql = alloc1float(nlayers+nrand_layers);
qt = alloc1float(nlayers+nrand_layers);
rho = alloc1float(nlayers+nrand_layers);
t = alloc1float(nlayers+nrand_layers);
lobs = alloc1int(nor+1);
lobs[nor]=0;
/*********************************************************************/
/* read input parameters from files or command line */
if (*clfile !='\0') { /* read from a file */
if ((infp=efopen(clfile,"r"))==NULL)
err("cannot open file of pwave velocities=%s\n",clfile);
fread(cl,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("cl",cl); /* get from command line */
if (*qlfile !='\0') {
if ((infp=efopen(qlfile,"r"))==NULL)
err("cannot open file of compressional Q=%s\n",qlfile);
fread(ql,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("ql",ql);
if (*ctfile !='\0') {
if ((infp=efopen(ctfile,"r"))==NULL)
err("cannot open file of swave velocities=%s\n",ctfile);
fread(ct,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("ct",ct);
if (*qtfile !='\0') {
if ((infp=efopen(qtfile,"r"))==NULL)
err("cannot open file of shear Q=%s\n",qtfile);
fread(qt,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("qt",qt);
if (*rhofile !='\0') {
if ((infp=efopen(rhofile,"r"))==NULL)
err("cannot open file of densities=%s\n",rhofile);
fread(rho,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("rho",rho);
if (*tfile !='\0') {
if ((infp=efopen(tfile,"r"))==NULL)
err("cannot open file of thicknesses=%s\n",tfile);
fread(t,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("t",t);
if (*lobsfile !='\0') {
if ((infp=efopen(lobsfile,"r"))==NULL)
err("can't open file of receiver layers=%s\n",lobsfile);
fread(lobs,sizeof(int),nor,infp);
efclose(infp);
} else getparint("lobs",lobs);
/*********************************************************************/
/* if requested, do interpolation and/or parameter adjustment */
if (nlint!=0)
parameter_interpolation (nlayers, intlayers, nintlayers,
intlayth, cl, ql, ct, qt, rho, t);
/* if requested, compute random velocity layers */
if (rand==1) {
random_velocity_layers (&nlayers, &lsource, nrand_layers, sdcl,
sdct, layer, zlayer, cl, ql, ct, qt, rho, t);
}
/* if requested, apply earth flattening approximation */
if (flt==1) {
apply_earth_flattening (nlayers, z0, cl, ct, rho, t);
}
/*********************************************************************/
/* get filter parameters */
if (*filtypefile !='\0') {
if ((infp=efopen(filtypefile,"r"))==NULL)
err("cannot open file=%s\n",filtypefile);
getparint("nfilters",&nfilters);
filters_type=alloc1int(nfilters);
fread (filters_type,sizeof(int),nfilters,infp);
efclose(infp);
} else {
nfilters=countparval("filters_type");
filters_type=alloc1int(nfilters);
getparint("filters_type",filters_type);
}
if (*fphfile !='\0') {
if ((infp=efopen(fphfile,"r"))==NULL)
err("cannot open file=%s\n",fphfile);
filters_phase=alloc1int(nfilters);
fread (filters_phase,sizeof(float),nfilters,infp);
efclose(infp);
} else if (nfilters == countparval("filters_phase")) {
filters_phase=alloc1int(nfilters);
getparint("filters_phase",filters_phase);
} else err("number of elements infilterstype and phase must be equal");
if (*dbpofile !='\0') {
if ((infp=efopen(dbpofile,"r"))==NULL)
err("cannot open file=%s\n",dbpofile);
dbpo=alloc1float(nfilters);
fread (dbpo,sizeof(float),nfilters,infp);
efclose(infp);
} else if (nfilters == countparval("dbpo")) {
dbpo=alloc1float(nfilters);
getparfloat("dbpo",dbpo);
} else err("number of elements in filters_type and dbpo must be equal");
if (*f1file !='\0') {
if ((infp=efopen(f1file,"r"))==NULL)
err("cannot open file=%s\n",f1file);
f1=alloc1float(nfilters);
fread (f1,sizeof(float),nfilters,infp);
efclose(infp);
} else if (nfilters == countparval("f1")) {
f1=alloc1float(nfilters);
getparfloat("f1",f1);
} else err("number of elements in filters_type and f1 must be equal");
if (*f2file !='\0') {
if ((infp=efopen(f2file,"r"))==NULL)
err("cannot open file=%s\n",f2file);
f2=alloc1float(nfilters);
fread (f2,sizeof(float),nfilters,infp);
efclose(infp);
} else if (nfilters == countparval("f2")) {
f2=alloc1float(nfilters);
getparfloat("f2",f2);
} else err("number of elements in filters_type and f2 must be equal");
/*********************************************************************/
/* allocate space for wavefield computations */
wavefield1=alloc2float(nt,nx);
if (wtype==1) {
wavefield2=alloc2float(nt,nx);
wavefield3=alloc2float(nt,nx);
}
/* get name of output file for processing information */
if (verbose==2||verbose==3) {
if (!getparstring("outf",&outf)) outf="info";
if ((outfp=efopen(outf,"w"))==NULL) {
warn("cannot open processing file =%s, no processing\n"
"information file will be generated\n",outf);
verbose=1;
}
}
/* initialize wavefields */
if (wtype==1) {
for (ix=0;ix<nx;ix++) {
for (it=0;it<nt;it++) {
wavefield1[ix][it]=0.0;
wavefield2[ix][it]=0.0;
wavefield3[ix][it]=0.0;
}
}
} else if (wtype==2) {
for (ix=0;ix<nx;ix++) {
for (it=0;it<nt;it++) {
wavefield1[ix][it]=0.0;
}
}
}
/* number of time samples in computed traces */
ntc=tsec/dt;
if (int_type==2) bp=0.0;
/*********************************************************************/
/* Now, compute the actual reflectivities */
compute_reflectivities (int_type, verbose, wtype, wfield, vsp, flt,
win, nx, nt, ntc, nor, nf, nlayers, lsource, layern, nfilters,
filters_phase, nw, np, bp, tlag, red_vel, w1, w2, fx, dx, bx,
fs, decay, p2w, tsec, fref, wrefp, wrefs, epsp, epss, sigp,
sigs, pw1, pw2, pw3, pw4, h1, h2, m1, m2, m3, fref, lobs,
filters_type, dbpo, f1, f2, cl, ct, ql, qt, rho, t, wavefield1,
wavefield2, wavefield3, outfp);
/*********************************************************************/
/* if open, close processing information file */
if (verbose==2||verbose==3) efclose(outfp);
/* convolve with a wavelet and write the results out */
if (wtype==1) { /* PSV */
/* convolve with a wavelet to produce the seismograms */
convolve_wavelet (wavelet_type, nx, nt, dt, fpeak, wavefield1);
convolve_wavelet (wavelet_type, nx, nt, dt, fpeak, wavefield2);
convolve_wavelet (wavelet_type, nx, nt, dt, fpeak, wavefield3);
/* output results in SU format */
if(*wfp!='\0'){
if ((wfp_file=efopen(wfp,"w"))==NULL)
err("cannot open pressure file=%s\n",wfp);
{ register int ix;
for (ix=0; ix<nx; ix++) {
for (it=0; it<nt; it++)
tr1.data[it]=wavefield1[ix][it];
/* headers*/
tr1.ns=nt;
tr1.dt=1000*(int)(1000*dt);
tr1.offset=(bx+ix*dx)*1000;
/* output trace */
fputtr(wfp_file, &tr1);
}
efclose (wfp_file);
}
}
if (*wfr !='\0') {
if ((wfr_file=efopen(wfr,"w"))==NULL)
err("cannot open radial wfield file=%s\n",wfr);
{ register int ix;
for (ix=0; ix<nx; ix++) {
for (it=0; it<nt; it++)
tr2.data[it]=wavefield2[ix][it];
tr2.ns=nt;
tr2.dt=1000*(int)(1000*dt);
tr2.offset=(bx+ix*dx)*1000;
fputtr(wfr_file, &tr2);
}
efclose (wfr_file);
}
}
if (*wfz !='\0') {
if ((wfz_file=efopen(wfz,"w"))==NULL)
err("canno open vertical field file=%s\n",wfz);
{ register int ix;
for (ix=0; ix<nx; ix++) {
for (it=0; it<nt; it++)
tr3.data[it]=wavefield3[ix][it];
tr3.ns=nt;
tr3.dt=1000*(int)(1000*dt);
tr3.offset=(bx+ix*dx)*1000;
fputtr(wfz_file, &tr3);
}
efclose (wfz_file);
}
}
/* free allocated space */
free2float(wavefield1);
free2float(wavefield2);
free2float(wavefield3);
} else if (wtype==2) { /* SH */
/* convolve with a wavelet to produce the seismogram */
convolve_wavelet (wavelet_type, nx, nt, dt, fpeak, wavefield1);
/* output the result in SU format */
if (*wft !='\0') {
if ((wft_file=efopen(wft,"w"))==NULL)
err("cannot open tangential file=%s\n",wft);
{ register int ix;
for (ix=0; ix<nx; ix++) {
for (it=0; it<nt; it++)
tr1.data[it]=wavefield1[ix][it];
tr1.ns=nt;
tr1.dt=1000*(int)(1000*dt);
tr1.offset=(bx+ix*dx)*1000;
fputtr(wft_file, &tr1);
}
efclose (wft_file);
}
}
/* free allocated space */
free2float(wavefield1);
}
/* free workspace */
free1float(cl);
free1float(ct);
free1float(ql);
free1float(qt);
free1float(rho);
free1float(t);
free1int(lobs);
free1int(filters_type);
free1int(filters_phase);
free1float(dbpo);
free1float(f1);
free1float(f2);
return EXIT_SUCCESS;
}
int
main(int argc, char **argv)
{
int nx,nz;
float fx,fz,dx,dz,xs,zs,ex,ez,**v,**t,**a,**sg,**bet;
FILE *vfp=stdin,*tfp=stdout,*afp,*sfp,*bfp;
char *bfile="", *sfile="", *afile="";
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(0);
/* get required parameters */
if (!getparint("nx",&nx)) err("must specify nx!\n");
if (!getparint("nz",&nz)) err("must specify nz!\n");
if (!getparfloat("xs",&xs)) err("must specify xs!\n");
if (!getparfloat("zs",&zs)) err("must specify zs!\n");
/* get optional parameters */
if (!getparfloat("dx",&dx)) dx = 1.0;
if (!getparfloat("fx",&fx)) fx = 0.0;
if (!getparfloat("dz",&dz)) dz = 1.0;
if (!getparfloat("fz",&fz)) fz = 0.0;
if (!getparstring("sfile",&sfile)) sfile = "sfile";
if (!getparstring("bfile",&bfile)) bfile = "bfile";
if (!getparstring("afile",&afile)) afile = "afile";
checkpars();
if ((sfp=fopen(sfile,"w"))==NULL)
err("cannot open sfile=%s",sfile);
if ((bfp=fopen(bfile,"w"))==NULL)
err("cannot open bfile=%s",bfile);
if ((afp=fopen(afile,"w"))==NULL)
err("cannot open afile=%s",afile);
/* ensure source is in grid */
ex = fx+(nx-1)*dx;
ez = fz+(nz-1)*dz;
if (fx>xs || ex<xs || fz>zs || ez<zs)
err("source lies outside of specified (x,z) grid\n");
/* allocate space */
v = alloc2float(nz,nx);
t = alloc2float(nz,nx);
sg = alloc2float(nz,nx);
a = alloc2float(nz,nx);
bet = alloc2float(nz,nx);
/* read velocities */
fread(v[0],sizeof(float),nx*nz,vfp);
/* compute times, angles, sigma, and betas */
eiktam(xs,zs,nz,dz,fz,nx,dx,fx,v,t,a,sg,bet);
/* write first-arrival times */
fwrite(t[0],sizeof(float),nx*nz,tfp);
/* write sigma */
fwrite(sg[0],sizeof(float),nx*nz,sfp);
/* write angle */
fwrite(a[0],sizeof(float),nx*nz,afp);
/* write beta */
fwrite(bet[0],sizeof(float),nx*nz,bfp);
/* close files */
fclose(sfp);
fclose(afp);
fclose(bfp);
/* free space */
free2float(v);
free2float(t);
free2float(a);
free2float(sg);
free2float(bet);
return(CWP_Exit());
}
/************************ 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);
}
int
main (int argc, char **argv)
{
int nt,nzt,nxt,nz,nxo,nxs,ns,nx,nr,is,ixo,ixs;
int ls,jtr,mtr,tracl,mzmax;
off_t nseek;
float ft,fzt,fxt,fz,fx,fxo,fs,fxs,dt,dzt,dxt,dz,dx,dxo,ds,dxs,
ext,ezt,es,ex,ez,xo,s,xs,xg,fpeak;
float v0,dvz;
float fmax,angmax,offmax,rmax,aperx;
float **mig,**migi,***ttab,**tb,**pb,**cosb,**sigb,**tsum,**tt;
char *infile="stdin",*outfile="stdout",*ttfile,*jpfile;
FILE *infp,*outfp,*ttfp,*jpfp;
Wavelet *w;
/* hook up getpar to handle the parameters */
initargs(argc, argv);
requestdoc(1);
/* open input and output files */
if( !getparstring("infile",&infile)) {
infp = stdin;
} else
if ((infp=fopen(infile,"r"))==NULL)
err("cannot open infile=%s\n",infile);
if( !getparstring("outfile",&outfile)) {
outfp = stdout;
} else {
outfp = fopen(outfile,"w");
}
efseeko(infp,(off_t) 0,SEEK_CUR);
warn("Got A");
efseeko(outfp,(off_t) 0,SEEK_CUR);
if( !getparstring("ttfile",&ttfile))
err("must specify ttfile!\n");
if ((ttfp=fopen(ttfile,"r"))==NULL)
err("cannot open ttfile=%s\n",ttfile);
if( !getparstring("jpfile",&jpfile)) {
jpfp = stderr;
} else
jpfp = fopen(jpfile,"w");
/* get information for seismogram traces */
if (!getparint("nt",&nt)) nt = 501;
if (!getparfloat("dt",&dt)) dt = 0.004;
if (!getparfloat("ft",&ft)) ft = 0.0;
if (!getparfloat("fmax",&fmax)) fmax = 1.0/(4*dt);
fpeak = 0.2/dt;
if (!getparint("nxs",&nxs)) nxs = 101;
if (!getparfloat("dxs",&dxs)) dxs = 15;
if (!getparfloat("fxs",&fxs)) fxs = 0.0;
if (!getparint("nxo",&nxo)) nxo = 1;
if (!getparfloat("dxo",&dxo)) dxo = 50;
if (!getparfloat("fxo",&fxo)) fxo = 0.0;
/* get traveltime table parameters */
if (!getparint("nxt",&nxt)) err("must specify nxt!\n");
if (!getparfloat("fxt",&fxt)) err("must specify fxt!\n");
if (!getparfloat("dxt",&dxt)) err("must specify dxt!\n");
if (!getparint("nzt",&nzt)) err("must specify nzt!\n");
if (!getparfloat("fzt",&fzt)) err("must specify fzt!\n");
if (!getparfloat("dzt",&dzt)) err("must specify dzt!\n");
if (!getparint("ns",&ns)) err("must specify ns!\n");
if (!getparfloat("fs",&fs)) err("must specify fs!\n");
if (!getparfloat("ds",&ds)) err("must specify ds!\n");
ext = fxt+(nxt-1)*dxt;
ezt = fzt+(nzt-1)*dzt;
es = fs+(ns-1)*ds;
/* check source and receiver coordinates */
for (ixs=0; ixs<nxs; ++ixs) {
xs = fxs+ixs*dxs;
for (ixo=0; ixo<nxo; ++ixo) {
xg = xs+fxo+ixo*dxo;
if (fs>xs || es<xs || fs>xg || es<xg)
err("shot or receiver lie outside of specified (x,z) grid\n");
}
}
/* get migration section parameters */
if (!getparint("nx",&nx)) err("must specify nx!\n");
if (!getparfloat("fx",&fx)) err("must specify fx!\n");
if (!getparfloat("dx",&dx)) err("must specify dx!\n");
if (!getparint("nz",&nz)) err("must specify nz!\n");
if (!getparfloat("fz",&fz)) err("must specify fz!\n");
if (!getparfloat("dz",&dz)) err("must specify dz!\n");
ex = fx+(nx-1)*dx;
ez = fz+(nz-1)*dz;
if(fxt>fx || ext<ex || fzt>fz || ezt<ez)
err(" migration section is out of traveltime table!\n");
if (!getparfloat("v0",&v0)) v0 = 1500;
if (!getparfloat("dvz",&dvz)) dvz = 0;
if (!getparfloat("angmax",&angmax)) angmax = 60.;
if (angmax<0.00001) err("angmax must be positive!\n");
mzmax = dx*sin(angmax*PI/180.)/dz;
if(mzmax<1) mzmax = 1;
if (!getparfloat("aperx",&aperx)) aperx = 0.5*nxt*dxt;
if (!getparint("ls",&ls)) ls = 1;
if (!getparint("mtr",&mtr)) mtr = 100;
fprintf(jpfp,"\n");
fprintf(jpfp," Modeling parameters\n");
fprintf(jpfp," ================\n");
fprintf(jpfp," infile=%s \n",infile);
fprintf(jpfp," outfile=%s \n",outfile);
fprintf(jpfp," ttfile=%s \n",ttfile);
fprintf(jpfp," \n");
fprintf(jpfp," nzt=%d fzt=%g dzt=%g\n",nzt,fzt,dzt);
fprintf(jpfp," nxt=%d fxt=%g dxt=%g\n",nxt,fxt,dxt);
fprintf(jpfp," ns=%d fs=%g ds=%g\n",ns,fs,ds);
fprintf(jpfp," \n");
fprintf(jpfp," nz=%d fz=%g dz=%g\n",nz,fz,dz);
fprintf(jpfp," nx=%d fx=%g dx=%g\n",nx,fx,dx);
fprintf(jpfp," \n");
fprintf(jpfp," nxs=%d fxs=%g dxs=%g\n",nxs,fxs,dxs);
fprintf(jpfp," nxo=%d fxo=%g dxo=%g\n",nxo,fxo,dxo);
fprintf(jpfp," \n");
/* compute reference traveltime and slowness */
offmax = MAX(ABS(fxo),ABS(fxo+(nxo-1)*dxo));
rmax = MAX(es-fxt,ext-fs);
rmax = MIN(rmax,0.5*offmax+aperx);
nr = 2+(int)(rmax/dx);
tb = ealloc2float(nzt,nr);
pb = ealloc2float(nzt,nr);
sigb = ealloc2float(nzt,nr);
cosb = ealloc2float(nzt,nr);
timeb(nr,nzt,dx,dzt,fzt,dvz,v0,tb,pb,sigb,cosb);
fprintf(jpfp," nt=%d ft=%g dt=%g fpeak=%g \n",nt,ft,dt,fpeak);
fprintf(jpfp," v0=%g dvz=%g \n",v0,dvz);
fprintf(jpfp," aperx=%g angmax=%g offmax=%g\n",aperx,angmax,offmax);
fprintf(jpfp," mtr=%d ls=%d\n",mtr,ls);
fprintf(jpfp," ================\n");
fflush(jpfp);
/* allocate space */
mig = ealloc2float(nz,nx);
migi = ealloc2float(nz+2*mzmax,nx);
ttab = ealloc3float(nzt,nxt,ns);
tt = ealloc2float(nzt,nxt);
tsum = ealloc2float(nzt,nxt);
/* make wavelet */
makericker(fpeak,dt,&w);
/* set constant segy trace header parameters */
memset((void *) &tr, 0, sizeof(segy));
tr.trid = 1;
tr.counit = 1;
tr.ns = nt;
tr.dt = 1.0e6*dt;
tr.delrt = 1.0e3*ft;
fprintf(jpfp," read traveltime tables \n");
fflush(jpfp);
/* compute traveltime residual */
for(is=0; is<ns; ++is){
nseek = (off_t) nxt*nzt*is;
efseeko(ttfp,nseek*((off_t) sizeof(float)),SEEK_SET);
fread(ttab[is][0],sizeof(float),nxt*nzt,ttfp);
s = fs+is*ds;
resit(nxt,fxt,dxt,nzt,nr,dx,tb,ttab[is],s);
}
fprintf(jpfp," read migration section \n");
fflush(jpfp);
/* read migration section */
fread(mig[0],sizeof(float),nx*nz,infp);
/* integrate migration section for constructing anti-aliasing
filter */
integ(mig,nz,dz,nx,mzmax,migi);
fprintf(jpfp," start synthesis ... \n");
fprintf(jpfp," \n");
fflush(jpfp);
jtr = 0;
/* loop over shots */
for (ixs=0,xs=fxs,tracl=0; ixs<nxs; ++ixs,xs+=dxs) {
/* loop over offsets */
for (ixo=0,xo=fxo; ixo<nxo; ++ixo,xo+=dxo) {
float as,res;
int is;
xg = xs+xo;
/* set segy trace header parameters */
tr.tracl = tr.tracr = ++tracl;
tr.fldr = 1+ixs;
tr.tracf = 1+ixo;
tr.offset = NINT(xo);
tr.sx = NINT(xs);
tr.gx = NINT(xg);
as = (xs-fs)/ds;
is = (int)as;
if(is==ns-1) is=ns-2;
res = as-is;
if(res<=0.01) res = 0.0;
if(res>=0.99) res = 1.0;
sum2(nxt,nzt,1-res,res,ttab[is],ttab[is+1],tsum);
as = (xg-fs)/ds;
is = (int)as;
if(is==ns-1) is=ns-2;
res = as-is;
if(res<=0.01) res = 0.0;
if(res>=0.99) res = 1.0;
sum2(nxt,nzt,1-res,res,ttab[is],ttab[is+1],tt);
sum2(nxt,nzt,1,1,tt,tsum,tsum);
fflush(jpfp);
/* make one trace */
maketrace(tr.data,nt,ft,dt,xs,xg,mig,migi,aperx,
nx,fx,dx,nz,fz,dz,mzmax,ls,angmax,v0,fmax,w,
tb,pb,sigb,cosb,nr,tsum,nxt,fxt,dxt,nzt,fzt,dzt);
/* write trace */
fputtr(outfp,&tr);
jtr++;
if((jtr-1)%mtr ==0 ){
fprintf(jpfp," generated trace %d\n",jtr);
fflush(jpfp);
}
}
}
fprintf(jpfp," generated %d traces in total\n",jtr);
fprintf(jpfp," \n");
fprintf(jpfp," output done\n");
fflush(jpfp);
efclose(jpfp);
efclose(outfp);
free2float(tsum);
free2float(tt);
free2float(pb);
free2float(tb);
free2float(cosb);
free2float(sigb);
free3float(ttab);
free2float(mig);
free2float(migi);
return(CWP_Exit());
}
void slopefilter (int nslopes, float slopes[], float amps[], float bias,
int nt, float dt, int nx, float dx, FILE *tracefp)
/******************************************************************************
apply slope filter in frequency-wavenumber domain
*******************************************************************************
Input:
nslopes number of slopes (and amplitudes) specified
slopes slopes at which amplitudes are specified (see notes below)
amps amplitudes corresponding to slopes (see notes below)
bias linear moveout slope before and after filtering
nt number of time samples
dt time sampling interval
nx number of traces
dx trace space (spatial sampling interval)
tracefp file pointer to data to be filtered
Output:
tracefp file pointer to filtered data
*******************************************************************************
Notes:
Linear interpolation and constant extrapolation are used to
determine amplitudes for slopes that are not specified.
******************************************************************************/
{
int ntfft; /* nt after padding for FFT */
int nxfft; /* nx after padding for FFT */
float sfft; /* scale factor for FFT */
int nw; /* number of frequencies */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
int nk; /* number of wavenumbers */
float dk; /* wavenumber sampling interval */
float w,k; /* frequency and wavenumber */
int it,ix,iw,ik; /* sample indices */
float slope,amp; /* slope and amplitude for particular w,k */
complex **cpfft; /* complex FFT workspace */
float **pfft; /* float FFT workspace */
float phase; /* phase shift for bias */
complex cshift; /* complex phase shifter for bias */
/* determine lengths and scale factors for prime-factor FFTs */
ntfft = npfar(nt);
nxfft = npfa(nx);
sfft = 1.0/(ntfft*nxfft);
/* determine frequency and wavenumber sampling */
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
fw = 0.000001*dw; /* non-zero to avoid divide by zero w */
nk = nxfft;
dk = 2.0*PI/(nxfft*dx);
/* allocate real and complex workspace for FFTs */
cpfft = alloc2complex(nw,nk);
pfft = alloc2float(ntfft,nxfft);
/* copy data from input to FFT array and pad with zeros */
rewind(tracefp);
for (ix=0; ix<nx; ix++) {
efread(pfft[ix], FSIZE, nt, tracefp);
for (it=nt; it<ntfft; it++)
pfft[ix][it] = 0.0;
}
for (ix=nx; ix<nxfft; ix++)
for (it=0; it<ntfft; it++)
pfft[ix][it] = 0.0;
/* Fourier transform t to w */
pfa2rc(1,1,ntfft,nx,pfft[0],cpfft[0]);
/* do linear moveout bias via phase shift */
for (ix=0; ix<nx; ix++) {
for (iw=0,w=0.0; iw<nw; iw++,w+=dw) {
phase = -ix*dx*w*bias;
cshift = cmplx(cos(phase),sin(phase));
cpfft[ix][iw] = cmul(cpfft[ix][iw],cshift);
}
}
/* Fourier transform x to k */
pfa2cc(-1,2,nw,nxfft,cpfft[0]);
/* loop over wavenumbers */
for (ik=0; ik<nk; ik++) {
/* determine wavenumber */
k = (ik<=nk/2) ? ik*dk : (ik-nk)*dk;
/* loop over frequencies */
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
/* determine biased slope */
slope = k/w+bias;
/* linearly interpolate to find amplitude */
intlin(nslopes,slopes,amps,amps[0],amps[nslopes-1],
1,&slope,&);
/* include fft scaling */
amp *= sfft;
/* filter real and imaginary parts */
cpfft[ik][iw].r *= amp;
cpfft[ik][iw].i *= amp;
}
}
/* Fourier transform k to x */
pfa2cc(1,2,nw,nxfft,cpfft[0]);
/* undo linear moveout bias via phase shift */
for (ix=0; ix<nx; ix++) {
for (iw=0,w=0.0; iw<nw; iw++,w+=dw) {
phase = ix*dx*w*bias;
cshift = cmplx(cos(phase),sin(phase));
cpfft[ix][iw] = cmul(cpfft[ix][iw],cshift);
}
}
/* Fourier transform w to t */
pfa2cr(-1,1,ntfft,nx,cpfft[0],pfft[0]);
/* copy filtered data from FFT array to output */
rewind(tracefp);
for (ix=0; ix<nx; ix++)
efwrite(pfft[ix], FSIZE, nt, tracefp);
/* free workspace */
free2complex(cpfft);
free2float(pfft);
}
int
main(int argc, char **argv)
{
int ix,it; /* loop counters */
int i,j,k;
int ntr; /* number of input traces */
int nt; /* number of time samples */
int nx; /* number of horizontal samples */
float dt; /* Time sample interval */
float dx=1; /* horizontal sample interval */
float pminf; /* Minimum slope for Tau-P transform */
float pmaxf; /* Maximum slope for Tau-P transform */
float dpf; /* slope sampling interval */
int np; /* number of slopes for slant stack */
int nwin; /* spatial window length */
int npoints; /* number of points for rho filter */
float **twin; /* array[nwin][nt] of window traces */
float **pwin; /* array[np][nt] of sl traces */
int ntrw; /* number of traces in processing window */
/* full multiple of nwin */
int ist; /* start processing from this window */
int ntfft;
float **traces;
int w; /* flag to apply semblance weights */
int s; /* flag to apply smoothing weights */
int sl1; /* length of smoothing window */
int sl2; /* length of smoothing window */
float *smb; /* semblance weights */
double pw;
float smbwin;
int sn;
float *spw; /* array of spatial weights */
float **out_traces; /* array[nx][nt] of output traces */
int verbose; /* flag for echoing information */
char *tmpdir; /* directory path for tmp files */
cwp_Bool istmpdir=cwp_false;/* true for user-given path */
float fh1; /* maximum frequency before taper */
float fh2; /* maximum frequency */
float prw; /* prewithening */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
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);
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
dt = (float) tr.dt/1000000.0;
/* Store traces in tmpfile 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);
}
ntr = 0;
do {
++ntr;
efwrite(&tr, 1, HDRBYTES, headerfp);
efwrite(tr.data, FSIZE, nt, tracefp);
} while (gettr(&tr));
/* get general flags and parameters and set defaults */
if (!getparint("np",&np)) np = 25;
if (!getparfloat("pminf",&pminf)) pminf = -0.01;
if (!getparfloat("pmaxf",&pmaxf)) pmaxf = 0.01;
if (!getparfloat("fh1",&fh1)) fh1 = 100;
if (!getparfloat("fh2",&fh2)) fh2 = 120;
if (!getparfloat("prw",&prw)) prw = 0.01;
if (!getparfloat("dx",&dx)) dx = 1.0;
if (!getparint("npoints",&npoints)) npoints = 71;
if (!getparint("nwin",&nwin)) nwin= 5;
if (!getparfloat("dt",&dt)) dt = dt;
if (!getparfloat("smbwin",&smbwin)) smbwin = 0.05;
if (!getpardouble("pw",&pw)) pw = 1.0;
if (!getparint("w",&w)) w = 0;
if (!getparint("s",&s)) s = 0;
if (!getparint("sl1",&sl1)) sl1 = 2*nwin;
if (!getparint("sl2",&sl2)) sl2 = nwin;
nx = ntr;
if (dt == 0.0)
err("header field dt not set, must be getparred");
/* allocate space */
ntfft=npfar(nt);
ntrw=nwin;
while (ntrw < ntr) {
ntrw+=nwin;
}
ist = ntrw-ntr/2;
twin = alloc2float(nt, nwin);
pwin = ealloc2float(ntfft,np);
traces = alloc2float(nt, ntr);
out_traces = alloc2float(nt, ntr);
smb = ealloc1float(nt);
/* Set up some constans*/
dpf=(pmaxf-pminf)/(np-1);
sn = (int)(smbwin/dt+0.5);
if(sn%2==0) sn++;
if(nwin%2==0) nwin++;
/* spatial trace weigths */
spw = ealloc1float(nwin);
for(k=0,i=1;k<nwin/2+1;k++,i++) spw[k] = (float)i;
for(k=nwin/2+1,i=nwin/2;k<nwin;k++,i--) spw[k] = (float)i;
/* for(k=0,i=1;k<nwin;k++,i++) spw[k] =1.0; */
/* load traces into an array and close temp file */
erewind(headerfp);
erewind(tracefp);
memset( (void *) traces[0], (int) '\0', (nt*ntr)*FSIZE);
memset( (void *) out_traces[0], (int) '\0', (nt*ntr)*FSIZE);
for (ix=0; ix<ntr; ix++)
fread (traces[ix], FSIZE, nt, tracefp);
efclose (tracefp);
if (istmpdir) eremove(tracefile);
/* do requested operation */
for(i=0; i<ntr; i+=nwin/2) {
memcpy( (void *) twin[0], (const void *) traces[i],
nt*nwin*FSIZE);
/* compute forward slant stack */
/* fwd_tx_sstack (dt, nt, nwin, -nwin/2*dx, dx, np, pminf, dpf,
twin, pwin);
*/ forward_p_transform(nwin,nt,dt,pmaxf*1000.0,pminf*1000.0,dpf*1000.0,
0.0,fh1,fh2,3.0,30.0,400,5,1,0,0,1,prw,
0.0,nwin*dx,1,dx,0.0,0.0,0.0,twin,pwin);
/* fwd_FK_sstack (dt, nt, nwin, -nwin/2*dx, dx, np, pminf, dpf,0,
twin, pwin);
*/
/* compute semplance */
if(w==1) {
semb(sn,pwin,np,nt,smb);
/* apply weights */
for(j=0;j<nt;j++)
for(k=0;k<np;k++) pwin[k][j] *=smb[j];
}
if(s==1) {
gaussian2d_smoothing (np,nt,sl2,sl1,pwin);
}
if(s==2) {
dlsq_smoothing (nt,np,0,nt,0,np,sl1,sl2,0,pwin);
}
/* compute inverse slant stack */
/* inv_tx_sstack (dt, nt, nwin, npoints,-nwin/2*dx, dx, np,pminf,dpf,
pwin, twin);
*/ inverse_p_transform(nwin,nt,dt,pmaxf*1000.0,pminf*1000.0,dpf*1000.0,
0.0,fh1,fh2,0.0,nwin*dx,1,dx,0.0,
pwin,twin);
/* inv_FK_sstack (dt, nt, nwin,-nwin/2*dx, dx, np,pminf,dpf,0,
pwin, twin);
*/
{ register int itr,it,spind;;
for(itr=0;itr<nwin;itr++) {
spind=i+itr;
for(it=0;it<nt;it++) {
if(spind>0 && spind<ntr)
out_traces[spind][it] += spw[itr]*twin[itr][it];
/* out_traces[spind][it] = twin[itr][it]; */
}
}
}
/* fprintf(stderr," Trace #= %5d\n",i); */
}
/* write output traces */
erewind(headerfp);
{ register int itr;
for (itr=0; itr<ntr; itr++) {
efread(&tr, 1, HDRBYTES, headerfp);
for (it=0; it<nt; it++)
tr.data[it]=out_traces[itr][it];
puttr(&tr);
}
}
efclose(headerfp);
if (istmpdir) eremove(headerfile);
/* free allocated space */
free2float(out_traces);
free1float(spw);
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 iz,iw,ix,it,ik; /* loop counters */
int igx; /* integerized gx value */
int ntfft,nxfft; /* fft size */
int nw,truenw,nk; /* number of wave numbers */
int dip=65; /* dip angle */
int oldigx=0; /* old value of integerized gx value */
int oldisx=0; /* old value of integerized sx value */
float sx,gx; /* x source and geophone location */
float gxmin=0.0,gxmax=0.0; /* x source and geophone location */
float min_sx_gx; /* min(sx,gx) */
float oldgx; /* old gx position */
float oldgxmin; /* old gx position */
float oldgxmax; /* old gx position */
float oldsx=0.0; /* old sx position */
int isx=0,nxo; /* index for source and geophone */
int ix1,ix2,ix3,ixshot,il=0,ir=0; /* dummy index */
int lpad,rpad; /* padding on both sides of the migrated section */
float *wl=NULL,*wtmp=NULL;
float fmax;
float f1,f2,f3,f4;
int nf1,nf2,nf3,nf4;
int ntw;
float dt=0.004,dz; /* time and depth sampling interval */
float dw,dk; /* wavenumber and frequency sampling interval */
float fw,fk; /* first wavenumber and frequency */
float w,k; /* wavenumber and frequency */
float dx; /* spatial sampling interval */
float **p=NULL;
float **cresult=NULL; /* input, output data */
float v1,vmin;
double kz1,kz2;
double phase1;
float **v=NULL;
float **vp=NULL;
complex cshift1,cshift2;
complex *wlsp=NULL;
complex **cp=NULL;
complex **cp1=NULL;
complex **cq=NULL;
complex **cq1=NULL; /*complex input,output*/
char *vfile=""; /* name of file containing velocities */
FILE *vfp=NULL;
int verbose; /* verbose flag */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get optional parameters */
MUSTGETPARINT("nz",&nz);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile", &vfile);
MUSTGETPARINT("nxo",&nxo);
MUSTGETPARINT("nxshot",&nxshot);
if (!getparfloat("fmax",&fmax)) fmax = 25. ;
if (!getparfloat("f1",&f1)) f1 = 10.0;
if (!getparfloat("f2",&f2)) f2 = 20.0;
if (!getparfloat("f3",&f3)) f3 = 40.0;
if (!getparfloat("f4",&f4)) f4 = 50.0;
if (!getparint("lpad",&lpad)) lpad=9999;
if (!getparint("rpad",&rpad)) rpad=9999;
if (!getparint("dip",&dip)) dip=65;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocate space */
cresult = alloc2float(nz,nxo);
vp=alloc2float(nxo,nz);
/* load velocity file */
vfp=efopen(vfile,"r");
efread(vp[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/* zero out cresult array */
memset((void *) cresult[0], 0, nxo*nz*FSIZE);
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
get_sx_gx(&sx,&gx);
min_sx_gx = MIN(sx,gx);
gxmin=gxmax=gx;
erewind(stdin);
/*
sx = sx - min_sx_gx;
gx = gx - min_sx_gx;
*/
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
warn("tr.d2 not set, assuming d2=1.0");
}
}
do { /* begin loop over shots */
/* determine frequency sampling interval*/
ntfft = npfar(nt);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
/* compute the index of the frequency to be migrated */
fw=2.0*PI*f1;
nf1=fw/dw+0.5;
fw=2.0*PI*f2;
nf2=fw/dw+0.5;
fw=2.0*PI*f3;
nf3=fw/dw+0.5;
fw=2.0*PI*f4;
nf4=fw/dw+0.5;
/* the number of frequencies to migrated */
truenw=nf4-nf1+1;
fw=0.0+nf1*dw;
if (verbose)
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/* generate the Ricker wavelet */
wtmp=ricker(fmax,dt,&ntw);
/* zero out wl[] array */
memset((void *) wl, 0, ntfft*FSIZE);
/* CHANGE BY CHRIS STOLK, Dec. 11, 2005 */
/* The next two lines are the old code, */
/* it is erroneous because the peak of */
/* the wavelet occurs at positive time */
/* instead of time zero. */
for(it=0;it<ntw;it++)
wl[it]=wtmp[it];
/* New code: we put in the wavelet in a centered fashion */
/*
for(it=0;it<ntw;it++) {
wl[(it-ntw/2+ntfft) % ntfft]=wtmp[it];
}
*/
/* warn("%12i %12f \n",(it-ntw/2+ntfft) % ntfft,wtmp[it]); */
/* End of new code */
free1float(wtmp);
/* fourier transform wl array */
pfarc(-1,ntfft,wl,wlsp);
/* CS TEST: this was used to output the array wlsp
(the wavelet in the frequency domain) to the file CSinfo,
no longer needed and commented out */
/*
FILE *CSinfo;
CSinfo=fopen("CSinfo","w");
fprintf(CSinfo,"ntfft=%10i\n",ntfft);
fprintf(CSinfo,"ntw=%10i\n",ntw);
for(iw=0;iw<ntfft/2+1;iw++)
fprintf(CSinfo,"%12f %12f \n",wlsp[iw].r,wlsp[iw].i);
fclose(CSinfo);
*/
/* conclusion from the analysis of this info:
the wavelet (whose fourier transform is in wlsp)
is not zero phase!!!
so there is a timeshift error!!!
Conclusion obtained dec 11 2005 */
/* CS */
/* allocate space */
p = alloc2float(ntfft,nxo);
cq = alloc2complex(nw,nxo);
/* zero out p[][] array */
memset((void *) p[0], 0, ntfft*nxo*FSIZE);
/* initialize a number of items before looping over traces */
nx = 0;
if (gx < 0 ) {
igx=gx/dx + nxo;
} else {
igx=gx/dx ;
}
oldigx=igx;
oldsx=sx;
oldgx=gx;
oldgxmax=gxmax;
oldgxmin=gxmin;
while(gettr(&tr)) { /* begin looping over traces within a shot gather */
/* get sx and gx */
get_sx_gx(&sx,&gx);
/*
warn("%d nx=%d", igx, nx);
sx = (sx - min_sx_gx);
gx = (gx - min_sx_gx);
*/
if (gx < 0 ) {
igx=gx/dx + nxo;
} else {
igx=gx/dx ;
}
if (igx==oldigx)
warn("repeated igx!!! check dx or scalco value!!!");
oldigx = igx;
if(tr.sx!=oldsx){ efseeko(stdin,(off_t)(-240-nt*4),SEEK_CUR); break;}
if(gxmin>gx)gxmin=gx;
if(gxmax<gx)gxmax=gx;
if(verbose)
warn(" inside loop: min_sx_gx %f isx %d igx %d gx %f sx %f",min_sx_gx,isx,igx,gx,sx);
/* sx, gx must increase monotonically */
if (!(oldsx <= sx) )
err("sx field must be monotonically increasing!");
if (!(oldgx <= gx) )
err("gx field must be monotonically increasing!");
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
++nx;
}
isx=oldsx/dx;
if (isx==oldisx)
warn("repeated isx!!! check dx or scalco value!!!");
oldisx=isx;
ixshot=isx;
if(verbose) {
warn("sx %f, gx %f , gxmin %f gxmax %f nx %d",sx,gx,gxmin,gxmax, nx);
warn("isx %d igx %d ixshot %d" ,isx,igx,ixshot);
}
/* transform the shot gather from time to frequency domain */
pfa2rc(1,1,ntfft,nxo,p[0],cq[0]);
/* compute the most left and right index for the migrated */
/* section */
ix1=oldsx/dx;
ix2=gxmin/dx;
ix3=gxmax/dx;
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
il=ix2;
ir=ix3;
ix2-=lpad;
ix3+=rpad;
if(ix2<0)ix2=0;
if(ix3>nxo-1)ix3=nxo-1;
/* the total traces to be migrated */
nx=ix3-ix2+1;
nw=truenw;
/* determine wavenumber sampling (for complex to complex FFT) */
nxfft = npfa(nx);
nk = nxfft;
dk = 2.0*PI/(nxfft*dx);
fk = -PI/dx;
/* allocate space for velocity profile within the aperature */
v=alloc2float(nx,nz);
for(iz=0;iz<nz;iz++)
for(ix=0;ix<nx;ix++)
v[iz][ix]=vp[iz][ix+ix2];
/* allocate space */
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
/* transpose the frequency domain data from */
/* data[ix][iw] to data[iw][ix] and apply a */
/* Hamming at the same time */
for (ix=0; ix<nx; ix++) {
for (iw=0; iw<nw; iw++){
float tmpp=0.0,tmppp=0.0;
if(iw>=(nf1-nf1)&&iw<=(nf2-nf1)){
tmpp=PI/(nf2-nf1);
tmppp=tmpp*(iw-nf1)-PI;
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
if(iw>=(nf3-nf1)&&iw<=(nf4-nf1)){
tmpp=PI/(nf4-nf3);
tmppp=tmpp*(iw-nf3);
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
cp[iw][ix]=cq[ix+ix2][iw+nf1];}
}
cp1[iw][ix]=cmplx(0.0,0.0);
}
}
for(iw=0;iw<nw;iw++){
cp1[iw][ixshot-ix2]=wlsp[iw+nf1];
}
if(verbose) {
warn("ixshot %d ix %d ix1 %d ix2 %d ix3 %d",ixshot,ix,ix1,ix2,ix3);
warn("oldsx %f ",oldsx);
}
free2float(p);
free2complex(cq);
free1float(wl);
free1complex(wlsp);
/* allocating space */
cq=alloc2complex(nxfft,nw);
cq1=alloc2complex(nxfft,nw);
/* loops over depth */
for(iz=0;iz<nz;++iz){
/* the imaging condition */
for(ix=0;ix<nx;ix++){
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
complex tmp;
float ratio=10.0;
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
else
tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/* get the minimum velocity */
vmin=0;
for(ix=il-ix2;ix<=ir-ix2;ix++){
vmin+=1.0/v[iz][ix]/(ir-il+1);
}
vmin=1.0/vmin;
/* compute the shifted wavefield */
for (ik=0;ik<nx;++ik) {
for (iw=0; iw<nw; ++iw) {
cq[iw][ik] = ik%2 ? cneg(cp[iw][ik]) : cp[iw][ik];
cq1[iw][ik] = ik%2 ? cneg(cp1[iw][ik]) : cp1[iw][ik];
}
}
/* zero out cq[][] cq1[][] */
for (ik=nx; ik<nk; ++ik) {
for (iw=0; iw<nw; ++iw) {
cq[iw][ik] = cmplx(0.0,0.0);
cq1[iw][ik] = cmplx(0.0,0.0);
}
}
/* FFT to W-K domain */
pfa2cc(-1,1,nk,nw,cq[0]);
pfa2cc(-1,1,nk,nw,cq1[0]);
v1=vmin;
for(ik=0,k=fk;ik<nk;++ik,k+=dk) {
for(iw=0,w=fw;iw<nw;++iw,w+=dw){
if(w==0.0)w=1.0e-10/dt;
kz1=1.0-pow(v1*k/w,2.0);
if(kz1>0.15){
phase1 = -w*sqrt(kz1)*dz/v1;
cshift1 = cmplx(cos(phase1), sin(phase1));
cq[iw][ik] = cmul(cq[iw][ik],cshift1);
cq1[iw][ik] = cmul(cq1[iw][ik],cshift1);
} else {
cq[iw][ik] = cq1[iw][ik] = cmplx(0.0,0.0);
}
}
}
pfa2cc(1,1,nk,nw,cq[0]);
pfa2cc(1,1,nk,nw,cq1[0]);
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
float a=0.015,g=1.0;
int I=10;
if(ix<=I)g=exp(-a*(I-ix)*(I-ix));
if(ix>=nx-I)g=exp(-a*(-nx+I+ix)*(-nx+I+ix));
cq[iw][ix] = crmul( cq[iw][ix],1.0/nxfft);
cq[iw][ix] =ix%2 ? cneg(cq[iw][ix]) : cq[iw][ix];
kz2=(1.0/v1-1.0/v[iz][ix])*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cq[iw][ix],cshift2);
cq1[iw][ix] = crmul( cq1[iw][ix],1.0/nxfft);
cq1[iw][ix] =ix%2 ? cneg(cq1[iw][ix]) : cq1[iw][ix];
cp1[iw][ix]=cmul(cq1[iw][ix],cshift2);
}
}
}
free2complex(cp);
free2complex(cp1);
free2complex(cq);
free2complex(cq1);
free2float(v);
--nxshot;
} while(nxshot);
/* restore header fields and write output */
for(ix=0; ix<nxo; ix++){
tr.ns = nz;
tr.d1 = dz;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
return(CWP_Exit());
}
int main (int argc, char **argv)
{
int Finish,dip=65;
int nz; /* number of migrated depth samples */
int nxo,nx; /* number of midpoints */
int iz,iw,ix,ix2,ix3,ixshot; /* loop counters*/
int ntfft; /* fft size*/
int nw; /* number of frequency*/
int mytid,msgtype,rc,parent_tid;
float dt=0.004,dz; /*time and depth sampling interval*/
float dw; /*frequency sampling interval */
float fw; /* first frequency*/
float w; /* frequency*/
float dx; /* spatial sampling interval*/
float **cresult; /*output data*/
float v1;
float para;
double kz2;
float **vp,**v;
complex cshift2;
complex **cp,**cp1; /* complex input,output */
/*get my and father pids*/
mytid=pvm_mytid();
parent_tid=pvm_parent();
/*receive global parameters*/
msgtype=PARA_MSGTYPE;
rc=pvm_recv(-1,msgtype);
rc=pvm_upkint(&nxo,1,1);
rc=pvm_upkint(&nz,1,1);
rc=pvm_upkint(&dip,1,1);
rc=pvm_upkfloat(¶,1,1);
/*allocate space for velocity profile and receive velocity from father*/
vp=alloc2float(nxo,nz);
msgtype=VEL_MSGTYPE;
rc=pvm_recv(-1,msgtype);
rc=pvm_upkfloat(vp[0],nxo*nz,1);
/*allocate space for the storage of partial image and zero it out now*/
cresult = alloc2float(nz,nxo);
for(ix=0;ix<nxo;ix++)
for(iz=0;iz<nz;iz++)
cresult[ix][iz]=0.0;
/*loop over shotgather*/
loop:
/*receive parameters for each shot gather*/
msgtype=PARA_MSGTYPE;
rc=pvm_recv(parent_tid,msgtype);
rc=pvm_upkint(&Finish,1,1);
if(Finish==FinalDone)goto end;
rc=pvm_upkint(&ntfft,1,1);
rc=pvm_upkint(&ix2,1,1);
rc=pvm_upkint(&ix3,1,1);
rc=pvm_upkint(&ixshot,1,1);
nx=ix3-ix2+1;
rc=pvm_upkfloat(&dx,1,1);
rc=pvm_upkfloat(&dz,1,1);
rc=pvm_upkfloat(&dw,1,1);
rc=pvm_upkfloat(&dt,1,1);
/*allocate space for velocity profile within the aperature*/
v=alloc2float(nx,nz);
for(iz=0;iz<nz;iz++)
for(ix=0;ix<nx;ix++){
v[iz][ix]=vp[iz][ix+ix2];
}
while(1){
/*receive parameters and data for processing*/
msgtype=DATA_MSGTYPE;
rc=pvm_recv(parent_tid,msgtype);
rc=pvm_upkint(&Finish,1,1);
if(Finish==Done) {free2float(v);goto loop; }
rc=pvm_upkfloat(&fw,1,1);
rc=pvm_upkint(&nw,1,1);
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
rc=pvm_upkfloat((float *)cp[0],nx*nw*2,1);
rc=pvm_upkfloat((float *)cp1[0],nx*nw*2,1);
/* loops over depth */
for(iz=0;iz<nz;++iz){
/*the imaging condition*/
/* for(ix=0;ix<nx;ix++){
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
complex tmp;
float ratio=10.0;
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
else tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
*/
/* anothe imaging condition, slightly different from the above one, but not quite
slow*/
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
float kk=0.0;
complex tmp;
float ratio=1.5;
if(dip<80)ratio=1.5;
else ratio=1.5;
for(ix=0;ix<nx;ix++){
kk+=(pow(cp1[iw][ix].i,2.0)+pow(cp1[iw][ix].r,2.0))/nx;
}
for(ix=0;ix<nx;ix++){
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=crmul(tmp,1.0/(kk+1.0e-10));
else tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/*get the average velocity*/
v1=0.0;
for(ix=0;ix<nx;++ix)
{v1+=v[iz][ix]/nx;}
/*compute time-invariant wavefield*/
/* for(ix=0;ix<nx;++ix)
for(iw=0,w=fw;iw<nw;w+=dw,++iw) {
kz2=-(1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
*/
/*wave-propagation using finite-difference method*/
fdmig( cp, nx, nw,v[iz],fw,dw,dz,dx,dt,dip,para);
fdmig( cp1,nx, nw,v[iz],fw,dw,dz,dx,dt,dip,para);
/*apply thin lens term here*/
for(ix=0;ix<nx;++ix)
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
float Wi=-dw;
kz2=-(1.0/v[iz][ix])*dz;
/* kz2=-(1.0/v[iz][ix]-1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));*/
cshift2=cexp(cmplx(-Wi*kz2,w*kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
/*finish a portion of the data, request more*/
pvm_initsend(PvmDataDefault);
pvm_pkint(&mytid,1,1);
msgtype=COM_MSGTYPE;
pvm_send(parent_tid,msgtype);
free2complex(cp);
free2complex(cp1);
}
end:
/*everything done,send back partial image and wait for signal to kill itself*/
pvm_initsend(PvmDataDefault);
pvm_pkfloat(cresult[0],nxo*nz,1);
msgtype=RESULT_MSGTYPE;
pvm_send(parent_tid,msgtype);
msgtype=COM_MSGTYPE;
pvm_recv(-1,msgtype);
pvm_exit();
exit(0);
}
void *wpcCompress(float *f, int n1, int n2, float error, int *nbytes)
/************************************************************************
Input:
f pointer to the 2D section
n1 # of samples in the fast dimension
n2 # of samples in the slow dimension
error relative RMS error tolerable during compression
Output:
nbytes # of bytes after compression
Return: pointer to the compressed data
*************************************************************************
Note: The compression is done block by block, so the data is tiled first.
The size of the tiling is set in the routine wpcInitConfig.
Those numbers are obtained empirically. To support upgrading,
the numbers and the filter parameters are stored as the header.
Since we cannot determine the size of the output before compression,
memory is allocated within this routine, and adjusted after the
compression.
************************************************************************/
{
int tileszt, tileszx;
int istrip, nblock, nstrip, n1p, n2p, n2l;
float **strip, **block;
int i, j, it, istart;
int size, bsize, mbound, pos;
void *interblock=NULL; /* reserve a spot for inter block
communication, not used yet */
wpcPTR *wpc;
static wpcCONFIG *config;
wpcBUFF *buff;
unsigned char *code;
mbound = n1*n2;
/* allocate space for wpc */
wpc = (wpcPTR *) malloc(sizeof(wpcPTR));
wpc->config = (wpcCONFIG *) malloc(sizeof(wpcCONFIG));
wpc->code = (unsigned char *) malloc(sizeof(char)*mbound);
/* allocate space for buffer */
buff = (wpcBUFF *)malloc(sizeof(wpcBUFF));
/* save some parameters */
wpc->version = 1; /* version # for portability */
wpc->size = 0; /* no data yet */
wpc->n1 = n1;
wpc->n2 = n2;
/* save the configuration info for portability */
config = wpc->config;
wpcInitConfig(config);
code = wpc->code;
/* prepare for tiling */
tileszt = config->tileszt;
tileszx = config->tileszx;
/* # of strips */
nblock = (n1-1)/tileszt + 1;
nstrip = (n2-1)/tileszx + 1;
/* regular sizes */
n1p = nblock*tileszt;
n2p = nstrip*tileszx;
n2l = n2 - n2p + tileszx;
strip = alloc2float (n1p, tileszx);
block = (float **) malloc(tileszx*sizeof(float *));
/* init */
istart = 0;
size = 0;
buff->mbound = mbound;
buff->pos = 0;
buff->code = code;
for(istrip=0;istrip<nstrip-1;istrip++){
/* read a strip of traces and pad with zeroes */
for(j=0; j<tileszx; j++){
memcpy(strip[j], f+istart, n1*sizeof(float));
istart += n1;
/* pad with zeroes */
for(i=n1;i<n1p;i++) strip[j][i] = 0.;
}
/* for each block in the strip */
for(it=0; it<n1p; it += tileszt){
/* get one block of data */
for(i=0;i<tileszx;i++)
block[i] = strip[i] + it;
/* remember the output location */
pos = buff->pos;
/* encoding */
bsize = wpcEncoder(block, error, config, buff, interblock);
/* this almost never happens */
if(bsize == WPC_EOB){
/* reallocate a larger space */
mbound *= WPC_BOUND;
code = (unsigned char *)realloc(code, mbound*sizeof(char));
/* update the buffer */
buff->code = code;
buff->mbound = mbound;
buff->pos = pos;
/* recode this block */
it -= tileszt;
continue;
}
size += bsize;
}
}
/* for the last strip */
for(j=0; j<n2l; j++){
/* read a strip of traces */
memcpy(strip[j], f+istart, n1*sizeof(float));
istart += n1;
/* pad with zeroes */
for(i=n1; i<n1p; i++) strip[j][i] = 0.;
}
/* pad with dead traces */
for(j=n2l; j<tileszx; j++)
for(i=0; i< n1p; i++)
strip[j][i] = 0.;
/* for each block in the strip */
for(it=0; it<n1p; it += tileszt){
/* get one block of data */
for(i=0;i<tileszx;i++)
block[i] = strip[i] + it;
/* remember the output location */
pos = buff->pos;
/* encoding */
bsize = wpcEncoder(block, error, config, buff, interblock);
/* this almost never happens */
if(bsize == WPC_EOB){
/* reallocate a larger space */
mbound *= WPC_BOUND;
code = (unsigned char *)realloc(code, mbound*sizeof(char));
/* update the buffer */
buff->code = code;
buff->mbound = mbound;
buff->pos = pos;
/* recode this block */
it -= tileszt;
continue;
}
size += bsize;
}
/* safety check */
if(size == buff->pos){
/* adjust the size of the buffer */
code = (unsigned char *)realloc(code, size*sizeof(char));
wpc->size = size;
*nbytes = size;
}
else{
free((void *)code);
free((void *)config);
free((void *)wpc);
wpc = NULL;
}
free2float(strip);
free((void *)block);
free((void *)buff);
return((void *)wpc);
}
int
main (int argc, char **argv)
{
int nr,ir,ls,smooth,ndpfz,ns,ixo,ixm,nxo,nxm,nt,
nx,nz,nxb,nxd,ixd,i,ix,iz,nx1,nx0,nxd1,
verbose,tracl,
*nxz;
float tmin,temp,temp1,
dsmax,fpeak,dx,dz,fx,ex,fx1,ex1,
dxm,dxo,dt,fxm,fxo,ft,xo,xm,vs0,vg0,
xs,xg,ez,
*ar,**xr,**zr,
**vold,**ts,**as,**sgs,**tg,**ag,**sgg,**bas,**bag,
**v,**ts1=NULL,**as1=NULL,**sgs1=NULL,
**tg1=NULL,**ag1=NULL,**sgg1=NULL;
FILE *vfp=stdin;
Reflector *r;
Wavelet *w;
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(0);
/* get required parameters */
if (!getparint("nx",&nx)) err("must specify nx!\n");
if (!getparint("nz",&nz)) err("must specify nz!\n");
/* get optional parameters */
if (!getparint("nxb",&nxb)) nxb = nx;
if (!getparint("nxd",&nxd)) nxd = 1;
if (!getparfloat("dx",&dx)) dx = 100;
if (!getparfloat("fx",&fx)) fx = 0.0;
if (!getparfloat("dz",&dz)) dz = 100;
if (!getparint("nt",&nt)) nt = 101; CHECK_NT("nt",nt);
if (!getparfloat("dt",&dt)) dt = 0.04;
if (!getparfloat("ft",&ft)) ft = 0.0;
if (!getparint("nxo",&nxo)) nxo = 1;
if (!getparfloat("dxo",&dxo)) dxo = 50;
if (!getparfloat("fxo",&fxo)) fxo = 0.0;
if (!getparint("nxm",&nxm)) nxm = 101;
if (!getparfloat("dxm",&dxm)) dxm = 50;
if (!getparfloat("fxm",&fxm)) fxm = 0.0;
if (!getparfloat("fpeak",&fpeak)) fpeak = 0.2/dt;
if (!getparint("ls",&ls)) ls = 0;
if (!getparfloat("tmin",&tmin)) tmin = 10.0*dt;
if (!getparint("ndpfz",&ndpfz)) ndpfz = 5;
if (!getparint("smooth",&smooth)) smooth = 0;
if (!getparint("verbose",&verbose)) verbose = 0;
/* check the ranges of shots and receivers */
ex = fx+(nx-1)*dx;
ez = (nz-1)*dz;
for (ixm=0; ixm<nxm; ++ixm)
for (ixo=0; ixo<nxo; ++ixo) {
/* compute source and receiver coordinates */
xs = fxm+ixm*dxm-0.5*(fxo+ixo*dxo);
xg = xs+fxo+ixo*dxo;
if (fx>xs || ex<xs || fx>xg || ex<xg)
err("shot or receiver lie outside of specified (x,z) grid\n");
}
decodeReflectors(&nr,&ar,&nxz,&xr,&zr);
if (!smooth) breakReflectors(&nr,&ar,&nxz,&xr,&zr);
/* allocate space */
vold = ealloc2float(nz,nx);
/* read velocities */
if(fread(vold[0],sizeof(float),nx*nz,vfp)!=nx*nz)
err("cannot read %d velocities from file %s",nx*nz,vfp);
/* determine maximum reflector segment length */
tmin = MAX(tmin,MAX(ft,dt));
dsmax = vold[0][0]/(2*ndpfz)*sqrt(tmin/fpeak);
/* make reflectors */
makeref(dsmax,nr,ar,nxz,xr,zr,&r);
/* count reflector segments */
for (ir=0,ns=0; ir<nr; ++ir)
ns += r[ir].ns;
/* make wavelet */
makericker(fpeak,dt,&w);
/* if requested, print information */
if (verbose) {
warn("\nSUSYNVXZ:");
warn("Total number of small reflecting segments is %d.\n",ns);
}
/* set constant segy trace header parameters */
memset( (void *) &tr, 0, sizeof(segy));
tr.trid = 1;
tr.counit = 1;
tr.ns = nt;
tr.dt = 1.0e6*dt;
tr.delrt = 1.0e3*ft;
/* allocate space */
nx1 = 1+2*nxb;
ts = ealloc2float(nz,nx1);
as = ealloc2float(nz,nx1);
sgs = ealloc2float(nz,nx1);
tg = ealloc2float(nz,nx1);
ag = ealloc2float(nz,nx1);
sgg = ealloc2float(nz,nx1);
v = ealloc2float(nz,nx1);
bas = ealloc2float(nz,nx1);
bag = ealloc2float(nz,nx1);
if(nxd>1) {
/* allocate space for interpolation */
ts1 = ealloc2float(nz,nx1);
as1 = ealloc2float(nz,nx1);
sgs1 = ealloc2float(nz,nx1);
tg1 = ealloc2float(nz,nx1);
ag1 = ealloc2float(nz,nx1);
sgg1 = ealloc2float(nz,nx1);
}
/* loop over offsets and midpoints */
for (ixo=0, tracl=0; ixo<nxo; ++ixo){
xo = fxo+ixo*dxo;
if(ABS(xo)>nxb*dx) err("\t band NXB is too small!\n");
nxd1 = nxd;
for (ixm=0; ixm<nxm; ixm +=nxd1){
xm = fxm+ixm*dxm;
xs = xm-0.5*xo;
xg = xs+xo;
/* set range for traveltimes' calculation */
fx1 = xm-nxb*dx;
ex1 = MIN(ex+(nxd1-1)*dxm,xm+nxb*dx);
nx1 = 1+(ex1-fx1)/dx;
nx0 = (fx1-fx)/dx;
temp = (fx1-fx)/dx-nx0;
/* transpose velocity such that the first row is at fx1 */
for(ix=0;ix<nx1;++ix)
for(iz=0;iz<nz;++iz){
if(ix<-nx0)
v[ix][iz] = vold[0][iz];
else if(ix+nx0>nx-2)
v[ix][iz]=vold[nx-1][iz];
else
v[ix][iz] = vold[ix+nx0][iz]*(1.0-temp)
+temp*vold[ix+nx0+1][iz];
}
if(ixm==0 || nxd1==1){
/* No interpolation */
/* compute traveltimes, propagation angles, sigmas
from shot and receiver respectively */
eiktam(xs,0.,nz,dz,0.,nx1,dx,fx1,v,ts,as,sgs,bas);
eiktam(xg,0.,nz,dz,0.,nx1,dx,fx1,v,tg,ag,sgg,bag);
ixd = NINT((xs-fx)/dx);
vs0 = vold[ixd][0];
ixd = NINT((xg-fx)/dx);
vg0 = vold[ixd][0];
/* make one trace */
ex1 = MIN(ex,xm+nxb*dx);
makeone(ts,as,sgs,tg,ag,sgg,ex1,ez,dx,dz,fx1,vs0,vg0,
ls,w,nr,r,nt,dt,ft,tr.data);
/* set segy trace header parameters */
tr.tracl = tr.tracr = ++tracl;
tr.cdp = 1+ixm;
tr.cdpt = 1+ixo;
tr.offset = NINT(xo);
tr.sx = NINT(xs);
tr.gx = NINT(xg);
/* write trace */
puttr(&tr);
}
else {
/* Linear interpolation */
eiktam(xs,0,nz,dz,0,nx1,dx,fx1,v,ts1,as1,sgs1,bas);
eiktam(xg,0,nz,dz,0,nx1,dx,fx1,v,tg1,ag1,sgg1,bag);
ixd = NINT((xs-fx)/dx);
vs0 = vold[ixd][0];
ixd = NINT((xg-fx)/dx);
vg0 = vold[ixd][0];
xm -= nxd1*dxm;
for(i=1; i<=nxd1; ++i) {
xm += dxm;
xs = xm-0.5*xo;
xg = xs+xo;
fx1 = xm-nxb*dx;
ex1 = MIN(ex+(nxd1-1)*dxm,xm+nxb*dx);
nx1 = 1+(ex1-fx1)/dx;
temp = nxd1-i;
temp1 = 1.0/(nxd1-i+1);
for(ix=0;ix<nx1;++ix)
for(iz=0;iz<nz;++iz){
if(i==nxd1){
ts[ix][iz] = ts1[ix][iz];
tg[ix][iz] = tg1[ix][iz];
sgs[ix][iz] = sgs1[ix][iz];
ag[ix][iz] = ag1[ix][iz];
sgg[ix][iz] = sgg1[ix][iz];
as[ix][iz] = as1[ix][iz];
}
else{
ts[ix][iz] = (temp*ts[ix][iz]
+ts1[ix][iz])*temp1;
tg[ix][iz] = (temp*tg[ix][iz]
+tg1[ix][iz])*temp1;
as[ix][iz] = (temp*as[ix][iz]
+as1[ix][iz])*temp1;
sgs[ix][iz] = (temp*sgs[ix][iz]
+sgs1[ix][iz])*temp1;
ag[ix][iz] = (temp*ag[ix][iz]
+ag1[ix][iz])*temp1;
sgg[ix][iz] = (temp*sgg[ix][iz]
+sgg1[ix][iz])*temp1;
}
}
/* make one trace */
ex1 = MIN(ex,xm+nxb*dx);
makeone(ts,as,sgs,tg,ag,sgg,ex1,ez,dx,dz,fx1,vs0,vg0,
ls,w,nr,r,nt,dt,ft,tr.data);
/* set segy trace header parameters */
tr.tracl = tr.tracr = ++tracl;
tr.cdp = 1+ixm-nxd1+i;
tr.cdpt = 1+ixo;
tr.offset = NINT(xo);
tr.d2=dxm;
tr.f2=fxm;
tr.sx = NINT(xs);
tr.gx = NINT(xg);
/* write trace */
puttr(&tr);
}
}
/* set skip parameter */
if(ixm<nxm-1 && ixm>nxm-1-nxd1) nxd1 = nxm-1-ixm;
}
warn("\t finish offset %f\n",xo);
}
free2float(vold);
free2float(ts);
free2float(bas);
free2float(sgs);
free2float(as);
free2float(v);
free2float(tg);
free2float(bag);
free2float(sgg);
free2float(ag);
if(nxd>1) {
free2float(ts1);
free2float(as1);
free2float(sgs1);
free2float(tg1);
free2float(ag1);
free2float(sgg1);
}
return(CWP_Exit());
}
int main(int argc, char **argv)
{
FILE *fpint, *fpcp, *fpcs, *fpro;
int example, verbose, writeint, nb;
int above, diffrwidth, dtype;
int Ngp, Ngs, Ngr, Np, Ns, Nr, Ng, Ni, Nv, Nvi, No, Noi;
int jint, jcount, j, ix, iz, nx, nz, nxp, nzp, *zp, nmaxx, nminx, optgrad, poly, gradt;
int ncp, nro, ncs, nvel, skip, rayfile, store_int;
long lseed;
size_t nwrite;
float *data_out, orig[2], cp0, cs0, ro0;
float *x, *z, *var, *interface, **inter;
float back[3], sizex, sizez, dx, dz;
float **cp ,**cs, **ro, aver, gradlen, gradcp, gradcs, gradro;
/* Gradient unit flag */
/* ------------------ */
/* - 0 Unit : m/s per dz */
/* - 1 Unit : m/s per m */
int gradunit;
/* Number of Z-reference points (one per layer) */
int Nzr=0;
float **gridcp, **gridcs, **gridro;
segy *hdrs;
FILE *fpout;
char *file, intt[10], *file_base, filename[150];
initargs(argc, argv);
requestdoc(1);
if (!getparint("example", &example)) example=0;
else { plotexample(); exit(0); }
if(getparstring("file",&file_base))
vwarn("parameters file is changed to file_base");
else {
if(!getparstring("file_base",&file_base))
verr("file_base not specified.");
}
if(getparfloat("back", back)) {
vwarn("parameters back is not used anymore");
vwarn("it has changed into cp0 (ro0,cs0 are optional)");
nb = countparval("back");
if (nb == 1) {
vwarn("The new call should be cp0=%.1f",back[0]);
cp0 = back[0];
}
if (nb == 2) {
vwarn("The new call should be cp0=%.1f",back[0]);
vwarn(" ro0=%.1f",back[1]);
cp0 = back[0];
ro0 = back[1];
}
if (nb == 3) {
vwarn("The new call should be cp0=%.1f",back[0]);
vwarn(" cs0=%.1f",back[1]);
vwarn(" ro0=%.1f",back[2]);
cp0 = back[0];
cs0 = back[1];
ro0 = back[2];
}
vmess("Don't worry everything still works fine");
}
else {
if(!getparfloat("cp0", &cp0)) verr("cp0 not specified.");
if(!getparfloat("cs0", &cs0)) cs0 = -1;
if(!getparfloat("ro0", &ro0)) ro0 = -1;
}
if(!getparfloat("sizex", &sizex)) verr("x-model size not specified.");
if(!getparfloat("sizez", &sizez)) verr("z-model size not specified.");
if(!getparfloat("dx", &dx)) verr("grid distance dx not specified.");
if(!getparfloat("dz", &dz)) verr("grid distance dz not specified.");
if(!getparfloat("orig", orig)) orig[0] = orig[1] = 0.0;
if(!getparint("gradt", &gradt)) gradt = 1;
if(!getparint("gradunit", &gradunit)) gradunit = 0;
if(!getparint("writeint", &writeint)) writeint = 0;
if(!getparint("rayfile", &rayfile)) rayfile = 0;
if(!getparint("skip", &skip)) skip = 5;
if(!getparint("above", &above)) above=0;
if(!getparint("verbose", &verbose)) verbose=0;
if(!getparint("dtype", &dtype)) dtype = 0;
if ((writeint == 1) || (rayfile == 1)) store_int = 1;
else store_int = 0;
/*=================== check parameters =================*/
Np = countparname("cp");
Ns = countparname("cs");
Nr = countparname("ro");
Ng = countparname("grad");
No = countparname("poly");
Ni = countparname("intt");
Nv = countparname("var");
Ngp = countparname("gradcp");
Ngs = countparname("gradcs");
Ngr = countparname("gradro");
Nvi = 0;
for (jint = 1; jint <= Ni; jint++) {
getnparstring(jint,"intt", &file);
strcpy(intt, file);
if (strstr(intt,"sin") != NULL) Nvi++;
if (strstr(intt,"rough") != NULL) Nvi++;
if (strstr(intt,"fract") != NULL) Nvi++;
if (strstr(intt,"elipse") != NULL) Nvi++;
if (strstr(intt,"random") != NULL) Nvi++;
// if (strstr(intt,"randdf") != NULL) Nvi++;
if (strstr(intt,"diffr") != NULL || strstr(intt,"randdf") != NULL) {
Nvi++;
// if (Ng != 0) Ng++;
// if (No != 0) No++;
}
}
// fprintf(stderr,"Nvi=%d ng=%d No=%d np=%d,", Nvi,Ng,No,Np);
if (Np != Nr && ro0 > 0) verr("number of cp and ro not equal.");
if (Np != Ni) verr("number of cp and interfaces not equal.");
if (Nvi != Nv) verr("number of interface variables(var) not correct.");
if (Ns == 0 && Nr == 0) if (verbose>=2) vmess("Velocity model.");
if (Ns == 0) { if (verbose>=2) vmess("Acoustic model."); }
else {
if (verbose>=2) vmess("Elastic model.");
if (Np != Ns) verr("number of cp and cs not equal");
}
if (Ng == 0) {
if (verbose>=2) vmess("No boundary gradients are defined.");
}
else if (Ng != Np) {
verr("number of boundary gradients and interfaces are not equal.");
}
if (Ngp == 0) {
if (verbose>=2) vmess("No interface gradients for cp defined.");
}
else if (Ngp != Np) {
verr("gradcp gradients and interfaces are not equal.");
}
if (Ngs == 0) {
if (verbose>=2) vmess("No interface gradients for cs defined.");
}
else if (Ngs != Np) {
verr("gradcs gradients and interfaces are not equal.");
}
if (Ngr == 0) {
if (verbose>=2) vmess("No interface gradients for rho defined.");
}
else if (Ngr != Np) {
verr("gradro gradients and interfaces are not equal.");
}
if (No == 0) {
if (verbose>=2) vmess("All interfaces are linear.");
}
// else if (No != Np) {
// verr("number of poly variables and interfaces are not equal.");
// }
if (Np > 0) {
if (countparname("x") != Np)
verr("a x array must be specified for each interface.");
if (countparname("z") != Np)
verr("a z array must be specified for each interface.");
}
else Np = 1;
if (Nzr != Np && Nzr !=0) {
verr("number of zref gradients not equal to number of interfaces");
}
/*=================== initialization of arrays =================*/
nz = NINT(sizez/dz)+1;
nx = NINT(sizex/dx)+1;
zp = (int *)malloc(nx*sizeof(int));
interface = (float *)malloc(nx*sizeof(float));
var = (float *)malloc(8*sizeof(float));
gridcp = alloc2float(nz, nx);
if(gridcp == NULL) verr("memory allocation error gridcp");
if (Ns || (NINT(cs0*1e3) >= 0)) {
gridcs = alloc2float(nz, nx);
if(gridcs == NULL) verr("memory allocation error gridcs");
}
else gridcs = NULL;
if (Nr || (NINT(ro0*1e3) >= 0)) {
gridro = alloc2float(nz, nx);
if(gridro == NULL) verr("memory allocation error gridro");
}
else gridro = NULL;
cp = alloc2float(nx,3);
cs = alloc2float(nx,3);
ro = alloc2float(nx,3);
if (store_int == 1) inter = alloc2float(nx, 2*Np);
if (verbose) {
vmess("Origin top left (x,z) . = %.1f, %.1f", orig[0], orig[1]);
vmess("Base name ............. = %s", file_base);
vmess("Number of interfaces .. = %d", Np);
vmess("length in x ........... = %f (=%d)", sizex, nx);
vmess("length in z ........... = %f (=%d)", sizez, nz);
vmess("delta x ............... = %f", dx);
vmess("delta z ............... = %f", dz);
vmess("cp0 ................... = %f", cp0);
if (Ns) vmess("cs0 ................... = %f", cs0);
if (Nr) vmess("ro0 ................... = %f", ro0);
vmess("write interfaces ...... = %d", writeint);
vmess("store interfaces ...... = %d", store_int);
if (above) vmess("define model above interface");
else vmess("define model below interface");
}
/*========== initializing for homogeneous background =============*/
nminx = 0;
nmaxx = nx;
for (j = nminx; j < nmaxx; j++) {
cp[0][j] = cp0;
cs[0][j] = cs0;
ro[0][j] = ro0;
zp[j] = 0;
cp[1][j] = cp0;
cs[1][j] = cs0;
ro[1][j] = ro0;
}
gradlen = 0.0;
gradcp = gradcs = gradro = 0.0;
optgrad = 3;
if (above == 0) {
Nvi = 1; Noi = 1;
} else {
Nvi = Ngp; Noi = Ngp;
}
grid(gridcp, gridcs, gridro, zp, cp, cs, ro, nminx, nmaxx, optgrad,
gradlen, gradcp, gradcs, gradro, dx, dz, nz);
nxp = nzp = 2;
x = (float *)malloc(nxp*sizeof(float));
z = (float *)malloc(nzp*sizeof(float));
if (Ni == 0) {
if (verbose) vmess("No interfaces are defined, Homogeneous model.");
Np = 0;
}
/*========== filling gridded model with interfaces =============*/
for (jcount = 1; jcount <= Np; jcount++) {
/* for above interface definition reverse */
/* order of interfaces to scan */
if (above == 0) jint=jcount;
else jint=Np+1-jcount;
if (verbose) vmess("***** Interface number %d *****", jint);
getnparstring(jint,"intt", &file);
strcpy(intt, file);
nxp = countnparval(jint,"x");
nzp = countnparval(jint,"z");
if (nxp != nzp) {
vmess("nxp = %d nzp =%d for interface %d",nxp, nzp, jint);
verr("Number of x and z values not equal for interface %d",jint);
}
ncp = countnparval(jint,"cp");
nro = countnparval(jint,"ro");
ncs = countnparval(jint,"cs");
if (ncp == 1) {
if (verbose>=2) vmess("No lateral gradient in P velocity");
}
else if (ncp == 2) {
if (verbose) vmess("lateral P-gradient from begin to end");
}
else if (ncp != nxp) {
vmess("ncp = %d nxp =%d for interface %d",ncp, nxp, jint);
verr("Number of cp's and x not equal for interface %d",jint);
}
if (nro <= 1) {
if (verbose>=2) vmess("No lateral gradient in density");
}
else if (nro == 2) {
if (verbose) vmess("lateral Rho-gradient from begin to end");
}
else if (nro != nxp) {
vmess("nro = %d nxp =%d for interface %d",nro, nxp, jint);
verr("Number of ro's and x not equal for interface %d",jint);
}
if (ncs <= 1) {
if (verbose>=2) vmess("No lateral gradient in S velocity");
}
else if (ncs == 2) {
if (verbose) vmess("lateral S-gradient from begin to end");
}
else if (ncs != nxp) {
vmess("ncs = %d nxp =%d for interface %d",ncs, nxp, jint);
verr("Number of cs's and x not equal for interface %d",jint);
}
nvel = MAX(ncp, MAX(nro, ncs));
free(x);
free(z);
x = (float *)malloc(nxp*sizeof(float));
z = (float *)malloc(nzp*sizeof(float));
memset(interface, 0, nx*sizeof(float));
getnparfloat(jint,"x",x);
getnparfloat(jint,"z",z);
getnparfloat(jint,"cp",cp[2]);
if (Nr == 0) ro[2][0] = 0.0;
else getnparfloat(jint,"ro", ro[2]);
if (Ns == 0) cs[2][0] = 0.0;
else getnparfloat(jint,"cs", cs[2]);
if (Ng == 0) gradlen = 0.0;
else getnparfloat(Noi,"grad", &gradlen);
if (No == 0) poly = 0;
else getnparint(Noi,"poly", &poly);
if (Ngp == 0) gradcp = 0.0;
else getnparfloat(Noi,"gradcp", &gradcp);
if (Ngs == 0) gradcs = 0.0;
else getnparfloat(Noi,"gradcs", &gradcs);
if (Ngr == 0) gradro = 0.0;
else getnparfloat(Noi,"gradro", &gradro);
/* if gradunit is in meters, recalculate gradcp,gradcs and gradro */
if (gradunit > 0) {
gradcs = gradcs * dz;
gradcp = gradcp * dz;
gradro = gradro * dz;
}
if (nvel != 1) {
if (ncp == 1) {
for (j = 1; j < nvel; j++) cp[2][j] = cp[2][0];
}
if (ncs == 1) {
for (j = 1; j < nvel; j++) cs[2][j] = cs[2][0];
}
if (nro == 1) {
for (j = 1; j < nvel; j++) ro[2][j] = ro[2][0];
}
}
if (verbose) {
vmess("Interface type .......... = %s", intt);
vmess("Boundary gradient ....... = %f", gradlen);
vmess("Interface gradient cp ... = %f", gradcp);
if (Ns) vmess("Interface gradient cs ... = %f", gradcs);
if (Nr) vmess("Interface gradient ro ... = %f", gradro);
if (verbose>=2) {
vmess("Polynomal ............... = %d", poly);
vmess("Number of (x,z) points... = %d", nxp);
vmess("P-wave velocities ....... = %d", ncp);
if (Ns) vmess("S-wave velocities ....... = %d", ncs);
if (Nr) vmess("Densities ............... = %d", nro);
}
for (j = 0; j < nxp; j++) {
vmess("x = %6.1f \t z = %6.1f", x[j], z[j]);
if (nvel != 1) {
vmess(" cp = %f", cp[2][j]);
if (Ns) vmess(" cs = %f", cs[2][j]);
if (Nr) vmess(" rho = %f", ro[2][j]);
}
}
if (nvel == 1) {
vmess(" cp = %f", cp[2][0]);
if (Ns) vmess(" cs = %f", cs[2][0]);
if (Nr) vmess(" rho = %f", ro[2][0]);
}
}
for (j = 0; j < nxp; j++) {
x[j] -= orig[0];
z[j] -= orig[1];
}
for (j = 0; j < nxp; j++) {
if(x[j] > sizex) verr("x coordinate bigger than model");
if(z[j] > sizez) verr("z coordinate bigger than model");
}
if (gradlen > 0) optgrad = gradt;
else optgrad = 3;
if (strstr(intt,"random") != NULL) {
Nv = countnparval(Nvi,"var");
if (Nv != 1) verr("Random interface must have 1 variables.");
getnparfloat(Nvi,"var", var);
lseed = (long)var[0];
srand48(lseed);
gradcp=gradcs=gradro=var[0];
optgrad = 4;
if (above == 0) Noi++; else Noi--;
if (above == 0) Nvi++; else Nvi--;
}
if ((strstr(intt,"diffr") == NULL) && (strstr(intt,"randdf") == NULL)) {
interpolation(x, z, nxp, nx, poly, &nminx, &nmaxx, dx,
cp, cs, ro, nvel, interface);
}
if ( (strstr(intt,"def") != NULL) || (strstr(intt,"random") != NULL) ) {
linearint(zp, nminx, nmaxx, dz, interface);
if (above == 0) Noi++; else Noi--;
}
if (strstr(intt,"sin") != NULL) {
Nv = countnparval(Nvi,"var");
if (Nv != 2) verr("Sinus interface must have 2 variables.");
getnparfloat(Nvi,"var", var);
sinusint(zp, nminx, nmaxx, dz, interface, dx, var[0], var[1]);
if (above == 0) Noi++; else Noi--;
if (above == 0) Nvi++; else Nvi--;
}
else if (strstr(intt,"rough") != NULL) {
Nv = countnparval(Nvi,"var");
if (Nv != 3) verr("Rough interface must have 3 variables.");
getnparfloat(Nvi,"var", var);
roughint(zp, nminx, nmaxx, dz, interface, var[0],var[1],var[2]);
if (above == 0) Noi++; else Noi--;
if (above == 0) Nvi++; else Nvi--;
}
else if (strstr(intt,"fract") != NULL) {
Nv = countnparval(Nvi, "var");
if (Nv != 6) verr("Fractal interface must have 6 variables.");
getnparfloat(Nvi,"var", var);
fractint(zp, nminx, nmaxx, dx, dz, interface, var[0], var[1],
var[2], var[3], var[4], var[5]);
if (above == 0) Noi++; else Noi--;
if (above == 0) Nvi++; else Nvi--;
}
else if (strstr(intt,"randdf") != NULL) {
float x0, z0, dsx, dsz;
int i;
Nv = countnparval(Nvi, "var");
if (Nv != 2) verr("randdf interface must have 2 variables: number of points, width.");
getnparfloat(Nvi,"var", var);
if(!getparint("dtype", &dtype)) dtype = -1;
randdf(x, z, nxp, dx, dz, gridcp, gridcs, gridro, cp, cs, ro,
interface, zp, nx, sizex, sizez, var[0], (int)var[1], dtype);
if (above == 0) Noi++; else Noi--;
if (above == 0) Nvi++; else Nvi--;
}
else if (strstr(intt,"elipse") != NULL) {
Nv = countnparval(Nvi, "var");
if (Nv != 2) verr("Elipse interface must have 2 variables.");
getnparfloat(Nvi,"var", var);
elipse(x, z, nxp, dx, dz, gridcp, gridcs, gridro,
cp, cs, ro, interface, zp, nz, nx, var[0], var[1], gradcp, gradcs, gradro);
if (above == 0) Noi++; else Noi--;
if (above == 0) Nvi++; else Nvi--;
}
else if ((strstr(intt,"diffr") != NULL)) {
Nv = countnparval(Nvi, "var");
if (Nv == 2 || Nv == 1) {
getnparfloat(Nvi,"var", var);
diffrwidth=(int)var[0];
if (Nv==1) {
if(!getparint("dtype", &dtype)) dtype = 0;
}
else dtype=(int)var[1];
}
else {
verr("diffr interface must have 1 or 2 variables: width,type.");
}
diffraction(x, z, nxp, dx, dz, gridcp, gridcs, gridro,
cp, cs, ro, interface, zp, nx, diffrwidth, dtype);
if (above == 0) Noi++; else Noi--;
if (above == 0) Nvi++; else Nvi--;
}
else {
if (above == 0) {
grid(gridcp, gridcs, gridro, zp, cp, cs, ro, nminx, nmaxx,
optgrad, gradlen, gradcp, gradcs, gradro, dx, dz, nz);
}
else {
gridabove(gridcp, gridcs, gridro, zp, cp, cs, ro, nminx, nmaxx,
optgrad, gradlen, gradcp, gradcs, gradro, dx, dz, nz);
}
}
if (store_int == 1) {
for(j = 0; j < nminx; j++) inter[jint-1][j] = 0.0;
for(j = nminx; j < nmaxx; j++) inter[jint-1][j] = interface[j];
for(j = nmaxx; j < nx; j++) inter[jint-1][j] = 0.0;
for(j = 0; j < nminx; j++) inter[jint-1+Np][j] = 0.0;
for(j = nminx; j < nmaxx; j++) inter[jint-1+Np][j] = zp[j]*dz;
for(j = nmaxx; j < nx; j++) inter[jint-1+Np][j] = 0.0;
}
} /* end of loop over interfaces */
if (verbose) vmess("Writing data to disk.");
hdrs = (segy *) calloc(nx,sizeof(segy));
for(j = 0; j < nx; j++) {
hdrs[j].f1= orig[1];
hdrs[j].f2= orig[0];
hdrs[j].d1= dz;
hdrs[j].d2= dx;
hdrs[j].ns= nz;
hdrs[j].trwf= nx;
hdrs[j].tracl= j;
hdrs[j].tracf= j;
hdrs[j].gx = (orig[0] + j*dx)*1000;
hdrs[j].scalco = -1000;
hdrs[j].timbas = 25;
hdrs[j].trid = TRID_DEPTH;
}
/* due to bug in SU, int-file has to be opened before other files are closed */
if (writeint == 1) {
strcpy(filename, file_base);
name_ext(filename, "_int");
fpint = fopen(filename,"w");
assert(fpint != NULL);
}
/* write P-velocities in file */
strcpy(filename, file_base);
name_ext(filename, "_cp");
fpcp = fopen(filename,"w");
assert(fpcp != NULL);
data_out = (float *)malloc(nx*nz*sizeof(float));
for(ix = 0; ix < nx; ix++) {
for(iz = 0; iz < nz; iz++) {
data_out[ix*nz+iz] = gridcp[ix][iz];
}
nwrite = fwrite( &hdrs[ix], 1, TRCBYTES, fpcp);
assert(nwrite == TRCBYTES);
nwrite = fwrite( &data_out[ix*nz], sizeof(float), nz, fpcp);
assert(nwrite == nz);
}
fclose(fpcp);
free2float(gridcp);
/* write S-velocities in file */
if (Ns > 0 || getparfloat("cs0", &cs0)) {
strcpy(filename, file_base);
name_ext(filename, "_cs");
fpcs = fopen(filename,"w");
assert(fpcs != NULL);
for(ix = 0; ix < nx; ix++) {
for(iz = 0; iz < nz; iz++) {
data_out[ix*nz+iz] = gridcs[ix][iz];
}
nwrite = fwrite( &hdrs[ix], 1, TRCBYTES, fpcs);
assert(nwrite == TRCBYTES);
nwrite = fwrite( &data_out[ix*nz], sizeof(float), nz, fpcs);
assert(nwrite == nz);
}
fclose(fpcs);
free2float(gridcs);
} /* end of writing S-velocity file */
/* write densities in file */
if (Nr > 0 || getparfloat("ro0", &ro0)) {
strcpy(filename, file_base);
name_ext(filename, "_ro");
fpro = fopen(filename,"w");
assert(fpro != NULL);
for(ix = 0; ix < nx; ix++) {
for(iz = 0; iz < nz; iz++) {
data_out[ix*nz+iz] = gridro[ix][iz];
}
nwrite = fwrite( &hdrs[ix], 1, TRCBYTES, fpro);
assert(nwrite == TRCBYTES);
nwrite = fwrite( &data_out[ix*nz], sizeof(float), nz, fpro);
assert(nwrite == nz);
}
fclose(fpro);
free2float(gridro);
} /* end of writing density file */
/* write depths of the interfaces */
if (writeint == 1) {
free(hdrs);
hdrs = (segy *) calloc(Np,sizeof(segy));
for(j = 0; j < Np; j++) {
hdrs[j].fldr = 1;
hdrs[j].timbas = 25;
hdrs[j].f1= orig[0];
hdrs[j].f2= 0.0;
hdrs[j].d1= dx;
hdrs[j].d2= dz;
hdrs[j].ns= nx;
hdrs[j].trwf= Np;
hdrs[j].tracl= j;
hdrs[j].tracf= j;
hdrs[j].trid= TRID_DEPTH;
}
/* note that due to bug in SU, interface file ha salready been opened */
strcpy(filename, file_base);
name_ext(filename, "_int");
free(data_out);
data_out = (float *)malloc(nx*Np*sizeof(float));
for(jint = 0; jint < Np; jint++) {
for(j = 0; j < nx; j++) {
data_out[jint*nx+j] = inter[jint][j]+orig[1];
}
nwrite = fwrite( &hdrs[ix], 1, TRCBYTES, fpint);
assert(nwrite == TRCBYTES);
nwrite = fwrite( &data_out[jint*nx], sizeof(float), nx, fpint);
assert(nwrite == nx);
}
for(j = 0; j < Np; j++) hdrs[j].fldr = 2;
for(jint = 0; jint < Np; jint++) {
for(j = 0; j < nx; j++) {
data_out[jint*nx+j] = inter[jint+Np][j]+orig[1];
}
nwrite = fwrite( &hdrs[ix], 1, TRCBYTES, fpint);
assert(nwrite == TRCBYTES);
nwrite = fwrite( &data_out[jint*nx], sizeof(float), nx, fpint);
assert(nwrite == nx);
}
fclose(fpint);
} /* end of writing interface file */
if (rayfile == 1) {
strcpy(filename, file_base);
strcpy(strrchr(filename, '.'), ".mod");
fpout = fopen(filename, "w+");
fprintf(fpout,"RAYTRACE MODEL FILE\n");
fprintf(fpout,"# ASCII file for ray-tracer\n\n");
fprintf(fpout,"# Top interface\n\n");
fprintf(fpout,"x=0,%.1f\n", sizex);
fprintf(fpout,"z=0.,0.\n");
/* for(i = 1; i <= Np; i++) {
fprintf(fpout,"\n# %d th interface\n\nx=",i);
nxp = countnparval(i,"x");
nzp = countnparval(i,"z");
free(x);
free(z);
x = (float *)malloc(nxp*sizeof(float));
z = (float *)malloc(nzp*sizeof(float));
getnparfloat(i,"x",x);
getnparfloat(i,"z",z);
for(j = 0; j < (nxp-1); j ++) fprintf(fpout,"%.1f,", x[j]);
fprintf(fpout,"%.1f\nz=", x[nxp-1]);
for(j = 0; j < (nxp-1); j ++) fprintf(fpout,"%.1f,", z[j]);
fprintf(fpout,"%.1f\n", z[nxp-1]);
}
*/
for(jint = 0; jint < Np; jint++) {
fprintf(fpout,"\n# %d th interface\n\nx=0",jint+1);
for(j = skip; j < nx; j += skip)
fprintf(fpout,",%.1f", (float)j*dx);
fprintf(fpout,"\nz=%.1f", inter[jint][0]);
for(j = skip; j < nx; j += skip)
fprintf(fpout,",%.1f", inter[jint][j]);
fprintf(fpout,"\n");
}
fprintf(fpout,"\n# %d th interface\n\nx=0",jint+1);
for(j = skip; j < nx; j += skip)
fprintf(fpout,",%.1f", (float)j*dx);
fprintf(fpout,"\nz=%.1f", sizez);
for(j = skip; j < nx; j += skip)
fprintf(fpout,",%.1f", sizez);
fprintf(fpout,"\n");
/**/
fprintf(fpout,"\n\n");
fprintf(fpout,"cp=%.1f,", back[0]);
for(jint = 1; jint <= Np; jint++) {
aver = 0.0;
ncp = countnparval(jint,"cp");
getnparfloat(jint,"cp",cp[2]);
for(j = 0; j < ncp; j++)
aver += cp[2][j];
aver = aver/((float)ncp);
if (jint == Np ) fprintf(fpout,"%.1f", aver);
else fprintf(fpout,"%.1f,", aver);
}
fclose(fpout);
free2float(inter);
}
free(hdrs);
return 0;
}
void vsm3d(float ***v,int n3,int n2,int n1,int iter,int depth,
float r3,float r2,float r1,float mu,int sl,float vmin,float vmax)
/***************************************************************************
Smooth 3d-velocity.
*************************************************************************/
{
int i2, i1, i3, i;
float **d=NULL, **e=NULL, **f=NULL, *w, ww=1.0;
/* compute the weight function */
w = alloc1float(n1+n2+n3-2);
if(depth==1){
mu = (mu*mu-1.0)/(n1*n1);
for(i1=0; i1<n1; ++i1) w[i1] = 1.0/(1+i1*i1*mu);
}
if(depth==2){
mu = (mu*mu-1.0)/(n2*n2);
for(i2=0; i2<n2; ++i2) w[i2] = 1.0/(1+i2*i2*mu);
}
if(depth==3){
mu = (mu*mu-1.0)/(n3*n3);
for(i3=0; i3<n3; ++i3) w[i3] = 1.0/(1+i3*i3*mu);
}
/* scale smoothing parameters according to the iteration number */
if(iter==1) {
r1 /= 3.39*3.39;
r2 /= 3.39*3.39;
r3 /= 3.39*3.39;
} else if(iter==2){
r1 /= 5.19*5.19;
r2 /= 5.19*5.19;
r3 /= 5.19*5.19;
} else {
r1 /= 6.60*6.60;
r2 /= 6.60*6.60;
r3 /= 6.60*6.60;
}
/* clip velocity */
for(i3=0; i3<n3; ++i3)
for(i2=0; i2<n2; ++i2)
for(i1=0; i1<n1; ++i1){
if(v[i3][i2][i1] >vmax) v[i3][i2][i1] = vmax;
if(v[i3][i2][i1] <vmin) v[i3][i2][i1] = vmin;
}
if(sl) {
/* smoothing on slowness */
for(i3=0; i3<n3; ++i3)
for(i2=0; i2<n2; ++i2)
for(i1=0; i1<n1; ++i1)
v[i3][i2][i1] = 1.0/v[i3][i2][i1];
}
if(r2>0.) {
/* smoothing velocity in the second direction */
/* allocate space */
d = alloc2float(n1,n2);
e = alloc2float(n1,n2);
f = alloc2float(n1,n2);
for(i3=0; i3<n3; ++i3){
if(depth==3) ww = w[i3];
for(i2=0; i2<n2-1; ++i2){
if(depth==2) ww = w[i2+1];
for(i1=0; i1<n1; ++i1){
if(depth==1) ww = w[i1];
d[i2][i1] = ww+r2*2.0;
e[i2][i1] = -r2;
f[i2][i1] = ww*v[i3][i2+1][i1];
}
}
for(i1=0; i1<n1; ++i1){
d[n2-2][i1] -= r2;
f[0][i1] += r2*v[i3][0][i1];
}
tripd2(d,e,f,n2-1,n1);
for(i=1; i<iter; ++i) {
for(i2=0; i2<n2-1; ++i2){
if(depth==2) ww = w[i2+1];
for(i1=0; i1<n1; ++i1){
if(depth==1) ww = w[i1];
d[i2][i1] = ww+r2*2.0;
e[i2][i1] = -r2;
f[i2][i1] *= ww;
}
}
for(i1=0; i1<n1; ++i1){
d[n2-2][i1] -= r2;
f[0][i1] += r2*v[i3][0][i1];
}
tripd2(d,e,f,n2-1,n1);
}
for(i2=0; i2<n2-1; ++i2)
for(i1=0; i1<n1; ++i1)
v[i3][i2+1][i1] = f[i2][i1];
}
}
if(r3>0.) {
/* smooth velocity in the third direction */
/* allocate space */
d = alloc2float(n1,n3);
e = alloc2float(n1,n3);
f = alloc2float(n1,n3);
for(i2=0; i2<n2; ++i2){
if(depth==2) ww = w[i2];
for(i3=0; i3<n3-1; ++i3){
if(depth==3) ww = w[i3+1];
for(i1=0; i1<n1; ++i1){
if(depth==1) ww = w[i1];
d[i3][i1] = ww+2.*r3;
e[i3][i1] = -r3;
f[i3][i1] = ww*v[i3+1][i2][i1];
}
}
for(i1=0; i1<n1; ++i1){
d[n3-2][i1] -= r3;
f[0][i1] += r3*v[0][i2][i1];
}
tripd2(d,e,f,n3-1,n1);
for(i=1; i<iter; ++i){
for(i3=0; i3<n3-1; ++i3){
if(depth==3) ww = w[i3+1];
for(i1=0; i1<n1; ++i1){
if(depth==1) ww = w[i1];
d[i3][i1] = ww+2.*r3;
e[i3][i1] = -r3;
f[i3][i1] *= ww;
}
}
for(i1=0; i1<n1; ++i1){
d[n3-2][i1] -= r3;
f[0][i1] += r3*v[0][i2][i1];
}
tripd2(d,e,f,n3-1,n1);
}
for(i3=0; i3<n3-1; ++i3)
for(i1=0; i1<n1; ++i1)
v[i3+1][i2][i1] = f[i3][i1];
}
}
if(r1>0.) {
/* smooth velocity in the first direction */
/* allocate space */
d = alloc2float(1,n1);
e = alloc2float(1,n1);
f = alloc2float(1,n1);
for(i3=0; i3<n3; ++i3){
if(depth==3) ww = w[i3];
for(i2=0; i2<n2; ++i2){
if(depth==2) ww = w[i2];
for(i1=0; i1<n1-1; ++i1){
if(depth==1) ww = w[i1+1];
d[i1][0] = ww+r1*2.0;
e[i1][0] = -r1;
f[i1][0] = ww*v[i3][i2][i1+1];
}
d[n1-2][0] -= r1;
f[0][0] += r1*v[i3][i2][0];
tripd2(d,e,f,n1-1,1);
for(i=1; i<iter; ++i) {
for(i1=0; i1<n1-1; ++i1){
if(depth==1) ww = w[i1+1];
d[i1][0] = ww+r1*2.0;
e[i1][0] = -r1;
f[i1][0] *= ww;
}
d[n1-2][0] -= r1;
f[0][0] += r1*v[i3][i2][0];
tripd2(d,e,f,n1-1,1);
}
for(i1=0; i1<n1-1; ++i1)
v[i3][i2][i1+1] = f[i1][0];
}
}
}
if(sl) {
for(i3=0; i3<n3; ++i3)
for(i2=0; i2<n2; ++i2)
for(i1=0; i1<n1; ++i1)
v[i3][i2][i1] = 1.0/v[i3][i2][i1];
}
free1float(w);
if(r1>0. || r2>0. || r3>0.) {
free2float(d);
free2float(e);
free2float(f);
}
}
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[] )
{
cwp_String key; /* header key word from segy.h */
cwp_String type; /* ... its type */
Value val;
segy **rec_o; /* trace header+data matrix */
int first=0; /* true when we passed the first gather */
int ng=0;
float dt;
int nt;
int ntr;
int nfft=0; /* lenghth of padded array */
float snfft; /* scale factor for inverse fft */
int nf=0; /* number of frequencies */
float d1; /* frequency sampling int. */
float *rt; /* real trace */
complex *ct; /* complex trace */
complex **fd; /* frequency domain data */
float **cc; /* correlation coefficinet matrix */
float padd;
float cch;
float ccl;
/* Initialize */
initargs(argc, argv);
requestdoc(1);
if (!getparstring("key", &key)) key = "ep";
if (!getparfloat("padd", &padd)) padd = 25.0;
padd = 1.0+padd/100.0;
if (!getparfloat("cch", &cch)) cch = 1.0;
if (!getparfloat("ccl", &ccl)) ccl = 0.3;
/* get the first record */
rec_o = get_gather(&key,&type,&val,&nt,&ntr,&dt,&first);
if(ntr==0) err("Can't get first record\n");
/* set up the fft */
nfft = npfar(nt*padd);
if (nfft >= SU_NFLTS || nfft >= PFA_MAX)
err("Padded nt=%d--too big", nfft);
nf = nfft/2 + 1;
snfft=1.0/nfft;
rt = ealloc1float(nfft);
do {
ng++;
fd = ealloc2complex(nf,ntr);
cc = ealloc2float(nf,ntr);
/* transform the data into FX domain */
{ unsigned int itr;
for(itr=0;itr<ntr;itr++) {
memcpy( (void *) rt, (const void *) (*rec_o[itr]).data,nt*FSIZE);
memset( (void *) &rt[nt], (int) '\0', (nfft - nt)*FSIZE);
pfarc(1, nfft, rt, fd[itr]);
}
}
/* Compute correlation coefficients */
{ unsigned int itr,ifr;
for(itr=0;itr<ntr-1;itr++) {
for(ifr=0;ifr<nf-1;ifr++) {
cc[itr][ifr] = cos(PHSSP(fd[itr][ifr])-PHSSP(fd[itr+1][ifr]));
}
}
}
/* Filter */
{ unsigned int itr,ifr;
for(itr=0;itr<ntr-1;itr++) {
for(ifr=0;ifr<nf-1;ifr++) {
if(cc[itr][ifr]> cch || cc[itr][ifr]<ccl) {
fd[itr][ifr].r = 0.0;
fd[itr][ifr].i = 0.0;
}
}
}
}
{ unsigned int itr,it;
for(itr=0;itr<ntr;itr++) {
pfacr(-1, nfft, fd[itr], rt);
for(it=0;it<nt;it++)
(*rec_o[itr]).data[it]=rt[it]*snfft;
}
}
free2complex(fd);
free2float(cc);
rec_o = put_gather(rec_o,&nt,&ntr);
rec_o = get_gather(&key,&type,&val,&nt,&ntr,&dt,&first);
fprintf(stderr," %d %d\n",ng,ntr);
} while(ntr);
free1float(rt);
warn("Number of gathers %10d\n",ng);
return EXIT_SUCCESS;
}
int main(int argc, char **argv)
{
int verbose;
time_t start,finish;
double elapsed_time;
int ix,nt,nx,nx_out;
float dt,dh,hmin,hmax;
float *h,*h_out;
float **din,**dout,**din_tw,**dout_tw;
int *ih,*ih_out;
int padt,padx;
int Ltw,Dtw;
int twstart;
float taper;
int itw,Itw,Ntw,niter;
float fmin,fmax;
/********/
fprintf(stderr,"*******SUALFT*********\n");
/* Initialize */
initargs(argc, argv);
requestdoc(1);
start=time(0);
/* Get parameters */
if (!getparint("verbose", &verbose)) verbose = 0;
if (!getparint("nx", &nx)) nx = 10000;
if (!getparfloat("dh", &dh)) dh = 10;
if (!gettr(&tr)) err("can't read first trace");
if (!tr.dt) err("dt header field must be set");
if (!tr.ns) err("ns header field must be set");
if (!getparint("Ltw", &Ltw)) Ltw = 200; /* length of time window in samples */
if (!getparint("Dtw", &Dtw)) Dtw = 10; /* overlap of time windows in samples */
dt = ((float) tr.dt)/1000000.0;
nt = (int) tr.ns;
if (!getparint("padt", &padt)) padt = 2; /* padding factor in time dimension*/
if (!getparint("padx", &padx)) padx = 2; /* padding factor in spatial dimension*/
if (!getparfloat("fmin",&fmin)) fmin = 0;
if (!getparfloat("fmax",&fmax)) fmax = 0.5/dt;
if (!getparint("niter", &niter)) niter = 100;
fmax = MIN(fmax,0.5/dt);
din = ealloc2float(nt,nx);
h = ealloc1float(nx);
ih = ealloc1int(nx);
/* ***********************************************************************
input data
*********************************************************************** */
ix=0;
do {
h[ix]=(float) tr.offset;
memcpy((void *) din[ix],(const void *) tr.data,nt*sizeof(float));
ix++;
if (ix > nx) err("Number of traces > %d\n",nx);
} while (gettr(&tr));
erewind(stdin);
nx=ix;
if (verbose) fprintf(stderr,"processing %d traces \n", nx);
hmin = h[0];
hmax = h[0];
for (ix=0;ix<nx;ix++){
if (hmin>h[ix]) hmin = h[ix];
if (hmax<h[ix]) hmax = h[ix];
}
for (ix=0;ix<nx;ix++){
ih[ix] = (int) truncf((h[ix]-hmin)/dh);
}
nx_out = 0;
for (ix=0;ix<nx;ix++){
if (nx_out<ih[ix]) nx_out = ih[ix] + 1;
}
nx_out = nx_out + 1;
ih_out = ealloc1int(nx_out);
h_out = ealloc1float(nx_out);
for (ix=0;ix<nx_out;ix++){
ih_out[ix] = ix;
h_out[ix] = ix*dh + hmin;
}
dout = ealloc2float(nt,nx_out);
Ntw = 9999;
/* number of time windows (will be updated during first
iteration to be consistent with total number of time samples
and the length of each window) */
din_tw = ealloc2float(Ltw,nx);
dout_tw = ealloc2float(Ltw,nx_out);
/***********************************************************************
process using sliding time windows
***********************************************************************/
twstart = 0;
taper = 0;
for (Itw=0;Itw<Ntw;Itw++){
if (Itw == 0){
Ntw = (int) truncf(nt/(Ltw-Dtw));
if ( (float) nt/(Ltw-Dtw) - (float) Ntw > 0) Ntw++;
}
twstart = (int) Itw * (int) (Ltw-Dtw);
if ((twstart+Ltw-1 >nt) && (Ntw > 1)){
twstart=nt-Ltw;
}
if (Itw*(Ltw-Dtw+1) > nt){
Ltw = (int) Ltw + nt - Itw*(Ltw-Dtw+1);
}
for (ix=0;ix<nx;ix++){
for (itw=0;itw<Ltw;itw++){
din_tw[ix][itw] = din[ix][twstart+itw];
}
}
fprintf(stderr,"processing time window %d of %d\n",Itw+1,Ntw);
if (verbose) fprintf(stderr,"Ltw=%d\n",Ltw);
if (verbose) fprintf(stderr,"Dtw=%d\n",Dtw);
process_time_window(din_tw,dout_tw,h,h_out,hmin,hmax,dt,Ltw,nx,nx_out,fmin,fmax,niter,padt,padx,verbose);
if (Itw==0){
for (ix=0;ix<nx_out;ix++){
for (itw=0;itw<Ltw;itw++){
dout[ix][twstart+itw] = dout_tw[ix][itw];
}
}
}
else{
for (ix=0;ix<nx_out;ix++){
for (itw=0;itw<Dtw;itw++){ /* taper the top of the time window */
taper = (float) ((Dtw-1) - itw)/(Dtw-1);
dout[ix][twstart+itw] = dout[ix][twstart+itw]*(taper) + dout_tw[ix][itw]*(1-taper);
}
for (itw=Dtw;itw<Ltw;itw++){
dout[ix][twstart+itw] = dout_tw[ix][itw];
}
}
}
}
/***********************************************************************
end of processing time windows
***********************************************************************/
/* ***********************************************************************
output data
*********************************************************************** */
rewind(stdin);
for (ix=0;ix<nx_out;ix++){
memcpy((void *) tr.data,(const void *) dout[ix],nt*sizeof(float));
tr.offset=(int) h_out[ix];
tr.ntr=nx_out;
tr.ns=nt;
tr.dt = NINT(dt*1000000.);
tr.tracl = ix+1;
tr.tracr = ix+1;
fputtr(stdout,&tr);
}
/******** End of output **********/
finish=time(0);
elapsed_time=difftime(finish,start);
fprintf(stderr,"Total time required: %6.2fs\n", elapsed_time);
free1float(h);
free1float(h_out);
free2float(din);
free2float(dout);
free1int(ih);
free1int(ih_out);
free2float(din_tw);
free2float(dout_tw);
return EXIT_SUCCESS;
}
int SeisPipe2D(DsuTask *zz)
{
int nt,nx,nz,nw,ntpad,ntfft;
int it,ix,iz,izz,iw,iw0,iw1,iw2,iw3,iwmin,iwmax;
int nfreqs,verbose;
float dt,dx,dy,dz,dw;
float freqs[4],fw,w,scale,fftscl;
float *p, **v, *wdxov,*sx;
complex *cpx;
float **qx;
void *TabInfo;
eTable *et;
char msg[80];
int info, ToTid, MasterTid;
int sz, pz, pei;
int SeisIntPars[20];
float SeisFloPars[20];
/* Receive process control information */
MsgLog(zz, "Receiving Control info ... " );
MasterTid = RecvInt(SeisIntPars, 2, -1, MsgCntl);
pei = SeisIntPars[0];
ToTid = SeisIntPars[1];
MsgLog(zz, " Ready \n");
/* Receive: efile and other pars ... */
MsgLog(zz, "Receiving parameters ..." );
TabInfo = RecvBytes(-1, MsgTable);
RecvFI(SeisFloPars, 10, SeisIntPars, 10, -1, -1);
MsgLog(zz, " Ready \n" );
/* get integer parameters */
nt = SeisIntPars[0];
nx = SeisIntPars[1];
nz = SeisIntPars[2];
ntpad = SeisIntPars[3];
verbose = SeisIntPars[4];
sz = SeisIntPars[5];
pz = SeisIntPars[6];
/* get Floating point parameters */
dt = SeisFloPars[0];
dx = SeisFloPars[1];
dz = SeisFloPars[2];
freqs[0] = SeisFloPars[3];
freqs[1] = SeisFloPars[4];
freqs[2] = SeisFloPars[5];
freqs[3] = SeisFloPars[6];
sz = nz / pz;
if (pei == (pz - 1)) sz += nz % pz;
sprintf(msg, "Receiving Velocity info (pei = %d, sz = %d) ... ", pei, sz);
MsgLog(zz,msg);
v = alloc2float(nx, sz);
for (iz=0; iz<sz; ++iz)
RecvFloat(v[iz], nx, -1, MsgVel);
MsgLog(zz, " Ready \n" );
/* determine frequency w sampling */
ntfft = npfar(nt+ntpad);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
iwmin = MAX(0,MIN(nw-1,NINT(2.0*PI*freqs[0]/dw)));
iwmax = MAX(0,MIN(nw-1,NINT(2.0*PI*freqs[3]/dw)));
/* read extrapolator table */
et = ezread(TabInfo);
/* pret(zz -> fp_log, et); */
/* allocate workspace */
MsgLog(zz, "Allocating space ... ");
qx = alloc2float(nx,sz);
sx = alloc1float(nx);
wdxov = alloc1float(nx);
cpx = alloc1complex(nx);
MsgLog(zz, " Ready \n");
sprintf(msg, "Process (%d) starting loop on depth steps(%d,%d)\n",
pei, pei*(nz/pz), pei*(nz/pz) + sz);
MsgLog(zz, msg);
/* Cleanup qx */
for (iz=0; iz<sz; ++iz)
for (ix=0; ix<nx; ++ix)
qx[iz][ix] = 0.0;
/* loop over frequencies w */
for (iw=iwmin,w=iwmin*dw; iw<iwmax; ++iw,w+=dw) {
if (verbose && !(iw%1)) {
sprintf(msg, "\t%d/%d\n",iw,iwmax);
MsgLog(zz, msg);
}
/* load wavefield */
RecvCplx(cpx, nx, -1, MsgSlice);
/* loop over depth steps nz */
for (iz=0; iz<sz; ++iz) {
/* compute 2.0*dx/v(x) and zero migrated data */
for (ix=0; ix<nx; ix++)
sx[ix] = 2.0*dx/v[iz][ix];
/* make w*dx/v(x) */
for (ix=0; ix<nx; ++ix)
wdxov[ix] = w*sx[ix];
/* extrapolate wavefield */
etextrap(et,nx,wdxov,cpx);
/* accumulate migrated data */
for (ix=0; ix<nx; ++ix)
qx[iz][ix] += cpx[ix].r;
}
/* Send down the wavefield */
if ( pei != (pz -1))
SendCplx(cpx, nx, ToTid, MsgSlice);
} /* End of loop for iw */
for (iz=0; iz<sz; iz++) {
izz = pei*(nz/pz) + iz;
if (verbose) {
sprintf(msg, "Sending values for iz = %d\n",izz);
MsgLog(zz, msg);
}
SendFI(qx[iz], nx, &izz, 1, MasterTid, MsgDepth);
}
sprintf(msg, "End of processing for (%d)\n",pei);
MsgLog(zz, msg);
/* free workspace */
free1float(sx);
free1float(wdxov);
free2float(v);
free2float(qx);
free1complex(cpx);
pvm_exit();
return(0);
}
void maketrace(float *trace,int nt,float ft,float dt,
float xs,float xg,float **mig,float **migi,float aperx,
int nx,float fx,float dx,int nz,float fz,float dz,
int mzmax,int ls,float angmax,float v0,float fmax,Wavelet *w,
float **tb,float **pb,float **sigb,float **cosb,int nr,float **tsum,
int nxt,float fxt,float dxt,int nzt,float fzt,float dzt)
/*****************************************************************************
Make one synthetic seismogram
******************************************************************************
Input:
**mig migration section
**migi integrated migration section
nt number of time samples in seismic trace
ft first time sample of seismic trace
dt time sampleing interval in seismic trace
xs,xg lateral coordinates of source and geophone
aperx lateral aperature in migration
nx,fx,dx,nz,fz,dz dimension parameters of migration region
mzmax number of depth samples in triangle filter
ls =1 for line source; =0 for point source
w wavelet to convolve with trace
angmax migration angle aperature from vertical
tb,pb,sigb,cosb reference traveltime, lateral slowness, sigma
and cosine of emergent angle
nr number of lateral samples in reference quantities
tsum sum of residual traveltimes from shot and receiver
nxt,fxt,dxt,nzt,fzt,dzt dimension parameters of traveltime table
Output:
trace array[nt] containing synthetic seismogram
*****************************************************************************/
{
int nxf,nxe,nxtf,nxte,ix,iz,iz0,izt0,nzp,jrs,jrg,jz,jt,jx,mz,iz1;
float xm,x,dis,rxz,ar,srs,srg,srs0,srg0,sigp,z0,rdz,ampd,
sigs,sigg,coss,cosg,ax,ax0,pmin,
odt=1.0/dt,pd,az,sz,sz0,at,td,res,temp;
float *zpt,**ampt,**ampti,**zmt,*amp,*ampi,*zm,*tzt,*work1;
int lhd=LHD,nhd=NHD;
static float hd[NHD];
static int madehd=0;
/* if half-derivative filter not yet made, make it */
if (!madehd) {
mkhdiff(dt,lhd,hd);
madehd = 1;
}
/* zero trace */
for (jt=0; jt<nt; ++jt)
trace[jt] = 0.0;
zmt = ealloc2float(nzt,nxt);
ampt = ealloc2float(nzt,nxt);
ampti = ealloc2float(nzt,nxt);
amp = ealloc1float(nzt);
ampi = ealloc1float(nzt);
zm = ealloc1float(nzt);
tzt = ealloc1float(nzt);
zpt = ealloc1float(nxt);
work1 = ealloc1float(nt);
z0 = (fz-fzt)/dzt;
pmin = 1.0/(2.0*dx*fmax);
rdz = dz/dzt;
xm = 0.5*(xs+xg);
rxz = (angmax==90)?0.0:1.0/tan(angmax*PI/180.);
nxtf = (xm-aperx-fxt)/dxt;
if(nxtf<0) nxtf = 0;
nxte = (xm+aperx-fxt)/dxt+1.0;
if(nxte>=nxt) nxte = nxt-1;
/* compute amplitudes */
for(ix=nxtf; ix<=nxte; ++ix){
x = fxt+ix*dxt;
dis = (xm>=x)?xm-x:x-xm;
izt0 = ((dis-dxt)*rxz-fzt)/dzt-1;
if(izt0<0) izt0 = 0;
if(izt0>=nzt) izt0 = nzt-1;
ar = (xs>=x)?(xs-x)/dx:(x-xs)/dx;
jrs = (int)ar;
if(jrs>nr-2) jrs = nr-2;
srs = ar-jrs;
srs0 = 1.0-srs;
ar = (xg>=x)?(xg-x)/dx:(x-xg)/dx;
jrg = (int)ar;
if(jrg>nr-2) jrg = nr-2;
srg = ar-jrg;
srg0 = 1.0-srg;
sigp = ((xs-x)*(xg-x)>0)?1.0:-1.0;
zpt[ix] = fzt+(nzt-1)*dzt;
for(iz=izt0; iz<nzt; ++iz){
sigs = srs0*sigb[jrs][iz]+srs*sigb[jrs+1][iz];
sigg = srg0*sigb[jrg][iz]+srg*sigb[jrg+1][iz];
coss = srs0*cosb[jrs][iz]+srs*cosb[jrs+1][iz];
cosg = srg0*cosb[jrg][iz]+srg*cosb[jrg+1][iz];
ampd = v0*dx*(coss+cosg)*dz;
if(ampd<0.0) ampd = -ampd;
if(ls)
ampt[ix][iz] = ampd/sqrt(v0*sigs*sigg);
else
ampt[ix][iz] = ampd/sqrt(sigs*sigg*(sigs+sigg));
pd = srs0*pb[jrs][iz]+srs*pb[jrs+1][iz]+sigp
*(srg0*pb[jrg][iz]+srg*pb[jrg+1][iz]);
if(pd<0.0) pd = -pd;
if(pd<0.0) pd = -pd;
temp = 0.5*pd*v0*dx/dz;
if(temp<1) temp = 1.0;
if(temp>mzmax) temp = mzmax;
ampti[ix][iz] = ampt[ix][iz]/(temp*temp);
zmt[ix][iz] = temp;
if(pd<pmin && zpt[ix]>fzt+(nzt-1.1)*dzt)
zpt[ix] = fzt+iz*dzt;
}
}
nxf = (xm-aperx-fx)/dx+0.5;
if(nxf<0) nxf = 0;
nxe = (xm+aperx-fx)/dx+0.5;
if(nxe>=nx) nxe = nx-1;
/* interpolate amplitudes */
for(ix=nxf; ix<=nxe; ++ix){
x = fx+ix*dx;
dis = (xm>=x)?xm-x:x-xm;
izt0 = (dis*rxz-fzt)/dzt-1;
if(izt0<0) izt0 = 0;
if(izt0>=nzt) izt0 = nzt-1;
iz0 = (dis*rxz-fz)/dz;
if(iz0<0) iz0 = 0;
if(iz0>=nz) iz0 = nz-1;
ax = (x-fxt)/dxt;
jx = (int)ax;
ax = ax-jx;
if(ax<=0.01) ax = 0.;
if(ax>=0.99) ax = 1.0;
ax0 = 1.0-ax;
if(jx>nxte-1) jx = nxte-1;
if(jx<nxtf) jx = nxtf;
ar = (xs>=x)?(xs-x)/dx:(x-xs)/dx;
jrs = (int)ar;
if(jrs>=nr-1) jrs = nr-2;
srs = ar-jrs;
srs0 = 1.0-srs;
ar = (xg>=x)?(xg-x)/dx:(x-xg)/dx;
jrg = (int)ar;
if(jrg>=nr-1) jrg = nr-2;
srg = ar-jrg;
srg0 = 1.0-srg;
for(iz=izt0; iz<nzt; ++iz){
tzt[iz] = ax0*tsum[jx][iz]+ax*tsum[jx+1][iz]
+srs0*tb[jrs][iz]+srs*tb[jrs+1][iz]
+srg0*tb[jrg][iz]+srg*tb[jrg+1][iz];
amp[iz] = ax0*ampt[jx][iz]+ax*ampt[jx+1][iz];
ampi[iz] = ax0*ampti[jx][iz]+ax*ampti[jx+1][iz];
zm[iz] = ax0*zmt[jx][iz]+ax*zmt[jx+1][iz];
}
nzp = (ax0*zpt[jx]+ax*zpt[jx+1]-fz)/dz+1.5;
if(nzp<iz0) nzp = iz0;
if(nzp>nz) nzp = nz;
/* interpolate along depth if operater aliasing */
for(iz=iz0; iz<nzp; ++iz) {
az = z0+iz*rdz;
jz = (int)az;
if(jz>=nzt-1) jz = nzt-2;
sz = az-jz;
sz0 = 1.0-sz;
td = sz0*tzt[jz]+sz*tzt[jz+1];
at = (td-ft)*odt;
jt = (int)at;
if(jt > 0 && jt < nt-1){
ampd = sz0*ampi[jz]+sz*ampi[jz+1];
mz = (int)(0.5+sz0*zm[jz]+sz*zm[jz+1]);
res = at-jt;
iz1 = iz+mzmax;
temp = (-migi[ix][iz1-mz]+2.0*migi[ix][iz1]
-migi[ix][iz1+mz])*ampd;
trace[jt] += (1.0-res)*temp;
trace[jt+1] += res*temp;
}
}
/* interpolate along depth if not operater aliasing */
for(iz=nzp; iz<nz; ++iz) {
az = z0+iz*rdz;
jz = (int)az;
if(jz>=nzt-1) jz = nzt-2;
sz = az-jz;
sz0 = 1.0-sz;
td = sz0*tzt[jz]+sz*tzt[jz+1];
at = (td-ft)*odt;
jt = (int)at;
if(jt > 0 && jt < nt-1){
ampd = sz0*amp[jz]+sz*amp[jz+1];
res = at-jt;
temp = mig[ix][iz]*ampd;
trace[jt] += (1.0-res)*temp;
trace[jt+1] += res*temp;
}
}
}
/* apply half-derivative filter to trace */
convolve_cwp(nhd,-lhd,hd,nt,0,trace,nt,0,work1);
/* convolve wavelet with trace */
convolve_cwp(w->lw,w->iw,w->wv,nt,0,work1,nt,0,trace);
/* free workspace */
free2float(ampt);
free2float(ampti);
free1float(tzt);
free1float(work1);
free1float(amp);
free1float(ampi);
free2float(zmt);
free1float(zpt);
free1float(zm);
}
