/*
* modified bessel function
*/
double bessel_i0(double x)
{
if (x < 0.)
return bessel_i0(-x);
if (x < 8.)
return exp(x) * chebeval(x / 4. - 1., ARRAY_SIZE(coeff_0to8), coeff_0to8);
return exp(x) * chebeval(16. / x - 1., ARRAY_SIZE(coeff_8toinf), coeff_8toinf) / sqrt(x);
}
static void qp_cheb(void)
/* Chebyshev spectral algorithm */
{
int i,k,ind,ind1;
float b[NC],b2[NC],coef[NC],cder[NC],rhs[3][NC],creg[NC],crder[NC],crd2[NC];
float f0,f1,yp1,ypn;
const float a1=23.0/12.0, a2=-4.0/3.0, a3=5.0/12.0;
char ch='y';
for(i=0;i<nc;i++) {
ind=i;
*(y+ind)=-1.0;
*(g+ind)=0.0;
}
for( k=0;k<2;k++ ) {
/*---chebspectrum for y---*/
for(i=0;i<nc;i++) b[i]=*(y+i+k*nc);
chebcoef(b,coef,nc);
/*---computation of RHS---*/
for(i=0;i<nc;i++) {
ind=i+k*nc;
b[i]=(*(fc+ind))/(*(y+ind));
}
chebcoef(b,coef,nc);
for(i=0;i<nc;i++) cder[i]=0.0;
chebder(0.,xmax,coef,cder,nc);
for(i=0;i<nc;i++) {
ind=i+nc*k;
b[i]=chebeval(cder,cp[i],neval)*(*(y+ind));
}
chebcoef(b,coef,nc);
chebder(0.,xmax,coef,cder,nc);
/*---add (y_t/f^2)_{xx}---*/
for(i=0;i<nc;i++) {
ind=i+nc*k;
b[i]=(*(g+ind));
}
chebcoef(b,creg,nc);
for(i=0;i<nc;i++) {crder[i]=0.0; crd2[i]=0.0;}
chebder(0.,xmax,creg,crder,nc);
chebder(0.,xmax,crder,crd2,nc);
/*---time step---*/
for(i=0;i<nc;i++) {
ind=i+k*nc;
b[i]=chebeval(cder,cp[i],neval);
rhs[k][i]=(*(y+ind))*b[i]/(*(fc+ind))+eps*chebeval(crd2,cp[i],neval);
ind1=ind+nc;
*(g+ind1)=*(g+ind)+ht*rhs[k][i];
f0=*(fc+ind);
f1=*(fc+ind1);
*(y+ind1)=*(y+ind)+0.5*ht*(f0*f0*(*(g+ind))+f1*f1*(*(g+ind1)));
}
}
while(k<nt1 && ch=='y') {
sf_warning("%d of %d;",k,nt1);
/*---chebspectrum for y---*/
for(i=0;i<nc;i++) b[i]=*(y+i+k*nc);
chebcoef(b,coef,nc);
/*---computation of RHS---*/
for(i=0;i<nc;i++) {
ind=i+k*nc;
b[i]=(*(fc+ind))/(*(y+ind));
}
chebcoef(b,coef,nc);
chebder(0.,xmax,coef,cder,nc);
for(i=0;i<nc;i++) {
ind=i+nc*k;
b[i]=chebeval(cder,cp[i],neval)*(*(y+ind));
}
chebcoef(b,coef,nc);
chebder(0.,xmax,coef,cder,nc);
for(i=0;i<nc;i++) {
ind=i+nc*k;
b[i]=(*(g+ind));
}
chebcoef(b,creg,nc);
for(i=0;i<nc;i++) {crder[i]=0.0; crd2[i]=0.0;}
chebder(0.,xmax,creg,crder,nc);
chebder(0.,xmax,crder,crd2,nc);
/*---time step---*/
for(i=0;i<nc;i++) {
ind=i+k*nc;
b[i]=chebeval(cder,cp[i],neval);
rhs[k%3][i]=(*(y+ind))*b[i]/(*(fc+ind))+eps*chebeval(crd2,cp[i],neval);
ind1=ind+nc;
*(g+ind1)=*(g+ind)+
ht*(a1*rhs[k%3][i]+a2*rhs[(k-1)%3][i]+a3*rhs[(k-2)%3][i]);
f0=*(fc+ind);
f1=*(fc+ind1);
*(y+ind1)=*(y+ind)+0.5*ht*(f0*f0*(*(g+ind))+f1*f1*(*(g+ind1)));
if( *(y+ind1)>=-0.1 ) ch='n';
}
k++;
}
sf_warning(".");
/*---------- find the velocity on the regular mesh by cubicsplines --------*/
for( k=1;k<nt;k++) {
for(i=0;i<nc;i++) b[i]=*(y+i+nc*k);
yp1=(*(y+k*nc+1)-(*(y+k*nc)))/((cp[1]-cp[0]));
ypn=(*(y+k*nc+nc-1)-(*(y+k*nc+nc-2)))/((cp[nc-1]-cp[nc-2]));
spline(cp,b,nc,yp1,ypn,b2);
for( i=0;i<nx;i++ ) {
ind=i+nx*k;
q[ind]=-1.0/splineval(cp,b,b2,nc,((i*hx)-bpa)/bma);
s[ind]=1.0/(f[ind]*q[ind]);
}
}
}