void retris(complex *data,complex *a,complex *c, complex *b,
complex endl,complex endr, int nx, complex *d)
{
int ix;
complex *e,den;
complex *f;
e=alloc1complex(nx);
f=alloc1complex(nx);
e[0]=cdiv(cneg(a[0]),endl);
f[0]=cdiv(d[0],endl);
for(ix=1;ix<nx-1;++ix){
den=cadd(b[ix],cmul(c[ix],e[ix-1]));
e[ix]=cdiv(cneg(a[ix]),den);
f[ix]=cdiv(csub(d[ix],cmul(f[ix-1],c[ix])),den);
}
data[nx-1]=cdiv(csub(d[nx-1],cmul(f[nx-2],c[nx-2])),cadd(endr,cmul(c[nx-2],e[nx-2])));
for(ix=nx-2;ix>-1;--ix)
data[ix]=cadd(cmul(data[ix+1],e[ix]),f[ix]);
free1complex(e);
free1complex(f);
return;
}
void fft(Complex f[], int len, int t) {
int i, j, k;
Complex e, u, v;
reverse(f, len);
for (i = 2; i <= len; i <<= 1) {
Complex wn;
wn.real = cos(-t * 2 * pi / i);
wn.image = sin(-t * 2 * pi / i);
for (j = 0; j < len; j += i) {
e.real = 1, e.image = 0;
for (k = j; k < j + i / 2; k++) {
u = f[k];
v = cmul(e, f[k+i/2]);
f[k] = cadd(u, v);
f[k+i/2] = csub(u, v);
e = cmul(e, wn);
}
}
}
if (-1 == t) {
for (i = 0; i < len; i++)
f[i].real /= len;
}
}
void ifft(cmplx a[],int n,cmplx f[]) {
if(n==1) {
f[0].re=a[0].re;
f[0].im=a[0].im;
return;
}
cmplx *o,*e,*ef,*of,omega,omegak,cmu;
o=(cmplx*)malloc((n/2)*sizeof(cmplx));
e=(cmplx*)malloc((n/2+n%2)*sizeof(cmplx));
of=(cmplx*)malloc((n/2)*sizeof(cmplx));
ef=(cmplx*)malloc((n/2+n%2)*sizeof(cmplx));
int i,j;
for(i=0,j=0;j<n;i++,j+=2) {
e[i]=a[j];
if(j==n-1) continue;
o[i]=a[j+1];
}
fft(o,n/2,of);
fft(e,n/2+n%2,ef);
omega.re=cos(2*pi/n);
omega.im=-sin(2*pi/n);
omegak.re=1;omegak.im=0;
for(i=0;i<n/2;i++) {
cmu=cmul(omegak,of[i]);
f[i].re=ef[i].re+cmu.re;
f[i].im=ef[i].im+cmu.im;
f[i+n/2].re=ef[i].re-cmu.re;
f[i+n/2].im=ef[i].im-cmu.im;
omegak=cmul(omega,omegak);
}
if(n%2) {
f[n]=ef[n/2+1];
}
}
void fft(cmplx a[],int n,cmplx f[]) {
if(n==1) {
f[0].re=f[1].re=a[0].re;
f[0].im=f[1].im=a[0].im;
return;
}
cmplx *o,*e,*ef,*of,omega,omegak,cmu;
o=(cmplx*)malloc((n/2)*sizeof(cmplx));
e=(cmplx*)malloc((n/2+n%2)*sizeof(cmplx));
of=(cmplx*)malloc(n*sizeof(cmplx));
ef=(cmplx*)malloc(n*sizeof(cmplx));
int i,j;
for(i=0,j=0;j<n;i++,j+=2) {
e[i].re=a[j].re;
o[i].re=a[j+1].re;
}
fft(o,n/2,of);
fft(e,n/2+n%2,ef);
omega.re=cos(pi/n);
omega.im=sin(pi/n);
omegak.re=1;omegak.im=0;
for(i=0;i<n;i++) {
cmu=cmul(omegak,of[i]);
f[i].re=ef[i].re+cmu.re;
f[i].im=ef[i].im+cmu.im;
f[i+n].re=ef[i].re-cmu.re;
f[i+n].im=ef[i].im-cmu.im;
omegak=cmul(omega,omegak);
}
}
//vector cross product
//use the MAC mode of the hardware multiplier
VEC_INT* ivec_cross(VEC_INT* a,const VEC_INT* b){
//temp variables for Y and Y
SCL_INT xt,yt;
//xt=a->c.y*b->c.z - a->c.z*b->c.y;
xt=cmul(a->c.y,b->c.z,a->c.z,b->c.y);
//y component
//yt=a->c.z*b->c.x - a->c.x*b->c.z;
yt=cmul(a->c.z,b->c.x,a->c.x,b->c.z);
//Z can be set directly because the other components are calculated
a->c.z=cmul(a->c.x,b->c.y,a->c.y,b->c.x);
a->c.x=xt;
a->c.y=yt;
//a->c.z=a->c.x*b->c.y - a->c.y*b->c.x;
return a;
}
/* c <- a - s*b, matrices */
void c_scalar_mult_sub_su3mat( su3_matrix *a, su3_matrix *b, complex *s,
su3_matrix *c){
#ifndef NATIVEDOUBLE
register int i,j;
complex t;
for(i=0;i<3;i++)for(j=0;j<3;j++){
t = cmul(&b->e[i][j], s);
c->e[i][j] = csub(&a->e[i][j], &t);
}
#else
register int i,j;
register double sr,si,br,bi,cr,ci;
sr = (*s).real; si = (*s).imag;
for(i=0;i<3;i++)for(j=0;j<3;j++){
br=b->e[i][j].real; bi=b->e[i][j].imag;
cr = sr*br - si*bi;
ci = sr*bi + si*br;
c->e[i][j].real = a->e[i][j].real - cr;
c->e[i][j].imag = a->e[i][j].imag - ci;
}
#endif
}
void fft_scope::addElement (DSPCOMPLEX x) {
int32_t i;
DSPFLOAT multiplier = (DSPFLOAT)segmentSize / displaySize;
//
inputBuffer [fillPointer] = x;
fillPointer = (fillPointer + 1) % spectrumFillpoint;
if (++ sampleCounter < segmentSize)
return;
sampleCounter = 0;
for (i = 0; i < spectrumFillpoint; i ++) {
DSPCOMPLEX tmp = inputBuffer [(fillPointer + i) % spectrumFillpoint];
spectrumBuffer [i] = cmul (tmp, multiplier * Window [i]);
}
for (i = spectrumFillpoint; i < spectrumSize; i ++)
spectrumBuffer [i] = 0;
spectrum_fft -> do_FFT ();
mapSpectrumtoDisplay (zoomingLevel, zoomingPoint);
doAverage ();
showSpectrum ();
}
void c_scalar_mult_sub_su3vec( su3_vector *v1, complex *phase, su3_vector *v2 ){
#ifndef NATIVEDOUBLE
register int i;
complex t;
for(i=0;i<3;i++){
t = cmul(&v2->c[i],phase);
v1->c[i] = csub(&v1->c[i],&t);
}
#else
register int i;
register double sr,si,br,bi,cr,ci;
sr = (*phase).real; si = (*phase).imag;
for(i=0;i<3;i++){
br=v2->c[i].real; bi=v2->c[i].imag;
cr = sr*br - si*bi;
ci = sr*bi + si*br;
v1->c[i].real -= cr;
v1->c[i].imag -= ci;
}
#endif
}
void mul(int a[],int b[],int c[],int n) {
cmplx *aco,*bco,*af,*bf,*cf,*cco,cmu;
aco=(cmplx*)malloc(n*sizeof(cmplx));
bco=(cmplx*)malloc(n*sizeof(cmplx));
af=(cmplx*)malloc(2*n*sizeof(cmplx));
bf=(cmplx*)malloc(2*n*sizeof(cmplx));
cf=(cmplx*)malloc(2*n*sizeof(cmplx));
cco=(cmplx*)malloc(2*n*sizeof(cmplx));
int i;
for(i=0;i<n;i++) {
aco[i].re=a[i];
aco[i].im=0;
bco[i].re=b[i];
bco[i].im=0;
}
fft(aco,n,af);
fft(bco,n,bf);
for(i=0;i<2*n;i++) {
cmu=cmul(af[i],bf[i]);
cf[i].re=cmu.re;
cf[i].im=cmu.im;
}
ifft(cf,2*n,cco);
for(i=0;i<n;i++) {
cco[i].re/=n;
cco[i].im/=n;
}
for(i=0;i<n;i++) {
printf("\n%f %f",cco[i].re,cco[i].im);
}
}
static void tabulate_eir(int natom, rvec x[], int kmax, cvec **eir, rvec lll)
{
int i, j, m;
if (kmax < 1)
{
printf("Go away! kmax = %d\n", kmax);
exit(1);
}
for (i = 0; (i < natom); i++)
{
for (m = 0; (m < 3); m++)
{
eir[0][i][m].re = 1;
eir[0][i][m].im = 0;
}
for (m = 0; (m < 3); m++)
{
eir[1][i][m].re = cos(x[i][m]*lll[m]);
eir[1][i][m].im = sin(x[i][m]*lll[m]);
}
for (j = 2; (j < kmax); j++)
{
for (m = 0; (m < 3); m++)
{
eir[j][i][m] = cmul(eir[j-1][i][m], eir[1][i][m]);
}
}
}
}
int main()
{
complex temp, z, prod;
double radius;
FILE *outfile;
int n;
char filename[100];
temp.re = 1.0; temp.im = .05;
z = rdiv(temp,cnorm(temp));
prod.re = 1.0; prod.im = 0.0;
printf("Enter radius parameter:\n");
scanf("%lf", &radius);
printf("radius = %f\n", radius);
z = rmul(radius,z);
sprintf(filename,"cmultest_r%.2f.dat", radius);
printf("Data stored in %s\n", filename);
outfile = fopen(filename, "w");
for(n=0; n<120; n++)
{
fprintf(outfile,"%f\t%f\n", prod.re, prod.im); /* print results */
prod = cmul(prod, z);
}
return(0);
}
void conv(Complex a[], Complex b[], int len) {
int i;
fft(a, len, 1);
fft(b, len, 1);
for (i = 0; i < len; i++)
a[i] = cmul(a[i], b[i]);
fft(a, len, -1);
}
int32_t cardReader::getSamples (DSPCOMPLEX *b, int32_t a, uint8_t m) {
int32_t i, n;
DSPCOMPLEX temp [a];
readerOwner. lock ();
n = myReader -> getSamples (temp, a, m);
readerOwner. unlock ();
for (i = 0; i < n; i ++)
b [i] = cmul (temp [i], float (gainValue) / 100);
return n;
}
void virtualReader::convertandStore (DSPCOMPLEX *s, int32_t amount) {
int32_t i, j;
for (i = 0; i < amount; i ++) {
inTable [conv++] = s [i];
if (conv >= inSize) { // full buffer, map
for (j = 0; j < outSize - 1; j ++) {
int16_t base = (int)(floor (mapTable [j]));
float frac = mapTable [j] - base;
outTable [j] = cmul (inTable [base], 1 - frac) +
cmul (inTable [base + 1], frac);
}
//
// let op, het laatste element was nog niet gebruikta
conv = 1;
inTable [0] = inTable [inSize - 1];
theBuffer -> putDataIntoBuffer (outTable, outSize - 1);
}
}
}
void gaussj(complex_dble **a, int n,complex_dble **b,int m)
{
int *indxc,*indxr,*ipiv;
int i,icol,irow,j,k,l,ll;
double big;
complex_dble dum,pivinv,c;
indxc=ivector(1,n);
indxr=ivector(1,n);
ipiv=ivector(1,n);
for (j=1;j<=n;j++) ipiv[j]=0;
for (i=1;i<=n;i++) {
big=0.0;
for (j=1;j<=n;j++)
if (ipiv[j] != 1)
for (k=1;k<=n;k++) {
if (ipiv[k] == 0) {
if (cabs(a[j][k]) >= big) {
big=cabs(a[j][k]);
irow=j;
icol=k;
}
} else if (ipiv[k] > 1) nrerror("GAUSSJ: Singular Matrix-1");
}
++(ipiv[icol]);
if (irow != icol) {
for (l=1;l<=n;l++) SWAP(a[irow][l],a[icol][l])
for (l=1;l<=m;l++) SWAP(b[irow][l],b[icol][l])
}
indxr[i]=irow;
indxc[i]=icol;
if ((a[icol][icol].re == 0.0)&&(a[icol][icol].im == 0.0))
nrerror("GAUSSJ: Singular Matrix-2");
pivinv.re=cinv(a[icol][icol]);
a[icol][icol].re=1.0;
a[icol][icol].im=0.0;
for (l=1;l<=n;l++) a[icol][l] = cmul(a[icol][l],pivinv);
for (l=1;l<=m;l++) b[icol][l] = cmul(b[icol][l],pivinv);
for (ll=1;ll<=n;ll++)
if (ll != icol) {
dum.re=a[ll][icol].re;
dum.im=a[ll][icol].im;
a[ll][icol].re=0.0;
a[ll][icol].im=0.0;
for (l=1;l<=n;l++) {
c.re=a[ll][icol].re;
c.im=a[ll][icol].im;
a[ll][l].re = c.re-cmul(c,dum);
a[ll][l].im = c.im-cmul(c,dum);
}
for (l=1;l<=m;l++)
c.re=b[ll][icol].re;
c.im=b[ll][icol].im;
b[ll][l].re = c.re-cmul(c,dum);
b[ll][l].im = c.im-cmul(c,dum);
}
}
}
int32_t eladHandler::getSamples (DSPCOMPLEX *V, int32_t size, uint8_t Mode) {
int32_t amount, i;
uint8_t buf [iqSize * size];
if (!deviceOK)
return 0;
amount = _I_Buffer -> getDataFromBuffer (buf, iqSize * size);
for (i = 0; i < amount / iqSize; i ++) {
switch (conversionNumber) {
case 1: default:
V [i] = cmul (makeSample_31bits (&buf [iqSize * i]),
attenuation / 100.0);
break;
case 2:
V [i] = cmul (makeSample_30bits (&buf [iqSize * i]),
attenuation / 100.0);
break;
case 3:
V [i] = cmul (makeSample_15bits (&buf [iqSize * i]),
attenuation / 100.0);
break;
}
switch (Mode) {
default:
case IandQ:
break;
case QandI:
V [i] = DSPCOMPLEX (imag (V [i]), real (V [i]));
break;
}
}
return amount / iqSize;
}
//Processing when import frame
void frame_in(){
int k,n;
float mag;
for(k=0;k<FFTLEN;k++){
buffer[k]=cmplx(inframe[k],0);
}
//perform FFT
fft(FFTLEN,buffer);
//rotate every 2.5s
n=rotate_inteval*FSAMP*OVERSAMP/FFTLEN;
if(i== n){
M4=M3;
M3=M2;
M2=M1;
M1=M4;
i=0;
}
//Import to M1
if(i==0){
for(k=0;k<FFTLEN;k++){
M1[k]=cabs(buffer[k]);
}
}
else{
if(lpf_switch==0){
for(k=0;k<FFTLEN;k++){
mag=cabs(buffer[k]);
if(M1[k]>mag){
M1[k]=mag;
}
}
}
else{
for(k=0;k<FFTLEN;k++){
if(lpf_power_switch==1){
mag=cabs(cmul(buffer[k],buffer[k]));
M1[k]=sqrt((1-lpf_weight)*mag+lpf_weight*(M1[k]*M1[k]));
}
else{
mag=cabs(buffer[k]);
M1[k]=(1-lpf_weight)*mag+lpf_weight*M1[k];
}
}
}
}
}
static inline complex mixer(struct trx *trx, complex in)
{
struct feld *s = (struct feld *) trx->modem;
complex z;
c_re(z) = cos(s->rxphacc);
c_im(z) = sin(s->rxphacc);
z = cmul(z, in);
s->rxphacc -= 2.0 * M_PI * trx->frequency / SampleRate;
if (s->rxphacc > M_PI)
s->rxphacc -= 2.0 * M_PI;
else if (s->rxphacc < M_PI)
s->rxphacc += 2.0 * M_PI;
return z;
}
int main(void) {
char Choice;
short int a,b;
unsigned short int x,q;
unsigned char y,r;
long int c;
instruction();
printf("\nChoice:");
Choice=getchar();
getchar();
while(Choice!='0') {
switch(Choice) {
case '5':
printf("Input two 16-bit short ints:\n");
scanf("%d%d",&a,&b);
c=cmul(a,b);
printf("%d * %d = %d\n",a,b,c);
break;
case '6':
printf("Input a 16-bit unsigned short int and a 8-bit unsigned int:\n");
scanf("%d%d",&x,&y);
if(!y)
printf("Divisor should be positive.\n");
else {
cdiv(x,y,&q,&r);
printf("%d / %d = %d remains %d\n",x,y,q,r);
}
break;
default:
printf("Wrong choice number!\n\n");
instruction();
}
printf("\nChoice:");
do {
Choice=getchar();
} while(Choice>'9'||Choice<'0');
}
}
//reduce noise using noise buffer
void noise_reduction(){
int k;
float a,b,gain;
for (k=0;k<FFTLEN;k++)
{
P[k]=(1-lpf_weight)*cabs(buffer[k])+lpf_weight*P[k];
switch(gain_sel){
case 1://enhancement4 trial 1
a=lambda*N[k]/cabs(buffer[k]);
b=1-N[k]/cabs(buffer[k]);
break;
case 2:
a=lambda*P[k]/cabs(buffer[k]);
b=1-N[k]/cabs(buffer[k]);
break;
case 3:
a=lambda*N[k]/P[k];
b=1-N[k]/P[k];
break;
case 4:
a=lambda;
b=1-N[k]/P[k];
break;
case 5: //enhancement5
a=lambda;
b=sqrt(1-N[k]*N[k]/cabs(cmul(buffer[k],buffer[k])));
break;
default://no enhancement
a=lambda;
b=1-N[k]/cabs(buffer[k]);
break;
}
gain=a;
if(a<b){
gain=b;
}
buffer[k] = rmul(gain,buffer[k]);
}
ifft(FFTLEN,buffer);
}
/*
* Filter with fast convolution (overlap-add algorithm).
*/
gint fftfilt_run(struct fftfilt *s, complex in, complex **out)
{
gint i;
/* collect filterlen/2 input samples */
s->fft->in[s->inptr++] = in;
if (s->inptr < s->filterlen / 2)
return 0;
/* FFT */
fft_run(s->fft);
/* multiply with the filter shape */
for (i = 0; i < s->filterlen; i++)
s->ift->in[i] = cmul(s->fft->out[i], s->filter[i]);
/* IFFT */
fft_run(s->ift);
/* overlap and add */
for (i = 0; i < s->filterlen / 2; i++) {
c_re(s->ift->out[i]) += c_re(s->ovlbuf[i]);
c_im(s->ift->out[i]) += c_im(s->ovlbuf[i]);
}
*out = s->ift->out;
/* save the second half for overlapping */
for (i = 0; i < s->filterlen / 2; i++) {
c_re(s->ovlbuf[i]) = c_re(s->ift->out[i + s->filterlen / 2]);
c_im(s->ovlbuf[i]) = c_im(s->ift->out[i + s->filterlen / 2]);
}
/* clear inbuf */
fft_clear_inbuf(s->fft);
s->inptr = 0;
/* signal the caller there is filterlen/2 samples ready */
return s->filterlen / 2;
}
// Passing here is more complex since we
// adapt the filtercoeeficients at the same time
DSPCOMPLEX adaptiveFilter::Pass (DSPCOMPLEX z) {
DSPCOMPLEX tmp = 0;
int16_t i;
DSPFLOAT sum = 0.0;
DSPCOMPLEX refSymbol = Buffer [ip];
/*
* first filter with delayed elements
* Buffer is used in a circular way, with insertion and reading
* differing by firsize
*/
Buffer [ip] = z;
for (i = 0; i < firsize; i ++) {
int16_t index = (ip - i);
if (index < 0)
index += firsize;
tmp += cmul (Buffer [index], Kernel [i]);
}
ip = (ip + 1);
if (ip >= firsize)
ip = 0;
//
// determine the error
err = abs (refSymbol) - abs (tmp);
// err = (real (z) - real (tmp)) + (imag (z) - imag (tmp));
/*
* ... and adapt the kernel elements accordingly
*/
for (i = 0; i < firsize; i ++) {
Kernel [i] = 0.99 * Kernel [i] + 2.0 * mu * err * real (z);
sum += Kernel [i];
}
for (i = 0; i < firsize; i ++)
Kernel [i] /= sum;
return tmp;
}
void gft_1dComplex64(double *signal, unsigned int N, double *win, int *pars, int stride) {
int fstart, fend, fcount;
double *fband;
int i;
// Do the initial FFT of the signal
fft(N, signal, stride);
// Apply the windows
for (i=0; i<N*2; i+=2) {
cmul(signal+i*stride,win+i);
}
// For each of the GFT frequency bands
fcount = 0;
fstart = 0;
while (pars[fcount] >= 0) {
fend = pars[fcount];
// frequency band that we're working with
fband = signal+fstart*2*stride;
// inverse FFT to transform to S-space
ifft(fend-fstart, fband, stride);
fstart = pars[fcount];
fcount++;
}
}
extern "C" void positionKernel(const Range& globalID,const Range& localID,CPUImage<Complex>& image,Type& offsetReal,Type& offsetImag,Complex& scaleFactor){
int w = image.getWidth();
int h = image.getHeight();
Complex offset ={
offsetReal, offsetImag
};
float fx = globalID.x, fy = globalID.y;
if(MULTISAMPLING_ENABLED){
uint64_t seed = globalID.x + globalID.y + localID.x + localID.y;
if(MULTISAMPLING_PATTERN == JITTERING){
float xR = uint32_t(seed = random(seed)) / (float)UINT_MAX;
float yR = uint32_t(seed = random(seed)) / (float)UINT_MAX;
fx += xR - 0.5;
fy += yR - 0.5;
}
}
Complex pos = {
floatToType(2 * (fx - w/2) / w),
floatToType(2 * (fy - h/2) / h * (float)h/w)
};
image.at(globalID.x,globalID.y) = cadd(cmul(scaleFactor,pos),offset);
}
/************************PSPI migration************************/
void pspimig(float **data,complex **image,float **v,int nt,int nx,int nz,float dt,float dx, float dz)
{
int ntfft; /*number of samples of the zero padded trace*/
int nxfft;
int nw; /*number of temporal freqs.*/
int it; /*loop index over time sample*/
int ix; /*loop index over midpoint sample*/
int iw; /*loop index over frequency*/
int ik; /*loop index over wavenumber*/
int iz; /*loop index over migrated depth samples*/
int iv; /*loop index over reference velocities*/
int nvref_max=8; /*number of reference velocities in each layer*/
int nvref;
int i1; /*nearest reference velocity*/
int i2;
int iw1;
int iw2;
float **vref; /*2D reference velocity array*/
float w0; /*first frequency sample*/
float w; /*frequency*/
float dw; /*frequency sampling interval*/
float k0; /*first wavenumber*/
float k;
float dk; /*wave number sampling interval in x*/
float dv; /*velocity interval*/
float *in; /*input 1D data in FFTW*/
float **cpdata;
float phase;
float wv;
float vmin;
float vmax;
float f1 = 1.0;
float f2 = 35.0;
complex *out; /*output of 1D FFT using FFTW*/
complex **datawx; /*data in frequency-wavenumber domain*/
complex *in2;
complex *out2;
complex *in3;
complex *out3;
complex **Pkv; /*wavefield in k-v*/
complex **Pxv; /*wavefield in x-v*/
complex **Pwx; /*wavefield in w-x*/
complex cshift;
complex tmp_a;
complex tmp_b;
fftwf_plan p1;
fftwf_plan p2;
fftwf_plan p3;
/*allocate memory of reference velocities*/
vref = alloc2float(nz,nvref_max); /*allocate 2D array for reference velocity to avoid changing memory of vector*/
/*nz by nvref_max*/
for (ix=0;ix<nx;ix++){
for (iz=0;iz<nz;iz++){
image[ix][iz] = cmplx(0.0,0.0); /*nz by nz*/
}
}
/*devide velocity by 2 for downward continuation*/
for (iz=0;iz<nz;iz++){
for (ix=0;ix<nx;ix++){
v[ix][iz]=v[ix][iz]/2.0;
}
}
/*fprintf(stderr,"nx=%d nz=%d",nx,nz);
FILE *Fvp = fopen("vel.bin", "wb");
fwrite(v[0],1,4*nx*nz,Fvp);
fclose(Fvp);*/
/*zero padding in termporal direction*/
ntfft = 1.0*exp2(ceil(log2(nt))); /*number of zero padded trace in FFT*/
nw = ntfft/2+1; /*number of points of frequency axis after FFTW*/
cpdata = alloc2float(ntfft,nx); /*data after zero padding*/
for (ix=0;ix<nx;ix++){
for (it=0;it<ntfft;it++){
if(it<=nt) cpdata[ix][it] = data[ix][it];
else {cpdata[ix][it] = 0.0;
}
}
}
/*allocate memory for w-x domain data*/
datawx = alloc2complex(nw,nx); /*w-x data nx by nw*/
iw1 = floor(f1*dt*ntfft)+1;
iw2 = floor(f2*dt*ntfft)+1;
/*define plans for FFT using FFTW*/
/*plan 1 from t-x to w-x*/
in = alloc1float(ntfft);
out = alloc1complex(nw);
p1 = fftwf_plan_dft_r2c_1d(ntfft,in,(fftwf_complex*)out,FFTW_ESTIMATE); /*real to complex*/
/*plan 2 from w-x to w-k*/
nxfft = 1.0*exp2(ceil(log2(nx)));
in2 = alloc1complex(nxfft);
out2 = alloc1complex(nxfft);
p2 = fftwf_plan_dft_1d(nxfft,(fftwf_complex*)in2,(fftwf_complex*)out2,FFTW_FORWARD,FFTW_ESTIMATE);
/*plan 3 from w-k to w-x*/
in3 = alloc1complex(nxfft);
out3 = alloc1complex(nxfft);
p3 = fftwf_plan_dft_1d(nxfft,(fftwf_complex*)in3,(fftwf_complex*)out3,FFTW_BACKWARD,FFTW_ESTIMATE);
Pxv = alloc2complex(nvref_max,nxfft);
Pkv = alloc2complex(nvref_max,nxfft);
Pwx = alloc2complex(nw,nxfft);
/*apply first 1-D Fourier transform on data from t-x to w-x using FFTW package*/
for (ix=0;ix<nx;ix++){
for(it=0;it<ntfft;it++){
in[it] = cpdata[ix][it]; /*assign one trace to a vector*/
}
fftwf_execute(p1);
for(iw=0;iw<nw;iw++){
datawx[ix][iw] = cdiv(out[iw], cmplx(sqrt(ntfft), 0.0));
} /*w*/
} /*x*/
fftwf_destroy_plan(p1);
/*determine frequency and wavenumber axis*/
dw = 2.0*PI/(ntfft*dt); /*frequency sampling interval*/
w0 = 0.0; /*first frequency sample*/
dk = 2.0*PI/(nxfft*dx); /*wavenumber sampling interval*/
k0 = 0.0; /*first wavenumber sample*/
/*initialization of downward wavefield*/
for (iw=0;iw<nw;iw++){
for (ix=0;ix<nxfft;ix++){
if (ix<nx){Pwx[ix][iw] = datawx[ix][iw];}
else{Pwx[ix][iw] = cmplx(0.0,0.0);}
}
}
/*loop over depth z*/
for (iz=0;iz<nz;iz++){
fprintf(stderr,"depth sample %d\n",iz);
/*calculate reference velocities of each layer*/
vmin = v[0][iz];
vmax = v[0][iz];
for (ix=0;ix<nx;ix++){
if(v[ix][iz]>=vmax) vmax=v[ix][iz]; /*get the maximum velocity*/
if(v[ix][iz]<=vmin) vmin=v[ix][iz]; /*get the minimum velocity*/
}
dv = (vmax-vmin)/(nvref_max-1);
if(dv/vmax<=0.001){
nvref = 1;
vref[0][iz]=(vmin+vmax)/2;
}
else
{
nvref = nvref_max;
for (iv=0;iv<nvref_max;iv++)
{
vref[iv][iz] = vmin+dv*iv;
}
}
/*loop over frequencies*/
w = w0;
for (iw=iw1;iw<=iw2;iw++){
w = w0 + iw*dw; /*frequency axis (important)*/
/*apply phase-shift in w-x (optional)*/
/*datawx*/
/*Apply second FFT to tranform w-x data to w-k domain using FFTW*/
for (ix=0;ix<nxfft;ix++){
in2[ix] = Pwx[ix][iw];
}
fftwf_execute(p2);
for (ik=0;ik<nxfft;ik++){
out2[ik] = cdiv(out2[ik], cmplx(sqrt(nxfft), 0.0));
}
/*loop over wavenumbers*/
k = k0;
for (ik=0;ik<nxfft;ik++){
if (ik<=nxfft/2){
k = ik*dk; /*wavenumber axis (important)*/
}
else{
k = (ik-nxfft)*dk;
}
/*loop over reference velocities*/
for (iv=0;iv<nvref;iv++){
wv = w/vref[iv][iz];
if(wv>fabs(k)){ /*note that k can be negative*/
phase = sqrt(wv*wv-k*k)*dz;
cshift = cmplx(cos(phase),sin(phase));
}
else{
cshift = cmplx(0.0,0.0);
}
Pkv[ik][iv] = cmul(out2[ik],cshift);
} /*end for v*/
} /*end for k*/
/*from w-k go back to w-x domain*/
for (iv=0;iv<nvref;iv++){ /*inverse FFT for each velocity*/
for (ik=0;ik<nxfft;ik++){
in3[ik] = Pkv[ik][iv];
} /*end for k*/
fftwf_execute(p3);
for (ix=0;ix<nxfft;ix++){
Pxv[ix][iv] = cdiv(out3[ix], cmplx(sqrt(nxfft), 0.0));
} /*end for x*/
} /*end for v*/ /*Pxv ix by iv*/
/*interpolation of wavefield in w-x*/
if (nvref==1){
for (ix=0;ix<nx;ix++){
Pwx[ix][iw] = Pxv[ix][0];
}
}
else
{
for (ix=0;ix<nx;ix++){
if (v[ix][iz]==vmax){i1=(v[ix][iz]-vmin)/dv-1;}
else
{i1 = (v[ix][iz]-vmin)/dv;} /*find nearest reference velocity and wavefield*/
i2 = i1+1;
tmp_a = cadd(crmul(Pxv[ix][i1], vref[i2][iz]-v[ix][iz]) , crmul(Pxv[ix][i2], v[ix][iz]-vref[i1][iz]));
tmp_b = cmplx(vref[i2][iz]-vref[i1][iz], 0.0);
Pwx[ix][iw] = cdiv(tmp_a,tmp_b);
} /*interpolate wavefield*/
} /*end else*/
/*imaging condition*/
for (ix=0;ix<nx;ix++){
image[ix][iz] = cadd(image[ix][iz],Pwx[ix][iw]);
}
/*zero padding*/
for (ix=nx;ix<nxfft;ix++){
Pwx[ix][iw] = cmplx(0.0,0.0);
}
} /*w*/
} /*z*/
fftwf_destroy_plan(p2);
fftwf_destroy_plan(p3);
} /*end pspimig migration function*/
int ChebyshevFilter::zplna()
{
cmplx r, cnum, cden, cwc, ca, cb, b4ac;
double C;
if( kind == 3 )
C = c;
else
C = wc;
for( i=0; i<ARRSIZ; i++ )
{
z[i].r = 0.0;
z[i].i = 0.0;
}
nc = np;
jt = -1;
ii = -1;
for( icnt=0; icnt<2; icnt++ )
{
/* The maps from s plane to z plane */
do
{
ir = ii + 1;
ii = ir + 1;
r.r = zs[ir];
r.i = zs[ii];
switch( type )
{
case 1:
case 3:
/* Substitute s - r = s/wc - r = (1/wc)(z-1)/(z+1) - r
*
* 1 1 - r wc ( 1 + r wc )
* = --- -------- ( z - -------- )
* z+1 wc ( 1 - r wc )
*
* giving the root in the z plane.
*/
cnum.r = 1 + C * r.r;
cnum.i = C * r.i;
cden.r = 1 - C * r.r;
cden.i = -C * r.i;
jt += 1;
cdiv( &cden, &cnum, &z[jt] );
if( r.i != 0.0 )
{
/* fill in complex conjugate root */
jt += 1;
z[jt].r = z[jt-1 ].r;
z[jt].i = -z[jt-1 ].i;
}
break;
case 2:
case 4:
/* Substitute s - r => s/wc - r
*
* z^2 - 2 z cgam + 1
* => ------------------ - r
* (z^2 + 1) wc
*
* 1
* = ------------ [ (1 - r wc) z^2 - 2 cgam z + 1 + r wc ]
* (z^2 + 1) wc
*
* and solve for the roots in the z plane.
*/
if( kind == 2 )
cwc.r = cbp;
else
cwc.r = c;
cwc.i = 0.0;
cmul( &r, &cwc, &cnum ); /* r wc */
csub( &cnum, &cone, &ca ); /* a = 1 - r wc */
cmul( &cnum, &cnum, &b4ac ); /* 1 - (r wc)^2 */
csub( &b4ac, &cone, &b4ac );
b4ac.r *= 4.0; /* 4ac */
b4ac.i *= 4.0;
cb.r = -2.0 * cgam; /* b */
cb.i = 0.0;
cmul( &cb, &cb, &cnum ); /* b^2 */
csub( &b4ac, &cnum, &b4ac ); /* b^2 - 4 ac */
csqrt( &b4ac, &b4ac );
cb.r = -cb.r; /* -b */
cb.i = -cb.i;
ca.r *= 2.0; /* 2a */
ca.i *= 2.0;
cadd( &b4ac, &cb, &cnum ); /* -b + sqrt( b^2 - 4ac) */
cdiv( &ca, &cnum, &cnum ); /* ... /2a */
jt += 1;
cmov( &cnum, &z[jt] );
if( cnum.i != 0.0 )
{
jt += 1;
z[jt].r = cnum.r;
z[jt].i = -cnum.i;
}
if( (r.i != 0.0) || (cnum.i == 0) )
{
csub( &b4ac, &cb, &cnum ); /* -b - sqrt( b^2 - 4ac) */
cdiv( &ca, &cnum, &cnum ); /* ... /2a */
jt += 1;
cmov( &cnum, &z[jt] );
if( cnum.i != 0.0 )
{
jt += 1;
z[jt].r = cnum.r;
z[jt].i = -cnum.i;
}
}
} /* end switch */
}
while( --nc > 0 );
if( icnt == 0 )
{
zord = jt+1;
if( nz <= 0 )
{
if( kind != 3 )
return(0);
else
break;
}
}
nc = nz;
} /* end for() loop */
return 0;
}
real do_ewald(FILE *log, bool bVerbose,
t_inputrec *ir,
rvec x[], rvec f[],
real charge[], rvec box,
t_commrec *cr, t_nsborder *nsb,
matrix lrvir, real ewaldcoeff)
{
static bool bFirst = TRUE;
static int nx,ny,nz,kmax;
static cvec **eir;
static t_complex *tab_xy,*tab_qxyz;
real factor=-1.0/(4*ewaldcoeff*ewaldcoeff);
real energy;
rvec lll;
int lowiy,lowiz,ix,iy,iz,n;
real tmp,cs,ss,ak,akv,mx,my,mz,m2;
if (bFirst) {
if (bVerbose)
fprintf(log,"Will do ordinary reciprocal space Ewald sum.\n");
if (cr != NULL) {
if (cr->nnodes > 1 || cr->nthreads>1)
fatal_error(0,"No parallel Ewald. Use PME instead.\n");
}
nx = ir->nkx+1;
ny = ir->nky+1;
nz = ir->nkz+1;
kmax = max(nx,max(ny,nz));
snew(eir,kmax);
for(n=0;n<kmax;n++)
snew(eir[n],HOMENR(nsb));
snew(tab_xy,HOMENR(nsb));
snew(tab_qxyz,HOMENR(nsb));
bFirst = FALSE;
}
clear_mat(lrvir);
calc_lll(box,lll);
/* make tables for the structure factor parts */
tabulate_eir(HOMENR(nsb),x,kmax,eir,lll);
lowiy=0;
lowiz=1;
energy=0;
for(ix=0;ix<nx;ix++) {
mx=ix*lll[XX];
for(iy=lowiy;iy<ny;iy++) {
my=iy*lll[YY];
if(iy>=0)
for(n=0;n<HOMENR(nsb);n++)
tab_xy[n]=cmul(eir[ix][n][XX],eir[iy][n][YY]);
else
for(n=0;n<HOMENR(nsb);n++)
tab_xy[n]=conjmul(eir[ix][n][XX],eir[-iy][n][YY]);
for(iz=lowiz;iz<nz;iz++) {
mz=iz*lll[ZZ];
m2=mx*mx+my*my+mz*mz;
ak=exp(m2*factor)/m2;
akv=2.0*ak*(1.0/m2-factor);
if(iz>=0)
for(n=0;n<HOMENR(nsb);n++)
tab_qxyz[n]=rcmul(charge[n],cmul(tab_xy[n],eir[iz][n][ZZ]));
else
for(n=0;n<HOMENR(nsb);n++)
tab_qxyz[n]=rcmul(charge[n],conjmul(tab_xy[n],eir[-iz][n][ZZ]));
cs=ss=0;
for(n=0;n<HOMENR(nsb);n++) {
cs+=tab_qxyz[n].re;
ss+=tab_qxyz[n].im;
}
energy+=ak*(cs*cs+ss*ss);
tmp=akv*(cs*cs+ss*ss);
lrvir[XX][XX]-=tmp*mx*mx;
lrvir[XX][YY]-=tmp*mx*my;
lrvir[XX][ZZ]-=tmp*mx*mz;
lrvir[YY][YY]-=tmp*my*my;
lrvir[YY][ZZ]-=tmp*my*mz;
lrvir[ZZ][ZZ]-=tmp*mz*mz;
for(n=0;n<HOMENR(nsb);n++) {
tmp=ak*(cs*tab_qxyz[n].im-ss*tab_qxyz[n].re);
f[n][XX]+=tmp*mx;
f[n][YY]+=tmp*my;
f[n][ZZ]+=tmp*mz;
}
lowiz=1-nz;
}
lowiy=1-ny;
}
}
tmp=4.0*M_PI/(box[XX]*box[YY]*box[ZZ])*ONE_4PI_EPS0;
for(n=0;n<HOMENR(nsb);n++) {
f[n][XX]*=2*tmp;
f[n][YY]*=2*tmp;
f[n][ZZ]*=2*tmp;
}
lrvir[XX][XX]=-0.5*tmp*(lrvir[XX][XX]+energy);
lrvir[XX][YY]=-0.5*tmp*(lrvir[XX][YY]);
lrvir[XX][ZZ]=-0.5*tmp*(lrvir[XX][ZZ]);
lrvir[YY][YY]=-0.5*tmp*(lrvir[YY][YY]+energy);
lrvir[YY][ZZ]=-0.5*tmp*(lrvir[YY][ZZ]);
lrvir[ZZ][ZZ]=-0.5*tmp*(lrvir[ZZ][ZZ]+energy);
lrvir[YY][XX]=lrvir[XX][YY];
lrvir[ZZ][XX]=lrvir[XX][ZZ];
lrvir[ZZ][YY]=lrvir[YY][ZZ];
energy*=tmp;
return energy;
}
void gazdagvt (float k,
int nt, float dt, float ft,
int ntau, float dtau, float ftau,
float *vt, complex *p, complex *q, float qual, float gainceil)
/*****************************************************************************
Gazdag's phase-shift zero-offset migration for one wavenumber
adapted to v(tau) velocity profile
******************************************************************************
Input:
k wavenumber
nt number of time samples
dt time sampling interval
ft first time sample
ntau number of migrated time samples
dtau migrated time sampling interval
ftau first migrated time sample
vt velocity v[tau]
p array[nt] containing data to be migrated
Output:
q array[ntau] containing migrated data
******************************************************************************/
{
int ntfft,nw,it,itau,iw;
float dw,fw,tmax,w,tau,phase,coss, *cumgain, gain, alpha;
complex cshift,*pp;
/* determine frequency sampling */
ntfft = npfa(nt);
nw = ntfft;
dw = 2.0*PI/(ntfft*dt);
fw = -PI/dt;
/* determine maximum time */
tmax = ft+(nt-1)*dt;
/* allocate workspace */
pp = alloc1complex(nw);
cumgain = alloc1float(nw);
for (iw=0; iw<nw; iw++)
cumgain[iw] = 1.0;
/* pad with zeros and Fourier transform t to w, with w centered */
for (it=0; it<nt; it++)
pp[it] = (it%2 ? cneg(p[it]) : p[it]);
for (it=nt; it<ntfft; it++)
pp[it] = cmplx(0.0,0.0);
pfacc(1,ntfft,pp);
/* account for non-zero ft and non-zero ftau */
for (itau=0 ; itau < ftau ; itau++){
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
if (w==0.0) w = 1e-10/dt;
coss = 1.0-pow(0.5 * vt[itau] * k/w,2.0);
if (coss>=pow(ftau/tmax,2.0)) {
phase = w*(ft-ftau*sqrt(coss));
cshift = cmplx(cos(phase),sin(phase));
pp[iw] = cmul(pp[iw],cshift);
} else {
pp[iw] = cmplx(0.0,0.0);
}
}
}
/* loop over migrated times tau */
for (itau=0,tau=ftau; itau<ntau; itau++,tau+=dtau) {
/* initialize migrated sample */
q[itau] = cmplx(0.0,0.0);
/* loop over frequencies w */
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
/* accumulate image (summed over frequency) */
q[itau] = cadd(q[itau],pp[iw]);
/* compute cosine squared of propagation angle */
if (w==0.0) w = 1e-10/dt;
coss = 1.0-pow(0.5 * vt[itau] * k/w,2.0);
/* if wave could have been recorded in time */
if (coss>=pow(tau/tmax,2.0)) {
/* extrapolate down one migrated time step */
phase = -w*dtau*sqrt(coss);
cshift = cmplx(cos(phase),sin(phase));
/* apply gain until gain ceiling is reached */
if (cumgain[iw] < gainceil) {
alpha = w/(2.0*vt[itau]*qual);
gain = exp(fabs(0.5*vt[itau]*dtau*alpha));
pp[iw] = cmul(pp[iw],crmul(cshift,gain));
cumgain[iw] *= gain;
} else {
pp[iw] = cmplx(0.0,0.0);
}
/* else, if wave couldn't have been recorded in time */
} else {
/* zero the wave */
pp[iw] = cmplx(0.0,0.0);
}
}
/* scale accumulated image just as we would for an FFT */
q[itau] = crmul(q[itau],1.0/nw);
}
/* free workspace */
free1complex(pp);
free1float(cumgain);
}
int
main(int argc, char **argv)
{
float phase; /* phase shift = phasefac*PI */
float power; /* phase shift = phasefac*PI */
register float *rt; /* real trace */
register complex *ct; /* complex transformed trace */
complex *filt; /* complex power */
int nt; /* number of points on input trace */
size_t ntsize; /* nt in bytes */
int ncdp; /* number of cdps specified */
int icdp; /* index into cdp array */
long oldoffset; /* offset of previous trace */
long oldcdp; /* cdp of previous trace */
int newsloth; /* if non-zero, new sloth function was computed */
int jcdp; /* index into cdp array */
float dt; /* sample spacing (secs) on input trace */
float tn; /* sample spacing (secs) on input trace */
float omega; /* circular frequency */
float domega; /* circular frequency spacing (from dt) */
int nfft; /* number of points in nfft */
int ntnmo; /* number of tnmos specified */
float *cdp; /* array[ncdp] of cdps */
float *vnmo; /* array[nvnmo] of vnmos */
float *ovvt; /* array[nvnmo] of vnmos */
int nvnmo; /* number of tnmos specified */
float *fnmo; /* array[ntnmo] of tnmos */
float **ovv; /* array[nf] of fnmos */
float doffs; /* offset */
float acdp; /* temporary used to sort cdp array */
float *aovv; /* temporary used to sort ovv array */
int invert; /* if non-zero, do invers DLMO */
int cm; /* if non-zero, the offset in cm */
int nf; /* number of frequencies (incl Nyq) */
int it; /* number of frequencies (incl Nyq) */
float onfft; /* 1 / nfft */
float v; /* velocity */
size_t nzeros; /* number of padded zeroes in bytes */
/* Initialize */
initargs(argc, argv);
requestdoc(1);
/* Set parameters */
power=0.0;
/* Get info from first trace*/
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
if (!getparfloat("dt", &dt)) dt = ((double) tr.dt)/1000000.0;
if (!dt) err("dt field is zero and not getparred");
ntsize = nt * FSIZE;
if (!getparint("invert",&invert)) invert = 0;
if (!getparint("cm",&cm)) cm = 0;
/* Set up for fft */
nfft = npfaro(nt, LOOKFAC * nt);
if (nfft >= SU_NFLTS || nfft >= PFA_MAX)
err("Padded nt=%d -- too big", nfft);
nf = nfft/2 + 1;
onfft = 1.0 / nfft;
nzeros = (nfft - nt) * FSIZE;
domega = TWOPI * onfft / dt;
/* get velocity functions, linearly interpolated in frequency */
ncdp = countparval("cdp");
if (ncdp>0) {
if (countparname("vnmo")!=ncdp)
err("a vnmo array must be specified for each cdp");
if (countparname("fnmo")!=ncdp)
err("a tnmo array must be specified for each cdp");
} else {
ncdp = 1;
if (countparname("vnmo")>1)
err("only one (or no) vnmo array must be specified");
if (countparname("fnmo")>1)
err("only one (or no) tnmo array must be specified");
}
cdp = ealloc1float(ncdp);
if (!getparfloat("cdp",cdp)) cdp[0] = tr.cdp;
ovv = ealloc2float(nf,ncdp);
for (icdp=0; icdp<ncdp; ++icdp) {
nvnmo = countnparval(icdp+1,"vnmo");
ntnmo = countnparval(icdp+1,"fnmo");
if (nvnmo!=ntnmo && !(ncdp==1 && nvnmo==1 && ntnmo==0))
err("number of vnmo and tnmo values must be equal");
if (nvnmo==0) nvnmo = 1;
if (ntnmo==0) ntnmo = nvnmo;
/* equal numbers of parameters vnmo, fnmo */
vnmo = ealloc1float(nvnmo);
fnmo = ealloc1float(nvnmo);
if (!getnparfloat(icdp+1,"vnmo",vnmo)) vnmo[0] = 400.0;
if (!getnparfloat(icdp+1,"fnmo",fnmo)) fnmo[0] = 0.0;
for (it=0; it<ntnmo; ++it)
fnmo[it]*=TWOPI;
for (it=1; it<ntnmo; ++it)
if (fnmo[it]<=fnmo[it-1])
err("tnmo values must increase monotonically");
for (it=0,tn=0; it<nf; ++it,tn+=domega) {
intlin(ntnmo,fnmo,vnmo,vnmo[0],vnmo[nvnmo-1],1,&tn,&v);
ovv[icdp][it] = 1.0/(v);
}
free1float(vnmo);
free1float(fnmo);
}
/* sort (by insertion) sloth and anis functions by increasing cdp */
for (jcdp=1; jcdp<ncdp; ++jcdp) {
acdp = cdp[jcdp];
aovv = ovv[jcdp];
for (icdp=jcdp-1; icdp>=0 && cdp[icdp]>acdp; --icdp) {
cdp[icdp+1] = cdp[icdp];
ovv[icdp+1] = ovv[icdp];
}
cdp[icdp+1] = acdp;
ovv[icdp+1] = aovv;
}
/* allocate workspace */
ovvt = ealloc1float(nf);
/* interpolate sloth and anis function for first trace */
interpovv(nf,ncdp,cdp,ovv,(float)tr.cdp,ovvt);
/* set old cdp and old offset for first trace */
oldcdp = tr.cdp;
oldoffset = tr.offset-1;
/* Allocate fft arrays */
rt = ealloc1float(nfft);
ct = ealloc1complex(nf);
filt = ealloc1complex(nf);
/* Loop over traces */
do {
/* if necessary, compute new sloth and anis function */
if (tr.cdp!=oldcdp && ncdp>1) {
interpovv(nt,ncdp,cdp,ovv,(float)tr.cdp,
ovvt);
newsloth = 1;
} else {
newsloth = 0;
}
/* if sloth and anis function or offset has changed */
if (newsloth || tr.offset!=oldoffset) {
doffs = (fabs)((float)(tr.offset));
if (cm==1) doffs/=100;
/* Load trace into rt (zero-padded) */
memcpy( (void *) rt, (const void *) tr.data, ntsize);
memset((void *) (rt + nt), (int) '\0', nzeros);
/* FFT */
pfarc(1, nfft, rt, ct);
/* Apply filter */
{ register int i;
for (i = 0; i < nf; ++i){
omega = i * domega;
if (power < 0 && i == 0) omega = FLT_MAX;
if (invert==0)
phase = -1.0*omega*ovvt[i]*doffs;
else
phase = 1.0*omega*ovvt[i]*doffs;
/* filt[i] = cmplx(cos(phase),sin(phase)); */
filt[i] = cwp_cexp(crmul(I,phase));
filt[i] = crmul(filt[i], onfft);
ct[i] = cmul(ct[i], filt[i]);
}
}
}
/* Invert */
pfacr(-1, nfft, ct, rt);
/* Load traces back in, recall filter had nfft factor */
{ register int i;
for (i = 0; i < nt; ++i) tr.data[i] = rt[i];
}
puttr(&tr);
} while (gettr(&tr));
return EXIT_SUCCESS;
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx; /* number of horizontal samples */
int nxshot; /* number of shots to be migrated */
/*int nxshot_orig;*/ /* first value of nxshot */
int iz,iw,ix,it; /* loop counters */
int igx; /* integerized gx value */
int ntfft; /* fft size */
int nw,truenw; /* number of wave numbers */
int dip=79; /* dip angle */
float sx,gx; /* x source and geophone location */
float gxmin=0.0,gxmax=0.0; /* x source and geophone location */
float min_sx_gx; /* min(sx,gx) */
float oldgx; /* old gx position */
/* float oldgxmin; */ /* old gx position */
/* float oldgxmax; */ /* old gx position */
float oldsx=0.0; /* old sx position */
int isx=0,nxo; /* index for source and geophone */
int oldisx=0; /* old value of source index */
int oldigx=0; /* old value of integerized gx value */
int ix1,ix2,ix3,ixshot; /* dummy index */
int lpad,rpad; /* padding on both sides of the migrated section */
float *wl=NULL,*wtmp=NULL;
float fmax;
float f1,f2,f3,f4;
int nf1,nf2,nf3,nf4;
int ntw;
float dt=0.004,dz; /* time and depth sampling interval */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
float w; /* frequency */
float dx; /* spatial sampling interval */
float **p=NULL; /* input data */
float **cresult=NULL; /* output result */
float v1; /* average velocity */
double kz2;
float **v=NULL,**vp=NULL;/* pointers for the velocity profile */
complex cshift2;
complex *wlsp=NULL; /* complex input,output */
complex **cp=NULL; /* ... */
complex **cp1=NULL; /* ... */
complex **cq=NULL; /* ... */
char *vfile=""; /* name of file containing velocities */
FILE *vfp=NULL;
int verbose; /* verbose flag */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get required parameters */
MUSTGETPARINT("nz",&nz);
MUSTGETPARINT("nxo",&nxo);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile",&vfile);
MUSTGETPARINT("nxshot",&nxshot);
/* get optional parameters */
if (!getparfloat("fmax",&fmax)) fmax = 25.0;
if (!getparfloat("f1",&f1)) f1 = 10.0;
if (!getparfloat("f2",&f2)) f2 = 20.0;
if (!getparfloat("f3",&f3)) f3 = 40.0;
if (!getparfloat("f4",&f4)) f4 = 50.0;
if (!getparint("lpad",&lpad)) lpad=9999;
if (!getparint("rpad",&rpad)) rpad=9999;
if (!getparint("dip",&dip)) dip=79;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocating space */
cresult = alloc2float(nz,nxo);
vp = alloc2float(nxo,nz);
/* load velicoty file */
vfp=efopen(vfile,"r");
efread(vp[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/* zero out cresult array */
memset((void *) cresult[0], 0, nxo*nz*FSIZE);
/* save value of nxshot */
/* nxshot_orig=nxshot; */
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
get_sx_gx(&sx,&gx);
min_sx_gx = MIN(sx,gx);
sx = sx - min_sx_gx;
gx = gx - min_sx_gx;
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
if(verbose) warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
if(verbose) warn("tr.d2 not set, assuming d2=1.0");
}
}
checkpars();
oldisx=0;
do { /* begin loop over shots */
/* determine frequency sampling interval*/
ntfft = npfar(nt);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
/* compute the index of the frequency to be migrated*/
fw=2.0*PI*f1;
nf1=fw/dw+0.5;
fw=2.0*PI*f2;
nf2=fw/dw+0.5;
fw=2.0*PI*f3;
nf3=fw/dw+0.5;
fw=2.0*PI*f4;
nf4=fw/dw+0.5;
/* the number of frequencies to migrated*/
truenw=nf4-nf1+1;
fw=0.0+nf1*dw;
if(verbose)
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/* generate the Ricker wavelet */
wtmp=ricker(fmax,dt,&ntw);
/* zero out wl[] array */
memset((void *) wl, 0, ntfft*FSIZE);
/* CHANGE BY CHRIS STOLK, Dec. 11, 2005 */
/* The next two lines are the old code, */
/* it is erroneous because the peak of */
/* the wavelet occurs at positive time */
/* instead of time zero. */
/*
for(it=0;it<ntw;it++)
wl[it]=wtmp[it];
*/
/* New code: we put in the wavelet in a centered fashion */
for(it=0;it<ntw;it++)
wl[(it-ntw/2+ntfft) % ntfft]=wtmp[it];
/* End of new code */
free1float(wtmp);
/* fourier transform wl array */
pfarc(-1,ntfft,wl,wlsp);
/* allocate space */
p = alloc2float(ntfft,nxo);
cq = alloc2complex(nw,nxo);
/* zero out p[][] array */
memset((void *) p[0], 0, ntfft*nxo*FSIZE);
/* initialize a number of items before looping over traces */
nx = 0;
igx=0;
oldigx=0;
oldsx=sx;
oldgx=gx;
/* oldgxmax=gxmax; */
/* oldgxmin=gxmin; */
do { /* begin looping over traces within a shot gather */
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
/* get sx and gx */
get_sx_gx(&sx,&gx);
sx = (sx - min_sx_gx);
gx = (gx - min_sx_gx);
igx = NINT(gx/dx);
if (igx==oldigx)
warn("repeated igx!!! check dx or scalco value!!!");
oldigx = igx;
if(gxmin>gx)gxmin=gx;
if(gxmax<gx)gxmax=gx;
if(verbose)
warn(" inside loop: min_sx_gx %f isx %d igx %d gx %f sx %f",min_sx_gx,isx,igx,gx,sx);
/* sx, gx must increase monotonically */
if (!(oldsx <= sx) )
err("sx field must be monotonically increasing!");
if (!(oldgx <= gx) )
err("gx field must be monotonically increasing!");
++nx;
} while(gettr(&tr) && sx==oldsx);
isx=NINT(oldsx/dx);
ixshot=isx;
if (isx==oldisx)
warn("repeated isx!!! check dx or scalco value!!!");
oldisx=isx;
if(verbose) {
warn("sx %f, gx %f , gxmin %f gxmax %f nx %d",sx,gx,gxmin,gxmax, nx);
warn("isx %d igx %d ixshot %d" ,isx,igx,ixshot);
}
/* transform the shot gather from time to frequency domain */
pfa2rc(1,1,ntfft,nxo,p[0],cq[0]);
/* compute the most left and right index for the migrated */
/* section */
ix1=NINT(oldsx/dx);
ix2=NINT(gxmin/dx);
ix3=NINT(gxmax/dx);
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
ix2-=lpad;
ix3+=rpad;
if(ix2<0)ix2=0;
if(ix3>nxo-1)ix3=nxo-1;
/* the total traces to be migrated */
nx=ix3-ix2+1;
nw=truenw;
/* allocate space for velocity profile within the aperature */
v=alloc2float(nx,nz);
for(iz=0;iz<nz;iz++)
for(ix=0;ix<nx;ix++)
v[iz][ix]=vp[iz][ix+ix2];
/* allocate space */
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
/* transpose the frequency domain data from */
/* data[ix][iw] to data[iw][ix] and apply a */
/* Hamming at the same time */
for (ix=0; ix<nx; ++ix) {
for (iw=0; iw<nw; iw++){
float tmpp=0.0,tmppp=0.0;
if(iw>=(nf1-nf1)&&iw<=(nf2-nf1)){
tmpp=PI/(nf2-nf1);
tmppp=tmpp*(iw-nf1)-PI;
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
if(iw>=(nf3-nf1)&&iw<=(nf4-nf1)) {
tmpp=PI/(nf4-nf3);
tmppp=tmpp*(iw-nf3);
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
cp[iw][ix]=cq[ix+ix2][iw+nf1];
}
}
cp1[iw][ix]=cmplx(0.0,0.0);
}
}
for(iw=0;iw<nw;iw++){
cp1[iw][ixshot-ix2]=wlsp[iw+nf1];
}
if(verbose) {
warn("ixshot %d ix %d ix1 %d ix2 %d ix3 %d",ixshot,ix,ix1,ix2,ix3);
warn("oldsx %f ",oldsx);
}
free2float(p);
free2complex(cq);
free1float(wl);
free1complex(wlsp);
/* loops over depth */
for(iz=0; iz<nz; ++iz) {
/* the imaging condition */
for(ix=0; ix<nx; ++ix){
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
complex tmp;
float ratio=10.0;
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
else
tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/* get the average velocity */
v1=0.0;
for(ix=0;ix<nx;++ix)
v1+=v[iz][ix]/nx;
/* compute time-invariant wavefield */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw) {
kz2=-(1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
/* wave-propagation using finite-difference method */
fdmig(cp, nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
fdmig(cp1,nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
/* apply thin lens term here */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
kz2=-(1.0/v[iz][ix]-1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
}
free2complex(cp);
free2complex(cp1);
free2float(v);
--nxshot;
} while(nxshot);
/* restore header fields and write output */
for(ix=0; ix<nxo; ix++){
tr.ns = nz;
tr.d1 = dz;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
return(CWP_Exit());
}
