/*----------------------------------------------------------------- cvDlsDQJac ----------------------------------------------------------------- This routine is a wrapper for the Dense and Band implementations of the difference quotient Jacobian approximation routines. ---------------------------------------------------------------*/ int cvDlsDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, void *cvode_mem, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; CVodeMem cv_mem; cv_mem = (CVodeMem) cvode_mem; /* verify that Jac is non-NULL */ if (Jac == NULL) { cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", "cvDlsDQJac", MSGD_LMEM_NULL); return(CVDLS_LMEM_NULL); } if (SUNMatGetID(Jac) == SUNMATRIX_DENSE) { retval = cvDlsDenseDQJac(t, y, fy, Jac, cv_mem, tmp1); } else if (SUNMatGetID(Jac) == SUNMATRIX_BAND) { retval = cvDlsBandDQJac(t, y, fy, Jac, cv_mem, tmp1, tmp2); } else if (SUNMatGetID(Jac) == SUNMATRIX_SPARSE) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVDLS", "cvDlsDQJac", "cvDlsDQJac not implemented for SUNMATRIX_SPARSE"); retval = CV_ILL_INPUT; } else { cvProcessError(cv_mem, CV_ILL_INPUT, "CVDLS", "cvDlsDQJac", "unrecognized matrix type for cvDlsDQJac"); retval = CV_ILL_INPUT; } return(retval); }
sunindextype SUNBandMatrix_StoredUpperBandwidth(SUNMatrix A) { if (SUNMatGetID(A) == SUNMATRIX_BAND) return SM_SUBAND_B(A); else return -1; }
sunindextype SUNBandMatrix_LowerBandwidth(SUNMatrix A) { if (SUNMatGetID(A) == SUNMATRIX_BAND) return SM_LBAND_B(A); else return -1; }
sunindextype SUNBandMatrix_Columns(SUNMatrix A) { if (SUNMatGetID(A) == SUNMATRIX_BAND) return SM_COLUMNS_B(A); else return -1; }
sunindextype SUNBandMatrix_Rows(SUNMatrix A) { if (SUNMatGetID(A) == SUNMATRIX_BAND) return SM_ROWS_B(A); else return -1; }
void SUNBandMatrix_Print(SUNMatrix A, FILE* outfile) { sunindextype i, j, start, finish; /* should not be called unless A is a band matrix; otherwise return immediately */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return; /* perform operation */ fprintf(outfile,"\n"); for (i=0; i<SM_ROWS_B(A); i++) { start = SUNMAX(0, i-SM_LBAND_B(A)); finish = SUNMIN(SM_COLUMNS_B(A)-1, i+SM_UBAND_B(A)); for (j=0; j<start; j++) fprintf(outfile,"%12s ",""); for (j=start; j<=finish; j++) { #if defined(SUNDIALS_EXTENDED_PRECISION) fprintf(outfile,"%12Lg ", SM_ELEMENT_B(A,i,j)); #elif defined(SUNDIALS_DOUBLE_PRECISION) fprintf(outfile,"%12g ", SM_ELEMENT_B(A,i,j)); #else fprintf(outfile,"%12g ", SM_ELEMENT_B(A,i,j)); #endif } fprintf(outfile,"\n"); } fprintf(outfile,"\n"); return; }
realtype* SUNBandMatrix_Column(SUNMatrix A, sunindextype j) { if (SUNMatGetID(A) == SUNMATRIX_BAND) return SM_COLUMN_B(A,j); else return NULL; }
realtype* SUNBandMatrix_Data(SUNMatrix A) { if (SUNMatGetID(A) == SUNMATRIX_BAND) return SM_DATA_B(A); else return NULL; }
sunindextype SUNBandMatrix_LDim(SUNMatrix A) { if (SUNMatGetID(A) == SUNMATRIX_BAND) return SM_LDIM_B(A); else return -1; }
/*----------------------------------------------------------------- cvLsDQJac This routine is a wrapper for the Dense and Band implementations of the difference quotient Jacobian approximation routines. ---------------------------------------------------------------*/ int cvLsDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, void *cvode_mem, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVodeMem cv_mem; int retval; /* access CVodeMem structure */ if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVLS", "cvLsDQJac", MSG_LS_CVMEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* verify that Jac is non-NULL */ if (Jac == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVLS", "cvLsDQJac", MSG_LS_LMEM_NULL); return(CVLS_LMEM_NULL); } /* Verify that N_Vector supports required operations */ if (cv_mem->cv_tempv->ops->nvcloneempty == NULL || cv_mem->cv_tempv->ops->nvwrmsnorm == NULL || cv_mem->cv_tempv->ops->nvlinearsum == NULL || cv_mem->cv_tempv->ops->nvdestroy == NULL || cv_mem->cv_tempv->ops->nvscale == NULL || cv_mem->cv_tempv->ops->nvgetarraypointer == NULL || cv_mem->cv_tempv->ops->nvsetarraypointer == NULL) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "cvLsDQJac", MSG_LS_BAD_NVECTOR); return(CVLS_ILL_INPUT); } /* Call the matrix-structure-specific DQ approximation routine */ if (SUNMatGetID(Jac) == SUNMATRIX_DENSE) { retval = cvLsDenseDQJac(t, y, fy, Jac, cv_mem, tmp1); } else if (SUNMatGetID(Jac) == SUNMATRIX_BAND) { retval = cvLsBandDQJac(t, y, fy, Jac, cv_mem, tmp1, tmp2); } else { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "cvLsDQJac", "unrecognized matrix type for cvLsDQJac"); retval = CVLS_ILL_INPUT; } return(retval); }
static booleantype SMCompatible_Band(SUNMatrix A, SUNMatrix B) { /* both matrices must be SUNMATRIX_BAND */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return SUNFALSE; if (SUNMatGetID(B) != SUNMATRIX_BAND) return SUNFALSE; /* both matrices must have the same number of columns (note that we do not check for identical bandwidth) */ if (SM_ROWS_B(A) != SM_ROWS_B(B)) return SUNFALSE; if (SM_COLUMNS_B(A) != SM_COLUMNS_B(B)) return SUNFALSE; return SUNTRUE; }
int SUNMatZero_Band(SUNMatrix A) { sunindextype i; realtype *Adata; /* Verify that A is a band matrix */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return 1; /* Perform operation */ Adata = SM_DATA_B(A); for (i=0; i<SM_LDATA_B(A); i++) Adata[i] = ZERO; return 0; }
static booleantype SMCompatible2_Band(SUNMatrix A, N_Vector x, N_Vector y) { /* matrix must be SUNMATRIX_BAND */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return SUNFALSE; /* vectors must be one of {SERIAL, OPENMP, PTHREADS} */ if ( (N_VGetVectorID(x) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(x) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(x) != SUNDIALS_NVEC_PTHREADS) ) return SUNFALSE; /* Optimally we would verify that the dimensions of A, x and y agree, but since there is no generic 'length' routine for N_Vectors we cannot */ return SUNTRUE; }
int SUNMatScaleAddI_Band(realtype c, SUNMatrix A) { sunindextype i, j; realtype *A_colj; /* Verify that A is a band matrix */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return 1; /* Perform operation */ for (j=0; j<SM_COLUMNS_B(A); j++) { A_colj = SM_COLUMN_B(A,j); for (i=-SM_UBAND_B(A); i<=SM_LBAND_B(A); i++) A_colj[i] *= c; SM_ELEMENT_B(A,j,j) += ONE; } return 0; }
int SUNLinSolSetup_LapackDense(SUNLinearSolver S, SUNMatrix A) { int n, ier; /* check for valid inputs */ if ( (A == NULL) || (S == NULL) ) return(SUNLS_MEM_NULL); /* Ensure that A is a dense matrix */ if (SUNMatGetID(A) != SUNMATRIX_DENSE) { LASTFLAG(S) = SUNLS_ILL_INPUT; return(LASTFLAG(S)); } /* Call LAPACK to do LU factorization of A */ n = SUNDenseMatrix_Rows(A); xgetrf_f77(&n, &n, SUNDenseMatrix_Data(A), &n, PIVOTS(S), &ier); LASTFLAG(S) = (long int) ier; if (ier > 0) return(SUNLS_LUFACT_FAIL); if (ier < 0) return(SUNLS_PACKAGE_FAIL_UNREC); return(SUNLS_SUCCESS); }
/*----------------------------------------------------------------- cvLsInitialize This routine performs remaining initializations specific to the iterative linear solver interface (and solver itself) -----------------------------------------------------------------*/ int cvLsInitialize(CVodeMem cv_mem) { CVLsMem cvls_mem; int retval; /* access CVLsMem structure */ if (cv_mem->cv_lmem==NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVLS", "cvLsInitialize", MSG_LS_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* Test for valid combinations of matrix & Jacobian routines: */ if (cvls_mem->A == NULL) { /* If SUNMatrix A is NULL: ensure 'jac' function pointer is NULL */ cvls_mem->jacDQ = SUNFALSE; cvls_mem->jac = NULL; cvls_mem->J_data = NULL; } else if (cvls_mem->jacDQ) { /* If A is non-NULL, and 'jac' is not user-supplied: - if A is dense or band, ensure that our DQ approx. is used - otherwise => error */ retval = 0; if (cvls_mem->A->ops->getid) { if ( (SUNMatGetID(cvls_mem->A) == SUNMATRIX_DENSE) || (SUNMatGetID(cvls_mem->A) == SUNMATRIX_BAND) ) { cvls_mem->jac = cvLsDQJac; cvls_mem->J_data = cv_mem; } else { retval++; } } else { retval++; } if (retval) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "cvLsInitialize", "No Jacobian constructor available for SUNMatrix type"); cvls_mem->last_flag = CVLS_ILL_INPUT; return(CVLS_ILL_INPUT); } } else { /* If A is non-NULL, and 'jac' is user-supplied, reset J_data pointer (just in case) */ cvls_mem->J_data = cv_mem->cv_user_data; } /* reset counters */ cvLsInitializeCounters(cvls_mem); /* Set Jacobian-related fields, based on jtimesDQ */ if (cvls_mem->jtimesDQ) { cvls_mem->jtsetup = NULL; cvls_mem->jtimes = cvLsDQJtimes; cvls_mem->jt_data = cv_mem; } else { cvls_mem->jt_data = cv_mem->cv_user_data; } /* if A is NULL and psetup is not present, then cvLsSetup does not need to be called, so set the lsetup function to NULL */ if ( (cvls_mem->A == NULL) && (cvls_mem->pset == NULL) ) cv_mem->cv_lsetup = NULL; /* Call LS initialize routine, and return result */ cvls_mem->last_flag = SUNLinSolInitialize(cvls_mem->LS); return(cvls_mem->last_flag); }
/* ---------------------------------------------------------------------- * Check matrix * --------------------------------------------------------------------*/ int check_matrix(SUNMatrix A, SUNMatrix B, realtype tol) { int failure = 0; realtype *Adata, *Bdata; sunindextype *Aindexptrs, *Bindexptrs; sunindextype *Aindexvals, *Bindexvals; sunindextype i, ANP, BNP, Annz, Bnnz; /* get matrix pointers */ Adata = SUNSparseMatrix_Data(A); Aindexptrs = SUNSparseMatrix_IndexPointers(A); Aindexvals = SUNSparseMatrix_IndexValues(A); ANP = SUNSparseMatrix_NP(A); Annz = Aindexptrs[ANP]; Bdata = SUNSparseMatrix_Data(B); Bindexptrs = SUNSparseMatrix_IndexPointers(B); Bindexvals = SUNSparseMatrix_IndexValues(B); BNP = SUNSparseMatrix_NP(B); Bnnz = Bindexptrs[BNP]; /* matrices must have same sparsetype, shape and actual data lengths */ if (SUNMatGetID(A) != SUNMatGetID(B)) { printf(">>> ERROR: check_matrix: Different storage types (%d vs %d)\n", SUNMatGetID(A), SUNMatGetID(B)); return(1); } if (SUNSparseMatrix_SparseType(A) != SUNSparseMatrix_SparseType(B)) { printf(">>> ERROR: check_matrix: Different storage types (%d vs %d)\n", SUNSparseMatrix_SparseType(A), SUNSparseMatrix_SparseType(B)); return(1); } if (SUNSparseMatrix_Rows(A) != SUNSparseMatrix_Rows(B)) { printf(">>> ERROR: check_matrix: Different numbers of rows (%ld vs %ld)\n", (long int) SUNSparseMatrix_Rows(A), (long int) SUNSparseMatrix_Rows(B)); return(1); } if (SUNSparseMatrix_Columns(A) != SUNSparseMatrix_Columns(B)) { printf(">>> ERROR: check_matrix: Different numbers of columns (%ld vs %ld)\n", (long int) SUNSparseMatrix_Columns(A), (long int) SUNSparseMatrix_Columns(B)); return(1); } if (Annz != Bnnz) { printf(">>> ERROR: check_matrix: Different numbers of nonzeos (%ld vs %ld)\n", (long int) Annz, (long int) Bnnz); return(1); } /* compare sparsity patterns */ for (i=0; i<ANP; i++) failure += (Aindexptrs[i] != Bindexptrs[i]); if (failure > ZERO) { printf(">>> ERROR: check_matrix: Different indexptrs \n"); return(1); } for (i=0; i<Annz; i++) failure += (Aindexvals[i] != Bindexvals[i]); if (failure > ZERO) { printf(">>> ERROR: check_matrix: Different indexvals \n"); return(1); } /* compare matrix values */ for(i=0; i<Annz; i++) failure += FNEQ(Adata[i], Bdata[i], tol); if (failure > ZERO) { printf(">>> ERROR: check_matrix: Different entries \n"); return(1); } return(0); }
SUNLinearSolver SUNLinSol_LapackDense(N_Vector y, SUNMatrix A) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_LapackDense content; sunindextype MatrixRows, VecLength; /* Check compatibility with supplied SUNMatrix and N_Vector */ if (SUNMatGetID(A) != SUNMATRIX_DENSE) return(NULL); if (SUNDenseMatrix_Rows(A) != SUNDenseMatrix_Columns(A)) return(NULL); MatrixRows = SUNDenseMatrix_Rows(A); if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) return(NULL); /* optimally this function would be replaced with a generic N_Vector routine */ VecLength = GlobalVectorLength_LapDense(y); if (MatrixRows != VecLength) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_LapackDense; ops->initialize = SUNLinSolInitialize_LapackDense; ops->setup = SUNLinSolSetup_LapackDense; ops->solve = SUNLinSolSolve_LapackDense; ops->lastflag = SUNLinSolLastFlag_LapackDense; ops->space = SUNLinSolSpace_LapackDense; ops->free = SUNLinSolFree_LapackDense; ops->setatimes = NULL; ops->setpreconditioner = NULL; ops->setscalingvectors = NULL; ops->numiters = NULL; ops->resnorm = NULL; ops->resid = NULL; /* Create content */ content = NULL; content = (SUNLinearSolverContent_LapackDense) malloc(sizeof(struct _SUNLinearSolverContent_LapackDense)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->N = MatrixRows; content->last_flag = 0; content->pivots = NULL; content->pivots = (sunindextype *) malloc(MatrixRows * sizeof(sunindextype)); if (content->pivots == NULL) { free(content); free(ops); free(S); return(NULL); } /* Attach content and ops */ S->content = content; S->ops = ops; return(S); }