void NR::simpr(Vec_I_DP &y, Vec_I_DP &dydx, Vec_I_DP &dfdx, Mat_I_DP &dfdy,
const DP xs, const DP htot, const int nstep, Vec_O_DP &yout,
void derivs(const DP, Vec_IO_DP &, Vec_O_DP &))
{
const int NMAX=61000;
Vec_INT ija(NMAX);
Vec_DP sa(NMAX);
double sa_a[NMAX];
int ija_a[NMAX];
int i,nn,RAZMER;
DP d,h,x;
const int ITOL=2,ITMAX=75;
const DP TOL=1.0e-9;
int ii,iter;
DP err;
int n=y.size();
Vec_INT indx(n);
Vec_DP del(n),ytemp(n),xinit(n);
h=htot/nstep;
NR::sprsin(dfdy,1.e-9,sa,ija);
RAZMER = (ija[n]-1);
for(i=0;i<RAZMER;i++) {ija_a[i]=ija[i]; sa_a[i] = -h*sa[i];}
for (i=0;i<n;i++) ++sa_a[i];// a[i][j] = -h*dfdy[i][j];
// ludcmp(a,indx,d);
for (i=0;i<n;i++){ xinit[i] = 0.;
yout[i]=h*(dydx[i]+h*dfdx[i]);}
ija_p=new Vec_INT(ija_a,NMAX);
sa_p=new Vec_DP(sa_a,NMAX);
NR::linbcg(yout,xinit,ITOL,TOL,ITMAX,iter,err);
// lubksb(a,indx,yout);
for (i=0;i<n;i++)
ytemp[i]=y[i]+(del[i]=yout[i]=xinit[i]);
x=xs+h;
derivs(x,ytemp,yout);
for (nn=2;nn<=nstep;nn++) {
for (i=0;i<n;i++)
yout[i]=h*yout[i]-del[i];
NR::linbcg(yout,xinit,ITOL,TOL,ITMAX,iter,err);
// lubksb(a,indx,yout);
for (i=0;i<n;i++) ytemp[i] += (del[i] += 2.0*(yout[i]=xinit[i]));
x += h;
derivs(x,ytemp,yout);
}
for (i=0;i<n;i++)
yout[i]=h*yout[i]-del[i];
NR::linbcg(yout,xinit,ITOL,TOL,ITMAX,iter,err);
// lubksb(a,indx,yout);
for (i=0;i<n;i++)
yout[i] = xinit[i] + ytemp[i];
delete sa_p;
delete ija_p;
}
void StepperDopr853<D>::dy(const Doub h,D &derivs) {
VecDoub ytemp(n);
Int i;
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*a21*dydx[i];
derivs(x+c2*h,ytemp,k2);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a31*dydx[i]+a32*k2[i]);
derivs(x+c3*h,ytemp,k3);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a41*dydx[i]+a43*k3[i]);
derivs(x+c4*h,ytemp,k4);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a51*dydx[i]+a53*k3[i]+a54*k4[i]);
derivs(x+c5*h,ytemp,k5);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a61*dydx[i]+a64*k4[i]+a65*k5[i]);
derivs(x+c6*h,ytemp,k6);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a71*dydx[i]+a74*k4[i]+a75*k5[i]+a76*k6[i]);
derivs(x+c7*h,ytemp,k7);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a81*dydx[i]+a84*k4[i]+a85*k5[i]+a86*k6[i]+a87*k7[i]);
derivs(x+c8*h,ytemp,k8);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a91*dydx[i]+a94*k4[i]+a95*k5[i]+a96*k6[i]+a97*k7[i]+
a98*k8[i]);
derivs(x+c9*h,ytemp,k9);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a101*dydx[i]+a104*k4[i]+a105*k5[i]+a106*k6[i]+
a107*k7[i]+a108*k8[i]+a109*k9[i]);
derivs(x+c10*h,ytemp,k10);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a111*dydx[i]+a114*k4[i]+a115*k5[i]+a116*k6[i]+
a117*k7[i]+a118*k8[i]+a119*k9[i]+a1110*k10[i]);
derivs(x+c11*h,ytemp,k2);
Doub xph=x+h;
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a121*dydx[i]+a124*k4[i]+a125*k5[i]+a126*k6[i]+
a127*k7[i]+a128*k8[i]+a129*k9[i]+a1210*k10[i]+a1211*k2[i]);
derivs(xph,ytemp,k3);
for (i=0;i<n;i++) {
k4[i]=b1*dydx[i]+b6*k6[i]+b7*k7[i]+b8*k8[i]+b9*k9[i]+b10*k10[i]+
b11*k2[i]+b12*k3[i];
yout[i]=y[i]+h*k4[i];
}
for (i=0;i<n;i++) {
yerr[i]=k4[i]-bhh1*dydx[i]-bhh2*k9[i]-bhh3*k3[i];
yerr2[i]=er1*dydx[i]+er6*k6[i]+er7*k7[i]+er8*k8[i]+er9*k9[i]+
er10*k10[i]+er11*k2[i]+er12*k3[i];
}
}
void StepperDopr853<D>::prepare_dense(const Doub h,VecDoub_I &dydxnew,
D &derivs) {
Int i;
Doub ydiff,bspl;
VecDoub ytemp(n);
for (i=0;i<n;i++) {
rcont1[i]=y[i];
ydiff=yout[i]-y[i];
rcont2[i]=ydiff;
bspl=h*dydx[i]-ydiff;
rcont3[i]=bspl;
rcont4[i]=ydiff-h*dydxnew[i]-bspl;
rcont5[i]=d41*dydx[i]+d46*k6[i]+d47*k7[i]+d48*k8[i]+
d49*k9[i]+d410*k10[i]+d411*k2[i]+d412*k3[i];
rcont6[i]=d51*dydx[i]+d56*k6[i]+d57*k7[i]+d58*k8[i]+
d59*k9[i]+d510*k10[i]+d511*k2[i]+d512*k3[i];
rcont7[i]=d61*dydx[i]+d66*k6[i]+d67*k7[i]+d68*k8[i]+
d69*k9[i]+d610*k10[i]+d611*k2[i]+d612*k3[i];
rcont8[i]=d71*dydx[i]+d76*k6[i]+d77*k7[i]+d78*k8[i]+
d79*k9[i]+d710*k10[i]+d711*k2[i]+d712*k3[i];
}
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a141*dydx[i]+a147*k7[i]+a148*k8[i]+a149*k9[i]+
a1410*k10[i]+a1411*k2[i]+a1412*k3[i]+a1413*dydxnew[i]);
derivs(x+c14*h,ytemp,k10);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a151*dydx[i]+a156*k6[i]+a157*k7[i]+a158*k8[i]+
a1511*k2[i]+a1512*k3[i]+a1513*dydxnew[i]+a1514*k10[i]);
derivs(x+c15*h,ytemp,k2);
for (i=0;i<n;i++)
ytemp[i]=y[i]+h*(a161*dydx[i]+a166*k6[i]+a167*k7[i]+a168*k8[i]+
a169*k9[i]+a1613*dydxnew[i]+a1614*k10[i]+a1615*k2[i]);
derivs(x+c16*h,ytemp,k3);
for (i=0;i<n;i++)
{
rcont5[i]=h*(rcont5[i]+d413*dydxnew[i]+d414*k10[i]+d415*k2[i]+d416*k3[i]);
rcont6[i]=h*(rcont6[i]+d513*dydxnew[i]+d514*k10[i]+d515*k2[i]+d516*k3[i]);
rcont7[i]=h*(rcont7[i]+d613*dydxnew[i]+d614*k10[i]+d615*k2[i]+d616*k3[i]);
rcont8[i]=h*(rcont8[i]+d713*dydxnew[i]+d714*k10[i]+d715*k2[i]+d716*k3[i]);
}
}
void NR::simpr(Vec_I_DP &y, Vec_I_DP &dydx, Vec_I_DP &dfdx, Mat_I_DP &dfdy,
const DP xs, const DP htot, const int nstep, Vec_O_DP &yout,
void derivs(const DP, Vec_I_DP &, Vec_O_DP &))
{
int i,j,nn;
DP d,h,x;
int n=y.size();
Mat_DP a(n,n);
Vec_INT indx(n);
Vec_DP del(n),ytemp(n);
h=htot/nstep;
for (i=0;i<n;i++) {
for (j=0;j<n;j++) a[i][j] = -h*dfdy[i][j];
++a[i][i];
}
ludcmp(a,indx,d);
for (i=0;i<n;i++)
yout[i]=h*(dydx[i]+h*dfdx[i]);
lubksb(a,indx,yout);
for (i=0;i<n;i++)
ytemp[i]=y[i]+(del[i]=yout[i]);
x=xs+h;
derivs(x,ytemp,yout);
for (nn=2;nn<=nstep;nn++) {
for (i=0;i<n;i++)
yout[i]=h*yout[i]-del[i];
lubksb(a,indx,yout);
for (i=0;i<n;i++) ytemp[i] += (del[i] += 2.0*yout[i]);
x += h;
derivs(x,ytemp,yout);
}
for (i=0;i<n;i++)
yout[i]=h*yout[i]-del[i];
lubksb(a,indx,yout);
for (i=0;i<n;i++)
yout[i] += ytemp[i];
}
void Foam::SIBS::SIMPR
(
const ODE& ode,
const scalar xStart,
const scalarField& y,
const scalarField& dydx,
const scalarField& dfdx,
const scalarSquareMatrix& dfdy,
const scalar deltaX,
const label nSteps,
scalarField& yEnd
) const
{
scalar h = deltaX/nSteps;
scalarSquareMatrix a(n_);
for (register label i=0; i<n_; i++)
{
for (register label j=0; j<n_; j++)
{
a[i][j] = -h*dfdy[i][j];
}
++a[i][i];
}
labelList pivotIndices(n_);
LUDecompose(a, pivotIndices);
for (register label i=0; i<n_; i++)
{
yEnd[i] = h*(dydx[i] + h*dfdx[i]);
}
LUBacksubstitute(a, pivotIndices, yEnd);
scalarField del(yEnd);
scalarField ytemp(n_);
for (register label i=0; i<n_; i++)
{
ytemp[i] = y[i] + del[i];
}
scalar x = xStart + h;
ode.derivatives(x, ytemp, yEnd);
for (register label nn=2; nn<=nSteps; nn++)
{
for (register label i=0; i<n_; i++)
{
yEnd[i] = h*yEnd[i] - del[i];
}
LUBacksubstitute(a, pivotIndices, yEnd);
for (register label i=0; i<n_; i++)
{
ytemp[i] += (del[i] += 2.0*yEnd[i]);
}
x += h;
ode.derivatives(x, ytemp, yEnd);
}
for (register label i=0; i<n_; i++)
{
yEnd[i] = h*yEnd[i] - del[i];
}
LUBacksubstitute(a, pivotIndices, yEnd);
for (register label i=0; i<n_; i++)
{
yEnd[i] += ytemp[i];
}
}
