/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ void ros_FunTimeDerivative ( /*~~~> Input arguments: */ KPP_REAL T, KPP_REAL Roundoff, KPP_REAL Y[], KPP_REAL Fcn0[], void (*ode_Fun)(KPP_REAL, KPP_REAL [], KPP_REAL []), /*~~~> Output arguments: */ KPP_REAL dFdT[] ) /*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The time partial derivative of the function by finite differences ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ { /*~~~> Local variables */ KPP_REAL Delta; Delta = SQRT(Roundoff)*MAX(DeltaMin,ABS(T)); (*ode_Fun)(T+Delta,Y,dFdT); WAXPY(KPP_NVAR,(-ONE),Fcn0,1,dFdT,1); WSCAL(KPP_NVAR,(ONE/Delta),dFdT,1); } /* ros_FunTimeDerivative */
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ void ros_FunTimeDerivative ( /*~~~> Input arguments: */ double T, double Roundoff, double Y[], double Fcn0[], void (*ode_Fun)(double, double [], double []), /*~~~> Output arguments: */ double dFdT[] ) /*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The time partial derivative of the function by finite differences ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ { /*~~~> Local variables */ double Delta; Delta = SQRT(Roundoff)*MAX(DeltaMin,ABS(T)); (*ode_Fun)(T+Delta,Y,dFdT); WAXPY(74,(-ONE),Fcn0,1,dFdT,1); WSCAL(74,(ONE/Delta),dFdT,1); } /* ros_FunTimeDerivative */
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ int RosenbrockIntegrator( /*~~~> Input: the initial condition at Tstart; Output: the solution at T */ KPP_REAL Y[], /*~~~> Input: integration interval */ KPP_REAL Tstart, KPP_REAL Tend , /*~~~> Input: tolerances */ KPP_REAL AbsTol[], KPP_REAL RelTol[], /*~~~> Input: ode function and its Jacobian */ void (*ode_Fun)(KPP_REAL, KPP_REAL [], KPP_REAL []), void (*ode_Jac)(KPP_REAL, KPP_REAL [], KPP_REAL []) , /*~~~> Input: The Rosenbrock method parameters */ int ros_S, KPP_REAL ros_M[], KPP_REAL ros_E[], KPP_REAL ros_A[], KPP_REAL ros_C[], KPP_REAL ros_Alpha[],KPP_REAL ros_Gamma[], KPP_REAL ros_ELO, char ros_NewF[], /*~~~> Input: integration parameters */ char Autonomous, char VectorTol, int Max_no_steps, KPP_REAL Roundoff, KPP_REAL Hmin, KPP_REAL Hmax, KPP_REAL Hstart, KPP_REAL FacMin, KPP_REAL FacMax, KPP_REAL FacRej, KPP_REAL FacSafe, /*~~~> Output: time at which the solution is returned (T=Tend if success) and last accepted step */ KPP_REAL *Texit, KPP_REAL *Hexit ) /*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Template for the implementation of a generic Rosenbrock method defined by ros_S (no of stages) and coefficients ros_{A,C,M,E,Alpha,Gamma} returned value: IERR, indicator of success (if positive) or failure (if negative) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ { KPP_REAL Ynew[KPP_NVAR], Fcn0[KPP_NVAR], Fcn[KPP_NVAR], dFdT[KPP_NVAR], Jac0[KPP_LU_NONZERO], Ghimj[KPP_LU_NONZERO]; KPP_REAL K[KPP_NVAR*ros_S]; KPP_REAL H, T, Hnew, HC, HG, Fac, Tau; KPP_REAL Err, Yerr[KPP_NVAR]; int Pivot[KPP_NVAR], Direction, ioffset, j, istage; char RejectLastH, RejectMoreH; /*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/ /*~~~> INITIAL PREPARATIONS */ T = Tstart; *Hexit = 0.0; H = MIN(Hstart,Hmax); if (ABS(H) <= 10.0*Roundoff) H = DeltaMin; if (Tend >= Tstart) { Direction = +1; } else { Direction = -1; } /* end if */ RejectLastH=0; RejectMoreH=0; /*~~~> Time loop begins below */ while ( ( (Direction > 0) && ((T-Tend)+Roundoff <= ZERO) ) || ( (Direction < 0) && ((Tend-T)+Roundoff <= ZERO) ) ) { if ( Nstp > Max_no_steps ) { /* Too many steps */ *Texit = T; return ros_ErrorMsg(-6,T,H); } if ( ((T+0.1*H) == T) || (H <= Roundoff) ) { /* Step size too small */ *Texit = T; return ros_ErrorMsg(-7,T,H); } /*~~~> Limit H if necessary to avoid going beyond Tend */ *Hexit = H; H = MIN(H,ABS(Tend-T)); /*~~~> Compute the function at current time */ (*ode_Fun)(T,Y,Fcn0); /*~~~> Compute the function derivative with respect to T */ if (!Autonomous) ros_FunTimeDerivative ( T, Roundoff, Y, Fcn0, ode_Fun, dFdT ); /*~~~> Compute the Jacobian at current time */ (*ode_Jac)(T,Y,Jac0); /*~~~> Repeat step calculation until current step accepted */ while (1) { /* WHILE STEP NOT ACCEPTED */ if( ros_PrepareMatrix( &H, Direction, ros_Gamma[0], Jac0, Ghimj, Pivot) ) { /* More than 5 consecutive failed decompositions */ *Texit = T; return ros_ErrorMsg(-8,T,H); } /*~~~> Compute the stages */ for (istage = 1; istage <= ros_S; istage++) { /* Current istage offset. Current istage vector is K[ioffset:ioffset+KPP_NVAR-1] */ ioffset = KPP_NVAR*(istage-1); /* For the 1st istage the function has been computed previously */ if ( istage == 1 ) WCOPY(KPP_NVAR,Fcn0,1,Fcn,1); else { /* istage>1 and a new function evaluation is needed at current istage */ if ( ros_NewF[istage-1] ) { WCOPY(KPP_NVAR,Y,1,Ynew,1); for (j = 1; j <= istage-1; j++) WAXPY(KPP_NVAR,ros_A[(istage-1)*(istage-2)/2+j-1], &K[KPP_NVAR*(j-1)],1,Ynew,1); Tau = T + ros_Alpha[istage-1]*Direction*H; (*ode_Fun)(Tau,Ynew,Fcn); } /*end if ros_NewF(istage)*/ } /* end if istage */ WCOPY(KPP_NVAR,Fcn,1,&K[ioffset],1); for (j = 1; j <= istage-1; j++) { HC = ros_C[(istage-1)*(istage-2)/2+j-1]/(Direction*H); WAXPY(KPP_NVAR,HC,&K[KPP_NVAR*(j-1)],1,&K[ioffset],1); } /* for j */ if ((!Autonomous) && (ros_Gamma[istage-1])) { HG = Direction*H*ros_Gamma[istage-1]; WAXPY(KPP_NVAR,HG,dFdT,1,&K[ioffset],1); } /* end if !Autonomous */ SolveTemplate(Ghimj, Pivot, &K[ioffset]); } /* for istage */ /*~~~> Compute the new solution */ WCOPY(KPP_NVAR,Y,1,Ynew,1); for (j=1; j<=ros_S; j++) WAXPY(KPP_NVAR,ros_M[j-1],&K[KPP_NVAR*(j-1)],1,Ynew,1); /*~~~> Compute the error estimation */ WSCAL(KPP_NVAR,ZERO,Yerr,1); for (j=1; j<=ros_S; j++) WAXPY(KPP_NVAR,ros_E[j-1],&K[KPP_NVAR*(j-1)],1,Yerr,1); Err = ros_ErrorNorm ( Y, Ynew, Yerr, AbsTol, RelTol, VectorTol ); /*~~~> New step size is bounded by FacMin <= Hnew/H <= FacMax */ Fac = MIN(FacMax,MAX(FacMin,FacSafe/pow(Err,ONE/ros_ELO))); Hnew = H*Fac; /*~~~> Check the error magnitude and adjust step size */ Nstp++; if ( (Err <= ONE) || (H <= Hmin) ) { /*~~~> Accept step */ Nacc++; WCOPY(KPP_NVAR,Ynew,1,Y,1); T += Direction*H; Hnew = MAX(Hmin,MIN(Hnew,Hmax)); /* No step size increase after a rejected step */ if (RejectLastH) Hnew = MIN(Hnew,H); RejectLastH = 0; RejectMoreH = 0; H = Hnew; break; /* EXIT THE LOOP: WHILE STEP NOT ACCEPTED */ } else { /*~~~> Reject step */ if (Nacc >= 1) Nrej++; if (RejectMoreH) Hnew=H*FacRej; RejectMoreH = RejectLastH; RejectLastH = 1; H = Hnew; } /* end if Err <= 1 */ } /* while LOOP: WHILE STEP NOT ACCEPTED */ } /* while: time loop */ /*~~~> The integration was successful */ *Texit = T; return 1; } /* RosenbrockIntegrator */