static int CVBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int ier; CVBandPrecData pdata; /* Assume matrix and pivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; if (jok) { /* If jok = TRUE, use saved copy of J. */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mu, ml); } else { /* If jok = FALSE, call CVBandPDQJac for new J value. */ *jcurPtr = TRUE; BandZero(savedJ); CVBandPDQJac(pdata, t, y, fy, tmp1, tmp2); BandCopy(savedJ, savedP, mu, ml); } /* Scale and add I to get savedP = I - gamma*J. */ BandScale(-gamma, savedP); BandAddI(savedP); /* Do LU factorization of matrix. */ ier = BandFactor(savedP, pivots); /* Return 0 if the LU was complete; otherwise return 1. */ if (ier > 0) return(1); return(0); }
static int CVBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int ier; CVBBDPrecData pdata; pdata = (CVBBDPrecData) bbd_data; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mukeep, mlkeep); } else { /* Otherwise call CVBBDDQJac for new J value */ *jcurPtr = TRUE; BandZero(savedJ); CVBBDDQJac(pdata, t, y, tmp1, tmp2, tmp3); nge += 1 + MIN(mldq + mudq + 1, Nlocal); BandCopy(savedJ, savedP, mukeep, mlkeep); } /* Scale and add I to get P = I - gamma*J */ BandScale(-gamma, savedP); BandAddI(savedP); /* Do LU factorization of P in place */ ier = BandFactor(savedP, pivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) return(1); return(0); }
/*--------------------------------------------------------------- ARKBandPrecSetup: Together ARKBandPrecSetup and ARKBandPrecSolve use a banded difference quotient Jacobian to create a preconditioner. ARKBandPrecSetup calculates a new J, if necessary, then calculates P = I - gamma*J, and does an LU factorization of P. The parameters of ARKBandPrecSetup are as follows: t is the current value of the independent variable. y is the current value of the dependent variable vector, namely the predicted value of y(t). fy is the vector f(t,y). jok is an input flag indicating whether Jacobian-related data needs to be recomputed, as follows: jok == FALSE means recompute Jacobian-related data from scratch. jok == TRUE means that Jacobian data from the previous PrecSetup call will be reused (with the current value of gamma). A ARKBandPrecSetup call with jok == TRUE should only occur after a call with jok == FALSE. *jcurPtr is a pointer to an output integer flag which is set by ARKBandPrecond as follows: *jcurPtr = TRUE if Jacobian data was recomputed. *jcurPtr = FALSE if Jacobian data was not recomputed, but saved data was reused. gamma is the scalar appearing in the Newton matrix. bp_data is a pointer to preconditoner data (set by ARKBandPrecInit) tmp1, tmp2, and tmp3 are pointers to memory allocated for vectors of length N for work space. This routine uses only tmp1 and tmp2. The value to be returned by the ARKBandPrecSetup function is 0 if successful, or 1 if the band factorization failed. ---------------------------------------------------------------*/ static int ARKBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { ARKBandPrecData pdata; ARKodeMem ark_mem; int retval; long int ier; /* Assume matrix and lpivots have already been allocated. */ pdata = (ARKBandPrecData) bp_data; ark_mem = (ARKodeMem) pdata->arkode_mem; if (jok) { /* If jok = TRUE, use saved copy of J. */ *jcurPtr = FALSE; BandCopy(pdata->savedJ, pdata->savedP, pdata->mu, pdata->ml); } else { /* If jok = FALSE, call ARKBandPDQJac for new J value. */ *jcurPtr = TRUE; SetToZero(pdata->savedJ); retval = ARKBandPDQJac(pdata, t, y, fy, tmp1, tmp2); if (retval < 0) { arkProcessError(ark_mem, -1, "ARKBANDPRE", "ARKBandPrecSetup", MSGBP_RHSFUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(pdata->savedJ, pdata->savedP, pdata->mu, pdata->ml); } /* Scale and add I to get savedP = I - gamma*J. */ BandScale(-gamma, pdata->savedP); AddIdentity(pdata->savedP); /* Do LU factorization of matrix. */ ier = BandGBTRF(pdata->savedP, pdata->lpivots); /* Return 0 if the LU was complete; otherwise return 1. */ if (ier > 0) return(1); return(0); }
static int CVBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int ier; CVBandPrecData pdata; CVodeMem cv_mem; int retval; /* Assume matrix and pivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = TRUE, use saved copy of J. */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mu, ml); } else { /* If jok = FALSE, call CVBandPDQJac for new J value. */ *jcurPtr = TRUE; BandZero(savedJ); retval = CVBandPDQJac(pdata, t, y, fy, tmp1, tmp2); if (retval < 0) { CVProcessError(cv_mem, CVBANDPRE_RHSFUNC_UNRECVR, "CVBANDPRE", "CVBandPrecSetup", MSGBP_RHSFUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(savedJ, savedP, mu, ml); } /* Scale and add I to get savedP = I - gamma*J. */ BandScale(-gamma, savedP); BandAddI(savedP); /* Do LU factorization of matrix. */ ier = BandFactor(savedP, pivots); /* Return 0 if the LU was complete; otherwise return 1. */ if (ier > 0) return(1); return(0); }
static int CVBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int ier; CVBBDPrecData pdata; CVodeMem cv_mem; int retval; pdata = (CVBBDPrecData) bbd_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mukeep, mlkeep); } else { /* Otherwise call CVBBDDQJac for new J value */ *jcurPtr = TRUE; SetToZero(savedJ); retval = CVBBDDQJac(pdata, t, y, tmp1, tmp2, tmp3); if (retval < 0) { CVProcessError(cv_mem, -1, "CVBBDPRE", "CVBBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(1); } BandCopy(savedJ, savedP, mukeep, mlkeep); } /* Scale and add I to get P = I - gamma*J */ BandScale(-gamma, savedP); AddIdentity(savedP); /* Do LU factorization of P in place */ ier = BandGBTRF(savedP, pivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) return(1); return(0); }
static int CVBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { booleantype jbad, jok; realtype dgamma; long int ier; CVBandMem cvband_mem; cvband_mem = (CVBandMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVB_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVB_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, M, mu, ml); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; BandZero(M); jac(n, mu, ml, M, tn, ypred, fpred, J_data, vtemp1, vtemp2, vtemp3); BandCopy(M, savedJ, mu, ml); } /* Scale and add I to get M = I - gamma*J */ BandScale(-gamma, M); BandAddI(M); /* Do LU factorization of M */ ier = BandFactor(M, pivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) { last_flag = ier; return(1); } last_flag = CVBAND_SUCCESS; return(0); }
int PVBBDPrecon(integer N, real t, N_Vector y, N_Vector fy, boole jok, boole *jcurPtr, real gamma, N_Vector ewt, real h, real uround, long int *nfePtr, void *P_data, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { integer Nlocal, ier; real rely, srur; PVBBDData pdata; pdata = (PVBBDData)P_data; Nlocal = N_VLOCLENGTH(y); if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, savedP, mukeep, mlkeep); } else { /* Otherwise call PVBBDDQJac for new J value */ *jcurPtr = TRUE; BandZero(savedJ); /* Set relative increment for y via dqrely and uround */ srur = RSqrt(uround); rely = (dqrely == ZERO) ? srur : dqrely; PVBBDDQJac(Nlocal, mudq, mldq, mukeep, mlkeep, rely, gloc, cfn, savedJ, f_data, t, y, ewt, h, uround, vtemp1, vtemp2, vtemp3); nge += 1 + MIN(mldq + mudq + 1, Nlocal); BandCopy(savedJ, savedP, mukeep, mlkeep); } /* Scale and add I to get P = I - gamma*J */ BandScale(-gamma, savedP); BandAddI(savedP); /* Do LU factorization of P in place */ ier = BandFactor(savedP, pivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) return(1); return(0); }
CAMLprim value c_bandmatrix_scale(value vc, value va) { CAMLparam2(vc, va); BandScale(Double_val(vc), DLSMAT(va)); CAMLreturn (Val_unit); }
static int cvBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { CVDlsMem cvdls_mem; booleantype jbad, jok; realtype dgamma; int ier, retval; cvdls_mem = (CVDlsMem) lmem; /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */ dgamma = ABS((gamma/gammap) - ONE); jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) || (convfail == CV_FAIL_OTHER); jok = !jbad; if (jok) { /* If jok = TRUE, use saved copy of J */ *jcurPtr = FALSE; BandCopy(savedJ, M, mu, ml); } else { /* If jok = FALSE, call jac routine for new J value */ nje++; nstlj = nst; *jcurPtr = TRUE; SetToZero(M); retval = jac(n, mu, ml, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSBAND", "cvBandSetup", MSGD_JACFUNC_FAILED); last_flag = CVDLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDLS_JACFUNC_RECVR; return(1); } BandCopy(M, savedJ, mu, ml); } /* Scale and add I to get M = I - gamma*J */ BandScale(-gamma, M); AddIdentity(M); /* Do LU factorization of M */ ier = BandGBTRF(M, pivots); /* Return 0 if the LU was complete; otherwise return 1 */ if (ier > 0) { last_flag = ier; return(1); } last_flag = CVDLS_SUCCESS; return(0); }