/*! \fn allocate memory for linear system solver Klu * */ int allocateKluData(int n_row, int n_col, int nz, void** voiddata) { DATA_KLU* data = (DATA_KLU*) malloc(sizeof(DATA_KLU)); assertStreamPrint(NULL, 0 != data, "Could not allocate data for linear solver Klu."); data->symbolic = NULL; data->numeric = NULL; data->n_col = n_col; data->n_row = n_row; data->nnz = nz; data->Ap = (int*) calloc((n_row+1),sizeof(int)); data->Ai = (int*) calloc(nz,sizeof(int)); data->Ax = (double*) calloc(nz,sizeof(double)); data->work = (double*) calloc(n_col,sizeof(double)); data->numberSolving = 0; klu_defaults(&(data->common)); *voiddata = (void*)data; return 0; }
KLU::~KLU() { klu_common Common; klu_defaults(&Common); klu_symbolic *Sym = (klu_symbolic*)_Symbolic; klu_numeric *Num = (klu_numeric*)_Numeric; if ( _Symbolic ) klu_free_symbolic( &Sym, &Common); if ( _Numeric ) klu_free_numeric ( &Num, &Common); }
/* This will prep KLU for subsequent linear solves by computing an initial fill-reducing ordering and numeric factorization (if values are available) of the user-supplied Jacobian. */ int InitKINKlu(KINMem kin_memory){ //check inputs if(!kin_memory) return 1; //grab the kinklu block KINKluMem kin_klu_mem=(KINKluMem)kin_memory->kin_lmem; if(!kin_klu_mem) return 1; kin_memory->kin_inexact_ls=FALSE; kin_memory->kin_setupNonNull=TRUE; //grab klu objects from kinklu memory int n=kin_klu_mem->n, ok; cs_di *jac=kin_klu_mem->jac; klu_symbolic *symb=kin_klu_mem->symbolic; klu_numeric *numeric=kin_klu_mem->numeric; klu_common *comm=&(kin_klu_mem->klu_comm); //if theres no jacobian to try factoring, we're done if(!jac) return 1; //check for, and delete if necessary, existing klu symbolic and numeric objects. if(symb){klu_free_symbolic(&symb, comm); symb=NULL; kin_klu_mem->symbolic=NULL;} if(numeric){klu_free_numeric(&numeric, comm); numeric=NULL; kin_klu_mem->numeric=NULL;} ok=klu_defaults(comm); //attempt the symbolic factorization. symb=klu_analyze(n, jac->p, jac->i, comm); //if there's an error doing the factorization, abort. don't delete the jacobian passed in, but null the kinklu jac pointer if(!symb) return 1; //otherwise, assign the kinklu symbolic pointer and indicate that the jacobian has been fill-reduced kin_klu_mem->symbolic=symb; kin_klu_mem->is_fill_reduced=1; //do numeric factor if values are available /* if(jac->x){ //try factorization. on failure, free the previous symbolic object and return. numeric = klu_factor(jac->p, jac->i, jac->x, symb, comm); if(!numeric){ klu_free_symbolic(&symb, comm); kin_klu_mem->symbolic = NULL; return 1; } //otherwise, assign the kinklu numeric pointer and return. kin_klu_mem->numeric = numeric; }*/ return 0; };
void KLUSystem::InitDefaults () { m_nBus = 0; bFactored = false; acx = NULL; zero_indices (); null_pointers (); if (!common_init) { klu_defaults (&Common); Common.halt_if_singular = 0; common_init = 1; } }
int main (void) { klu_symbolic *Symbolic ; klu_numeric *Numeric ; klu_common Common ; int i ; klu_defaults (&Common) ; Symbolic = klu_analyze (n, Ap, Ai, &Common) ; Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ; klu_solve (Symbolic, Numeric, 5, 1, b, &Common) ; klu_free_symbolic (&Symbolic, &Common) ; klu_free_numeric (&Numeric, &Common) ; for (i = 0 ; i < n ; i++) printf ("x [%d] = %g\n", i, b [i]) ; return (0) ; }
/*** KLU ***/ int KLU::Factor() { int status; int ndim; _NRC = _nnz; ndim = _dim; memcpy(&_rows[0], _rows_ptr, _nnz*sizeof(int)); memcpy(&_cols[0], _cols_ptr, _nnz*sizeof(int)); memcpy(&_vals[0], _vals_ptr, _nnz*sizeof(double)); _Ap.size(_dim+1); _Ai.size(_nnz); _Ax.size(_nnz); status = umfpack_di_triplet_to_col (ndim,ndim, _NRC, &_rows[0], &_cols[0], &_vals[0], &_Ap[0], &_Ai[0], &_Ax[0], (int*)NULL) ; if (status < 0 ) { fprintf(stderr,"KLU: umfpack_di_triplet_to_col failed\n"); return (-1); } klu_common Common; klu_defaults( &Common ); klu_numeric *Num; if ( _Symbolic == NULL ) _Symbolic = (void*)klu_analyze(ndim, &_Ap[0], &_Ai[0], &Common); if ( _Symbolic == NULL ) { fprintf(stderr,"KLU: symbolic analysis failed\n"); return (-1); } if ( _Numeric ) { Num = (klu_numeric*)_Numeric; klu_free_numeric( &Num, &Common); } _Numeric = (void*)klu_factor(&_Ap[0], &_Ai[0], &_Ax[0], (klu_symbolic*)_Symbolic, &Common); if ( _Numeric == NULL ) { fprintf(stderr,"KLU: numeric factorization failed\n"); return (-1); } _is_factored = 1; return 0; }
int KLU::Solve(double *rhs, double *x) { int rc = 0; if (!_is_factored) rc = Factor(); int NEQN = _dim; klu_symbolic *Sym = (klu_symbolic*)_Symbolic; klu_numeric *Num = (klu_numeric*)_Numeric; klu_common Common; klu_defaults( &Common ); /* load the rhs only (matrix already there) */ if (x != rhs) memcpy( x, rhs, NEQN*sizeof(double) ); /* we will deal with transpose later */ rc = klu_solve(Sym, Num, NEQN, 1, x, &Common); return rc; }
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); }
/*--------------------------------------------------------------- ARKKLU This routine initializes the memory record and sets various function fields specific to the ARKode / KLU linear solver module. ARKKLU first calls the existing lfree routine if this is not NULL. Then it sets the ark_linit, ark_lsetup, ark_lsolve and ark_lfree fields in (*arkode_mem) to be arkKLUInit, arkKLUSetup, arkKLUSolve and arkKLUFree, respectively. It allocates memory for a structure of type ARKSlsMemRec and sets the ark_lmem field in (*arkode_mem) to the address of this structure. It sets setupNonNull in (*arkode_mem) to TRUE. Finally, it allocates memory for KLU. The return value is ARKSLS_SUCCESS = 0, ARKSLS_LMEM_FAIL = -1, or ARKSLS_ILL_INPUT = -2. NOTE: The KLU linear solver assumes a serial implementation of the NVECTOR package. Therefore, ARKKLU will first test for a compatible N_Vector internal representation by checking that the function N_VGetArrayPointer exists. ---------------------------------------------------------------*/ int ARKKLU(void *arkode_mem, int n, int nnz, int sparsetype) { ARKodeMem ark_mem; ARKSlsMem arksls_mem; KLUData klu_data; int flag; /* Return immediately if ark_mem is NULL. */ if (arkode_mem == NULL) { arkProcessError(NULL, ARKSLS_MEM_NULL, "ARKSLS", "ARKKLU", MSGSP_ARKMEM_NULL); return(ARKSLS_MEM_NULL); } ark_mem = (ARKodeMem) arkode_mem; /* Test if the NVECTOR package is compatible with the solver */ if (ark_mem->ark_tempv->ops->nvgetarraypointer == NULL) { arkProcessError(ark_mem, ARKSLS_ILL_INPUT, "ARKSLS", "ARKKLU", MSGSP_BAD_NVECTOR); return(ARKSLS_ILL_INPUT); } if (ark_mem->ark_lfree != NULL) ark_mem->ark_lfree(ark_mem); /* Set four main function fields in ark_mem. */ ark_mem->ark_linit = arkKLUInit; ark_mem->ark_lsetup = arkKLUSetup; ark_mem->ark_lsolve = arkKLUSolve; ark_mem->ark_lfree = arkKLUFree; ark_mem->ark_lsolve_type = 3; /* Get memory for ARKSlsMemRec. */ arksls_mem = (ARKSlsMem) malloc(sizeof(struct ARKSlsMemRec)); if (arksls_mem == NULL) { arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS", "ARKKLU", MSGSP_MEM_FAIL); return(ARKSLS_MEM_FAIL); } /* Get memory for KLUData. */ klu_data = (KLUData) malloc(sizeof(struct KLUDataRec)); if (klu_data == NULL) { arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS", "ARKKLU", MSGSP_MEM_FAIL); free(arksls_mem); arksls_mem = NULL; return(ARKSLS_MEM_FAIL); } /* Initialize Jacobian-related data */ arksls_mem->s_Jeval = NULL; arksls_mem->s_Jdata = NULL; ark_mem->ark_setupNonNull = TRUE; arksls_mem->sparsetype = sparsetype; /* Initialize counters */ arksls_mem->s_nje = 0; arksls_mem->s_first_factorize = 1; arksls_mem->s_nstlj = 0; /* Allocate memory for the sparse Jacobian */ arksls_mem->s_A = NULL; arksls_mem->s_A = SparseNewMat(n, n, nnz, sparsetype); if (arksls_mem->s_A == NULL) { arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS", "ARKKLU", MSGSP_MEM_FAIL); free(klu_data); klu_data = NULL; free(arksls_mem); arksls_mem = NULL; return(ARKSLS_MEM_FAIL); } /* Allocate memory for saved sparse Jacobian */ arksls_mem->s_savedJ = NULL; arksls_mem->s_savedJ = SparseNewMat(n, n, nnz, sparsetype); if (arksls_mem->s_savedJ == NULL) { arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS", "ARKKLU", MSGSP_MEM_FAIL); SparseDestroyMat(arksls_mem->s_A); free(klu_data); klu_data = NULL; free(arksls_mem); arksls_mem = NULL; return(ARKSLS_MEM_FAIL); } /* Initialize KLU structures */ switch (sparsetype) { case CSC_MAT: klu_data->sun_klu_solve = &klu_solve; break; case CSR_MAT: klu_data->sun_klu_solve = &klu_tsolve; break; default: SparseDestroyMat(arksls_mem->s_A); SparseDestroyMat(arksls_mem->s_savedJ); free(klu_data); klu_data = NULL; free(arksls_mem); arksls_mem = NULL; return(ARKSLS_ILL_INPUT); } 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) { arkProcessError(ark_mem, ARKSLS_MEM_FAIL, "ARKSLS", "ARKKLU", MSGSP_MEM_FAIL); klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common)); free(klu_data->s_Numeric); klu_data->s_Numeric = NULL; klu_free_symbolic(&(klu_data->s_Symbolic), &(klu_data->s_Common)); free(klu_data->s_Symbolic); klu_data->s_Symbolic = NULL; SparseDestroyMat(arksls_mem->s_A); SparseDestroyMat(arksls_mem->s_savedJ); free(klu_data); klu_data = NULL; free(arksls_mem); arksls_mem = NULL; return(ARKSLS_MEM_FAIL); } /* Set ordering to COLAMD as the arkode default use. Users can set a different value with ARKKLUSetOrdering, and the user-set value is loaded before any call to klu_analyze in ARKKLUSetup. */ klu_data->s_ordering = 1; klu_data->s_Common.ordering = klu_data->s_ordering; /* Attach linear solver memory to the integrator memory */ arksls_mem->s_solver_data = (void *) klu_data; ark_mem->ark_lmem = arksls_mem; arksls_mem->s_last_flag = ARKSLS_SUCCESS; return(ARKSLS_SUCCESS); }
int CVKLU(void *cvode_mem, int n, int nnz, int sparsetype) { CVodeMem cv_mem; CVSlsMem cvsls_mem; KLUData klu_data; int flag; /* Return immediately if cv_mem is NULL. */ if (cvode_mem == NULL) { cvProcessError(NULL, CVSLS_MEM_NULL, "CVSLS", "cvKLU", MSGSP_CVMEM_NULL); return(CVSLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the NVECTOR package is compatible with the Direct solver */ if (cv_mem->cv_tempv->ops->nvgetarraypointer == NULL) { cvProcessError(cv_mem, CVSLS_ILL_INPUT, "CVSLS", "cvKLU", MSGSP_BAD_NVECTOR); return(CVSLS_ILL_INPUT); } if (cv_mem->cv_lfree != NULL) cv_mem->cv_lfree(cv_mem); /* Set five main function fields in cv_mem. */ cv_mem->cv_linit = cvKLUInit; cv_mem->cv_lsetup = cvKLUSetup; cv_mem->cv_lsolve = cvKLUSolve; cv_mem->cv_lfree = cvKLUFree; /* Get memory for CVSlsMemRec. */ cvsls_mem = (CVSlsMem) malloc(sizeof(struct CVSlsMemRec)); if (cvsls_mem == NULL) { cvProcessError(cv_mem, CVSLS_MEM_FAIL, "CVSLS", "cvKLU", MSGSP_MEM_FAIL); return(CVSLS_MEM_FAIL); } /* Get memory for KLUData. */ klu_data = (KLUData)malloc(sizeof(struct KLUDataRec)); if (klu_data == NULL) { cvProcessError(cv_mem, CVSLS_MEM_FAIL, "CVSLS", "cvKLU", MSGSP_MEM_FAIL); return(CVSLS_MEM_FAIL); } cv_mem->cv_setupNonNull = TRUE; /* Set default Jacobian routine and Jacobian data */ cvsls_mem->s_jaceval = NULL; cvsls_mem->s_jacdata = NULL; cvsls_mem->sparsetype = sparsetype; /* Allocate memory for the sparse Jacobian */ cvsls_mem->s_JacMat = SparseNewMat(n, n, nnz, sparsetype); if (cvsls_mem->s_JacMat == NULL) { cvProcessError(cv_mem, CVSLS_MEM_FAIL, "CVSLS", "cvKLU", MSGSP_MEM_FAIL); free(cvsls_mem); return(CVSLS_MEM_FAIL); } /* Allocate memory for saved sparse Jacobian */ cvsls_mem->s_savedJ = SparseNewMat(n, n, nnz, sparsetype); if (cvsls_mem->s_savedJ == NULL) { cvProcessError(cv_mem, CVSLS_MEM_FAIL, "CVSLS", "cvKLU", MSGSP_MEM_FAIL); SparseDestroyMat(cvsls_mem->s_JacMat); free(cvsls_mem); return(CVSLS_MEM_FAIL); } /* Initialize KLU structures */ switch (sparsetype) { case CSC_MAT: klu_data->sun_klu_solve = &klu_solve; break; case CSR_MAT: klu_data->sun_klu_solve = &klu_tsolve; break; default: SparseDestroyMat(cvsls_mem->s_JacMat); free(klu_data); free(cvsls_mem); return(CVSLS_ILL_INPUT); } 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) { cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "cvKLU", MSGSP_PACKAGE_FAIL); return(CVSLS_PACKAGE_FAIL); } /* Set ordering to COLAMD as the cvode default use. Users can set a different value with CVKLUSetOrdering, and the user-set value is loaded before any call to klu_analyze in CVKLUSetup. */ klu_data->s_ordering = 1; klu_data->s_Common.ordering = klu_data->s_ordering; /* Attach linear solver memory to the integrator memory */ cvsls_mem->s_solver_data = (void *) klu_data; cv_mem->cv_lmem = cvsls_mem; cvsls_mem->s_last_flag = CVSLS_SUCCESS; return(CVSLS_SUCCESS); }
int main (void) { KLU_common Common ; cholmod_sparse *A, *A2 ; cholmod_dense *X, *B ; cholmod_common ch ; Int *Ap, *Ai, *Puser, *Quser, *Gunk ; double *Ax, *Bx, *Xx, *A2x ; double one [2], zero [2], xsave, maxerr ; Int n, i, j, nz, save, isreal, k, nan ; KLU_symbolic *Symbolic, *Symbolic2 ; KLU_numeric *Numeric ; one [0] = 1 ; one [1] = 0 ; zero [0] = 0 ; zero [1] = 0 ; printf ("klu test: -------------------------------------------------\n") ; OK (klu_defaults (&Common)) ; CHOLMOD_start (&ch) ; ch.print = 0 ; normal_memory_handler (&Common) ; /* ---------------------------------------------------------------------- */ /* read in a sparse matrix from stdin */ /* ---------------------------------------------------------------------- */ A = CHOLMOD_read_sparse (stdin, &ch) ; if (A->nrow != A->ncol || A->stype != 0) { fprintf (stderr, "error: only square unsymmetric matrices handled\n") ; CHOLMOD_free_sparse (&A, &ch) ; return (0) ; } if (!(A->xtype == CHOLMOD_REAL || A->xtype == CHOLMOD_COMPLEX)) { fprintf (stderr, "error: only real or complex matrices hanlded\n") ; CHOLMOD_free_sparse (&A, &ch) ; return (0) ; } n = A->nrow ; Ap = A->p ; Ai = A->i ; Ax = A->x ; nz = Ap [n] ; isreal = (A->xtype == CHOLMOD_REAL) ; /* ---------------------------------------------------------------------- */ /* construct random permutations */ /* ---------------------------------------------------------------------- */ Puser = randperm (n, n) ; Quser = randperm (n, n) ; /* ---------------------------------------------------------------------- */ /* select known solution to Ax=b */ /* ---------------------------------------------------------------------- */ X = CHOLMOD_allocate_dense (n, NRHS, n, A->xtype, &ch) ; Xx = X->x ; for (j = 0 ; j < NRHS ; j++) { for (i = 0 ; i < n ; i++) { if (isreal) { Xx [i] = 1 + ((double) i) / ((double) n) + j * 100; } else { Xx [2*i ] = 1 + ((double) i) / ((double) n) + j * 100 ; Xx [2*i+1] = - ((double) i+1) / ((double) n + j) ; if (j == NRHS-1) { Xx [2*i+1] = 0 ; /* zero imaginary part */ } else if (j == NRHS-2) { Xx [2*i] = 0 ; /* zero real part */ } } } Xx += isreal ? n : 2*n ; } /* B = A*X */ B = CHOLMOD_allocate_dense (n, NRHS, n, A->xtype, &ch) ; CHOLMOD_sdmult (A, 0, one, zero, X, B, &ch) ; Bx = B->x ; /* ---------------------------------------------------------------------- */ /* test KLU */ /* ---------------------------------------------------------------------- */ test_memory_handler (&Common) ; maxerr = do_solves (A, B, X, Puser, Quser, &Common, &ch, &nan) ; /* ---------------------------------------------------------------------- */ /* basic error checking */ /* ---------------------------------------------------------------------- */ FAIL (klu_defaults (NULL)) ; FAIL (klu_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_extract (NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_analyze (0, NULL, NULL, NULL)) ; FAIL (klu_analyze (0, NULL, NULL, &Common)) ; FAIL (klu_analyze_given (0, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_analyze_given (0, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_cholmod (0, NULL, NULL, NULL, NULL)) ; FAIL (klu_factor (NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_factor (NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_factor (NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_factor (NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_refactor (NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_refactor (NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_refactor (NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_refactor (NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_rgrowth (NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_rgrowth (NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_rgrowth (NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_rgrowth (NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_condest (NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_condest (NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_condest (NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_condest (NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_flops (NULL, NULL, NULL)) ; FAIL (klu_flops (NULL, NULL, &Common)) ; FAIL (klu_z_flops (NULL, NULL, NULL)) ; FAIL (klu_z_flops (NULL, NULL, &Common)) ; FAIL (klu_rcond (NULL, NULL, NULL)) ; FAIL (klu_rcond (NULL, NULL, &Common)) ; FAIL (klu_z_rcond (NULL, NULL, NULL)) ; FAIL (klu_z_rcond (NULL, NULL, &Common)) ; FAIL (klu_free_symbolic (NULL, NULL)) ; OK (klu_free_symbolic (NULL, &Common)) ; FAIL (klu_free_numeric (NULL, NULL)) ; OK (klu_free_numeric (NULL, &Common)) ; FAIL (klu_z_free_numeric (NULL, NULL)) ; OK (klu_z_free_numeric (NULL, &Common)) ; FAIL (klu_scale (0, 0, NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_scale (0, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ; OK (klu_scale (-1, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_z_scale (0, 0, NULL, NULL, NULL, NULL, NULL, NULL)) ; FAIL (klu_z_scale (0, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ; OK (klu_z_scale (-1, 0, NULL, NULL, NULL, NULL, NULL, &Common)) ; FAIL (klu_solve (NULL, NULL, 0, 0, NULL, NULL)) ; FAIL (klu_solve (NULL, NULL, 0, 0, NULL, &Common)) ; FAIL (klu_z_solve (NULL, NULL, 0, 0, NULL, NULL)) ; FAIL (klu_z_solve (NULL, NULL, 0, 0, NULL, &Common)) ; FAIL (klu_tsolve (NULL, NULL, 0, 0, NULL, NULL)) ; FAIL (klu_tsolve (NULL, NULL, 0, 0, NULL, &Common)) ; FAIL (klu_z_tsolve (NULL, NULL, 0, 0, NULL, 0, NULL)) ; FAIL (klu_z_tsolve (NULL, NULL, 0, 0, NULL, 0, &Common)) ; FAIL (klu_malloc (0, 0, NULL)) ; FAIL (klu_malloc (0, 0, &Common)) ; FAIL (klu_malloc (Int_MAX, 1, &Common)) ; FAIL (klu_realloc (0, 0, 0, NULL, NULL)) ; FAIL (klu_realloc (0, 0, 0, NULL, &Common)) ; FAIL (klu_realloc (Int_MAX, 1, 0, NULL, &Common)) ; Gunk = (Int *) klu_realloc (1, 0, sizeof (Int), NULL, &Common) ; OK (Gunk) ; OK (klu_realloc (Int_MAX, 1, sizeof (Int), Gunk, &Common)) ; OK (Common.status == KLU_TOO_LARGE) ; klu_free (Gunk, 1, sizeof (Int), &Common) ; /* ---------------------------------------------------------------------- */ /* mangle the matrix, and other error checking */ /* ---------------------------------------------------------------------- */ printf ("\nerror handling:\n") ; Symbolic = klu_analyze (n, Ap, Ai, &Common) ; OK (Symbolic) ; Xx = X->x ; if (nz > 0) { /* ------------------------------------------------------------------ */ /* row index out of bounds */ /* ------------------------------------------------------------------ */ save = Ai [0] ; Ai [0] = -1 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ai [0] = save ; /* ------------------------------------------------------------------ */ /* row index out of bounds */ /* ------------------------------------------------------------------ */ save = Ai [0] ; Ai [0] = Int_MAX ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ai [0] = save ; /* ------------------------------------------------------------------ */ /* column pointers mangled */ /* ------------------------------------------------------------------ */ save = Ap [n] ; Ap [n] = -1 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ap [n] = save ; /* ------------------------------------------------------------------ */ /* column pointers mangled */ /* ------------------------------------------------------------------ */ save = Ap [n] ; Ap [n] = Ap [n-1] - 1 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ap [n] = save ; /* ------------------------------------------------------------------ */ /* duplicates */ /* ------------------------------------------------------------------ */ if (n > 1 && Ap [1] - Ap [0] > 1) { save = Ai [1] ; Ai [1] = Ai [0] ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; if (isreal) { FAIL (klu_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } else { FAIL (klu_z_scale (1, n, Ap, Ai, Ax, Xx, Puser, &Common)) ; } Ai [1] = save ; } /* ------------------------------------------------------------------ */ /* invalid ordering */ /* ------------------------------------------------------------------ */ save = Common.ordering ; Common.ordering = 42 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; Common.ordering = save ; /* ------------------------------------------------------------------ */ /* invalid ordering (klu_cholmod, with NULL user_ordering) */ /* ------------------------------------------------------------------ */ save = Common.ordering ; Common.user_order = NULL ; Common.ordering = 3 ; FAIL (klu_analyze (n, Ap, Ai, &Common)) ; Common.ordering = save ; } /* ---------------------------------------------------------------------- */ /* tests with valid symbolic factorization */ /* ---------------------------------------------------------------------- */ Common.halt_if_singular = FALSE ; Common.scale = 0 ; Numeric = NULL ; if (nz > 0) { /* ------------------------------------------------------------------ */ /* Int overflow */ /* ------------------------------------------------------------------ */ if (n == 100) { Common.ordering = 2 ; Symbolic2 = klu_analyze (n, Ap, Ai, &Common) ; OK (Symbolic2) ; Common.memgrow = Int_MAX ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic2, &Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic2, &Common) ; } Common.memgrow = 1.2 ; Common.ordering = 0 ; klu_free_symbolic (&Symbolic2, &Common) ; klu_free_numeric (&Numeric, &Common) ; } /* ------------------------------------------------------------------ */ /* Int overflow again */ /* ------------------------------------------------------------------ */ Common.initmem = Int_MAX ; Common.initmem_amd = Int_MAX ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ; } Common.initmem = 10 ; Common.initmem_amd = 1.2 ; klu_free_numeric (&Numeric, &Common) ; /* ------------------------------------------------------------------ */ /* mangle the matrix */ /* ------------------------------------------------------------------ */ save = Ai [0] ; Ai [0] = -1 ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ; } FAIL (Numeric) ; Ai [0] = save ; /* ------------------------------------------------------------------ */ /* nan and inf handling */ /* ------------------------------------------------------------------ */ xsave = Ax [0] ; Ax [0] = one [0] / zero [0] ; if (isreal) { Numeric = klu_factor (Ap, Ai, Ax, Symbolic, &Common) ; klu_rcond (Symbolic, Numeric, &Common) ; klu_condest (Ap, Ax, Symbolic, Numeric, &Common) ; } else { Numeric = klu_z_factor (Ap, Ai, Ax, Symbolic, &Common) ; klu_z_rcond (Symbolic, Numeric, &Common) ; klu_z_condest (Ap, Ax, Symbolic, Numeric, &Common) ; } printf ("Nan case: rcond %g condest %g\n", Common.rcond, Common.condest) ; OK (Numeric) ; Ax [0] = xsave ; /* ------------------------------------------------------------------ */ /* mangle the matrix again */ /* ------------------------------------------------------------------ */ save = Ai [0] ; Ai [0] = -1 ; if (isreal) { FAIL (klu_refactor (Ap, Ai, Ax, Symbolic, Numeric, &Common)) ; } else { FAIL (klu_z_refactor (Ap, Ai, Ax, Symbolic, Numeric, &Common)) ; } Ai [0] = save ; /* ------------------------------------------------------------------ */ /* all zero */ /* ------------------------------------------------------------------ */ A2 = CHOLMOD_copy_sparse (A, &ch) ; A2x = A2->x ; for (k = 0 ; k < nz * (isreal ? 1:2) ; k++) { A2x [k] = 0 ; } for (Common.halt_if_singular = 0 ; Common.halt_if_singular <= 1 ; Common.halt_if_singular++) { for (Common.scale = -1 ; Common.scale <= 2 ; Common.scale++) { if (isreal) { klu_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ; klu_condest (Ap, A2x, Symbolic, Numeric, &Common) ; } else { klu_z_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ; klu_z_condest (Ap, A2x, Symbolic, Numeric, &Common) ; } OK (Common.status = KLU_SINGULAR) ; } } CHOLMOD_free_sparse (&A2, &ch) ; /* ------------------------------------------------------------------ */ /* all one, or all 1i for complex case */ /* ------------------------------------------------------------------ */ A2 = CHOLMOD_copy_sparse (A, &ch) ; A2x = A2->x ; for (k = 0 ; k < nz ; k++) { if (isreal) { A2x [k] = 1 ; } else { A2x [2*k ] = 0 ; A2x [2*k+1] = 1 ; } } Common.halt_if_singular = 0 ; Common.scale = 0 ; if (isreal) { klu_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ; klu_condest (Ap, A2x, Symbolic, Numeric, &Common) ; } else { klu_z_refactor (Ap, Ai, A2x, Symbolic, Numeric, &Common) ; klu_z_condest (Ap, A2x, Symbolic, Numeric, &Common) ; } OK (Common.status = KLU_SINGULAR) ; CHOLMOD_free_sparse (&A2, &ch) ; } klu_free_symbolic (&Symbolic, &Common) ; if (isreal) { klu_free_numeric (&Numeric, &Common) ; } else { klu_z_free_numeric (&Numeric, &Common) ; } /* ---------------------------------------------------------------------- */ /* free problem and quit */ /* ---------------------------------------------------------------------- */ CHOLMOD_free_dense (&X, &ch) ; CHOLMOD_free_dense (&B, &ch) ; CHOLMOD_free_sparse (&A, &ch) ; free (Puser) ; free (Quser) ; CHOLMOD_finish (&ch) ; fprintf (stderr, " maxerr %10.3e", maxerr) ; printf (" maxerr %10.3e", maxerr) ; if (maxerr < 1e-8) { fprintf (stderr, " test passed") ; printf (" test passed") ; } else { fprintf (stderr, " test FAILED") ; printf (" test FAILED") ; } if (nan) { fprintf (stderr, " *") ; printf (" *") ; } fprintf (stderr, "\n") ; printf ("\n-----------------------------------------------------------\n") ; return (0) ; }