int IDASetMaxNumSteps(void *ida_mem, long int mxsteps) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumSteps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ if (mxsteps == 0) IDA_mem->ida_mxstep = MXSTEP_DEFAULT; else IDA_mem->ida_mxstep = mxsteps; return(IDA_SUCCESS); }
static int idaDlsDenseJacBSWrapper(long int NeqB, realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rrB, DlsMat JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; IDADlsMemB idadlsB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get linear solver's data for this backward problem. */ idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem; /* Get forward solution from interpolation. */ if( noInterp == FALSE) { if (interpSensi) flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, yySTmp, ypSTmp); else flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASDLS", "idaDlsDenseJacBSWrapper", MSGD_BAD_T); return(-1); } } /* Call user's adjoint dense djacBS routine */ flag = idadlsB_mem->d_djacBS(NeqB, tt, c_jB, yyTmp, ypTmp, yySTmp, ypSTmp, yyB, ypB, rrB, JacB, IDAB_mem->ida_user_data, tmp1B, tmp2B, tmp3B); return(flag); }
int IDABBDSpgmr(void *ida_mem, int maxl, void *bbd_data) { IDAMem IDA_mem; int flag; flag = IDASpgmr(ida_mem, maxl); if(flag != IDASPILS_SUCCESS) return(flag); IDA_mem = (IDAMem) ida_mem; if (bbd_data == NULL) { IDAProcessError(IDA_mem, IDABBDPRE_PDATA_NULL, "IDABBDPRE", "IDABBDSpgmr", MSGBBD_PDATA_NULL); return(IDABBDPRE_PDATA_NULL); } flag = IDASpilsSetPreconditioner(ida_mem, IDABBDPrecSetup, IDABBDPrecSolve, bbd_data); if(flag != IDASPILS_SUCCESS) return(flag); return(IDASPILS_SUCCESS); }
static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; long int retfac; IDADlsMem idadls_mem; idadls_mem = (IDADlsMem) lmem; /* Increment nje counter. */ nje++; /* Zero out JJ; call Jacobian routine jac; return if it failed. */ SetToZero(JJ); retval = djac(neq, tn, cj, yyp, ypp, rrp, JJ, jacdata, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDADENSE", "IDADenseSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of JJ; return success or fail flag. */ retfac = DenseGETRF(JJ, lpivots); if (retfac != 0) { last_flag = retfac; return(+1); } last_flag = IDADLS_SUCCESS; return(0); }
static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; long int retfac; IDABandMem idaband_mem; idaband_mem = (IDABandMem) lmem; /* Increment nje counter. */ nje++; /* Zero out JJ; call Jacobian routine jac; return if it failed. */ BandZero(JJ); retval = jac(neq, mu, ml, tn, yyp, ypp, rrp, cj, jacdata, JJ, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDABAND_JACFUNC_UNRECVR, "IDABAND", "IDABandSetup", MSGB_JACFUNC_FAILED); last_flag = IDABAND_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = IDABAND_JACFUNC_RECVR; return(+1); } /* Do LU factorization of JJ; return success or fail flag. */ retfac = BandGBTRF(JJ, pivots); if (retfac != 0) { last_flag = retfac; return(+1); } last_flag = IDABAND_SUCCESS; return(0); }
static int idaNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* ida_mem) { IDAMem IDA_mem; int m, retval; realtype delnrm; realtype rate; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "idaNlsConvTest", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* compute the norm of the correction */ delnrm = N_VWrmsNorm(del, ewt); /* get the current nonlinear solver iteration count */ retval = SUNNonlinSolGetCurIter(NLS, &m); if (retval != IDA_SUCCESS) return(IDA_MEM_NULL); /* test for convergence, first directly, then with rate estimate. */ if (m == 0){ IDA_mem->ida_oldnrm = delnrm; if (delnrm <= PT0001 * IDA_mem->ida_toldel) return(SUN_NLS_SUCCESS); } else { rate = SUNRpowerR( delnrm/IDA_mem->ida_oldnrm, ONE/m ); if (rate > RATEMAX) return(SUN_NLS_CONV_RECVR); IDA_mem->ida_ss = rate/(ONE - rate); } if (IDA_mem->ida_ss*delnrm <= tol) return(SUN_NLS_SUCCESS); /* not yet converged */ return(SUN_NLS_CONTINUE); }
/* * idaLapackBandSetup does the setup operations for the band linear solver. * It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y', * updates counters, and calls the band LU factorization routine. */ static int idaLapackBandSetup(IDAMem IDA_mem, N_Vector yP, N_Vector ypP, N_Vector fctP, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { IDADlsMem idadls_mem; int ier, retval; int intn, iml, imu, ldmat; idadls_mem = (IDADlsMem) lmem; intn = (int) n; iml = (int) ml; imu = (int) mu; ldmat = JJ->ldim; /* Call Jacobian function */ nje++; SetToZero(JJ); retval = bjac(n, mu, ml, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDALAPACK", "idaLapackBandSetup", MSGD_JACFUNC_FAILED); last_flag = IDADLS_JACFUNC_UNRECVR; return(-1); } else if (retval > 0) { last_flag = IDADLS_JACFUNC_RECVR; return(+1); } /* Do LU factorization of M */ dgbtrf_f77(&intn, &intn, &iml, &imu, JJ->data, &ldmat, pivots, &ier); /* Return 0 if the LU was complete; otherwise return 1 */ last_flag = (long int) ier; if (ier > 0) return(1); return(0); }
int IDASetEwtFn(void *ida_mem, IDAEwtFn efun, void *edata) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetEwtFn", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if ( IDA_mem->ida_VatolMallocDone ) { N_VDestroy(IDA_mem->ida_Vatol); lrw -= lrw1; liw -= liw1; IDA_mem->ida_VatolMallocDone = FALSE; } IDA_mem->ida_itol = IDA_WF; IDA_mem->ida_efun = efun; IDA_mem->ida_edata = edata; return(IDA_SUCCESS); }
int IDABand(void *ida_mem, int Neq, int mupper, int mlower) { IDAMem IDA_mem; IDADlsMem idadls_mem; int flag; /* Return immediately if ida_mem is NULL. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASBAND", "IDABand", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABand", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } /* Test mlower and mupper for legality. */ if ((mlower < 0) || (mupper < 0) || (mlower >= Neq) || (mupper >= Neq)) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABand", MSGD_BAD_SIZES); return(IDADLS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem. */ linit = IDABandInit; lsetup = IDABandSetup; lsolve = IDABandSolve; lperf = NULL; lfree = IDABandFree; /* Get memory for IDADlsMemRec. */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; bjac = NULL; jacdata = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Store problem size */ neq = Neq; idadls_mem->d_ml = mlower; idadls_mem->d_mu = mupper; /* Set extended upper half-bandwidth for JJ (required for pivoting). */ smu = MIN(Neq-1, mupper + mlower); /* Allocate memory for JJ and pivot array. */ JJ = NULL; JJ = NewBandMat(Neq, mupper, mlower, smu); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } pivots = NULL; pivots = NewIntArray(Neq); if (pivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to the integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); }
int IDAKLU(void *ida_mem, int n, int nnz) { IDAMem IDA_mem; IDASlsMem idasls_mem; KLUData klu_data; int flag; /* Return immediately if ida_mem is NULL. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASLS_MEM_NULL, "IDASLS", "IDAKLU", MSGSP_IDAMEM_NULL); return(IDASLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the Direct solver */ if (IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDASLS_ILL_INPUT, "IDASLS", "IDAKLU", MSGSP_BAD_NVECTOR); return(IDASLS_ILL_INPUT); } if (IDA_mem->ida_lfree != NULL) flag = IDA_mem->ida_lfree(IDA_mem); /* Set five main function fields in IDA_mem. */ IDA_mem->ida_linit = IDAKLUInit; IDA_mem->ida_lsetup = IDAKLUSetup; IDA_mem->ida_lsolve = IDAKLUSolve; IDA_mem->ida_lperf = NULL; IDA_mem->ida_lfree = IDAKLUFree; /* Get memory for IDASlsMemRec. */ idasls_mem = (IDASlsMem) malloc(sizeof(struct IDASlsMemRec)); if (idasls_mem == NULL) { IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU", MSGSP_MEM_FAIL); return(IDASLS_MEM_FAIL); } /* Get memory for KLUData. */ klu_data = (KLUData)malloc(sizeof(struct KLUDataRec)); if (klu_data == NULL) { IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU", MSGSP_MEM_FAIL); return(IDASLS_MEM_FAIL); } IDA_mem->ida_setupNonNull = TRUE; /* Set default Jacobian routine and Jacobian data */ idasls_mem->s_jaceval = NULL; idasls_mem->s_jacdata = IDA_mem->ida_user_data; /* Allocate memory for the sparse Jacobian */ idasls_mem->s_JacMat = NewSparseMat(n, n, nnz); if (idasls_mem->s_JacMat == NULL) { IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU", MSGSP_MEM_FAIL); return(IDASLS_MEM_FAIL); } /* KInitialize KLU structures */ klu_data->s_Symbolic = NULL; klu_data->s_Numeric = NULL; /* Set default parameters for KLU */ flag = klu_defaults(&klu_data->s_Common); if (flag == 0) { IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLU", MSGSP_PACKAGE_FAIL); return(IDASLS_PACKAGE_FAIL); } /* Set ordering to COLAMD as the idas default use. Users can set a different value with IDAKLUSetOrdering, and the user-set value is loaded before any call to klu_analyze in IDAKLUSetup. */ klu_data->s_ordering = 1; klu_data->s_Common.ordering = klu_data->s_ordering; /* Attach linear solver memory to the integrator memory */ idasls_mem->s_solver_data = (void *) klu_data; IDA_mem->ida_lmem = idasls_mem; idasls_mem->s_last_flag = IDASLS_SUCCESS; return(IDASLS_SUCCESS); }
int IDASetTolerances(void *ida_mem, int itol, realtype rtol, void *atol) { IDAMem IDA_mem; booleantype neg_atol; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetTolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if ida_mem was allocated */ if (IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASetTolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs */ if ((itol != IDA_SS) && (itol != IDA_SV)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetTolerances", MSG_BAD_ITOL); return(IDA_ILL_INPUT); } if (atol == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetTolerances", MSG_ATOL_NULL); return(IDA_ILL_INPUT); } if (rtol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetTolerances", MSG_BAD_RTOL); return(IDA_ILL_INPUT); } if (itol == IDA_SS) { neg_atol = (*((realtype *)atol) < ZERO); } else { neg_atol = (N_VMin((N_Vector)atol) < ZERO); } if (neg_atol) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetTolerances", MSG_BAD_ATOL); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ if ( (itol != IDA_SV) && (IDA_mem->ida_VatolMallocDone) ) { N_VDestroy(IDA_mem->ida_Vatol); lrw -= lrw1; liw -= liw1; IDA_mem->ida_VatolMallocDone = FALSE; } if ( (itol == IDA_SV) && !(IDA_mem->ida_VatolMallocDone) ) { IDA_mem->ida_Vatol = NULL; IDA_mem->ida_Vatol = N_VClone(IDA_mem->ida_ewt); lrw += lrw1; liw += liw1; IDA_mem->ida_VatolMallocDone = TRUE; } IDA_mem->ida_itol = itol; IDA_mem->ida_rtol = rtol; if (itol == IDA_SS) IDA_mem->ida_Satol = *((realtype *)atol); else N_VScale(ONE, (N_Vector)atol, IDA_mem->ida_Vatol); IDA_mem->ida_efun = IDAEwtSet; IDA_mem->ida_edata = ida_mem; return(IDA_SUCCESS); }
int IDAKLUReInit(void *ida_mem_v, int n, int nnz, int reinit_type) { IDAMem ida_mem; IDASlsMem idasls_mem; KLUData klu_data; SlsMat JacMat; /* Return immediately if ida_mem is NULL. */ if (ida_mem_v == NULL) { IDAProcessError(NULL, IDASLS_MEM_NULL, "IDASLS", "IDAKLUReInit", MSGSP_IDAMEM_NULL); return(IDASLS_MEM_NULL); } ida_mem = (IDAMem) ida_mem_v; /* Return immediately if ark_lmem is NULL. */ if (ida_mem->ida_lmem == NULL) { IDAProcessError(NULL, IDASLS_LMEM_NULL, "IDASLS", "IDAKLUReInit", MSGSP_LMEM_NULL); return(IDASLS_LMEM_NULL); } idasls_mem = (IDASlsMem) (ida_mem->ida_lmem); klu_data = (KLUData) idasls_mem->s_solver_data; /* Return if reinit_type is not valid */ if ((reinit_type != 1) && (reinit_type != 2)) { IDAProcessError(NULL, IDASLS_ILL_INPUT, "IDASLS", "IDAKLUReInit", MSGSP_ILL_INPUT); return(IDASLS_ILL_INPUT); } JacMat = idasls_mem->s_JacMat; if (reinit_type == 1) { /* Destroy previous Jacobian information */ if (idasls_mem->s_JacMat) { DestroySparseMat(idasls_mem->s_JacMat); } /* Allocate memory for the sparse Jacobian */ idasls_mem->s_JacMat = NewSparseMat(n, n, nnz); if (idasls_mem->s_JacMat == NULL) { IDAProcessError(ida_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU", MSGSP_MEM_FAIL); return(IDASLS_MEM_FAIL); } } /* Free the prior factorazation and reset for first factorization */ if( klu_data->s_Symbolic != NULL) klu_free_symbolic(&(klu_data->s_Symbolic), &(klu_data->s_Common)); if( klu_data->s_Numeric != NULL) klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common)); idasls_mem->s_first_factorize = 1; idasls_mem->s_last_flag = IDASLS_SUCCESS; return(0); }
static int IDAKLUSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, N_Vector rrp, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; realtype tn, cj; IDASlsMem idasls_mem; IDASlsSparseJacFn jaceval; KLUData klu_data; SlsMat JacMat; void *jacdata; realtype uround_twothirds; uround_twothirds = SUNRpowerR(IDA_mem->ida_uround,TWOTHIRDS); idasls_mem = (IDASlsMem) (IDA_mem->ida_lmem); tn = IDA_mem->ida_tn; cj = IDA_mem->ida_cj; klu_data = (KLUData) idasls_mem->s_solver_data; jaceval = idasls_mem->s_jaceval; jacdata = idasls_mem->s_jacdata; JacMat = idasls_mem->s_JacMat; /* Check that Jacobian eval routine is set */ if (jaceval == NULL) { IDAProcessError(IDA_mem, IDASLS_JAC_NOSET, "IDASLS", "IDAKLUSetup", MSGSP_JAC_NOSET); free(idasls_mem); idasls_mem = NULL; return(IDASLS_JAC_NOSET); } /* Increment nje counter and call Jacobian eval routine. */ idasls_mem->s_nje++; retval = jaceval(tn, cj, yyp, ypp, rrp, JacMat, jacdata, tmp1, tmp2, tmp3); if (retval < 0) { IDAProcessError(IDA_mem, IDASLS_JACFUNC_UNRECVR, "IDASLS", "IDAKLUSetup", MSGSP_JACFUNC_FAILED); idasls_mem->s_last_flag = IDASLS_JACFUNC_UNRECVR; return(IDASLS_JACFUNC_UNRECVR); } if (retval > 0) { idasls_mem->s_last_flag = IDASLS_JACFUNC_RECVR; return(+1); } if (idasls_mem->s_first_factorize) { /* ------------------------------------------------------------ Get the symbolic factorization ------------------------------------------------------------*/ /* Update the ordering option with any user-updated values from calls to IDAKLUSetOrdering */ klu_data->s_Common.ordering = klu_data->s_ordering; klu_data->s_Symbolic = klu_analyze(JacMat->N, JacMat->colptrs, JacMat->rowvals, &(klu_data->s_Common)); if (klu_data->s_Symbolic == NULL) { IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLUSetup", MSGSP_PACKAGE_FAIL); return(IDASLS_PACKAGE_FAIL); } /* ------------------------------------------------------------ Compute the LU factorization of the Jacobian. ------------------------------------------------------------*/ klu_data->s_Numeric = klu_factor(JacMat->colptrs, JacMat->rowvals, JacMat->data, klu_data->s_Symbolic, &(klu_data->s_Common)); if (klu_data->s_Numeric == NULL) { IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLUSetup", MSGSP_PACKAGE_FAIL); return(IDASLS_PACKAGE_FAIL); } idasls_mem->s_first_factorize = 0; } else { retval = klu_refactor(JacMat->colptrs, JacMat->rowvals, JacMat->data, klu_data->s_Symbolic, klu_data->s_Numeric, &(klu_data->s_Common)); if (retval == 0) { IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup", MSGSP_PACKAGE_FAIL); return(IDASLS_PACKAGE_FAIL); } /*----------------------------------------------------------- Check if a cheap estimate of the reciprocal of the condition number is getting too small. If so, delete the prior numeric factorization and recompute it. -----------------------------------------------------------*/ retval = klu_rcond(klu_data->s_Symbolic, klu_data->s_Numeric, &(klu_data->s_Common)); if (retval == 0) { IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup", MSGSP_PACKAGE_FAIL); return(IDASLS_PACKAGE_FAIL); } if ( (klu_data->s_Common.rcond) < uround_twothirds ) { /* Condition number may be getting large. Compute more accurate estimate */ retval = klu_condest(JacMat->colptrs, JacMat->data, klu_data->s_Symbolic, klu_data->s_Numeric, &(klu_data->s_Common)); if (retval == 0) { IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup", MSGSP_PACKAGE_FAIL); return(IDASLS_PACKAGE_FAIL); } if ( (klu_data->s_Common.condest) > (1.0/uround_twothirds) ) { /* More accurate estimate also says condition number is large, so recompute the numeric factorization */ klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common)); klu_data->s_Numeric = klu_factor(JacMat->colptrs, JacMat->rowvals, JacMat->data, klu_data->s_Symbolic, &(klu_data->s_Common)); if (klu_data->s_Numeric == NULL) { IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLUSetup", MSGSP_PACKAGE_FAIL); return(IDASLS_PACKAGE_FAIL); } } } } idasls_mem->s_last_flag = IDASLS_SUCCESS; return(0); }
static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight, N_Vector yy_now, N_Vector yp_now, N_Vector rr_now) { IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; int pretype, nli_inc, nps_inc, retval; realtype res_norm; idaspils_mem = (IDASpilsMem) lmem; spbcg_mem = (SpbcgMem)spils_mem; /* Set SpbcgSolve convergence test constant epslin, in terms of the Newton convergence test constant epsNewt and safety factors. The factor sqrt(Neq) assures that the Bi-CGSTAB convergence test is applied to the WRMS norm of the residual vector, rather than the weighted L2 norm. */ epslin = sqrtN*eplifac*epsNewt; /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */ ycur = yy_now; ypcur = yp_now; rcur = rr_now; /* Set SpbcgSolve inputs pretype and initial guess xx = 0 */ pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT; N_VConst(ZERO, xx); /* Call SpbcgSolve and copy xx to bb */ retval = SpbcgSolve(spbcg_mem, IDA_mem, xx, bb, pretype, epslin, IDA_mem, weight, weight, IDASpilsAtimes, IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc); last_flag = retval; if (nli_inc == 0) N_VScale(ONE, SPBCG_VTEMP(spbcg_mem), bb); else N_VScale(ONE, xx, bb); /* Increment counters nli, nps, and return if successful */ nli += nli_inc; nps += nps_inc; if (retval != SPBCG_SUCCESS) ncfl++; /* Interpret return value from SpbcgSolve */ last_flag = retval; switch(retval) { case SPBCG_SUCCESS: return(0); break; case SPBCG_RES_REDUCED: return(1); break; case SPBCG_CONV_FAIL: return(1); break; case SPBCG_PSOLVE_FAIL_REC: return(1); break; case SPBCG_ATIMES_FAIL_REC: return(1); break; case SPBCG_MEM_NULL: return(-1); break; case SPBCG_ATIMES_FAIL_UNREC: IDAProcessError(IDA_mem, SPBCG_ATIMES_FAIL_UNREC, "IDaSPBCG", "IDASpbcgSolve", MSGS_JTIMES_FAILED); return(-1); break; case SPBCG_PSOLVE_FAIL_UNREC: IDAProcessError(IDA_mem, SPBCG_PSOLVE_FAIL_UNREC, "IDASPBCG", "IDASpbcgSolve", MSGS_PSOLVE_FAILED); return(-1); break; } return(0); }
int IDACalcIC(void *ida_mem, int icopt, realtype tout1) { int ewtsetOK; int ier, nwt, nh, mxnh, icret, retval=0; int is; realtype tdist, troundoff, minid, hic, ypnorm; IDAMem IDA_mem; booleantype sensi_stg, sensi_sim; /* Check if IDA memory exists */ if(ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDACalcIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if(IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDACalcIC", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs to IDA for correctness and consistency */ ier = IDAInitialSetup(IDA_mem); if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT); IDA_mem->ida_SetupDone = TRUE; /* Check legality of input arguments, and set IDA memory copies. */ if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ICOPT); return(IDA_ILL_INPUT); } IDA_mem->ida_icopt = icopt; if(icopt == IDA_YA_YDP_INIT && (id == NULL)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_MISSING_ID); return(IDA_ILL_INPUT); } tdist = SUNRabs(tout1 - tn); troundoff = TWO*uround*(SUNRabs(tn) + SUNRabs(tout1)); if(tdist < troundoff) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_TOO_CLOSE); return(IDA_ILL_INPUT); } /* Are we computing sensitivities? */ sensi_stg = (sensi && (ism==IDA_STAGGERED)); sensi_sim = (sensi && (ism==IDA_SIMULTANEOUS)); /* Allocate space and initialize temporary vectors */ yy0 = N_VClone(ee); yp0 = N_VClone(ee); t0 = tn; N_VScale(ONE, phi[0], yy0); N_VScale(ONE, phi[1], yp0); if (sensi) { /* Allocate temporary space required for sensitivity IC: yyS0 and ypS0. */ yyS0 = N_VCloneVectorArray(Ns, ee); ypS0 = N_VCloneVectorArray(Ns, ee); /* Initialize sensitivity vector. */ for (is=0; is<Ns; is++) { N_VScale(ONE, phiS[0][is], yyS0[is]); N_VScale(ONE, phiS[1][is], ypS0[is]); } /* Initialize work space vectors needed for sensitivities. */ savresS = phiS[2]; delnewS = phiS[3]; yyS0new = phiS[4]; ypS0new = eeS; } /* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */ IDA_mem->ida_sysindex = 1; IDA_mem->ida_tscale = tdist; if(icopt == IDA_YA_YDP_INIT) { minid = N_VMin(id); if(minid < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ID); return(IDA_ILL_INPUT); } if(minid > HALF) IDA_mem->ida_sysindex = 0; } /* Set the test constant in the Newton convergence test */ IDA_mem->ida_epsNewt = epiccon; /* Initializations: cjratio = 1 (for use in direct linear solvers); set nbacktr = 0; */ cjratio = ONE; nbacktr = 0; /* Set hic, hh, cj, and mxnh. */ hic = PT001*tdist; ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg); if (sensi_sim) ypnorm = IDASensWrmsNormUpdate(IDA_mem, ypnorm, ypS0, ewtS, FALSE); if(ypnorm > HALF/hic) hic = HALF/ypnorm; if(tout1 < tn) hic = -hic; hh = hic; if(icopt == IDA_YA_YDP_INIT) { cj = ONE/hic; mxnh = maxnh; } else { cj = ZERO; mxnh = 1; } /* Loop over nwt = number of evaluations of ewt vector. */ for(nwt = 1; nwt <= 2; nwt++) { /* Loop over nh = number of h values. */ for(nh = 1; nh <= mxnh; nh++) { /* Call the IC nonlinear solver function. */ retval = IDANlsIC(IDA_mem); /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */ if(retval == IDA_SUCCESS) break; ncfn++; if(retval < 0) break; if(nh == mxnh) break; /* If looping to try again, reset yy0 and yp0 if not converging. */ if(retval != IC_SLOW_CONVRG) { N_VScale(ONE, phi[0], yy0); N_VScale(ONE, phi[1], yp0); if (sensi_sim) { /* Reset yyS0 and ypS0. */ /* Copy phiS[0] and phiS[1] into yyS0 and ypS0. */ for (is=0; is<Ns; is++) { N_VScale(ONE, phiS[0][is], yyS0[is]); N_VScale(ONE, phiS[1][is], ypS0[is]); } } } hic *= PT1; cj = ONE/hic; hh = hic; } /* End of nh loop */ /* Break on failure */ if(retval != IDA_SUCCESS) break; /* Reset ewt, save yy0, yp0 in phi, and loop. */ ewtsetOK = efun(yy0, ewt, edata); if(ewtsetOK != 0) { retval = IDA_BAD_EWT; break; } N_VScale(ONE, yy0, phi[0]); N_VScale(ONE, yp0, phi[1]); if (sensi_sim) { /* Reevaluate ewtS. */ ewtsetOK = IDASensEwtSet(IDA_mem, yyS0, ewtS); if(ewtsetOK != 0) { retval = IDA_BAD_EWT; break; } /* Save yyS0 and ypS0. */ for (is=0; is<Ns; is++) { N_VScale(ONE, yyS0[is], phiS[0][is]); N_VScale(ONE, ypS0[is], phiS[1][is]); } } } /* End of nwt loop */ /* Load the optional outputs. */ if(icopt == IDA_YA_YDP_INIT) hused = hic; /* On any failure, free memory, print error message and return */ if(retval != IDA_SUCCESS) { N_VDestroy(yy0); N_VDestroy(yp0); if(sensi) { N_VDestroyVectorArray(yyS0, Ns); N_VDestroyVectorArray(ypS0, Ns); } icret = IDAICFailFlag(IDA_mem, retval); return(icret); } /* Unless using the STAGGERED approach for sensitivities, return now */ if (!sensi_stg) { N_VDestroy(yy0); N_VDestroy(yp0); if(sensi) { N_VDestroyVectorArray(yyS0, Ns); N_VDestroyVectorArray(ypS0, Ns); } return(IDA_SUCCESS); } /* Find consistent I.C. for sensitivities using a staggered approach */ /* Evaluate res at converged y, needed for future evaluations of sens. RHS If res() fails recoverably, treat it as a convergence failure and attempt the step again */ retval = res(t0, yy0, yp0, delta, user_data); nre++; if(retval < 0) /* res function failed unrecoverably. */ return(IDA_RES_FAIL); if(retval > 0) /* res function failed recoverably but no recovery possible. */ return(IDA_FIRST_RES_FAIL); /* Loop over nwt = number of evaluations of ewt vector. */ for(nwt = 1; nwt <= 2; nwt++) { /* Loop over nh = number of h values. */ for(nh = 1; nh <= mxnh; nh++) { retval = IDASensNlsIC(IDA_mem); if(retval == IDA_SUCCESS) break; /* Increment the number of the sensitivity related corrector convergence failures. */ ncfnS++; if(retval < 0) break; if(nh == mxnh) break; /* If looping to try again, reset yyS0 and ypS0 if not converging. */ if(retval != IC_SLOW_CONVRG) { for (is=0; is<Ns; is++) { N_VScale(ONE, phiS[0][is], yyS0[is]); N_VScale(ONE, phiS[1][is], ypS0[is]); } } hic *= PT1; cj = ONE/hic; hh = hic; } /* End of nh loop */ /* Break on failure */ if(retval != IDA_SUCCESS) break; /* Since it was successful, reevaluate ewtS with the new values of yyS0, save yyS0 and ypS0 in phiS[0] and phiS[1] and loop one more time to check and maybe correct the new sensitivities IC with respect to the new weights. */ /* Reevaluate ewtS. */ ewtsetOK = IDASensEwtSet(IDA_mem, yyS0, ewtS); if(ewtsetOK != 0) { retval = IDA_BAD_EWT; break; } /* Save yyS0 and ypS0. */ for (is=0; is<Ns; is++) { N_VScale(ONE, yyS0[is], phiS[0][is]); N_VScale(ONE, ypS0[is], phiS[1][is]); } } /* End of nwt loop */ /* Load the optional outputs. */ if(icopt == IDA_YA_YDP_INIT) hused = hic; /* Free temporary space */ N_VDestroy(yy0); N_VDestroy(yp0); /* Here sensi is TRUE, so deallocate sensitivity temporary vectors. */ N_VDestroyVectorArray(yyS0, Ns); N_VDestroyVectorArray(ypS0, Ns); /* On any failure, print message and return proper flag. */ if(retval != IDA_SUCCESS) { icret = IDAICFailFlag(IDA_mem, retval); return(icret); } /* Otherwise return success flag. */ return(IDA_SUCCESS); }
int IDADense(void *ida_mem, long int Neq) { IDAMem IDA_mem; IDADlsMem idadls_mem; int flag; /* Return immediately if ida_mem is NULL. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADENSE", "IDADense", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the DENSE solver */ if (vec_tmpl->ops->nvgetarraypointer == NULL || vec_tmpl->ops->nvsetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDADENSE", "IDADense", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree != NULL) { flag = lfree(IDA_mem); } /* Set five main function fields in IDA_mem. */ linit = IDADenseInit; lsetup = IDADenseSetup; lsolve = IDADenseSolve; lperf = NULL; lfree = IDADenseFree; /* Get memory for IDADlsMemRec. */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; djac = NULL; jacdata = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Store problem size */ neq = Neq; /* Allocate memory for JJ and pivot array. */ JJ = NULL; JJ = NewDenseMat(Neq, Neq); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } lpivots = NULL; lpivots = NewLintArray(Neq); if (lpivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to the integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); }
/*--------------------------------------------------------------- User-Callable Functions: initialization, reinit and free ---------------------------------------------------------------*/ int IDABBDPrecInit(void *ida_mem, sunindextype Nlocal, sunindextype mudq, sunindextype mldq, sunindextype mukeep, sunindextype mlkeep, realtype dq_rel_yy, IDABBDLocalFn Gres, IDABBDCommFn Gcomm) { IDAMem IDA_mem; IDALsMem idals_mem; IBBDPrecData pdata; sunindextype muk, mlk, storage_mu, lrw1, liw1; long int lrw, liw; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the LS linear solver interface has been created */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* Test compatibility of NVECTOR package with the BBD preconditioner */ if(IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_BAD_NVECTOR); return(IDALS_ILL_INPUT); } /* Allocate data memory. */ pdata = NULL; pdata = (IBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* Set pointers to glocal and gcomm; load half-bandwidths. */ pdata->ida_mem = IDA_mem; pdata->glocal = Gres; pdata->gcomm = Gcomm; pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq)); pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq)); muk = SUNMIN(Nlocal-1, SUNMAX(0, mukeep)); mlk = SUNMIN(Nlocal-1, SUNMAX(0, mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Set extended upper half-bandwidth for PP (required for pivoting). */ storage_mu = SUNMIN(Nlocal-1, muk+mlk); /* Allocate memory for preconditioner matrix. */ pdata->PP = NULL; pdata->PP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu); if (pdata->PP == NULL) { free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* Allocate memory for temporary N_Vectors */ pdata->zlocal = NULL; pdata->zlocal = N_VNewEmpty_Serial(Nlocal); if (pdata->zlocal == NULL) { SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->rlocal = NULL; pdata->rlocal = N_VNewEmpty_Serial(Nlocal); if (pdata->rlocal == NULL) { N_VDestroy(pdata->zlocal); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->tempv1 = NULL; pdata->tempv1 = N_VClone(IDA_mem->ida_tempv1); if (pdata->tempv1 == NULL){ N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->tempv2 = NULL; pdata->tempv2 = N_VClone(IDA_mem->ida_tempv1); if (pdata->tempv2 == NULL){ N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->tempv1); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->tempv3 = NULL; pdata->tempv3 = N_VClone(IDA_mem->ida_tempv1); if (pdata->tempv3 == NULL){ N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->tempv4 = NULL; pdata->tempv4 = N_VClone(IDA_mem->ida_tempv1); if (pdata->tempv4 == NULL){ N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* Allocate memory for banded linear solver */ pdata->LS = NULL; pdata->LS = SUNLinSol_Band(pdata->rlocal, pdata->PP); if (pdata->LS == NULL) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); N_VDestroy(pdata->tempv4); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* initialize band linear solver object */ flag = SUNLinSolInitialize(pdata->LS); if (flag != SUNLS_SUCCESS) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); N_VDestroy(pdata->tempv4); SUNMatDestroy(pdata->PP); SUNLinSolFree(pdata->LS); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_SUNLS_FAIL); return(IDALS_SUNLS_FAIL); } /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : SUNRsqrt(IDA_mem->ida_uround); /* Store Nlocal to be used in IDABBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge. */ pdata->rpwsize = 0; pdata->ipwsize = 0; if (IDA_mem->ida_tempv1->ops->nvspace) { N_VSpace(IDA_mem->ida_tempv1, &lrw1, &liw1); pdata->rpwsize += 4*lrw1; pdata->ipwsize += 4*liw1; } if (pdata->rlocal->ops->nvspace) { N_VSpace(pdata->rlocal, &lrw1, &liw1); pdata->rpwsize += 2*lrw1; pdata->ipwsize += 2*liw1; } if (pdata->PP->ops->space) { flag = SUNMatSpace(pdata->PP, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } if (pdata->LS->ops->space) { flag = SUNLinSolSpace(pdata->LS, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } pdata->nge = 0; /* make sure pdata is free from any previous allocations */ if (idals_mem->pfree) idals_mem->pfree(IDA_mem); /* Point to the new pdata field in the LS memory */ idals_mem->pdata = pdata; /* Attach the pfree function */ idals_mem->pfree = IDABBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = IDASetPreconditioner(ida_mem, IDABBDPrecSetup, IDABBDPrecSolve); return(flag); }
/* * ----------------------------------------------------------------- * IDALapackBand * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the band linear solver module. It first calls * the existing lfree routine if this is not NULL. It then sets the * ida_linit, ida_lsetup, ida_lsolve, and ida_lfree fields in (*ida_mem) * to be idaLapackBandInit, idaLapackBandSetup, idaLapackBandSolve, * and idaLapackBandFree, respectively. It allocates memory for a * structure of type IDALapackBandMemRec and sets the ida_lmem field in * (*ida_mem) to the address of this structure. It sets setupNonNull * in (*ida_mem) to be TRUE, mu to be mupper, ml to be mlower, and * the jacE and jacI field to NULL. * Finally, it allocates memory for M and pivots. * The IDALapackBand return value is IDADLS_SUCCESS = 0, * IDADLS_MEM_FAIL = -1, or IDADLS_ILL_INPUT = -2. * * NOTE: The IDALAPACK linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDALapackBand will first * test for compatible a compatible N_Vector internal * representation by checking that the function * N_VGetArrayPointer exists. * ----------------------------------------------------------------- */ int IDALapackBand(void *ida_mem, int N, int mupper, int mlower) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackBand", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the BAND solver */ if (tempv->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree != NULL) lfree(IDA_mem); /* Set four main function fields in IDA_mem */ linit = idaLapackBandInit; lsetup = idaLapackBandSetup; lsolve = idaLapackBandSolve; lperf = NULL; lfree = idaLapackBandFree; /* Get memory for IDADlsMemRec */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_BAND; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; bjac = NULL; J_data = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Load problem dimension */ n = (long int) N; /* Load half-bandwiths in idadls_mem */ ml = (long int) mlower; mu = (long int) mupper; /* Test ml and mu for legality */ if ((ml < 0) || (mu < 0) || (ml >= n) || (mu >= n)) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_SIZES); free(idadls_mem); idadls_mem = NULL; return(IDADLS_ILL_INPUT); } /* Set extended upper half-bandwith for M (required for pivoting) */ smu = MIN(n-1, mu + ml); /* Allocate memory for JJ and pivot arrays */ JJ = NULL; pivots = NULL; JJ = NewBandMat(n, mu, ml, smu); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); }
/* * ----------------------------------------------------------------- * IDALapackDense * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the linear solver module. IDALapackDense first * calls the existing lfree routine if this is not NULL. Then it sets * the ida_linit, ida_lsetup, ida_lsolve, ida_lfree fields in (*ida_mem) * to be idaLapackDenseInit, idaLapackDenseSetup, idaLapackDenseSolve, * and idaLapackDenseFree, respectively. It allocates memory for a * structure of type IDADlsMemRec and sets the ida_lmem field in * (*ida_mem) to the address of this structure. It sets setupNonNull * in (*ida_mem) to TRUE, and the d_jac field to the default * idaLapackDenseDQJac. Finally, it allocates memory for M, pivots. * * The return value is SUCCESS = 0, or LMEM_FAIL = -1. * * NOTE: The dense linear solver assumes a serial implementation * of the NVECTOR package. Therefore, IDALapackDense will first * test for a compatible N_Vector internal representation * by checking that N_VGetArrayPointer and N_VSetArrayPointer * exist. * ----------------------------------------------------------------- */ int IDALapackDense(void *ida_mem, int N) { IDAMem IDA_mem; IDADlsMem idadls_mem; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackDense", MSGD_IDAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with the LAPACK solver */ if (tempv->ops->nvgetarraypointer == NULL || tempv->ops->nvsetarraypointer == NULL) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackDense", MSGD_BAD_NVECTOR); return(IDADLS_ILL_INPUT); } if (lfree !=NULL) lfree(IDA_mem); /* Set four main function fields in IDA_mem */ linit = idaLapackDenseInit; lsetup = idaLapackDenseSetup; lsolve = idaLapackDenseSolve; lperf = NULL; lfree = idaLapackDenseFree; /* Get memory for IDADlsMemRec */ idadls_mem = NULL; idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec)); if (idadls_mem == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* Set matrix type */ mtype = SUNDIALS_DENSE; /* Set default Jacobian routine and Jacobian data */ jacDQ = TRUE; djac = NULL; J_data = NULL; last_flag = IDADLS_SUCCESS; setupNonNull = TRUE; /* Set problem dimension */ n = (long int) N; /* Allocate memory for JJ and pivot array */ JJ = NULL; pivots = NULL; JJ = NewDenseMat(n, n); if (JJ == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } pivots = NewIntArray(N); if (pivots == NULL) { IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL); DestroyMat(JJ); free(idadls_mem); idadls_mem = NULL; return(IDADLS_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = idadls_mem; return(IDADLS_SUCCESS); }
void *IDABBDPrecAlloc(void *ida_mem, long int Nlocal, long int mudq, long int mldq, long int mukeep, long int mlkeep, realtype dq_rel_yy, IDABBDLocalFn Gres, IDABBDCommFn Gcomm) { IDAMem IDA_mem; IBBDPrecData pdata; N_Vector tempv4; long int muk, mlk, storage_mu; if (ida_mem == NULL) { IDAProcessError(NULL, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_IDAMEM_NULL); return(NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the NVECTOR package is compatible with BLOCK BAND preconditioner */ if(vec_tmpl->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_BAD_NVECTOR); return(NULL); } /* Allocate data memory. */ pdata = NULL; pdata = (IBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_MEM_FAIL); return(NULL); } /* Set pointers to glocal and gcomm; load half-bandwidths. */ pdata->ida_mem = IDA_mem; pdata->glocal = Gres; pdata->gcomm = Gcomm; pdata->mudq = MIN(Nlocal-1, MAX(0, mudq)); pdata->mldq = MIN(Nlocal-1, MAX(0, mldq)); muk = MIN(Nlocal-1, MAX(0, mukeep)); mlk = MIN(Nlocal-1, MAX(0, mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Set extended upper half-bandwidth for PP (required for pivoting). */ storage_mu = MIN(Nlocal-1, muk+mlk); /* Allocate memory for preconditioner matrix. */ pdata->PP = NULL; pdata->PP = BandAllocMat(Nlocal, muk, mlk, storage_mu); if (pdata->PP == NULL) { free(pdata); pdata = NULL; IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_MEM_FAIL); return(NULL); } /* Allocate memory for pivots. */ pdata->pivots = NULL; pdata->pivots = BandAllocPiv(Nlocal); if (pdata->PP == NULL) { BandFreeMat(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_MEM_FAIL); return(NULL); } /* Allocate tempv4 for use by IBBDDQJac */ tempv4 = NULL; tempv4 = N_VClone(vec_tmpl); if (tempv4 == NULL){ BandFreeMat(pdata->PP); BandFreePiv(pdata->pivots); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_MEM_FAIL); return(NULL); } pdata->tempv4 = tempv4; /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); /* Store Nlocal to be used in IDABBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge. */ pdata->rpwsize = Nlocal*(mlk + storage_mu + 1); pdata->ipwsize = Nlocal; pdata->nge = 0; return((void *)pdata); }
int IDABandB(void *ida_mem, int which, int NeqB, int mupperB, int mlowerB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDADlsMemB idadlsB_mem; void *ida_memB; int flag; /* Is ida_mem allright? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASBAND", "IDABandB", MSGD_CAMEM_NULL); return(IDADLS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDADLS_NO_ADJ, "IDASBAND", "IDABandB", MSGD_NO_ADJ); return(IDADLS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABandB", MSGD_BAD_WHICH); return(IDADLS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get memory for IDADlsMemRecB */ idadlsB_mem = (IDADlsMemB) malloc(sizeof(struct IDADlsMemRecB)); if (idadlsB_mem == NULL) { IDAProcessError(IDAB_mem->IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABandB", MSGD_MEM_FAIL); return(IDADLS_MEM_FAIL); } /* set matrix type and initialize Jacob function. */ idadlsB_mem->d_typeB = SUNDIALS_BAND; idadlsB_mem->d_bjacB = NULL; /* Attach lmemB data and lfreeB function. */ IDAB_mem->ida_lmem = idadlsB_mem; IDAB_mem->ida_lfree = IDABandFreeB; /* Call IDABand for the IDAS data of the backward problem. */ ida_memB = (void *)IDAB_mem->IDA_mem; flag = IDABand(ida_memB, NeqB, mupperB, mlowerB); if (flag != IDADLS_SUCCESS) { free(idadlsB_mem); idadlsB_mem = NULL; } return(flag); }
int IDASpbcgB(void *ida_mem, int which, int maxlB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDASpilsMemB idaspilsB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcgB", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == FALSE) { IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASPBCG", "IDASpbcgB", MSGS_NO_ADJ); return(IDASPILS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcgB", MSGS_BAD_WHICH); return(IDASPILS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Get memory for IDASpilsMemRecB */ idaspilsB_mem = NULL; idaspilsB_mem = (IDASpilsMemB) malloc(sizeof(struct IDASpilsMemRecB)); if (idaspilsB_mem == NULL) { IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcgB", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } idaspilsB_mem->s_psetB = NULL; idaspilsB_mem->s_psolveB = NULL; idaspilsB_mem->s_P_dataB = NULL; /* initialize Jacobian function */ idaspilsB_mem->s_jtimesB = NULL; /* attach lmem and lfree */ IDAB_mem->ida_lmem = idaspilsB_mem; IDAB_mem->ida_lfree = IDASpbcgFreeB; flag = IDASpbcg(IDAB_mem->IDA_mem, maxlB); if (flag != IDASPILS_SUCCESS) { free(idaspilsB_mem); idaspilsB_mem = NULL; } return(flag); }
int IDACalcIC(void *ida_mem, int icopt, realtype tout1) { int ewtsetOK; int ier, nwt, nh, mxnh, icret, retval=0; realtype tdist, troundoff, minid, hic, ypnorm; IDAMem IDA_mem; /* Check if IDA memory exists */ if(ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDACalcIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if(IDA_mem->ida_MallocDone == FALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDACalcIC", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs to IDA for correctness and consistency */ ier = IDAInitialSetup(IDA_mem); if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT); IDA_mem->ida_SetupDone = TRUE; /* Check legality of input arguments, and set IDA memory copies. */ if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ICOPT); return(IDA_ILL_INPUT); } IDA_mem->ida_icopt = icopt; if(icopt == IDA_YA_YDP_INIT && (id == NULL)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_MISSING_ID); return(IDA_ILL_INPUT); } tdist = SUNRabs(tout1 - tn); troundoff = TWO*uround*(SUNRabs(tn) + SUNRabs(tout1)); if(tdist < troundoff) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_TOO_CLOSE); return(IDA_ILL_INPUT); } /* Allocate space and initialize temporary vectors */ yy0 = N_VClone(ee); yp0 = N_VClone(ee); t0 = tn; N_VScale(ONE, phi[0], yy0); N_VScale(ONE, phi[1], yp0); /* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */ IDA_mem->ida_sysindex = 1; IDA_mem->ida_tscale = tdist; if(icopt == IDA_YA_YDP_INIT) { minid = N_VMin(id); if(minid < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ID); return(IDA_ILL_INPUT); } if(minid > HALF) IDA_mem->ida_sysindex = 0; } /* Set the test constant in the Newton convergence test */ IDA_mem->ida_epsNewt = epiccon; /* Initializations: cjratio = 1 (for use in direct linear solvers); set nbacktr = 0; */ cjratio = ONE; nbacktr = 0; /* Set hic, hh, cj, and mxnh. */ hic = PT001*tdist; ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg); if(ypnorm > HALF/hic) hic = HALF/ypnorm; if(tout1 < tn) hic = -hic; hh = hic; if(icopt == IDA_YA_YDP_INIT) { cj = ONE/hic; mxnh = maxnh; } else { cj = ZERO; mxnh = 1; } /* Loop over nwt = number of evaluations of ewt vector. */ for(nwt = 1; nwt <= 2; nwt++) { /* Loop over nh = number of h values. */ for(nh = 1; nh <= mxnh; nh++) { /* Call the IC nonlinear solver function. */ retval = IDAnlsIC(IDA_mem); /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */ if(retval == IDA_SUCCESS) break; ncfn++; if(retval < 0) break; if(nh == mxnh) break; /* If looping to try again, reset yy0 and yp0 if not converging. */ if(retval != IC_SLOW_CONVRG) { N_VScale(ONE, phi[0], yy0); N_VScale(ONE, phi[1], yp0); } hic *= PT1; cj = ONE/hic; hh = hic; } /* End of nh loop */ /* Break on failure; else reset ewt, save yy0, yp0 in phi, and loop. */ if(retval != IDA_SUCCESS) break; ewtsetOK = efun(yy0, ewt, edata); if(ewtsetOK != 0) { retval = IDA_BAD_EWT; break; } N_VScale(ONE, yy0, phi[0]); N_VScale(ONE, yp0, phi[1]); } /* End of nwt loop */ /* Free temporary space */ N_VDestroy(yy0); N_VDestroy(yp0); /* Load the optional outputs. */ if(icopt == IDA_YA_YDP_INIT) hused = hic; /* On any failure, print message and return proper flag. */ if(retval != IDA_SUCCESS) { icret = IDAICFailFlag(IDA_mem, retval); return(icret); } /* Otherwise return success flag. */ return(IDA_SUCCESS); }
int IDASetNonlinearSolver(void *ida_mem, SUNNonlinearSolver NLS) { IDAMem IDA_mem; int retval; /* return immediately if IDA memory is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetNonlinearSolver", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* return immediately if NLS memory is NULL */ if (NLS == NULL) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDA", "IDASetNonlinearSolver", "NLS must be non-NULL"); return(IDA_ILL_INPUT); } /* check for required nonlinear solver functions */ if ( NLS->ops->gettype == NULL || NLS->ops->initialize == NULL || NLS->ops->solve == NULL || NLS->ops->free == NULL || NLS->ops->setsysfn == NULL ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinearSolver", "NLS does not support required operations"); return(IDA_ILL_INPUT); } /* check for allowed nonlinear solver types */ if (SUNNonlinSolGetType(NLS) != SUNNONLINEARSOLVER_ROOTFIND) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinearSolver", "NLS type must be SUNNONLINEARSOLVER_ROOTFIND"); return(IDA_ILL_INPUT); } /* free any existing nonlinear solver */ if (IDA_mem->NLS) retval = SUNNonlinSolFree(IDA_mem->NLS); /* set SUNNonlinearSolver pointer */ IDA_mem->NLS = NLS; /* Set NLS ownership flag. If this function was called to attach the default NLS, IDA will set the flag to SUNTRUE after this function returns. */ IDA_mem->ownNLS = SUNFALSE; /* set the nonlinear residual function */ retval = SUNNonlinSolSetSysFn(IDA_mem->NLS, idaNlsResidual); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinearSolver", "Setting nonlinear system function failed"); return(IDA_ILL_INPUT); } /* set convergence test function */ retval = SUNNonlinSolSetConvTestFn(IDA_mem->NLS, idaNlsConvTest); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinearSolver", "Setting convergence test function failed"); return(IDA_ILL_INPUT); } /* set max allowed nonlinear iterations */ retval = SUNNonlinSolSetMaxIters(IDA_mem->NLS, MAXIT); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetNonlinearSolver", "Setting maximum number of nonlinear iterations failed"); return(IDA_ILL_INPUT); } return(IDA_SUCCESS); }
int IDASpbcg(void *ida_mem, int maxl) { IDAMem IDA_mem; IDASpilsMem idaspils_mem; SpbcgMem spbcg_mem; int flag, maxl1; /* Return immediately if ida_mem is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcg", MSGS_IDAMEM_NULL); return(IDASPILS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if N_VDotProd is present */ if (vec_tmpl->ops->nvdotprod == NULL) { IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcg", MSGS_BAD_NVECTOR); return(IDASPILS_ILL_INPUT); } if (lfree != NULL) flag = lfree((IDAMem) ida_mem); /* Set five main function fields in ida_mem */ linit = IDASpbcgInit; lsetup = IDASpbcgSetup; lsolve = IDASpbcgSolve; lperf = IDASpbcgPerf; lfree = IDASpbcgFree; /* Get memory for IDASpilsMemRec */ idaspils_mem = NULL; idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec)); if (idaspils_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); return(IDASPILS_MEM_FAIL); } /* Set ILS type */ idaspils_mem->s_type = SPILS_SPBCG; /* Set SPBCG parameters that were passed in call sequence */ maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl; idaspils_mem->s_maxl = maxl1; /* Set defaults for Jacobian-related fileds */ jtimesDQ = TRUE; jtimes = NULL; jdata = NULL; /* Set defaults for preconditioner-related fields */ idaspils_mem->s_pset = NULL; idaspils_mem->s_psolve = NULL; idaspils_mem->s_pfree = NULL; idaspils_mem->s_pdata = IDA_mem->ida_user_data; /* Set default values for the rest of the Spbcg parameters */ idaspils_mem->s_eplifac = PT05; idaspils_mem->s_dqincfac = ONE; idaspils_mem->s_last_flag = IDASPILS_SUCCESS; /* Set setupNonNull to FALSE */ setupNonNull = FALSE; /* Allocate memory for ytemp, yptemp, and xx */ ytemp = N_VClone(vec_tmpl); if (ytemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } yptemp = N_VClone(vec_tmpl); if (yptemp == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } xx = N_VClone(vec_tmpl); if (xx == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, ytemp); sqrtN = SUNRsqrt(N_VDotProd(ytemp, ytemp)); /* Call SpbcgMalloc to allocate workspace for Spbcg */ spbcg_mem = NULL; spbcg_mem = SpbcgMalloc(maxl1, vec_tmpl); if (spbcg_mem == NULL) { IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL); N_VDestroy(ytemp); N_VDestroy(yptemp); N_VDestroy(xx); free(idaspils_mem); idaspils_mem = NULL; return(IDASPILS_MEM_FAIL); } /* Attach SPBCG memory to spils memory structure */ spils_mem = (void *)spbcg_mem; /* Attach linear solver memory to the integrator memory */ lmem = idaspils_mem; return(IDASPILS_SUCCESS); }
/*--------------------------------------------------------------- User-Callable Functions: initialization, reinit and free ---------------------------------------------------------------*/ int IDABBDPrecInitB(void *ida_mem, int which, sunindextype NlocalB, sunindextype mudqB, sunindextype mldqB, sunindextype mukeepB, sunindextype mlkeepB, realtype dq_rel_yyB, IDABBDLocalFnB glocalB, IDABBDCommFnB gcommB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDABBDPrecDataB idabbdB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE", "IDABBDPrecInitB", MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDALS_NO_ADJ, "IDASBBDPRE", "IDABBDPrecInitB", MSG_LS_NO_ADJ); return(IDALS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE", "IDABBDPrecInitB", MSG_LS_BAD_WHICH); return(IDALS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Initialize the BBD preconditioner for this backward problem. */ flag = IDABBDPrecInit(ida_memB, NlocalB, mudqB, mldqB, mukeepB, mlkeepB, dq_rel_yyB, IDAAglocal, IDAAgcomm); if (flag != IDA_SUCCESS) return(flag); /* Allocate memory for IDABBDPrecDataB to store the user-provided functions which will be called from the wrappers */ idabbdB_mem = NULL; idabbdB_mem = (IDABBDPrecDataB) malloc(sizeof(* idabbdB_mem)); if (idabbdB_mem == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInitB", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* set pointers to user-provided functions */ idabbdB_mem->glocalB = glocalB; idabbdB_mem->gcommB = gcommB; /* Attach pmem and pfree */ IDAB_mem->ida_pmem = idabbdB_mem; IDAB_mem->ida_pfree = IDABBDPrecFreeB; return(IDALS_SUCCESS); }