void unwrap_phase(int n, float w, float *phase)
/************************************************************************
unwrap_phase - unwrap the phase
*************************************************************************
Input:
n number of samples
w unwrapping flag; returns an error if w=0
phase array[n] of input phase values
Output:
phase array[n] of output phase values
*************************************************************************
Notes:
The phase is assumed to be continuously increasing. The strategy is
to look at the change in phase (dphase) with each time step. If it is larger
than PI/w, then use the previous value of dphase. No attempt is
made at smoothing the dphase curve.
*************************************************************************
Author: John Stockwell, CWP, 1994
************************************************************************/
{
int i;
float pibyw=0.0;
float *dphase;
float *temp;
/* prevent division by zero in PI/w */
if (w==0) err("wrapping parameter is zero");
else pibyw = PI/w;
/* allocate space */
dphase = ealloc1float(n);
temp = ealloc1float(n);
/* initialize */
temp[0]=phase[0];
dphase[0]=0.0;
/* compute unwrapped phase at each time step */
for (i = 1; i < n; ++i) {
/* compute jump in phase */
dphase[i] = ABS(phase[i] - phase[i-1]);
/* if dphase >= PI/w, use previous dphase value */
if (ABS(dphase[i] - dphase[i-1]) >= pibyw )
dphase[i] = dphase[i-1];
/* sum up values in temporary vector */
temp[i] = temp[i-1] + dphase[i];
}
/* assign values of temporary vector to phase[i] */
for (i=0; i<n; ++i) phase[i] = temp[i];
/* free space */
free1float(temp);
free1float(dphase);
}
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 integ(float **mig,int nz,float dz,int nx,int m,float **migi)
/* integration of a two-dimensional array
input:
mig[nx][nz] two-dimensional array
output:
migi[nx][nz+2*m] integrated array
*/
{
int nfft, nw, ix, iz, iw;
float *amp, dw, *rt;
complex *ct;
/* Set up FFT parameters */
nfft = npfaro(nz+m, 2 * (nz+m));
if (nfft >= SU_NFLTS || nfft >= 720720)
err("Padded nt=%d -- too big", nfft);
nw = nfft/2 + 1;
dw = 2.0*PI/(nfft*dz);
amp = ealloc1float(nw);
for(iw=1; iw<nw; ++iw)
amp[iw] = 0.5/(nfft*(1-cos(iw*dw*dz)));
amp[0] = amp[1];
/* Allocate fft arrays */
rt = ealloc1float(nfft);
ct = ealloc1complex(nw);
for(ix=0; ix<nx; ++ix) {
memcpy(rt, mig[ix], nz*FSIZE);
memset((void *) (rt + nz), 0, (nfft-nz)*FSIZE);
pfarc(1, nfft, rt, ct);
/* Integrate traces */
for(iw=0; iw<nw; ++iw){
ct[iw].i = ct[iw].i*amp[iw];
ct[iw].r = ct[iw].r*amp[iw];
}
pfacr(-1, nfft, ct, rt);
for (iz=0; iz<m; ++iz) migi[ix][iz] = rt[nfft-m+iz];
for (iz=0; iz<nz+m; ++iz) migi[ix][iz+m] = rt[iz];
}
free1float(amp);
free1float(rt);
free1complex(ct);
}
/* Break up reflectors by duplicating interior (x,z) points */
void breakReflectors (int *nr, float **ar,
int **nu, float ***xu, float ***zu)
{
int nri,nro,*nui,*nuo,ir,jr,iu;
float *ari,*aro,**xui,**zui,**xuo,**zuo;
/* input reflectors */
nri = *nr;
ari = *ar;
nui = *nu;
xui = *xu;
zui = *zu;
/* number of output reflectors */
for (ir=0,nro=0; ir<nri; ++ir)
nro += nui[ir]-1;
/* make output reflectors and free space for input reflectors */
aro = ealloc1float(nro);
nuo = ealloc1int(nro);
xuo = ealloc1(nro,sizeof(float*));
zuo = ealloc1(nro,sizeof(float*));
for (ir=0,jr=0; ir<nri; ++ir) {
for (iu=0; iu<nui[ir]-1; ++iu,++jr) {
aro[jr] = ari[ir];
nuo[jr] = 2;
xuo[jr] = ealloc1float(2);
zuo[jr] = ealloc1float(2);
xuo[jr][0] = xui[ir][iu];
zuo[jr][0] = zui[ir][iu];
xuo[jr][1] = xui[ir][iu+1];
zuo[jr][1] = zui[ir][iu+1];
}
free1float(xui[ir]);
free1float(zui[ir]);
}
free1float(ari);
free1int(nui);
free1(xui);
free1(zui);
/* output reflectors */
*nr = nro;
*ar = aro;
*nu = nuo;
*xu = xuo;
*zu = zuo;
}
static void mkvrms (int ndmo, float *tdmo, float *vdmo,
int nt, float dt, float ft, float *vrms)
/*****************************************************************************
make uniformly sampled vrms(t) for DMO
******************************************************************************
Input:
ndmo number of tdmo,vdmo pairs
tdmo array[ndmo] of times
vdmo array[ndmo] of rms velocities
nt number of time samples
dt time sampling interval
ft first time sample
Output:
vrms array[nt] of rms velocities
******************************************************************************
Author: Dave Hale, Colorado School of Mines, 10/03/91
*****************************************************************************/
{
int it;
float t,(*vdmod)[4];
vdmod = (float(*)[4])ealloc1float(ndmo*4);
cmonot(ndmo,tdmo,vdmo,vdmod);
for (it=0,t=ft; it<nt; ++it,t+=dt)
intcub(0,ndmo,tdmo,vdmod,1,&t,&vrms[it]);
free1float((float*)vdmod);
}
void twindow(int nt, int wtime, float *data)
/************************************************************
twindow - simple time gating
*************************************************************
Input:
nt number of time samples
wtime = n*dt where n are integer ex=1,2,3,4,5,...
wtime=3 as default
used for Frequency Weighted and Thin-bed attributes
*************************************************************
Author: UGM (Geophysics Students): Agung Wiyono, 2005
************************************************************/
{
float val;
float *temp;
int i;
float sum;
int nwin;
nwin=2*wtime+1;
temp = ealloc1float(nt);
sum=0.0;
for (i = 0; i< wtime+1; ++i) {
val = data[i];
sum +=val;
}
/* weighted */
temp[0] = sum/nwin;
/* dt<wtime */
for (i = 1; i < wtime; ++i) {
val = data[i+wtime];
sum+=val;
++nwin;
temp[i] = sum/nwin;
}
/*wtime<dt<dt-wtime */
for (i = wtime ; i < nt-wtime; ++i) {
val = data[i+wtime];
sum += val;
val = data[i-wtime];
sum -=val;
temp[i] = sum/nwin;
}
/*dt-wtime<dt*/
for (i = nt - wtime; i < nt; ++i) {
val = data[i-wtime];
sum -= val;
--nwin;
temp[i] = sum/nwin;
}
for (i=0; i<nt; ++i) data[i] = temp[i];
/* Memori free */
free1float(temp);
}
/*************************************************************************
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);
}
void remove_fb(float *yp,float *ym,int n,short *scaler,short *shft)
/* Find Scale and timeshift
Yp = data trace
Ym = wavelet
F=min(Yp(x) - Ym(x)*a)^2 is a function to minimize for scaler
find shift first with xcorrelation then
solve for a - scaler
*/
{
#define RAMPR 5
void find_p(float *ym,float *yp,float *a,int *b,int n);
int it,ir;
float a=1.0;
int b=0;
int ramps;
float *a_ramp;
ramps=NINT(n-n/RAMPR);
find_p(ym,yp,&a,&b,n);
a_ramp = ealloc1float(n);
for(it=0;it<ramps;it++)
a_ramp[it]=1.0;
for(it=ramps,ir=0;it<n;it++,ir++) {
a_ramp[it]=1.0-(float)ir/(float)(n-ramps-1);
}
if (b<0) {
for(it=0;it<n+b;it++)
yp[it-b] -=ym[it]*a*a_ramp[it-b];
} else {
for(it=0;it<n-b;it++)
yp[it] -=ym[it-b]*a*a_ramp[it+b];
}
*scaler = NINT((1.0-a)*100.0);
*shft = b;
free1float(a_ramp);
}
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 main( int argc, char *argv[] )
{
int n1; /* number of x y values */
int stinc; /* x increment */
int f; /* filter length */
int m; /* filter method flag */
float *x; /* array of x index values */
float *y; /* array of y values */
/* Initialize */
initargs(argc, argv);
requestdoc(1);
MUSTGETPARINT("n1",&n1);
if( !getparint("stinc",&stinc)) stinc=1;
if( !getparint("f",&f)) f=5;
if( !getparint("m",&m)) m=1;
/* allocate arrays */
x = ealloc1float(n1);
y = ealloc1float(n1);
/* Read data into the arrays */
{ int i;
for(i=0;i<n1;i++) {
fscanf(stdin," %f %f\n",&x[i],&y[i]);
}
}
/* smooth */
sm_st(x,y,n1,f,stinc,m);
/* Write out */
{ int i;
for(i=0;i<n1;i++) {
fprintf(stdout," %10.3f %10.3f\n",x[i],y[i]);
}
}
free1float(x);
free1float(y);
return EXIT_SUCCESS;
}
/************************************************************************
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 differentiate(int n, float h, float *f)
/************************************************************************
differentiate - compute the 1st derivative of a function f[]
************************************************************************
Input:
n number of samples
h sample rate
f array[n] of input values
Output:
f array[n], the derivative of f
************************************************************************
Notes:
This is a simple 2 point centered-difference differentiator.
The derivatives at the endpoints are computed via 2 point leading and
lagging differences.
************************************************************************
Author: John Stockwell, CWP, 1994
************************************************************************/
{
int i;
float *temp;
float h2=2*h;
/* allocate space in temporary vector */
temp = ealloc1float(n);
/* do first as a leading difference */
temp[0] = (f[1] - f[0])/h;
/* do the middle values as a centered difference */
for (i=1; i<n-1; ++i) temp[i] = (f[i+1] - f[i-1])/h2;
/* do last value as a lagging difference */
temp[n-1] = (f[n-1] - f[n-2])/h;
for (i=0 ; i < n ; ++i) f[i] = temp[i];
free1float(temp);
}
static void makezt (int nz, float dz, float fz, float v[],
int nt, float dt, float ft, float z[])
/************************************************************************
makezt - compute z(t) from v(z)
*************************************************************************
Input:
nz number of z values (output)
dz depth sampling interval (output)
fz first depth value (output)
v[] array of velocities as a function of time t
nt number of time samples
dt time sampling interval
ft first time sample
Output:
z[] array of z values as a function of t
*************************************************************************
Author: CWP: based on maketz by Dave Hale (c. 1992)
*************************************************************************/
{
int iz; /* counter */
float vfz; /* velocity at the first depth sample */
float vlz; /* velocity at the last depth sample */
float *t=NULL; /* array of time values as a function of z */
/* allocate space */
t = ealloc1float(nz);
/* calculate t(z) from v(z) */
t[0] = 2.0*fz/v[0];
for (iz=1; iz<nz; ++iz)
t[iz] = t[iz-1]+2.0*dz/v[iz-1];
vfz = v[0];
vlz = v[nz-1];
/* compute z(t) from t(z) */
tzzt(nz,dz,fz,t,vfz,vlz,nt,dt,ft,z);
free1float(t);
}
void do_smooth(float *data, int nt, int isl) /********************************************************************** do_smooth - smooth data in a window of length isl samples ********************************************************************** Input: data[] array of floats of size nt nt size of array isl integerized window length Output: returns smoothed data. ********************************************************************** Author: Nils Maercklin, GeoForschungsZentrum (GFZ) Potsdam, Germany, 2001. E-mail: [email protected] **********************************************************************/ { register int it,jt; float *tmpdata, sval; tmpdata=ealloc1float(nt); for (it=0;it<nt;it++) { sval=0.0; if ( (it >= isl/2) && (it < nt-isl/2) ) { for (jt=it-isl/2;jt<it+isl/2;jt++) { sval += data[jt]; } tmpdata[it] = sval / (float) isl; } else { tmpdata[it] = data[it]; } } memcpy((void *) data, (const void *) tmpdata, nt*FSIZE); free1float(tmpdata); }
void do_smooth(float *data, int nt, int isl)
{
int it,jt;
float *tmpdata, sval;
tmpdata=ealloc1float(nt);
for (it=0;it<nt;it++) {
sval=0.0;
if ( (it >= isl/2) && (it < nt-isl/2) ) {
for (jt=it-isl/2;jt<it+isl/2;jt++) {
sval += data[jt];
}
tmpdata[it] = sval / (float) isl;
}
else {
tmpdata[it] = 0.0;
}
}
for (it=0;it<nt;it++) {
data[it] = tmpdata[it];
}
free1float(tmpdata);
}
int
main(int argc, char **argv)
{
float phase; /* phase shift = phasefac*PI */
float power; /* phase shift = phasefac*PI */
register float *rt; /* real trace */
register complex *ct; /* complex transformed trace */
complex *filt; /* complex power */
int nt; /* number of points on input trace */
size_t ntsize; /* nt in bytes */
int ncdp; /* number of cdps specified */
int icdp; /* index into cdp array */
long oldoffset; /* offset of previous trace */
long oldcdp; /* cdp of previous trace */
int newsloth; /* if non-zero, new sloth function was computed */
int jcdp; /* index into cdp array */
float dt; /* sample spacing (secs) on input trace */
float tn; /* sample spacing (secs) on input trace */
float omega; /* circular frequency */
float domega; /* circular frequency spacing (from dt) */
int nfft; /* number of points in nfft */
int ntnmo; /* number of tnmos specified */
float *cdp; /* array[ncdp] of cdps */
float *vnmo; /* array[nvnmo] of vnmos */
float *ovvt; /* array[nvnmo] of vnmos */
int nvnmo; /* number of tnmos specified */
float *fnmo; /* array[ntnmo] of tnmos */
float **ovv; /* array[nf] of fnmos */
float doffs; /* offset */
float acdp; /* temporary used to sort cdp array */
float *aovv; /* temporary used to sort ovv array */
int invert; /* if non-zero, do invers DLMO */
int cm; /* if non-zero, the offset in cm */
int nf; /* number of frequencies (incl Nyq) */
int it; /* number of frequencies (incl Nyq) */
float onfft; /* 1 / nfft */
float v; /* velocity */
size_t nzeros; /* number of padded zeroes in bytes */
/* Initialize */
initargs(argc, argv);
requestdoc(1);
/* Set parameters */
power=0.0;
/* Get info from first trace*/
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
if (!getparfloat("dt", &dt)) dt = ((double) tr.dt)/1000000.0;
if (!dt) err("dt field is zero and not getparred");
ntsize = nt * FSIZE;
if (!getparint("invert",&invert)) invert = 0;
if (!getparint("cm",&cm)) cm = 0;
/* Set up for fft */
nfft = npfaro(nt, LOOKFAC * nt);
if (nfft >= SU_NFLTS || nfft >= PFA_MAX)
err("Padded nt=%d -- too big", nfft);
nf = nfft/2 + 1;
onfft = 1.0 / nfft;
nzeros = (nfft - nt) * FSIZE;
domega = TWOPI * onfft / dt;
/* get velocity functions, linearly interpolated in frequency */
ncdp = countparval("cdp");
if (ncdp>0) {
if (countparname("vnmo")!=ncdp)
err("a vnmo array must be specified for each cdp");
if (countparname("fnmo")!=ncdp)
err("a tnmo array must be specified for each cdp");
} else {
ncdp = 1;
if (countparname("vnmo")>1)
err("only one (or no) vnmo array must be specified");
if (countparname("fnmo")>1)
err("only one (or no) tnmo array must be specified");
}
cdp = ealloc1float(ncdp);
if (!getparfloat("cdp",cdp)) cdp[0] = tr.cdp;
ovv = ealloc2float(nf,ncdp);
for (icdp=0; icdp<ncdp; ++icdp) {
nvnmo = countnparval(icdp+1,"vnmo");
ntnmo = countnparval(icdp+1,"fnmo");
if (nvnmo!=ntnmo && !(ncdp==1 && nvnmo==1 && ntnmo==0))
err("number of vnmo and tnmo values must be equal");
if (nvnmo==0) nvnmo = 1;
if (ntnmo==0) ntnmo = nvnmo;
/* equal numbers of parameters vnmo, fnmo */
vnmo = ealloc1float(nvnmo);
fnmo = ealloc1float(nvnmo);
if (!getnparfloat(icdp+1,"vnmo",vnmo)) vnmo[0] = 400.0;
if (!getnparfloat(icdp+1,"fnmo",fnmo)) fnmo[0] = 0.0;
for (it=0; it<ntnmo; ++it)
fnmo[it]*=TWOPI;
for (it=1; it<ntnmo; ++it)
if (fnmo[it]<=fnmo[it-1])
err("tnmo values must increase monotonically");
for (it=0,tn=0; it<nf; ++it,tn+=domega) {
intlin(ntnmo,fnmo,vnmo,vnmo[0],vnmo[nvnmo-1],1,&tn,&v);
ovv[icdp][it] = 1.0/(v);
}
free1float(vnmo);
free1float(fnmo);
}
/* sort (by insertion) sloth and anis functions by increasing cdp */
for (jcdp=1; jcdp<ncdp; ++jcdp) {
acdp = cdp[jcdp];
aovv = ovv[jcdp];
for (icdp=jcdp-1; icdp>=0 && cdp[icdp]>acdp; --icdp) {
cdp[icdp+1] = cdp[icdp];
ovv[icdp+1] = ovv[icdp];
}
cdp[icdp+1] = acdp;
ovv[icdp+1] = aovv;
}
/* allocate workspace */
ovvt = ealloc1float(nf);
/* interpolate sloth and anis function for first trace */
interpovv(nf,ncdp,cdp,ovv,(float)tr.cdp,ovvt);
/* set old cdp and old offset for first trace */
oldcdp = tr.cdp;
oldoffset = tr.offset-1;
/* Allocate fft arrays */
rt = ealloc1float(nfft);
ct = ealloc1complex(nf);
filt = ealloc1complex(nf);
/* Loop over traces */
do {
/* if necessary, compute new sloth and anis function */
if (tr.cdp!=oldcdp && ncdp>1) {
interpovv(nt,ncdp,cdp,ovv,(float)tr.cdp,
ovvt);
newsloth = 1;
} else {
newsloth = 0;
}
/* if sloth and anis function or offset has changed */
if (newsloth || tr.offset!=oldoffset) {
doffs = (fabs)((float)(tr.offset));
if (cm==1) doffs/=100;
/* Load trace into rt (zero-padded) */
memcpy( (void *) rt, (const void *) tr.data, ntsize);
memset((void *) (rt + nt), (int) '\0', nzeros);
/* FFT */
pfarc(1, nfft, rt, ct);
/* Apply filter */
{ register int i;
for (i = 0; i < nf; ++i){
omega = i * domega;
if (power < 0 && i == 0) omega = FLT_MAX;
if (invert==0)
phase = -1.0*omega*ovvt[i]*doffs;
else
phase = 1.0*omega*ovvt[i]*doffs;
/* filt[i] = cmplx(cos(phase),sin(phase)); */
filt[i] = cwp_cexp(crmul(I,phase));
filt[i] = crmul(filt[i], onfft);
ct[i] = cmul(ct[i], filt[i]);
}
}
}
/* Invert */
pfacr(-1, nfft, ct, rt);
/* Load traces back in, recall filter had nfft factor */
{ register int i;
for (i = 0; i < nt; ++i) tr.data[i] = rt[i];
}
puttr(&tr);
} while (gettr(&tr));
return EXIT_SUCCESS;
}
void gradient()
{
/* declaration of variables */
int i, indexF, iF, iR, iU, iDer, iL, iT, iT1;
/* counters */
float f; /* temporal frequency */
float w; /* radian frequency */
float u; /* slowness */
float cte; /* a constant */
float *buffer; /* auxiliary buffer */
complex dUCEp1, dUCEp2; /* dUC * epslon1 and dUC * epslon2 */
complex wCCte; /* auxiliar variable */
complex am; /* vertical P-wave slownesses */
complex amInv; /* 1. / am */
complex amI; /* amI = am * I */
complex bm; /* vertical S-wave slownesses */
complex bmInv; /* 1. / bm */
complex bmI; /* bmI = bm * I */
complex As1, As2; /* amplitudes of plane wave components (P)*/
complex Cs1, Cs2; /* amplitudes of plane wave components (S)*/
/* downgoing waves */
complex Bs1, Bs2; /* amplitudes of plane wave components (P)*/
complex Ds1, Ds2; /* amplitudes of plane wave components (S)*/
/* upgoing waves */
complex g[2]; /* phase-shift vector */
complex ***displ; /* Frechet derivative of the */
/* displacements in the frequency domain */
complex dpl; /* auxiliary variable */
/* allocating memory */
displ = alloc3complex(nSamples / 2 + 1, nR, numberPar * limRange);
buffer = alloc1float(nSamples);
/* auxiliar constant */
cte = 1. / (4 * PI * rho[0]);
/* reseting displ */
for (iDer = 0; iDer < numberPar * limRange; iDer++)
for (iR = 0; iR < nR; iR++)
for (iF = 0; iF < nSamples / 2 + 1; iF++)
displ[iDer][iR][iF] = zeroC;
for (indexF = NINT(f1 / dF), f = f1, iF = 0; iF < nF; iF++,
f += dF, indexF++)
{
fprintf(stderr,"FRECHET derivatives at frequency (Hz): %f\n", f);
/* reseting */
for (i = 0; i < numberPar * limRange; i++)
{
for (iR = 0; iR < nR; iR++)
{
aux11[i][iR] = zeroC; aux12[i][iR] = zeroC;
aux21[i][iR] = zeroC; aux22[i][iR] = zeroC;
aux11Old[i][iR] = zeroC; aux12Old[i][iR] = zeroC;
aux21Old[i][iR] = zeroC; aux22Old[i][iR] = zeroC;
}
}
w = 2 * PI * f;
wC.r = w; wC.i = -tau;
/* module and phase of complex frequency */
wCR = sqrt(wC.r * wC.r + wC.i * wC.i);
wCP = atan2(wC.i, wC.r);
/* complex slowness step */
dUC.r = w * dU / wCR;
dUC.i = tau * dU / wCR;
/* wCR / wR */
wCRwR = wCR / wR;
/* auxiliary variable */
wCCte.r = wC.r * cte;
wCCte.i = wC.i * cte;
/* compute frequency-dependent horizontal slownesses (squared) */
/* and also the s-wave VELOCITIES (squared) for all layers */
horSlownessFrechet();
for (u = u1, iU = 0; iU < nU; iU++,
u += dU, uC.r += dUC.r, uC.i += dUC.i)
{
uC.r = u;
uC.i = u * tau / wRef;
uC2.r = 2 * uC.r;
uC2.i = 2 * uC.i;
aux = uC.r * uC.r - uC.i * uC.i;
uuC.i = 2 * uC.r * uC.i;
uuC.r = aux;
uuC2.r = 2 * uuC.r;
uuC2.i = 2 * uuC.i;
muC.r = uC.r * -1;
muC.i = uC.i * -1;
/* building reflectivity matrices */
RmFrechet();
Rp();
/* reseting */
As1 = zeroC; As2 = zeroC; /* downgoing waves */
Cs1 = zeroC; Cs2 = zeroC; /* downgoing waves */
Bs1 = zeroC; Bs2 = zeroC; /* upgoing waves */
Ds1 = zeroC; Ds2 = zeroC; /* upgoing waves */
/* P-wave potential */
/* PSlowness^2 - uuC */
auxm1 = PSlowness[0][0].r - uuC.r;
auxm2 = PSlowness[0][0].i - uuC.i;
auxm3 = sqrt(auxm1 * auxm1 + auxm2 * auxm2);
auxm3 = sqrt(auxm3);
angle = atan2(auxm2, auxm1) / 2;
am.r = auxm3 * cos(angle);
am.i = auxm3 * sin(angle);
/* am * I */
amI.r = -am.i;
amI.i = am.r;
As1 = uC;
if (directWave) Bs1 = muC;
/* 1 / am */
aux = am.r * am.r + am.i * am.i;
amInv.r = am.r / aux;
amInv.i = -am.i / aux;
/* amInv * uuC */
aux2.r = amInv.r * uuC.r - uuC.i * amInv.i;
aux2.i = amInv.r * uuC.i + amInv.i * uuC.r;
/* aux2 * -I */
As2.r = aux2.i;
As2.i = -aux2.r;
/* notice that Bs2 = As2 */
if (directWave) Bs2 = As2;
/* S-wave potential */
/* SSlowness^2 - uuC */
auxm1 = SSlowness[0][0].r - uuC.r;
auxm2 = SSlowness[0][0].i - uuC.i;
/* computing bm */
auxm3 = sqrt(auxm1 * auxm1 + auxm2 * auxm2);
auxm3 = sqrt(auxm3);
angle = atan2(auxm2, auxm1) / 2;
bm.r = auxm3 * cos(angle);
bm.i = auxm3 * sin(angle);
/* bm * I */
bmI.r = -bm.i;
bmI.i = bm.r;
/* 1 / bm */
aux = bm.r * bm.r + bm.i * bm.i;
bmInv.r = bm.r / aux;
bmInv.i = -bm.i / aux;
/* 1. / bm * uuC */
aux1.r = bmInv.r * uuC.r - bmInv.i * uuC.i;
aux1.i = bmInv.r * uuC.i + bmInv.i * uuC.r;
/* notice that Cs1 = Ds1 */
Cs1 = aux1;
if (directWave) Ds1 = aux1;
Cs2.r = -uC.i;
Cs2.i = uC.r;
if (directWave)
{
Ds2.r = -Cs2.r;
Ds2.i = -Cs2.i;
}
/* computing compensation for free-surface */
buildFreeSurfaceCompensation(am, bm);
/* computing phase shift (that's the matrix G in Muller's */
/* paper eq. (87) */
/* exp(j * am * wC * (-zs)) */
auxm1 = zs * (- amI.r * wC.r + amI.i * wC.i);
auxm2 = -zs * (amI.r * wC.i + amI.i * wC.r);
g[0].r = exp(auxm1) * cos(auxm2);
g[0].i = exp(auxm1) * sin(auxm2);
/* exp(j * bm * wC * (-zs)) */
auxm1 = zs * (- bmI.r * wC.r + bmI.i * wC.i);
auxm2 = -zs * (bmI.r * wC.i + bmI.i * wC.r);
g[1].r = exp(auxm1) * cos(auxm2);
g[1].i = exp(auxm1) * sin(auxm2);
/* computing the product I - R-R+ */
auxm1 = rm[0][0].r * rp[0][0].r - rm[0][0].i * rp[0][0].i;
auxm2 = rm[0][0].r * rp[0][0].i + rm[0][0].i * rp[0][0].r;
auxm3 = rm[0][1].r * rp[1][0].r - rm[0][1].i * rp[1][0].i;
auxm4 = rm[0][1].r * rp[1][0].i + rm[0][1].i * rp[1][0].r;
irr[0][0].r = 1 - (auxm1 + auxm3);
irr[0][0].i = - (auxm2 + auxm4);
auxm1 = rm[0][0].r * rp[0][1].r - rm[0][0].i * rp[0][1].i;
auxm2 = rm[0][0].r * rp[0][1].i + rm[0][0].i * rp[0][1].r;
auxm3 = rm[0][1].r * rp[1][1].r - rm[0][1].i * rp[1][1].i;
auxm4 = rm[0][1].r * rp[1][1].i + rm[0][1].i * rp[1][1].r;
irr[0][1].r = - (auxm1 + auxm3);
irr[0][1].i = - (auxm2 + auxm4);
auxm1 = rm[1][0].r * rp[0][0].r - rm[1][0].i * rp[0][0].i;
auxm2 = rm[1][0].r * rp[0][0].i + rm[1][0].i * rp[0][0].r;
auxm3 = rm[1][1].r * rp[1][0].r - rm[1][1].i * rp[1][0].i;
auxm4 = rm[1][1].r * rp[1][0].i + rm[1][1].i * rp[1][0].r;
irr[1][0].r = - (auxm1 + auxm3);
irr[1][0].i = - (auxm2 + auxm4);
auxm1 = rm[1][0].r * rp[0][1].r - rm[1][0].i * rp[0][1].i;
auxm2 = rm[1][0].r * rp[0][1].i + rm[1][0].i * rp[0][1].r;
auxm3 = rm[1][1].r * rp[1][1].r - rm[1][1].i * rp[1][1].i;
auxm4 = rm[1][1].r * rp[1][1].i + rm[1][1].i * rp[1][1].r;
irr[1][1].r = 1 - (auxm1 + auxm3);
irr[1][1].i = - (auxm2 + auxm4);
/* inverting irr explicitly */
auxm1 = irr[0][0].r * irr[1][1].r - irr[0][0].i * irr[1][1].i;
auxm2 = irr[0][0].r * irr[1][1].i + irr[0][0].i * irr[1][1].r;
auxm3 = irr[0][1].r * irr[1][0].r - irr[0][1].i * irr[1][0].i;
auxm4 = irr[0][1].r * irr[1][0].i + irr[0][1].i * irr[1][0].r;
aux1.r = auxm1 - auxm3;
aux1.i = auxm2 - auxm4;
/* 1 / aux1 */
aux = aux1.r * aux1.r + aux1.i * aux1.i;
aux1.r = aux1.r / aux;
aux1.i = -aux1.i / aux;
/* Inverse of irr */
irrI[0][0].r = irr[1][1].r * aux1.r - irr[1][1].i * aux1.i;
irrI[0][0].i = irr[1][1].r * aux1.i + irr[1][1].i * aux1.r;
irrI[0][1].r = -(irr[0][1].r * aux1.r - irr[0][1].i * aux1.i);
irrI[0][1].i = -(irr[0][1].r * aux1.i + irr[0][1].i * aux1.r);
irrI[1][0].r = -(irr[1][0].r * aux1.r - irr[1][0].i * aux1.i);
irrI[1][0].i = -(irr[1][0].r * aux1.i + irr[1][0].i * aux1.r);
irrI[1][1].r = irr[0][0].r * aux1.r - irr[0][0].i * aux1.i;
irrI[1][1].i = irr[0][0].r * aux1.i + irr[0][0].i * aux1.r;
/* computing vectors V1,2, check eq (76) Muller's paper */
auxm1 = As1.r * rm[0][0].r - As1.i * rm[0][0].i;
auxm2 = As1.r * rm[0][0].i + As1.i * rm[0][0].r;
auxm3 = Cs1.r * rm[0][1].r - Cs1.i * rm[0][1].i;
auxm4 = Cs1.r * rm[0][1].i + Cs1.i * rm[0][1].r;
aux1.r = Bs1.r + (auxm1 + auxm3);
aux1.i = Bs1.i + (auxm2 + auxm4);
auxm1 = As1.r * rm[1][0].r - As1.i * rm[1][0].i;
auxm2 = As1.r * rm[1][0].i + As1.i * rm[1][0].r;
auxm3 = Cs1.r * rm[1][1].r - Cs1.i * rm[1][1].i;
auxm4 = Cs1.r * rm[1][1].i + Cs1.i * rm[1][1].r;
aux2.r = Ds1.r + (auxm1 + auxm3);
aux2.i = Ds1.i + (auxm2 + auxm4);
auxm1 = aux1.r * irrI[0][0].r - aux1.i * irrI[0][0].i;
auxm2 = aux1.r * irrI[0][0].i + aux1.i * irrI[0][0].r;
auxm3 = aux2.r * irrI[0][1].r - aux2.i * irrI[0][1].i;
auxm4 = aux2.r * irrI[0][1].i + aux2.i * irrI[0][1].r;
v1[0][0].r = auxm1 + auxm3;
v1[0][0].i = auxm2 + auxm4;
auxm1 = aux1.r * irrI[1][0].r - aux1.i * irrI[1][0].i;
auxm2 = aux1.r * irrI[1][0].i + aux1.i * irrI[1][0].r;
auxm3 = aux2.r * irrI[1][1].r - aux2.i * irrI[1][1].i;
auxm4 = aux2.r * irrI[1][1].i + aux2.i * irrI[1][1].r;
v1[0][1].r = auxm1 + auxm3;
v1[0][1].i = auxm2 + auxm4;
/* loop over "active" layers */
for (iDer = 1, i = 0; i < numberPar; i++)
{
/* i = 0 -> Vp */
/* i = 1 -> Vs */
/* i = 2 -> rho */
for (iL = MIN(lim[0], 2); iL < MIN(lim[0], 2) + limRange;
iL++, iDer++)
{
/* rp * [v1[0], v1[1]] + (As1, Cs1)*/
auxm1 = rp[0][0].r * v1[0][0].r - rp[0][0].i * v1[0][0].i;
auxm2 = rp[0][0].r * v1[0][0].i + rp[0][0].i * v1[0][0].r;
auxm1 += rp[0][1].r * v1[0][1].r - rp[0][1].i * v1[0][1].i
+ As1.r;
auxm2 += rp[0][1].r * v1[0][1].i + rp[0][1].i * v1[0][1].r
+ As1.i;
auxm3 = rp[1][0].r * v1[0][0].r - rp[1][0].i * v1[0][0].i;
auxm4 = rp[1][0].r * v1[0][0].i + rp[1][0].i * v1[0][0].r;
auxm3 += rp[1][1].r * v1[0][1].r - rp[1][1].i * v1[0][1].i
+ Cs1.r;
auxm4 += rp[1][1].r * v1[0][1].i + rp[1][1].i * v1[0][1].r
+ Cs1.i;
/* DmB[0][active layers][0 1 2 3] * */
/* ((auxm1, auxm2), (auxm3, auxm4)) */
aux1.r = auxm1 * DmB[0][i * limRange + iL][0].r
- auxm2 * DmB[0][i * limRange + iL][0].i
+ auxm3 * DmB[0][i * limRange + iL][1].r
- auxm4 * DmB[0][i * limRange + iL][1].i;
aux1.i = auxm1 * DmB[0][i * limRange + iL][0].i
+ auxm2 * DmB[0][i * limRange + iL][0].r
+ auxm3 * DmB[0][i * limRange + iL][1].i
+ auxm4 * DmB[0][i * limRange + iL][1].r;
aux2.r = auxm1 * DmB[0][i * limRange + iL][2].r
- auxm2 * DmB[0][i * limRange + iL][2].i
+ auxm3 * DmB[0][i * limRange + iL][3].r
- auxm4 * DmB[0][i * limRange + iL][3].i;
aux2.i = auxm1 * DmB[0][i * limRange + iL][2].i
+ auxm2 * DmB[0][i * limRange + iL][2].r
+ auxm3 * DmB[0][i * limRange + iL][3].i
+ auxm4 * DmB[0][i * limRange + iL][3].r;
/* irrI * (aux1, aux2) */
auxm1 = irrI[0][0].r * aux1.r - irrI[0][0].i * aux1.i;
auxm2 = irrI[0][0].r * aux1.i + irrI[0][0].i * aux1.r;
auxm3 = irrI[0][1].r * aux2.r - irrI[0][1].i * aux2.i;
auxm4 = irrI[0][1].r * aux2.i + irrI[0][1].i * aux2.r;
v1[iDer][0].r = auxm1 + auxm3;
v1[iDer][0].i = auxm2 + auxm4;
auxm1 = irrI[1][0].r * aux1.r - irrI[1][0].i * aux1.i;
auxm2 = irrI[1][0].r * aux1.i + irrI[1][0].i * aux1.r;
auxm3 = irrI[1][1].r * aux2.r - irrI[1][1].i * aux2.i;
auxm4 = irrI[1][1].r * aux2.i + irrI[1][1].i * aux2.r;
v1[iDer][1].r = auxm1 + auxm3;
v1[iDer][1].i = auxm2 + auxm4;
}
}
auxm1 = As2.r * rm[0][0].r - As2.i * rm[0][0].i;
auxm2 = As2.r * rm[0][0].i + As2.i * rm[0][0].r;
auxm3 = Cs2.r * rm[0][1].r - Cs2.i * rm[0][1].i;
auxm4 = Cs2.r * rm[0][1].i + Cs2.i * rm[0][1].r;
aux1.r = Bs2.r + (auxm1 + auxm3);
aux1.i = Bs2.i + (auxm2 + auxm4);
auxm1 = As2.r * rm[1][0].r - As2.i * rm[1][0].i;
auxm2 = As2.r * rm[1][0].i + As2.i * rm[1][0].r;
auxm3 = Cs2.r * rm[1][1].r - Cs2.i * rm[1][1].i;
auxm4 = Cs2.r * rm[1][1].i + Cs2.i * rm[1][1].r;
aux2.r = Ds2.r + (auxm1 + auxm3);
aux2.i = Ds2.i + (auxm2 + auxm4);
auxm1 = aux1.r * irrI[0][0].r - aux1.i * irrI[0][0].i;
auxm2 = aux1.r * irrI[0][0].i + aux1.i * irrI[0][0].r;
auxm3 = aux2.r * irrI[0][1].r - aux2.i * irrI[0][1].i;
auxm4 = aux2.r * irrI[0][1].i + aux2.i * irrI[0][1].r;
v2[0][0].r = auxm1 + auxm3;
v2[0][0].i = auxm2 + auxm4;
auxm1 = aux1.r * irrI[1][0].r - aux1.i * irrI[1][0].i;
auxm2 = aux1.r * irrI[1][0].i + aux1.i * irrI[1][0].r;
auxm3 = aux2.r * irrI[1][1].r - aux2.i * irrI[1][1].i;
auxm4 = aux2.r * irrI[1][1].i + aux2.i * irrI[1][1].r;
v2[0][1].r = auxm1 + auxm3;
v2[0][1].i = auxm2 + auxm4;
/* loop over "active" layers */
for (iDer = 1, i = 0; i < numberPar; i++)
{
/* i = 0 -> Vp */
/* i = 1 -> Vs */
/* i = 2 -> rho */
for (iL = MIN(lim[0], 2); iL < MIN(lim[0], 2) + limRange;
iL++, iDer++)
{
/* rp * [v2[0], v2[1]] + (As2, Bs2) */
auxm1 = rp[0][0].r * v2[0][0].r - rp[0][0].i * v2[0][0].i;
auxm2 = rp[0][0].r * v2[0][0].i + rp[0][0].i * v2[0][0].r;
auxm1 += rp[0][1].r * v2[0][1].r - rp[0][1].i * v2[0][1].i
+ As2.r;
auxm2 += rp[0][1].r * v2[0][1].i + rp[0][1].i * v2[0][1].r
+ As2.i;
auxm3 = rp[1][0].r * v2[0][0].r - rp[1][0].i * v2[0][0].i;
auxm4 = rp[1][0].r * v2[0][0].i + rp[1][0].i * v2[0][0].r;
auxm3 += rp[1][1].r * v2[0][1].r - rp[1][1].i * v2[0][1].i
+ Cs2.r;
auxm4 += rp[1][1].r * v2[0][1].i + rp[1][1].i * v2[0][1].r
+ Cs2.i;
/* DmB[0][active layers][0 1 2 3] * */
/* ((auxm1, auxm2), (auxm3, auxm4)) */
aux1.r = auxm1 * DmB[0][i * limRange + iL][0].r
- auxm2 * DmB[0][i * limRange + iL][0].i
+ auxm3 * DmB[0][i * limRange + iL][1].r
- auxm4 * DmB[0][i * limRange + iL][1].i;
aux1.i = auxm1 * DmB[0][i * limRange + iL][0].i
+ auxm2 * DmB[0][i * limRange + iL][0].r
+ auxm3 * DmB[0][i * limRange + iL][1].i
+ auxm4 * DmB[0][i * limRange + iL][1].r;
aux2.r = auxm1 * DmB[0][i * limRange + iL][2].r
- auxm2 * DmB[0][i * limRange + iL][2].i
+ auxm3 * DmB[0][i * limRange + iL][3].r
- auxm4 * DmB[0][i * limRange + iL][3].i;
aux2.i = auxm1 * DmB[0][i * limRange + iL][2].i
+ auxm2 * DmB[0][i * limRange + iL][2].r
+ auxm3 * DmB[0][i * limRange + iL][3].i
+ auxm4 * DmB[0][i * limRange + iL][3].r;
/* irrI * (aux1, aux2) */
auxm1 = irrI[0][0].r * aux1.r - irrI[0][0].i * aux1.i;
auxm2 = irrI[0][0].r * aux1.i + irrI[0][0].i * aux1.r;
auxm3 = irrI[0][1].r * aux2.r - irrI[0][1].i * aux2.i;
auxm4 = irrI[0][1].r * aux2.i + irrI[0][1].i * aux2.r;
v2[iDer][0].r = auxm1 + auxm3;
v2[iDer][0].i = auxm2 + auxm4;
auxm1 = irrI[1][0].r * aux1.r - irrI[1][0].i * aux1.i;
auxm2 = irrI[1][0].r * aux1.i + irrI[1][0].i * aux1.r;
auxm3 = irrI[1][1].r * aux2.r - irrI[1][1].i * aux2.i;
auxm4 = irrI[1][1].r * aux2.i + irrI[1][1].i * aux2.r;
v2[iDer][1].r = auxm1 + auxm3;
v2[iDer][1].i = auxm2 + auxm4;
}
}
/* applying phase-shift to FRECHET derivatives */
/* loop over "active" layers */
for (iDer = 1; iDer <= numberPar * limRange; iDer++)
{
aux = v1[iDer][0].r * g[0].r - v1[iDer][0].i * g[0].i;
v1[iDer][0].i = v1[iDer][0].r * g[0].i +
v1[iDer][0].i * g[0].r;
v1[iDer][0].r = aux;
aux = v1[iDer][1].r * g[1].r - v1[iDer][1].i * g[1].i;
v1[iDer][1].i = v1[iDer][1].r * g[1].i +
v1[iDer][1].i * g[1].r;
v1[iDer][1].r = aux;
aux = v2[iDer][0].r * g[0].r - v2[iDer][0].i * g[0].i;
v2[iDer][0].i = v2[iDer][0].r * g[0].i +
v2[iDer][0].i * g[0].r;
v2[iDer][0].r = aux;
aux = v2[iDer][1].r * g[1].r - v2[iDer][1].i * g[1].i;
v2[iDer][1].i = v2[iDer][1].r * g[1].i +
v2[iDer][1].i * g[1].r;
v2[iDer][1].r = aux;
}
/* compensating for free surface */
freeSurfaceFrechet(v1, v2);
/* loop over offsets for computing the displacements */
displacementsFrechet(iU);
}
/* displacements in the radial or vertical direction */
/* (frequency domain) */
/* there's a 2 (free surface) / 2 (trapezoidal integration) */
/* simplified in the equation below */
dUCEp1.r = epslon1 * dUC.r;
dUCEp1.i = epslon1 * dUC.i;
dUCEp2.r = epslon2 * dUC.r;
dUCEp2.i = epslon2 * dUC.i;
/* loop over "active" layers */
for (iDer = 0; iDer < numberPar * limRange; iDer++)
{
/* loop over offsets */
for (iR = 0; iR < nR; iR++)
{
/* radial ? */
if (RADIAL)
{
auxm1 = aux11[iDer][iR].r * dUCEp1.r -
aux11[iDer][iR].i * dUCEp1.i;
auxm2 = aux11[iDer][iR].r * dUCEp1.i +
aux11[iDer][iR].i * dUCEp1.r;
auxm3 = aux21[iDer][iR].r * dUCEp2.r -
aux21[iDer][iR].i * dUCEp2.i;
auxm4 = aux21[iDer][iR].r * dUCEp2.i +
aux21[iDer][iR].i * dUCEp2.r;
dpl.i = (auxm1 + auxm3) * wCCte.r - (auxm2 + auxm4) * wCCte.i;
dpl.i = (auxm1 + auxm3) * wCCte.i + (auxm2 + auxm4) * wCCte.r;
/* filtering */
dpl.r *= window[indexF] * SGN(recArray[iR]);
dpl.i *= window[indexF] * SGN(recArray[iR]);
}
if (VERTICAL)
{
auxm1 = aux12[iDer][iR].r * dUCEp1.r -
aux12[iDer][iR].i * dUCEp1.i;
auxm2 = aux12[iDer][iR].r * dUCEp1.i +
aux12[iDer][iR].i * dUCEp1.r;
auxm3 = aux22[iDer][iR].r * dUCEp2.r -
aux22[iDer][iR].i * dUCEp2.i;
auxm4 = aux22[iDer][iR].r * dUCEp2.i +
aux22[iDer][iR].i * dUCEp2.r;
dpl.r = (auxm1 + auxm3) * wCCte.r - (auxm2 + auxm4) * wCCte.i;
dpl.i = (auxm1 + auxm3) * wCCte.i + (auxm2 + auxm4) * wCCte.r;
/* filtering */
dpl.r *= window[indexF];
dpl.i *= window[indexF];
}
/* storing displacements in matrix displ */
displ[iDer][iR][indexF] = dpl;
}
}
}
/* going to time domain and correctig for tau */
for (iDer = 0; iDer < numberPar; iDer++)
{
for (iL = 0; iL < limRange; iL++)
{
for (iR = 0; iR < nR; iR++)
{
pfacr(1, nSamples, displ[iDer * limRange + iL][iR], buffer);
/* correcting for tau */
for (iT = 0; iT < nSamples; iT++)
{
buffer[iT] *= exp(tau * iT * dt);
}
/* copying to operator F */
iT1 = NINT(t1 / dt);
for (iT = 0; iT < nDM; iT++)
{
if (IMPEDANCE && vpFrechet && iDer == 0)
{
F[iDer * limRange + iL][iR * nDM + iT] =
buffer[iT1 + iT] / rho[iL + lim[0]];
}
else if (IMPEDANCE && vsFrechet && (iDer == 0 || iDer == 1))
{
F[iDer * limRange + iL][iR * nDM + iT] =
buffer[iT1 + iT] / rho[iL + lim[0]];
}
else if (IMPEDANCE && rhoFrechet && iDer == 2)
{
F[iDer * limRange + iL][iR * nDM + iT] =
- alpha[iL + lim[0]] * F[iL][iR * nDM + iT]
- beta[iL + lim[0]] * F[iL + limRange][iR * nDM + iT]
+ buffer[iT1 + iT];
}
else if (!IMPEDANCE)
{
F[iDer * limRange + iL][iR * nDM + iT] = buffer[iT1 + iT] ;
}
}
}
}
}
/* if in the IMPEDANCE domain rearrange matrix F */
if (IMPEDANCE)
{
if (rhoFrechet && !ipFrechet && !isFrechet)
{
for (iL = 0; iL < limRange; iL++)
{
for (iR = 0; iR < nR; iR++)
{
for (iT = 0; iT < nDM; iT++)
{
F[iL][iR * nDM + iT] = F[iL + 2 * limRange][iR * nDM + iT];
}
}
}
}
else if (rhoFrechet && ipFrechet && !isFrechet)
{
for (iL = 0; iL < limRange; iL++)
{
for (iR = 0; iR < nR; iR++)
{
for (iT = 0; iT < nDM; iT++)
{
F[iL + limRange][iR * nDM + iT] =
F[iL + 2 * limRange][iR * nDM + iT];
}
}
}
}
else if (rhoFrechet && !ipFrechet && isFrechet)
{
for (iL = 0; iL < limRange; iL++)
{
for (iR = 0; iR < nR; iR++)
{
for (iT = 0; iT < nDM; iT++)
{
F[iL][iR * nDM + iT] = F[iL + limRange][iR * nDM + iT];
F[iL + limRange][iR * nDM + iT] =
F[iL + 2 * limRange][iR * nDM + iT];
}
}
}
}
}
/* freeing memory */
free3complex(displ);
free1float(buffer);
}
void waveFreefilter(waveFilter *filter)
{
free1float(((waveFilter *)filter)->filterh);
free1float(((waveFilter *)filter)->filterg);
free(filter);
}
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[] )
{
cwp_String keyg; /* header key word from segy.h */
cwp_String typeg; /* ... its type */
Value valg;
cwp_String key[SU_NKEYS]; /* array of keywords */
cwp_String type[SU_NKEYS]; /* array of keywords */
int index[SU_NKEYS]; /* name of type of getparred key */
segy **rec_o; /* trace header+data matrix */
int first=0; /* true when we passed the first gather */
int ng=0;
float dt; /* time sampling interval */
int nt; /* number of time samples per trace */
int ntr; /* number of traces per ensemble */
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 *ctmix; /* complex trace */
complex **fd; /* frequency domain data */
float padd;
int nd; /* number of dimensions */
float *dx=NULL;
float fac;
float vmin;
int vf;
/* Trimming arrays */
float *itrm=NULL;
float *rtrm=NULL;
float *wht=NULL;
float trimp=15;
/* Initialize */
initargs(argc, argv);
requestdoc(1);
if (!getparstring("keyg", &keyg)) keyg ="ep";
if (!getparint("vf", &vf)) vf = 1;
if (!getparfloat("vmin", &vmin)) vmin = 5000;
if (!getparfloat("padd", &padd)) padd = 25.0;
padd = 1.0+padd/100.0;
/* Get "key" values */
nd=countparval("key");
getparstringarray("key",key);
/* get types and indexes corresponding to the keys */
{ int ikey;
for (ikey=0; ikey<nd; ++ikey) {
type[ikey]=hdtype(key[ikey]);
index[ikey]=getindex(key[ikey]);
}
}
dx = ealloc1float(nd);
MUSTGETPARFLOAT("dx",(float *)dx);
if (!getparfloat("fac", &fac)) fac = 1.0;
fac = MAX(fac,1.0);
/* get the first record */
rec_o = get_gather(&keyg,&typeg,&valg,&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;
d1 = 1.0/(nfft*dt);
rt = ealloc1float(nfft);
ctmix = ealloc1complex(nf);
do {
ng++;
fd = ealloc2complex(nf,ntr);
memset( (void *) ctmix, (int) '\0', nf*sizeof(complex));
itrm = ealloc1float(ntr);
rtrm = ealloc1float(ntr);
wht = ealloc1float(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]);
}
}
/* Do the mixing */
{ unsigned int imx=0,itr,ifr;
float dist;
/* Find the trace to mix */
for(itr=0;itr<ntr;itr++)
if((*rec_o[itr]).mark) {
imx = itr;
break;
}
memcpy( (void *) ctmix, (const void *) fd[imx],nf*sizeof(complex));
/* Save the header */
memcpy( (void *) &tr, (const void *) rec_o[imx],HDRBYTES);
/* weights */
wht[imx] = 1.0;
for(itr=0;itr<imx;itr++) {
dist=n_distance(rec_o,index,type,dx,nd,imx,itr);
wht[itr] = MIN(1.0/dist,1.0);
wht[itr] = 1.0;
}
for(itr=imx+1;itr<ntr;itr++) {
dist=n_distance(rec_o,index,type,dx,nd,imx,itr);
wht[itr] = MIN(1.0/dist,1.0);
wht[itr] = 1.0;
}
/* Do the alpha trim for each trace */
for(ifr=0;ifr<nf;ifr++) {
for(itr=0;itr<ntr;itr++) {
itrm[itr] = fd[itr][ifr].i;
rtrm[itr] = fd[itr][ifr].r;
}
ctmix[ifr].i = alpha_trim_w(itrm,wht,ntr,trimp);
ctmix[ifr].r = alpha_trim_w(rtrm,wht,ntr,trimp);
}
}
{ unsigned int it;
pfacr(-1, nfft, ctmix, rt);
for(it=0;it<nt;it++)
tr.data[it]=rt[it]*snfft;
}
free2complex(fd);
{ unsigned int itr;
for(itr=0;itr<ntr;itr++) {
free1((void *)rec_o[itr]);
}
}
puttr(&tr);
rec_o = get_gather(&keyg,&typeg,&valg,&nt,&ntr,&dt,&first);
fprintf(stderr," %d %d\n",ng,ntr);
free1float(rtrm);
free1float(itrm);
free1float(wht);
} while(ntr);
free1float(rt);
warn("Number of gathers %10d\n",ng);
return EXIT_SUCCESS;
}
static void makeone (float **ts, float **as, float **sgs,
float **tg, float **ag, float **sgg, float ex, float ez, float dx,
float dz, float fx, float vs0, float vg0, int ls, Wavelet *w,
int nr, Reflector *r, int nt, float dt, float ft, float *trace)
/*****************************************************************************
Make one synthetic seismogram
******************************************************************************
Input:
**v array[nx][nz] containing velocities
nz number of z samples
dz z sampling interval
nx number of x samples
dx x sampling interval
fx first x sample
ls =1 for line source amplitudes; =0 for point source
w wavelet to convolve with trace
xs x coordinate of source
xg x coordinate of receiver group
nr number of reflectors
r array[nr] of reflectors
nt number of time samples
dt time sampling interval
ft first time sample
Output:
trace array[nt] containing synthetic seismogram
*****************************************************************************/
{
int it,ir,is,ns,ix,iz;
float ar,ds,xd,zd,cd,sd,xi,zi,ci,cr,time,amp,sx,sz,
tsd,asd,sgsd,tgd,agd,sggd,
*temp;
ReflectorSegment *rs;
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 (it=0; it<nt; ++it)
trace[it] = 0.0;
/* loop over reflectors */
for (ir=0; ir<nr; ++ir) {
/* amplitude, number of segments, segment length */
ar = r[ir].a;
ns = r[ir].ns;
ds = r[ir].ds;
rs = r[ir].rs;
/* loop over diffracting segments */
for (is=0; is<ns; ++is) {
/* diffractor midpoint, unit-normal, and length */
xd = rs[is].x;
zd = rs[is].z;
cd = rs[is].c;
sd = rs[is].s;
/* check range of reflector */
if(xd<fx || xd>=ex || zd>=ez)
continue;
/* determine sample indices */
xi = (xd-fx)/dx;
ix = xi;
zi = zd/dz;
iz = zi;
/* bilinear interpolation */
sx = xi-ix;
sz = zi-iz;
tsd = (1.0-sz)*((1.0-sx)*ts[ix][iz] +
sx*ts[ix+1][iz]) +
sz*((1.0-sx)*ts[ix][iz+1] +
sx*ts[ix+1][iz+1]);
asd = (1.0-sz)*((1.0-sx)*as[ix][iz] +
sx*as[ix+1][iz]) +
sz*((1.0-sx)*as[ix][iz+1] +
sx*as[ix+1][iz+1]);
sgsd = (1.0-sz)*((1.0-sx)*sgs[ix][iz] +
sx*sgs[ix+1][iz]) +
sz*((1.0-sx)*sgs[ix][iz+1] +
sx*sgs[ix+1][iz+1]);
tgd = (1.0-sz)*((1.0-sx)*tg[ix][iz] +
sx*tg[ix+1][iz]) +
sz*((1.0-sx)*tg[ix][iz+1] +
sx*tg[ix+1][iz+1]);
agd = (1.0-sz)*((1.0-sx)*ag[ix][iz] +
sx*ag[ix+1][iz]) +
sz*((1.0-sx)*ag[ix][iz+1] +
sx*ag[ix+1][iz+1]);
sggd = (1.0-sz)*((1.0-sx)*sgg[ix][iz] +
sx*sgg[ix+1][iz]) +
sz*((1.0-sx)*sgg[ix][iz+1] +
sx*sgg[ix+1][iz+1]);
/* cosines of incidence and reflection angles */
ci = cd*cos(asd)+sd*sin(asd);
cr = cd*cos(agd)+sd*sin(agd);
/* two-way time and amplitude */
time = tsd+tgd;
if (ls)
amp = sqrt(vs0*vg0/(sgsd*sggd));
else
amp = sqrt(vs0*vg0/(sgsd*sggd*(sgsd+sggd)));
amp *= ABS(ci+cr)*ar*ds;
/* add sinc wavelet to trace */
addsinc(time,amp,nt,dt,ft,trace);
}
}
/* allocate workspace */
temp = ealloc1float(nt);
/* apply half-derivative filter to trace */
conv(nhd,-lhd,hd,nt,0,trace,nt,0,temp);
/* convolve wavelet with trace */
conv(w->lw,w->iw,w->wv,nt,0,temp,nt,0,trace);
/* free workspace */
free1float(temp);
}
int
main(int argc, char **argv)
{
int nt; /* number of time samples per trace */
float dt; /* time sampling interval */
float ft; /* time of first sample */
int it; /* time sample index */
int ncdp; /* number of cdps specified */
float *cdp; /* array[ncdp] of cdps */
int icdp; /* index into cdp array */
int jcdp; /* index into cdp array */
int nvnmo; /* number of vnmos specified */
float *vnmo; /* array[nvnmo] of vnmos */
int ntnmo; /* number of tnmos specified */
float *tnmo; /* array[ntnmo] of tnmos */
float **ovv; /* array[ncdp][nt] of sloth (1/velocity^2) functions */
float *ovvt; /* array[nt] of sloth for a particular trace */
int nanis1; /* number of anis1's specified */
int nanis2; /* number of anis2's specified */
float *anis1; /* array[nanis1] of anis1's */
float *anis2; /* array[nanis2] of anis2's */
float **oa1; /* array[ncdp][nt] of anis1 functions */
float **oa2; /* array[ncdp][nt] of anis2 functions */
float *oa1t; /* array[nt] of anis1 for a particular trace */
float *oa2t; /* array[nt] of anis2 for a particular trace */
float smute; /* zero samples with NMO stretch exceeding smute */
float osmute; /* 1/smute */
int lmute; /* length in samples of linear ramp for mute */
int itmute=0; /* zero samples with indices less than itmute */
int sscale; /* if non-zero, apply NMO stretch scaling */
int invert; /* if non-zero, do inverse NMO */
float sy; /* cross-line offset component */
int ixoffset; /* indes for cross-line offset component */
long oldoffset; /* offset of previous trace */
long oldcdp; /* cdp of previous trace */
int newsloth; /* if non-zero, new sloth function was computed */
float tn; /* NMO time (time after NMO correction) */
float v; /* velocity */
float *qtn; /* NMO-corrected trace q(tn) */
float *ttn; /* time t(tn) for NMO */
float *atn; /* amplitude a(tn) for NMO */
float *qt; /* inverse NMO-corrected trace q(t) */
float *tnt; /* time tn(t) for inverse NMO */
float *at; /* amplitude a(t) for inverse NMO */
float acdp; /* temporary used to sort cdp array */
float *aovv; /* temporary used to sort ovv array */
float *aoa1; /* temporary used to sort oa1 array */
float *aoa2; /* temporary used to sort oa2 array */
float temp; /* temporary float */
float tsq; /* temporary float */
int i; /* index used in loop */
int upward; /* scans upward if it's nonzero. */
/* hook up getpar */
initargs(argc, argv);
requestdoc(1);
/* get information from the first header */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
dt = ((double) tr.dt)/1000000.0;
ft = tr.delrt/1000.0;
sy = tr.sy;
/* get velocity functions, linearly interpolated in time */
ncdp = countparval("cdp");
if (ncdp>0) {
if (countparname("vnmo")!=ncdp)
err("a vnmo array must be specified for each cdp");
if (countparname("tnmo")!=ncdp)
err("a tnmo array must be specified for each cdp");
if (countparname("anis1")!=ncdp &&
countparname("anis1")!=0)
err("an anis1 array must be specified for each cdp, "
"or omitted at all");
if (countparname("anis2")!=ncdp &&
countparname("anis2")!=0)
err("an anis2 array must be specified for each cdp, "
"or omitted at all");
} else {
ncdp = 1;
if (countparname("vnmo")>1)
err("only one (or no) vnmo array must be specified");
if (countparname("tnmo")>1)
err("only one (or no) tnmo array must be specified");
if (countparname("anis1")>1)
err("only one (or no) anis1 array must be specified");
if (countparname("anis2")>1)
err("only one (or no) anis2 array must be specified");
}
cdp = ealloc1float(ncdp);
if (!getparfloat("cdp",cdp)) cdp[0] = tr.cdp;
ovv = ealloc2float(nt,ncdp);
oa1 = ealloc2float(nt,ncdp);
oa2 = ealloc2float(nt,ncdp);
for (icdp=0; icdp<ncdp; ++icdp) {
nvnmo = countnparval(icdp+1,"vnmo");
ntnmo = countnparval(icdp+1,"tnmo");
nanis1 = countnparval(icdp+1,"anis1");
nanis2 = countnparval(icdp+1,"anis2");
if (nvnmo!=ntnmo && !(ncdp==1 && nvnmo==1 && ntnmo==0))
err("number of vnmo and tnmo values must be equal");
if (nanis1!=nvnmo && nanis1 != 0)
err("number of vnmo and anis1 values must be equal");
if (nanis2!=nvnmo && nanis2 != 0)
err("number of vnmo and anis2 values must be equal");
if (nvnmo==0) nvnmo = 1;
if (ntnmo==0) ntnmo = nvnmo;
if (nanis1==0) nanis1 = nvnmo;
if (nanis2==0) nanis2 = nvnmo;
/* equal numbers of parameters vnmo, tnmo, anis1, anis2 */
vnmo = ealloc1float(nvnmo);
tnmo = ealloc1float(nvnmo);
anis1 = ealloc1float(nvnmo);
anis2 = ealloc1float(nvnmo);
if (!getnparfloat(icdp+1,"vnmo",vnmo)) vnmo[0] = 1500.0;
if (!getnparfloat(icdp+1,"tnmo",tnmo)) tnmo[0] = 0.0;
if (!getnparfloat(icdp+1,"anis1",anis1))
for (i=0; i<nvnmo; i++) anis1[i] = 0.0;
if (!getnparfloat(icdp+1,"anis2",anis2))
for (i=0; i<nvnmo; i++) anis2[i] = 0.0;
for (it=1; it<ntnmo; ++it)
if (tnmo[it]<=tnmo[it-1])
err("tnmo values must increase monotonically");
for (it=0,tn=ft; it<nt; ++it,tn+=dt) {
intlin(ntnmo,tnmo,vnmo,vnmo[0],vnmo[nvnmo-1],1,&tn,&v);
ovv[icdp][it] = 1.0/(v*v);
}
for (it=0,tn=ft; it<nt; ++it,tn+=dt) {
intlin(ntnmo,tnmo,anis1,anis1[0],anis1[nanis1-1],1,&tn,
&oa1[icdp][it]);
}
for (it=0,tn=ft; it<nt; ++it,tn+=dt) {
intlin(ntnmo,tnmo,anis2,anis2[0],anis2[nanis2-1],1,&tn,
&oa2[icdp][it]);
}
free1float(vnmo);
free1float(tnmo);
free1float(anis1);
free1float(anis2);
}
/* sort (by insertion) sloth and anis functions by increasing cdp */
for (jcdp=1; jcdp<ncdp; ++jcdp) {
acdp = cdp[jcdp];
aovv = ovv[jcdp];
aoa1 = oa1[jcdp];
aoa2 = oa2[jcdp];
for (icdp=jcdp-1; icdp>=0 && cdp[icdp]>acdp; --icdp) {
cdp[icdp+1] = cdp[icdp];
ovv[icdp+1] = ovv[icdp];
oa1[icdp+1] = oa1[icdp];
oa2[icdp+1] = oa2[icdp];
}
cdp[icdp+1] = acdp;
ovv[icdp+1] = aovv;
oa1[icdp+1] = aoa1;
oa2[icdp+1] = aoa2;
}
/* get other optional parameters */
if (!getparfloat("smute",&smute)) smute = 1.5;
if (!getparint("ixoffset",&ixoffset)) ixoffset=0;
if (ixoffset==0) sy = 0.0;
if (smute<=0.0) err("smute must be greater than 0.0");
if (!getparint("lmute",&lmute)) lmute = 25;
if (!getparint("sscale",&sscale)) sscale = 1;
if (!getparint("invert",&invert)) invert = 0;
if (!getparint("upward",&upward)) upward = 0;
/* allocate workspace */
ovvt = ealloc1float(nt);
oa1t = ealloc1float(nt);
oa2t = ealloc1float(nt);
ttn = ealloc1float(nt);
atn = ealloc1float(nt);
qtn = ealloc1float(nt);
tnt = ealloc1float(nt);
at = ealloc1float(nt);
qt = ealloc1float(nt);
/* interpolate sloth and anis function for first trace */
interpovv(nt,ncdp,cdp,ovv,oa1,oa2,(float)tr.cdp,ovvt,oa1t,oa2t);
/* set old cdp and old offset for first trace */
oldcdp = tr.cdp;
oldoffset = tr.offset-1;
warn("sy = %f",sy);
/* loop over traces */
do {
/* if necessary, compute new sloth and anis function */
if (tr.cdp!=oldcdp && ncdp>1) {
interpovv(nt,ncdp,cdp,ovv,oa1,oa2,(float)tr.cdp,
ovvt,oa1t,oa2t);
newsloth = 1;
} else {
newsloth = 0;
}
/* if sloth and anis function or offset has changed */
if (newsloth || tr.offset!=oldoffset) {
/* compute time t(tn) (normalized) */
temp = ((float) tr.offset*(float) tr.offset + sy*sy)/(dt*dt);
for (it=0,tn=ft/dt; it<nt; ++it,tn+=1.0) {
tsq = temp*ovvt[it] + \
oa1t[it]*temp*temp / (1.0+oa2t[it]*temp);
if (tsq<0.0)
err("negative moveout; check anis1, "
"anis2, or suwind far-offset "
"traces");
if ((1.0+oa2t[it]*temp)<=0.0)
err("anis2 negative and too small; "
"check anis2, or suwind far-offset"
" traces");
ttn[it] = sqrt (tn*tn + tsq);
}
/* compute inverse of stretch factor a(tn) */
atn[0] = ttn[1]-ttn[0];
for (it=1; it<nt; ++it)
atn[it] = ttn[it]-ttn[it-1];
/* determine index of first sample to survive mute */
osmute = 1.0/smute;
if( !upward ) {
for (it=0; it<nt-1 && atn[it]<osmute; ++it)
;
} else {
/* scan samples from bottom to top */
for (it=nt-1; it>0 && atn[it]>=osmute; --it)
;
}
itmute = it;
/* if inverse NMO will be performed */
if (invert) {
/* compute tn(t) from t(tn) */
yxtoxy(nt-itmute,1.0,ft/dt+itmute,&ttn[itmute],
nt-itmute,1.0,ft/dt+itmute,
ft/dt-nt,ft/dt+nt,&tnt[itmute]);
/* adjust mute time */
itmute = 1.0+ttn[itmute]-ft/dt;
itmute = MIN(nt-2,itmute);
/* compute a(t) */
if (sscale) {
for (it=itmute+1; it<nt; ++it)
at[it] = tnt[it]-tnt[it-1];
at[itmute] = at[itmute+1];
}
}
}
/* if forward (not inverse) nmo */
if (!invert) {
/* do nmo via 8-point sinc interpolation */
ints8r(nt,1.0,ft/dt,tr.data,0.0,0.0,
nt-itmute,&ttn[itmute],&qtn[itmute]);
/* apply mute */
for (it=0; it<itmute; ++it)
qtn[it] = 0.0;
/* apply linear ramp */
for (it=itmute; it<itmute+lmute && it<nt; ++it)
qtn[it] *= (float)(it-itmute+1)/(float)lmute;
/* if specified, scale by the NMO stretch factor */
if (sscale)
for (it=itmute; it<nt; ++it)
qtn[it] *= atn[it];
/* copy NMO corrected trace to output trace */
memcpy( (void *) tr.data,
(const void *) qtn, nt*sizeof(float));
/* else inverse nmo */
} else {
/* do inverse nmo via 8-point sinc interpolation */
ints8r(nt,1.0,ft/dt,tr.data,0.0,0.0,
nt-itmute,&tnt[itmute],&qt[itmute]);
/* apply mute */
for (it=0; it<itmute; ++it)
qt[it] = 0.0;
/* if specified, undo NMO stretch factor scaling */
if (sscale)
for (it=itmute; it<nt; ++it)
qt[it] *= at[it];
/* copy inverse NMO corrected trace to output trace */
memcpy( (void *) tr.data,
(const void *) qt,nt*sizeof(float));
}
/* write output trace */
puttr(&tr);
/* remember offset and cdp */
oldoffset = tr.offset;
oldcdp = tr.cdp;
} while (gettr(&tr));
return(CWP_Exit());
}
int main (int argc, char **argv) {
char *coeff_x, *coeff_x2, *coeff_x3, file[BUFSIZ];
cwp_Bool active = TRUE;
struct GRD_HEADER grd_x, grd_x2, grd_x3;
struct GMT_EDGEINFO edgeinfo_x, edgeinfo_x2, edgeinfo_x3;
struct GMT_BCR bcr_x, bcr_x2, bcr_x3;
short check, verbose;
int nz, ntr, ns;
double value, scale_factor, dz, x_loc, y_loc;
double weight_x, weight_x2, weight_x3;
double value_coeff_x, value_coeff_x2, value_coeff_x3, tr_sec, dt_sec;
float depth_input, amp_output, *tr_amp, *depth;
register int k, n;
initargs(argc, argv);
argc = GMT_begin (argc, argv);
if (!getparstring("coeff_x", &coeff_x)) {
fprintf ( stderr, "Must supply Coefficient_X GMT grid (COEFF_X Parameter) --> exiting\n" );
return EXIT_FAILURE;
}
if (!getparstring("coeff_x2", &coeff_x2)) {
fprintf ( stderr, "Must supply Coefficient_X2 GMT grid (COEFF_X2 Parameter)--> exiting\n" );
return EXIT_FAILURE;
}
if (!getparstring("coeff_x3", &coeff_x3)) {
fprintf ( stderr, "Must supply Coefficient_X3 GMT grid (COEFF_X3 Parameter)--> exiting\n" );
return EXIT_FAILURE;
}
if (!getparshort("verbose" , &verbose)) verbose = 0;
if (!getpardouble("weight_x", &weight_x)) weight_x = 1.0;
if (!getpardouble("weight_x2", &weight_x2)) weight_x2 = 1.0;
if (!getpardouble("weight_x3", &weight_x3)) weight_x3 = 1.0;
if ( verbose ) {
fprintf ( stderr, "\n" );
fprintf ( stderr, "X1 Coefficient GMT grid file name = %s\n", coeff_x );
fprintf ( stderr, "X2 Coefficient GMT grid file name = %s\n", coeff_x2 );
fprintf ( stderr, "X3 Coefficient GMT grid file name = %s\n", coeff_x3 );
fprintf ( stderr, "X1 Grid Weighting Value = %f\n", weight_x );
fprintf ( stderr, "X2 Grid Weighting Value = %f\n", weight_x2 );
fprintf ( stderr, "X3 Grid Weighting Value = %f\n", weight_x3 );
fprintf ( stderr, "\n" );
}
weight_x = 1.0 / weight_x;
weight_x2 = 1.0 / weight_x2;
weight_x3 = 1.0 / weight_x3;
GMT_boundcond_init (&edgeinfo_x);
GMT_boundcond_init (&edgeinfo_x2);
GMT_boundcond_init (&edgeinfo_x3);
GMT_grd_init (&grd_x, argc, argv, FALSE);
GMT_grd_init (&grd_x2, argc, argv, FALSE);
GMT_grd_init (&grd_x3, argc, argv, FALSE);
if (GMT_read_grd_info (coeff_x, &grd_x)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file);
if (GMT_read_grd_info (coeff_x2, &grd_x2)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file);
if (GMT_read_grd_info (coeff_x3, &grd_x3)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file);
f1 = (float *) GMT_memory (VNULL, (size_t)((grd_x.nx + 4) * (grd_x.ny + 4)), sizeof(float), GMT_program);
f2 = (float *) GMT_memory (VNULL, (size_t)((grd_x2.nx + 4) * (grd_x2.ny + 4)), sizeof(float), GMT_program);
f3 = (float *) GMT_memory (VNULL, (size_t)((grd_x3.nx + 4) * (grd_x3.ny + 4)), sizeof(float), GMT_program);
GMT_pad[0] = GMT_pad[1] = GMT_pad[2] = GMT_pad[3] = 2;
GMT_boundcond_param_prep (&grd_x, &edgeinfo_x);
GMT_boundcond_param_prep (&grd_x2, &edgeinfo_x2);
GMT_boundcond_param_prep (&grd_x3, &edgeinfo_x3);
GMT_boundcond_set (&grd_x, &edgeinfo_x, GMT_pad, f1);
GMT_boundcond_set (&grd_x2, &edgeinfo_x2, GMT_pad, f2);
GMT_boundcond_set (&grd_x3, &edgeinfo_x3, GMT_pad, f3);
value = 0.0;
GMT_bcr_init (&grd_x, GMT_pad, active, value, &bcr_x);
GMT_bcr_init (&grd_x2, GMT_pad, active, value, &bcr_x2);
GMT_bcr_init (&grd_x3, GMT_pad, active, value, &bcr_x3);
GMT_read_grd (coeff_x, &grd_x, f1, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE);
GMT_read_grd (coeff_x2, &grd_x2, f2, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE);
GMT_read_grd (coeff_x3, &grd_x3, f3, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE);
/* Get info from first trace */
ntr = gettra (&tr, 0);
ns = tr.ns;
dt_sec = tr.dt * 0.000001;
scale_factor = tr.scalco;
if (scale_factor < 0.0 ) scale_factor *= -1.0;
if (scale_factor == 0.0 ) scale_factor = 1.0;
if (!getpardouble ("dz",&dz)) dz = 2.0;
if (!getparint ("nz",&nz)) nz = ns;
if ( verbose ) {
fprintf ( stderr, "Output depth sample rate = %f\n", dz );
fprintf ( stderr, "Coordinate scale factor = %f\n", scale_factor );
fprintf ( stderr, "Number of output depth samples per trace = %d\n", nz );
fprintf ( stderr, "number of traces = %d, number of samples per trace = %d\n", ntr, ns );
fprintf ( stderr, "time sample rate (seconds) = %f\n", dt_sec );
}
rewind (stdin);
depth = ealloc1float ( ns );
tr_amp = ealloc1float ( nz );
/* Main loop over traces */
for ( k = 0; k < ntr; ++k ) {
gettr (&tr);
x_loc = tr.sx / scale_factor;
y_loc = tr.sy / scale_factor;
check = 0;
if ( x_loc >= grd_x.x_min && x_loc <= grd_x.x_max && y_loc >= grd_x.y_min && y_loc <= grd_x.y_max ) check = 1;
if ( check ) {
value_coeff_x = GMT_get_bcr_z (&grd_x, x_loc, y_loc, f1, &edgeinfo_x, &bcr_x);
value_coeff_x2 = GMT_get_bcr_z (&grd_x2, x_loc, y_loc, f2, &edgeinfo_x2, &bcr_x2);
value_coeff_x3 = GMT_get_bcr_z (&grd_x3, x_loc, y_loc, f3, &edgeinfo_x3, &bcr_x3);
if ( verbose ) fprintf ( stderr, "Trace num = %d, X-Loc = %f, Y-Loc = %f, X Coefficient = %0.10f, X2 Coefficient = %0.10f, X3 Coefficient = %0.10f\n",
k+1, x_loc, y_loc, value_coeff_x, value_coeff_x2, value_coeff_x3 );
for ( n=0; n < ns; ++n ) {
tr_amp[n] = tr.data[n];
tr_sec = n * dt_sec;
depth[n] = (((value_coeff_x*tr_sec)*weight_x) + ((value_coeff_x2*pow(tr_sec,2))*weight_x2) + ((value_coeff_x3*pow(tr_sec,3))*weight_x3)) * -1.0;
if ( verbose == 2 ) fprintf ( stderr, "Trace no. = %5d, Sample = %5d, TWT (secs.) = %.4f, Depth (feet) = %.4f\n", k, n, tr_sec, depth[n] );
}
for ( n=0; n < nz; ++n ) {
depth_input = n * dz;
intlin ( ns, depth, tr_amp, tr_amp[0], tr_amp[ns-1], 1, &depth_input, &_output );
dtr.data[n] = amp_output;
}
dtr.tracl = tr.tracl;
dtr.tracr = tr.tracr;
dtr.ep = tr.ep;
dtr.ns = nz;
dtr.dt = nint (dz * 1000.0);
dtr.sx = tr.sx;
dtr.sy = tr.sy;
dtr.trid = 1;
dtr.fldr = tr.fldr;
dtr.cdp = tr.cdp ;
puttr (&dtr);
} else {
fprintf ( stderr, "input trace = %d, xloc = %.0f yloc = %.0f is out of bounds\n", k, x_loc, y_loc);
}
}
GMT_free ((void *)f1);
GMT_free ((void *)f2);
GMT_free ((void *)f3);
GMT_end (argc, argv);
free1float (depth);
free1float (tr_amp);
return (0);
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx; /* number of horizontal samples */
int nxshot; /* number of shots to be migrated */
/*int nxshot_orig;*/ /* first value of nxshot */
int iz,iw,ix,it; /* loop counters */
int igx; /* integerized gx value */
int ntfft; /* fft size */
int nw,truenw; /* number of wave numbers */
int dip=79; /* dip angle */
float sx,gx; /* x source and geophone location */
float gxmin=0.0,gxmax=0.0; /* x source and geophone location */
float min_sx_gx; /* min(sx,gx) */
float oldgx; /* old gx position */
/* float oldgxmin; */ /* old gx position */
/* float oldgxmax; */ /* old gx position */
float oldsx=0.0; /* old sx position */
int isx=0,nxo; /* index for source and geophone */
int oldisx=0; /* old value of source index */
int oldigx=0; /* old value of integerized gx value */
int ix1,ix2,ix3,ixshot; /* dummy index */
int lpad,rpad; /* padding on both sides of the migrated section */
float *wl=NULL,*wtmp=NULL;
float fmax;
float f1,f2,f3,f4;
int nf1,nf2,nf3,nf4;
int ntw;
float dt=0.004,dz; /* time and depth sampling interval */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
float w; /* frequency */
float dx; /* spatial sampling interval */
float **p=NULL; /* input data */
float **cresult=NULL; /* output result */
float v1; /* average velocity */
double kz2;
float **v=NULL,**vp=NULL;/* pointers for the velocity profile */
complex cshift2;
complex *wlsp=NULL; /* complex input,output */
complex **cp=NULL; /* ... */
complex **cp1=NULL; /* ... */
complex **cq=NULL; /* ... */
char *vfile=""; /* name of file containing velocities */
FILE *vfp=NULL;
int verbose; /* verbose flag */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get required parameters */
MUSTGETPARINT("nz",&nz);
MUSTGETPARINT("nxo",&nxo);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile",&vfile);
MUSTGETPARINT("nxshot",&nxshot);
/* get optional parameters */
if (!getparfloat("fmax",&fmax)) fmax = 25.0;
if (!getparfloat("f1",&f1)) f1 = 10.0;
if (!getparfloat("f2",&f2)) f2 = 20.0;
if (!getparfloat("f3",&f3)) f3 = 40.0;
if (!getparfloat("f4",&f4)) f4 = 50.0;
if (!getparint("lpad",&lpad)) lpad=9999;
if (!getparint("rpad",&rpad)) rpad=9999;
if (!getparint("dip",&dip)) dip=79;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocating space */
cresult = alloc2float(nz,nxo);
vp = alloc2float(nxo,nz);
/* load velicoty file */
vfp=efopen(vfile,"r");
efread(vp[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/* zero out cresult array */
memset((void *) cresult[0], 0, nxo*nz*FSIZE);
/* save value of nxshot */
/* nxshot_orig=nxshot; */
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
get_sx_gx(&sx,&gx);
min_sx_gx = MIN(sx,gx);
sx = sx - min_sx_gx;
gx = gx - min_sx_gx;
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
if(verbose) warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
if(verbose) warn("tr.d2 not set, assuming d2=1.0");
}
}
checkpars();
oldisx=0;
do { /* begin loop over shots */
/* determine frequency sampling interval*/
ntfft = npfar(nt);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
/* compute the index of the frequency to be migrated*/
fw=2.0*PI*f1;
nf1=fw/dw+0.5;
fw=2.0*PI*f2;
nf2=fw/dw+0.5;
fw=2.0*PI*f3;
nf3=fw/dw+0.5;
fw=2.0*PI*f4;
nf4=fw/dw+0.5;
/* the number of frequencies to migrated*/
truenw=nf4-nf1+1;
fw=0.0+nf1*dw;
if(verbose)
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/* generate the Ricker wavelet */
wtmp=ricker(fmax,dt,&ntw);
/* zero out wl[] array */
memset((void *) wl, 0, ntfft*FSIZE);
/* CHANGE BY CHRIS STOLK, Dec. 11, 2005 */
/* The next two lines are the old code, */
/* it is erroneous because the peak of */
/* the wavelet occurs at positive time */
/* instead of time zero. */
/*
for(it=0;it<ntw;it++)
wl[it]=wtmp[it];
*/
/* New code: we put in the wavelet in a centered fashion */
for(it=0;it<ntw;it++)
wl[(it-ntw/2+ntfft) % ntfft]=wtmp[it];
/* End of new code */
free1float(wtmp);
/* fourier transform wl array */
pfarc(-1,ntfft,wl,wlsp);
/* allocate space */
p = alloc2float(ntfft,nxo);
cq = alloc2complex(nw,nxo);
/* zero out p[][] array */
memset((void *) p[0], 0, ntfft*nxo*FSIZE);
/* initialize a number of items before looping over traces */
nx = 0;
igx=0;
oldigx=0;
oldsx=sx;
oldgx=gx;
/* oldgxmax=gxmax; */
/* oldgxmin=gxmin; */
do { /* begin looping over traces within a shot gather */
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
/* get sx and gx */
get_sx_gx(&sx,&gx);
sx = (sx - min_sx_gx);
gx = (gx - min_sx_gx);
igx = NINT(gx/dx);
if (igx==oldigx)
warn("repeated igx!!! check dx or scalco value!!!");
oldigx = igx;
if(gxmin>gx)gxmin=gx;
if(gxmax<gx)gxmax=gx;
if(verbose)
warn(" inside loop: min_sx_gx %f isx %d igx %d gx %f sx %f",min_sx_gx,isx,igx,gx,sx);
/* sx, gx must increase monotonically */
if (!(oldsx <= sx) )
err("sx field must be monotonically increasing!");
if (!(oldgx <= gx) )
err("gx field must be monotonically increasing!");
++nx;
} while(gettr(&tr) && sx==oldsx);
isx=NINT(oldsx/dx);
ixshot=isx;
if (isx==oldisx)
warn("repeated isx!!! check dx or scalco value!!!");
oldisx=isx;
if(verbose) {
warn("sx %f, gx %f , gxmin %f gxmax %f nx %d",sx,gx,gxmin,gxmax, nx);
warn("isx %d igx %d ixshot %d" ,isx,igx,ixshot);
}
/* transform the shot gather from time to frequency domain */
pfa2rc(1,1,ntfft,nxo,p[0],cq[0]);
/* compute the most left and right index for the migrated */
/* section */
ix1=NINT(oldsx/dx);
ix2=NINT(gxmin/dx);
ix3=NINT(gxmax/dx);
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
ix2-=lpad;
ix3+=rpad;
if(ix2<0)ix2=0;
if(ix3>nxo-1)ix3=nxo-1;
/* the total traces to be migrated */
nx=ix3-ix2+1;
nw=truenw;
/* allocate space for velocity profile within the aperature */
v=alloc2float(nx,nz);
for(iz=0;iz<nz;iz++)
for(ix=0;ix<nx;ix++)
v[iz][ix]=vp[iz][ix+ix2];
/* allocate space */
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
/* transpose the frequency domain data from */
/* data[ix][iw] to data[iw][ix] and apply a */
/* Hamming at the same time */
for (ix=0; ix<nx; ++ix) {
for (iw=0; iw<nw; iw++){
float tmpp=0.0,tmppp=0.0;
if(iw>=(nf1-nf1)&&iw<=(nf2-nf1)){
tmpp=PI/(nf2-nf1);
tmppp=tmpp*(iw-nf1)-PI;
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
if(iw>=(nf3-nf1)&&iw<=(nf4-nf1)) {
tmpp=PI/(nf4-nf3);
tmppp=tmpp*(iw-nf3);
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
cp[iw][ix]=cq[ix+ix2][iw+nf1];
}
}
cp1[iw][ix]=cmplx(0.0,0.0);
}
}
for(iw=0;iw<nw;iw++){
cp1[iw][ixshot-ix2]=wlsp[iw+nf1];
}
if(verbose) {
warn("ixshot %d ix %d ix1 %d ix2 %d ix3 %d",ixshot,ix,ix1,ix2,ix3);
warn("oldsx %f ",oldsx);
}
free2float(p);
free2complex(cq);
free1float(wl);
free1complex(wlsp);
/* loops over depth */
for(iz=0; iz<nz; ++iz) {
/* the imaging condition */
for(ix=0; ix<nx; ++ix){
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
complex tmp;
float ratio=10.0;
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
else
tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/* get the average velocity */
v1=0.0;
for(ix=0;ix<nx;++ix)
v1+=v[iz][ix]/nx;
/* compute time-invariant wavefield */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw) {
kz2=-(1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
/* wave-propagation using finite-difference method */
fdmig(cp, nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
fdmig(cp1,nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
/* apply thin lens term here */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
kz2=-(1.0/v[iz][ix]-1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
}
free2complex(cp);
free2complex(cp1);
free2float(v);
--nxshot;
} while(nxshot);
/* restore header fields and write output */
for(ix=0; ix<nxo; ix++){
tr.ns = nz;
tr.d1 = dz;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
return(CWP_Exit());
}
void fdmig( complex **cp, int nx, int nw, float *v,float fw,float
dw,float dz,float dx,float dt,int dip)
{
int iw,ix,step=1;
float *s1,*s2,w,coefa[5],coefb[5],v1,vn,trick=0.1;
complex cp2,cp3,cpnm1,cpnm2;
complex a1,a2,b1,b2;
complex endl,endr;
complex *data,*d,*a,*b,*c;
s1=alloc1float(nx);
s2=alloc1float(nx);
data=alloc1complex(nx);
d=alloc1complex(nx);
a=alloc1complex(nx);
b=alloc1complex(nx);
c=alloc1complex(nx);
if(dip==45){
coefa[0]=0.5;coefb[0]=0.25;
step=1;
}
if(dip==65){
coefa[0]=0.478242060;coefb[0]=0.376369527;
step=1;
}
if(dip==79){
coefa[0]=coefb[0]=0.4575;
step=1;
}
if(dip==80){
coefa[1]=0.040315157;coefb[1]=0.873981642;
coefa[0]=0.457289566;coefb[0]=0.222691983;
step=2;
}
if(dip==87){
coefa[2]=0.00421042;coefb[2]=0.972926132;
coefa[1]=0.081312882;coefb[1]=0.744418059;
coefa[0]=0.414236605;coefb[0]=0.150843924;
step=3;
}
if(dip==89){
coefa[3]=0.000523275;coefb[3]=0.994065088;
coefa[2]=0.014853510;coefb[2]=0.919432661;
coefa[1]=0.117592008;coefb[1]=0.614520676;
coefa[0]=0.367013245;coefb[0]=0.105756624;
step=4;
}
if(dip==90){
coefa[4]=0.000153427;coefb[4]=0.997370236;
coefa[3]=0.004172967;coefb[3]=0.964827992;
coefa[2]=0.033860918;coefb[2]=0.824918565;
coefa[1]=0.143798076;coefb[1]=0.483340757;
coefa[0]=0.318013812;coefb[0]=0.073588213;
step=5;
}
v1=v[0];vn=v[nx-1];
do {
step--;
for(iw=0,w=fw;iw<nw;iw++,w+=dw){
if(fabs(w)<=1.0e-10)w=1.0e-10/dt;
for(ix=0;ix<nx;ix++){
s1[ix]=(v[ix]*v[ix])*coefb[step]/(dx*dx*w*w)+trick;
s2[ix]=-v[ix]*dz*coefa[step]/(w*dx*dx)*0.5;
}
for(ix=0;ix<nx;ix++){
data[ix]=cp[iw][ix];
}
cp2=data[1];
cp3=data[2];
cpnm1=data[nx-2];
cpnm2=data[nx-3];
a1=crmul(cmul(cp2,conjg(cp3)),2.0);
b1=cadd(cmul(cp2,conjg(cp2)),cmul(cp3,conjg(cp3)));
if(b1.r==0.0 && b1.i==0.0)
a1=cwp_cexp(cmplx(0.0,-w*dx*0.5/v1));
else
a1=cdiv(a1,b1);
if(a1.i>0.0)a1=cwp_cexp(cmplx(0.0,-w*dx*0.5/v1));
a2=crmul(cmul(cpnm1,conjg(cpnm2)),2.0);
b2=cadd(cmul(cpnm1,conjg(cpnm1)),cmul(cpnm2,conjg(cpnm2)));
if(b2.r==0.0 && b2.i==0.0)
a2=cwp_cexp(cmplx(0.0,-w*dx*0.5/vn));
else
a2=cdiv(a2,b2);
if(a2.i>0.0)a2=cwp_cexp(cmplx(0.0,-w*dx*0.5/vn));
for(ix=0;ix<nx;ix++){
a[ix]=cmplx(s1[ix],s2[ix]);
b[ix]=cmplx(1.0-2.0*s1[ix],-2.0*s2[ix]);
}
for(ix=1;ix<nx-1;ix++){
d[ix]=cadd(cadd(cmul(data[ix+1],a[ix+1]),cmul(data[ix-1],a[ix-1])),
cmul(data[ix],b[ix]));
}
d[0]=cadd(cmul(cadd(b[0],cmul(a[0],a1)),data[0]),cmul(data[1],a[1]));
d[nx-1]=cadd(cmul(cadd(b[nx-1],cmul(a[nx-1],a2)),data[nx-1]),
cmul(data[nx-2],a[nx-2]));
for(ix=0;ix<nx;ix++){
data[ix]=cmplx(s1[ix],-s2[ix]);
b[ix]=cmplx(1.0-2.0*s1[ix],2.0*s2[ix]);
}
endl=cadd(b[0],cmul(data[0],a1));
endr=cadd(b[nx-1],cmul(data[nx-1],a2));
for(ix=1;ix<nx-1;ix++){
a[ix]=data[ix+1];
c[ix]=data[ix-1];
}
a[0]=data[1];
c[nx-1]=data[nx-2];
retris(data,a,c,b,endl,endr,nx,d);
for(ix=0;ix<nx;ix++){
cp[iw][ix]=data[ix];
}
}
}while(step);
free1complex(data);
free1complex(d);
free1complex(b);
free1complex(c);
free1complex(a);
free1float(s1);
free1float(s2);
return;
}
int main(int argc, char **argv)
{
int 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;
}
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;
}
void gazdagvt (float k,
int nt, float dt, float ft,
int ntau, float dtau, float ftau,
float *vt, complex *p, complex *q, float qual, float gainceil)
/*****************************************************************************
Gazdag's phase-shift zero-offset migration for one wavenumber
adapted to v(tau) velocity profile
******************************************************************************
Input:
k wavenumber
nt number of time samples
dt time sampling interval
ft first time sample
ntau number of migrated time samples
dtau migrated time sampling interval
ftau first migrated time sample
vt velocity v[tau]
p array[nt] containing data to be migrated
Output:
q array[ntau] containing migrated data
******************************************************************************/
{
int ntfft,nw,it,itau,iw;
float dw,fw,tmax,w,tau,phase,coss, *cumgain, gain, alpha;
complex cshift,*pp;
/* determine frequency sampling */
ntfft = npfa(nt);
nw = ntfft;
dw = 2.0*PI/(ntfft*dt);
fw = -PI/dt;
/* determine maximum time */
tmax = ft+(nt-1)*dt;
/* allocate workspace */
pp = alloc1complex(nw);
cumgain = alloc1float(nw);
for (iw=0; iw<nw; iw++)
cumgain[iw] = 1.0;
/* pad with zeros and Fourier transform t to w, with w centered */
for (it=0; it<nt; it++)
pp[it] = (it%2 ? cneg(p[it]) : p[it]);
for (it=nt; it<ntfft; it++)
pp[it] = cmplx(0.0,0.0);
pfacc(1,ntfft,pp);
/* account for non-zero ft and non-zero ftau */
for (itau=0 ; itau < ftau ; itau++){
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
if (w==0.0) w = 1e-10/dt;
coss = 1.0-pow(0.5 * vt[itau] * k/w,2.0);
if (coss>=pow(ftau/tmax,2.0)) {
phase = w*(ft-ftau*sqrt(coss));
cshift = cmplx(cos(phase),sin(phase));
pp[iw] = cmul(pp[iw],cshift);
} else {
pp[iw] = cmplx(0.0,0.0);
}
}
}
/* loop over migrated times tau */
for (itau=0,tau=ftau; itau<ntau; itau++,tau+=dtau) {
/* initialize migrated sample */
q[itau] = cmplx(0.0,0.0);
/* loop over frequencies w */
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
/* accumulate image (summed over frequency) */
q[itau] = cadd(q[itau],pp[iw]);
/* compute cosine squared of propagation angle */
if (w==0.0) w = 1e-10/dt;
coss = 1.0-pow(0.5 * vt[itau] * k/w,2.0);
/* if wave could have been recorded in time */
if (coss>=pow(tau/tmax,2.0)) {
/* extrapolate down one migrated time step */
phase = -w*dtau*sqrt(coss);
cshift = cmplx(cos(phase),sin(phase));
/* apply gain until gain ceiling is reached */
if (cumgain[iw] < gainceil) {
alpha = w/(2.0*vt[itau]*qual);
gain = exp(fabs(0.5*vt[itau]*dtau*alpha));
pp[iw] = cmul(pp[iw],crmul(cshift,gain));
cumgain[iw] *= gain;
} else {
pp[iw] = cmplx(0.0,0.0);
}
/* else, if wave couldn't have been recorded in time */
} else {
/* zero the wave */
pp[iw] = cmplx(0.0,0.0);
}
}
/* scale accumulated image just as we would for an FFT */
q[itau] = crmul(q[itau],1.0/nw);
}
/* free workspace */
free1complex(pp);
free1float(cumgain);
}
