int LUSOL_factorize(LUSOLrec *LUSOL)
{
int inform;
LU1FAC( LUSOL, &inform );
return( inform );
}
PetscErrorCode MatLUFactorNumeric_LUSOL(Mat F,Mat A,const MatFactorInfo *info)
{
Mat_SeqAIJ *a;
Mat_LUSOL *lusol = (Mat_LUSOL*)F->spptr;
PetscErrorCode ierr;
int m, n, nz, nnz, status;
int i, rs, re;
int factorizations;
PetscFunctionBegin;
ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr);CHKERRQ(ierr);
a = (Mat_SeqAIJ*)A->data;
if (m != lusol->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"factorization struct inconsistent");
factorizations = 0;
do {
/*******************************************************************/
/* Check the workspace allocation. */
/*******************************************************************/
nz = a->nz;
nnz = PetscMax(lusol->nnz, (int)(lusol->elbowroom*nz));
nnz = PetscMax(nnz, 5*n);
if (nnz < lusol->luparm[12]) {
nnz = (int)(lusol->luroom * lusol->luparm[12]);
} else if ((factorizations > 0) && (lusol->luroom < 6)) {
lusol->luroom += 0.1;
}
nnz = PetscMax(nnz, (int)(lusol->luroom*(lusol->luparm[22] + lusol->luparm[23])));
if (nnz > lusol->nnz) {
ierr = PetscFree3(lusol->data,lusol->indc,lusol->indr);CHKERRQ(ierr);
ierr = PetscMalloc3(nnz,&lusol->data,nnz,&lusol->indc,nnz,&lusol->indr);CHKERRQ(ierr);
lusol->nnz = nnz;
}
/*******************************************************************/
/* Fill in the data for the problem. (1-based Fortran style) */
/*******************************************************************/
nz = 0;
for (i = 0; i < n; i++) {
rs = a->i[i];
re = a->i[i+1];
while (rs < re) {
if (a->a[rs] != 0.0) {
lusol->indc[nz] = i + 1;
lusol->indr[nz] = a->j[rs] + 1;
lusol->data[nz] = a->a[rs];
nz++;
}
rs++;
}
}
/*******************************************************************/
/* Do the factorization. */
/*******************************************************************/
LU1FAC(&m, &n, &nz, &nnz,
lusol->luparm, lusol->parmlu, lusol->data,
lusol->indc, lusol->indr, lusol->ip, lusol->iq,
lusol->lenc, lusol->lenr, lusol->locc, lusol->locr,
lusol->iploc, lusol->iqloc, lusol->ipinv,
lusol->iqinv, lusol->mnsw, &status);
switch (status) {
case 0: /* factored */
break;
case 7: /* insufficient memory */
break;
case 1:
case -1: /* singular */
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Singular matrix");
case 3:
case 4: /* error conditions */
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"matrix error");
default: /* unknown condition */
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"matrix unknown return code");
}
factorizations++;
} while (status == 7);
F->ops->solve = MatSolve_LUSOL;
F->assembled = PETSC_TRUE;
F->preallocated = PETSC_TRUE;
PetscFunctionReturn(0);
}
