template struct StepperBS : StepperBase { typedef D Dtype; static const Int KMAXX=8,IMAXX=KMAXX+1; Int k_targ; VecInt nseq; VecInt cost; MatDoub table; VecDoub dydxnew; Int mu; MatDoub coeff; VecDoub errfac; MatDoub ysave; MatDoub fsave; VecInt ipoint; VecDoub dens; StepperBS(VecDoub_IO &yy, VecDoub_IO &dydxx, Doub &xx, const Doub atol, const Doub rtol, bool dens); void step(const Doub htry,D &derivs); virtual void dy(VecDoub_I &y, const Doub htot, const Int k, VecDoub_O ¥d, Int &ipt, D &derivs); void polyextr(const Int k, MatDoub_IO &table, VecDoub_IO &last); virtual void prepare_dense(const Doub h,VecDoub_I &dydxnew, VecDoub_I &ysav, VecDoub_I &scale, const Int k, Doub &error); virtual Doub dense_out(const Int i,const Doub x,const Doub h); virtual void dense_interp(const Int n, VecDoub_IO &y, const Int imit); }; template StepperBS::StepperBS(VecDoub_IO &yy,VecDoub_IO &dydxx,Doub &xx, const Doub atoll,const Doub rtoll, bool dens) : StepperBase(yy,dydxx,xx,atoll,rtoll,dens),nseq(IMAXX),cost(IMAXX), table(KMAXX,n),dydxnew(n),coeff(IMAXX,IMAXX),errfac(2*IMAXX+2),ysave(IMAXX,n), fsave(IMAXX*(2*IMAXX+1),n),ipoint(IMAXX+1),dens((2*IMAXX+5)*n) { EPS=numeric_limits::epsilon(); if (dense) for (Int i=0;i njadd) njadd++; ipoint[i]=ipoint[i-1]+njadd; } } template Doub StepperBS::dense_out(const Int i,const Doub x,const Doub h) { Doub theta=(x-xold)/h; Doub theta1=1.0-theta; Doub yinterp=dens[i]+theta*(dens[n+i]+theta1*(dens[2*n+i]*theta +dens[3*n+i]*theta1)); if (mu<0) return yinterp; Doub theta05=theta-0.5; Doub t4=SQR(theta*theta1); Doub c=dens[n*(mu+4)+i]; for (Int j=mu;j>0; j--) c=dens[n*(j+3)+i]+c*theta05/j; yinterp += t4*c; return yinterp; } template void StepperBS::dense_interp(const Int n, VecDoub_IO &y, const Int imit) { Doub y0,y1,yp0,yp1,ydiff,aspl,bspl,ph0,ph1,ph2,ph3,fac1,fac2; VecDoub a(31); for (Int i=0; i= 1) { a[1]=16.0*(y[5*n+i]-ph1); if (imit >= 3) { a[3]=16.0*(y[7*n+i]-ph3+3*a[1]); for (Int im=5; im <=imit; im+=2) { fac1=im*(im-1)/2.0; fac2=fac1*(im-2)*(im-3)*2.0; a[im]=16.0*(y[(im+4)*n+i]+fac1*a[im-2]-fac2*a[im-4]); } } } a[0]=(y[4*n+i]-ph0)*16.0; if (imit >= 2) { a[2]=(y[n*6+i]-ph2+a[0])*16.0; for (Int im=4; im <=imit; im+=2) { fac1=im*(im-1)/2.0; fac2=im*(im-1)*(im-2)*(im-3); a[im]=(y[n*(im+4)+i]+a[im-2]*fac1-a[im-4]*fac2)*16.0; } } for (Int im=0; im<=imit; im++) y[n*(im+4)+i]=a[im]; } } template void StepperBS::dy(VecDoub_I &y,const Doub htot,const Int k,VecDoub_O ¥d, Int &ipt,D &derivs) { VecDoub ym(n),yn(n); Int nstep=nseq[k]; Doub h=htot/nstep; for (Int i=0;i void StepperBS::polyextr(const Int k, MatDoub_IO &table, VecDoub_IO &last) { Int l=last.size(); for (Int j=k-1; j>0; j--) for (Int i=0; i void StepperBS::prepare_dense(const Doub h,VecDoub_I &dydxnew, VecDoub_I &ysav,VecDoub_I &scale,const Int k,Doub &error) { mu=2*k-1; for (Int i=0; i=1; l--) { Doub factor=SQR(dblenj/nseq[l-1])-1.0; for (Int i=0; i=kbeg+1; l--) { Doub factor=SQR(dblenj/nseq[l-1])-1.0; for (Int i=0; i=lend; l-=2) for (Int i=0; i=lend; l-=2) for (Int i=0; i= 1) { for (Int i=0; i void StepperBS::step(const Doub htry,D &derivs) { const Doub STEPFAC1=0.65,STEPFAC2=0.94,STEPFAC3=0.02,STEPFAC4=4.0, KFAC1=0.8,KFAC2=0.9; static bool first_step=true,last_step=false; static bool forward,reject=false,prev_reject=false; Int i,k; Doub fac,h,hnew,hopt_int,err; bool firstk; VecDoub hopt(IMAXX),work(IMAXX); VecDoub ysav(n),yseq(n); VecDoub ymid(n),scale(n); work[0]=0; h=htry; forward = h>0 ? true : false; for (i=0;iSQR(nseq[k_targ]*nseq[k_targ+1]/(nseq[0]*nseq[0]))) { reject=true; k_targ=k; if (k_targ>1 && work[k-1]SQR(nseq[k+1]/nseq[0])) { reject=true; if (k_targ>1 && work[k-1] 1.0) { reject=true; if (k_targ>1 && work[k_targ-1] 10.0) { hnew=abs(hopt_int); reject=true; prev_reject=true; goto interp_error; } } dydx=dydxnew; xold=x; x+=h; hdid=h; first_step=false; Int kopt; if (k == 1) kopt=2; else if (k <= k_targ) { kopt=k; if (work[k-1] < KFAC1*work[k]) kopt=k-1; else if (work[k] < KFAC2*work[k-1]) kopt=MIN(k+1,KMAXX-1); } else { kopt=k-1; if (k > 2 && work[k-2] < KFAC1*work[k-1]) kopt=k-2; if (work[k] < KFAC2*work[kopt]) kopt=MIN(k,KMAXX-1); } if (prev_reject) { k_targ=MIN(kopt,k); hnew=MIN(abs(h),hopt[k_targ]); prev_reject=false; } else { if (kopt <= k) hnew=hopt[kopt]; else { if (k