/**
* @brief Solves a sparse matrix factorization.
*
* This solves Ax = b.
*
* @param[in,out] b Input right side vector that gets set to the output solution.
* @param[in] fact Factorization of the sparse matrix.
*/
void cs_fact_solve( double *b, cs_fact_t *fact )
{
#ifdef USE_UMFPACK
int ret;
double info[ UMFPACK_INFO ];
int fnan, finf;
#endif /* USE_UMFPACK */
int k;
switch (fact->type) {
case CS_FACT_CHOLESKY:
cs_ipvec( fact->S->pinv, b, fact->x, fact->n );
cs_lsolve( fact->N->L, fact->x );
cs_ltsolve( fact->N->L, fact->x );
cs_pvec( fact->S->pinv, fact->x, b, fact->n );
break;
case CS_FACT_LU:
cs_ipvec( fact->N->pinv, b, fact->x, fact->n );
cs_lsolve( fact->N->L, fact->x );
cs_usolve( fact->N->U, fact->x );
cs_ipvec( fact->S->q, fact->x, b, fact->n );
break;
case CS_FACT_QR:
cs_ipvec( fact->S->pinv, b, fact->x, fact->n );
for (k=0; k<fact->n; k++)
cs_happly( fact->N->L, k, fact->N->B[k], fact->x );
cs_usolve( fact->N->U, fact->x );
cs_ipvec( fact->S->q, fact->x, b, fact->n );
break;
case CS_FACT_UMFPACK:
#ifdef USE_UMFPACK
ret = umfpack_di_wsolve( UMFPACK_A, /* Solving Ax=b problem. */
fact->A->p, fact->A->i, fact->A->x,
fact->x, b, fact->numeric, NULL, info, fact->wi, fact->w );
if (ret == UMFPACK_WARNING_singular_matrix) {
fprintf( stderr, "UMFPACK: wsolver Matrix singular!\n" );
fnan = 0;
finf = 0;
for (k=0; k<fact->n; k++) {
if (isnan(fact->x[k])) {
fact->x[k] = 0.;
fnan = 1;
}
else if (isinf(fact->x[k])) {
fact->x[k] = 0.;
finf = 1;
}
}
if (fnan)
fprintf( stderr, "UMFPACK: NaN values detected!\n" );
if (finf)
fprintf( stderr, "UMFPACK: Infinity values detected!\n" );
}
memcpy( b, fact->x, fact->n*sizeof(double) );
#endif /* USE_UMFPACK */
default:
break;
}
}
int sci_umfpack(char* fname, void* pvApiCtx)
{
SciErr sciErr;
int mb = 0;
int nb = 0;
int i = 0;
int num_A = 0;
int num_b = 0;
int mW = 0;
int Case = 0;
int stat = 0;
SciSparse AA;
CcsSparse A;
int* piAddrA = NULL;
int* piAddr2 = NULL;
int* piAddrB = NULL;
double* pdblBR = NULL;
double* pdblBI = NULL;
double* pdblXR = NULL;
double* pdblXI = NULL;
int iComplex = 0;
int freepdblBI = 0;
int mA = 0; // rows
int nA = 0; // cols
int iNbItem = 0;
int* piNbItemRow = NULL;
int* piColPos = NULL;
double* pdblSpReal = NULL;
double* pdblSpImg = NULL;
/* umfpack stuff */
double Info[UMFPACK_INFO];
double* Control = NULL;
void* Symbolic = NULL;
void* Numeric = NULL;
int* Wi = NULL;
double* W = NULL;
char* pStr = NULL;
int iType2 = 0;
int iTypeA = 0;
int iTypeB = 0;
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 3, 3);
CheckOutputArgument(pvApiCtx, 1, 1);
/* First get arg #2 : a string of length 1 */
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddr2, &iType2);
if (sciErr.iErr || iType2 != sci_strings)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: string expected.\n"), fname, 2);
return 1;
}
if (getAllocatedSingleString(pvApiCtx, piAddr2, &pStr))
{
return 1;
}
/* select Case 1 or 2 depending (of the first char of) the string ... */
if (pStr[0] == '\\') // compare pStr[0] with '\'
{
Case = 1;
num_A = 1;
num_b = 3;
}
else if (pStr[0] == '/')
{
Case = 2;
num_A = 3;
num_b = 1;
}
else
{
Scierror(999, _("%s: Wrong input argument #%d: '%s' or '%s' expected.\n"), fname, 2, "\\", "/");
FREE(pStr);
return 1;
}
FREE(pStr);
/* get A */
sciErr = getVarAddressFromPosition(pvApiCtx, num_A, &piAddrA);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrA, &iTypeA);
if (sciErr.iErr || iTypeA != sci_sparse)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: A sparse matrix expected.\n"), fname, 1);
return 1;
}
if (isVarComplex(pvApiCtx, piAddrA))
{
AA.it = 1;
iComplex = 1;
sciErr = getComplexSparseMatrix(pvApiCtx, piAddrA, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal, &pdblSpImg);
}
else
{
AA.it = 0;
sciErr = getSparseMatrix(pvApiCtx, piAddrA, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// fill struct sparse
AA.m = mA;
AA.n = nA;
AA.nel = iNbItem;
AA.mnel = piNbItemRow;
AA.icol = piColPos;
AA.R = pdblSpReal;
AA.I = pdblSpImg;
if ( mA != nA || mA < 1 )
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, num_A);
return 1;
}
/* get B*/
sciErr = getVarAddressFromPosition(pvApiCtx, num_b, &piAddrB);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getVarType(pvApiCtx, piAddrB, &iTypeB);
if (sciErr.iErr || iTypeB != sci_matrix)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: A matrix expected.\n"), fname, 3);
return 1;
}
if (isVarComplex(pvApiCtx, piAddrB))
{
iComplex = 1;
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddrB, &mb, &nb, &pdblBR, &pdblBI);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddrB, &mb, &nb, &pdblBR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if ( (Case == 1 && ( mb != mA || nb < 1 )) || (Case == 2 && ( nb != mA || mb < 1 )) )
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, num_b);
return 1;
}
SciSparseToCcsSparse(&AA, &A);
/* allocate memory for the solution x */
if (iComplex)
{
sciErr = allocComplexMatrixOfDouble(pvApiCtx, 4, mb, nb, &pdblXR, &pdblXI);
}
else
{
sciErr = allocMatrixOfDouble(pvApiCtx, 4, mb, nb, &pdblXR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
freeCcsSparse(A);
return 1;
}
if (A.it == 1)
{
mW = 10 * mA;
}
else
{
mW = 5 * mA;
}
if (A.it == 1 && pdblBI == NULL)
{
int iSize = mb * nb * sizeof(double);
pdblBI = (double*)MALLOC(iSize);
memset(pdblBI, 0x00, iSize);
freepdblBI = 1;
}
/* Now calling umfpack routines */
if (A.it == 1)
{
stat = umfpack_zi_symbolic(mA, nA, A.p, A.irow, A.R, A.I, &Symbolic, Control, Info);
}
else
{
stat = umfpack_di_symbolic(mA, nA, A.p, A.irow, A.R, &Symbolic, Control, Info);
}
if ( stat != UMFPACK_OK )
{
Scierror(999, _("%s: An error occurred: %s: %s\n"), fname, _("symbolic factorization"), UmfErrorMes(stat));
freeCcsSparse(A);
if (freepdblBI)
{
FREE(pdblBI);
}
return 1;
}
if (A.it == 1)
{
stat = umfpack_zi_numeric(A.p, A.irow, A.R, A.I, Symbolic, &Numeric, Control, Info);
}
else
{
stat = umfpack_di_numeric(A.p, A.irow, A.R, Symbolic, &Numeric, Control, Info);
}
if (A.it == 1)
{
umfpack_zi_free_symbolic(&Symbolic);
}
else
{
umfpack_di_free_symbolic(&Symbolic);
}
if ( stat != UMFPACK_OK )
{
Scierror(999, _("%s: An error occurred: %s: %s\n"), fname, _("numeric factorization"), UmfErrorMes(stat));
if (A.it == 1)
{
umfpack_zi_free_numeric(&Numeric);
}
else
{
umfpack_di_free_numeric(&Numeric);
}
freeCcsSparse(A);
if (freepdblBI)
{
FREE(pdblBI);
}
return 1;
}
/* allocate memory for umfpack_di_wsolve usage or umfpack_zi_wsolve usage*/
Wi = (int*)MALLOC(mA * sizeof(int));
W = (double*)MALLOC(mW * sizeof(double));
if ( Case == 1 ) /* x = A\b <=> Ax = b */
{
if (A.it == 0)
{
for ( i = 0 ; i < nb ; i++ )
{
umfpack_di_wsolve(UMFPACK_A, A.p, A.irow, A.R, &pdblXR[i * mb], &pdblBR[i * mb],
Numeric, Control, Info, Wi, W);
}
if (isVarComplex(pvApiCtx, piAddrB))
{
for ( i = 0 ; i < nb ; i++ )
{
umfpack_di_wsolve(UMFPACK_A, A.p, A.irow, A.R, &pdblXI[i * mb], &pdblBI[i * mb],
Numeric, Control, Info, Wi, W);
}
}
}
else /* A.it == 1 */
{
for ( i = 0 ; i < nb ; i++ )
{
umfpack_zi_wsolve(UMFPACK_A, A.p, A.irow, A.R, A.I, &pdblXR[i * mb], &pdblXI[i * mb],
&pdblBR[i * mb], &pdblBI[i * mb], Numeric, Control, Info, Wi, W);
}
}
}
else /* Case == 2, x = b/A <=> x A = b <=> A.'x.' = b.' */
{
if (A.it == 0)
{
TransposeMatrix(pdblBR, mb, nb, pdblXR); /* put b in x (with transposition) */
for ( i = 0 ; i < mb ; i++ )
{
umfpack_di_wsolve(UMFPACK_At, A.p, A.irow, A.R, &pdblBR[i * nb], &pdblXR[i * nb],
Numeric, Control, Info, Wi, W); /* the solutions are in br */
}
TransposeMatrix(pdblBR, nb, mb, pdblXR); /* put now br in xr with transposition */
if (isVarComplex(pvApiCtx, piAddrB))
{
TransposeMatrix(pdblBI, mb, nb, pdblXI); /* put b in x (with transposition) */
for ( i = 0 ; i < mb ; i++ )
{
umfpack_di_wsolve(UMFPACK_At, A.p, A.irow, A.R, &pdblBI[i * nb], &pdblXI[i * nb],
Numeric, Control, Info, Wi, W); /* the solutions are in bi */
}
TransposeMatrix(pdblBI, nb, mb, pdblXI); /* put now bi in xi with transposition */
}
}
else /* A.it==1 */
{
TransposeMatrix(pdblBR, mb, nb, pdblXR);
TransposeMatrix(pdblBI, mb, nb, pdblXI);
for ( i = 0 ; i < mb ; i++ )
{
umfpack_zi_wsolve(UMFPACK_Aat, A.p, A.irow, A.R, A.I, &pdblBR[i * nb], &pdblBI[i * nb],
&pdblXR[i * nb], &pdblXI[i * nb], Numeric, Control, Info, Wi, W);
}
TransposeMatrix(pdblBR, nb, mb, pdblXR);
TransposeMatrix(pdblBI, nb, mb, pdblXI);
}
}
if (A.it == 1)
{
umfpack_zi_free_numeric(&Numeric);
}
else
{
umfpack_di_free_numeric(&Numeric);
}
if (piNbItemRow != NULL)
{
FREE(piNbItemRow);
}
if (piColPos != NULL)
{
FREE(piColPos);
}
if (pdblSpReal != NULL)
{
FREE(pdblSpReal);
}
if (pdblSpImg != NULL)
{
FREE(pdblSpImg);
}
FREE(W);
FREE(Wi);
if (freepdblBI)
{
FREE(pdblBI);
}
freeCcsSparse(A);
AssignOutputVariable(pvApiCtx, 1) = 4;
ReturnArguments(pvApiCtx);
return 0;
}
int sci_umf_lusolve(char* fname, unsigned long l)
{
SciErr sciErr;
int mb = 0;
int nb = 0;
int it_flag = 0;
int i = 0;
int j = 0;
int NoTranspose = 0;
int NoRaffinement = 0;
SciSparse AA;
CcsSparse A;
/* umfpack stuff */
double Info[UMFPACK_INFO]; // double *Info = (double *) NULL;
double Control[UMFPACK_CONTROL];
void* Numeric = NULL;
int lnz = 0, unz = 0, n = 0, n_col = 0, nz_udiag = 0, umf_flag = 0;
int* Wi = NULL;
int mW = 0;
double *W = NULL;
int iComplex = 0;
int* piAddr1 = NULL;
int* piAddr2 = NULL;
int* piAddr3 = NULL;
int* piAddr4 = NULL;
double* pdblBR = NULL;
double* pdblBI = NULL;
double* pdblXR = NULL;
double* pdblXI = NULL;
int mA = 0; // rows
int nA = 0; // cols
int iNbItem = 0;
int* piNbItemRow = NULL;
int* piColPos = NULL;
double* pdblSpReal = NULL;
double* pdblSpImg = NULL;
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 2, 4);
CheckOutputArgument(pvApiCtx, 1, 1);
/* First get arg #1 : the pointer to the LU factors */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
sciErr = getPointer(pvApiCtx, piAddr1, &Numeric);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* Check if this pointer is a valid ref to a umfpack LU numeric object */
if ( ! IsAdrInList(Numeric, ListNumeric, &it_flag) )
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be a valid reference to (umf) LU factors.\n"), fname, 1);
return 1;
}
/* get some parameters of the factorization (for some checking) */
if ( it_flag == 0 )
{
umfpack_di_get_lunz(&lnz, &unz, &n, &n_col, &nz_udiag, Numeric);
}
else
{
iComplex = 1;
umfpack_zi_get_lunz(&lnz, &unz, &n, &n_col, &nz_udiag, Numeric);
}
if ( n != n_col )
{
Scierror(999, _("%s: An error occurred: %s.\n"), fname, _("This is not a factorization of a square matrix"));
return 1;
}
if ( nz_udiag < n )
{
Scierror(999, _("%s: An error occurred: %s.\n"), fname, _("This is a factorization of a singular matrix"));
return 1;
}
/* Get now arg #2 : the vector b */
sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr2))
{
iComplex = 1;
sciErr = getComplexMatrixOfDouble(pvApiCtx, piAddr2, &mb, &nb, &pdblBR, &pdblBI);
}
else
{
sciErr = getMatrixOfDouble(pvApiCtx, piAddr2, &mb, &nb, &pdblBR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (mb != n || nb < 1) /* test if the right hand side is compatible */
{
Scierror(999, _("%s: Wrong size for input argument #%d.\n"), fname, 2);
return 1;
}
/* allocate memory for the solution x */
if (iComplex)
{
sciErr = allocComplexMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, mb, nb, &pdblXR, &pdblXI);
}
else
{
sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, mb, nb, &pdblXR);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* selection between the different options :
* -- solving Ax=b or A'x=b (Note: we could add A.'x=b)
* -- with or without raffinement
*/
if (nbInputArgument(pvApiCtx) == 2)
{
NoTranspose = 1;
NoRaffinement = 1;
}
else /* 3 or 4 input arguments but the third must be a string */
{
char* pStr = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
getAllocatedSingleString(pvApiCtx, piAddr3, &pStr);
if (strcmp(pStr, "Ax=b") == 0)
{
NoTranspose = 1;
}
else if ( strcmp(pStr, "A'x=b") == 0 )
{
NoTranspose = 0;
}
else
{
Scierror(999, _("%s: Wrong input argument #%d: '%s' or '%s' expected.\n"), fname, 3, "Ax=b", "A'x=b");
return 1;
}
if (nbInputArgument(pvApiCtx) == 4)
{
sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddr4);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
if (isVarComplex(pvApiCtx, piAddr4))
{
AA.it = 1;
sciErr = getComplexSparseMatrix(pvApiCtx, piAddr4, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal, &pdblSpImg);
}
else
{
AA.it = 0;
sciErr = getSparseMatrix(pvApiCtx, piAddr4, &mA, &nA, &iNbItem, &piNbItemRow, &piColPos, &pdblSpReal);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// fill struct sparse
AA.m = mA;
AA.n = nA;
AA.nel = iNbItem;
AA.mnel = piNbItemRow;
AA.icol = piColPos;
AA.R = pdblSpReal;
AA.I = pdblSpImg;
/* some check... but we can't be sure that the matrix corresponds to the LU factors */
if ( mA != nA || mA != n || AA.it != it_flag )
{
Scierror(999, _("%s: Wrong size for input argument #%d: %s.\n"), fname, 4, _("Matrix is not compatible with the given LU factors"));
return 1;
}
NoRaffinement = 0;
}
else
{
NoRaffinement = 1; /* only 3 input var => no raffinement */
}
}
/* allocate memory for umfpack_di_wsolve usage or umfpack_zi_wsolve usage*/
Wi = (int*)MALLOC(n * sizeof(int));
if (it_flag == 1)
{
if (NoRaffinement)
{
mW = 4 * n;
}
else
{
mW = 10 * n;
}
}
else
{
if (NoRaffinement)
{
mW = n;
}
else
{
mW = 5 * n;
}
}
W = (double*)MALLOC(mW * sizeof(double));
if (NoRaffinement == 0)
{
SciSparseToCcsSparse(&AA, &A);
}
else
{
A.p = NULL;
A.irow = NULL;
A.R = NULL;
A.I = NULL;
}
/* get the pointer for b */
if (it_flag == 1 && pdblBI == NULL)
{
int iSize = mb * nb * sizeof(double);
pdblBI = (double*)MALLOC(iSize);
memset(pdblBI, 0x00, iSize);
}
/* init Control */
if (it_flag == 0)
{
umfpack_di_defaults(Control);
}
else
{
umfpack_zi_defaults(Control);
}
if (NoRaffinement)
{
Control[UMFPACK_IRSTEP] = 0;
}
if (NoTranspose)
{
umf_flag = UMFPACK_A;
}
else
{
umf_flag = UMFPACK_At;
}
if (it_flag == 0)
{
for (j = 0; j < nb ; j++)
{
umfpack_di_wsolve(umf_flag, A.p, A.irow, A.R, &pdblXR[j * mb], &pdblBR[j * mb], Numeric, Control, Info, Wi, W);
}
if (iComplex == 1)
{
for (j = 0; j < nb ; j++)
{
umfpack_di_wsolve(umf_flag, A.p, A.irow, A.R, &pdblXI[j * mb], &pdblBI[j * mb], Numeric, Control, Info, Wi, W);
}
}
}
else
{
for (j = 0; j < nb ; j++)
{
umfpack_zi_wsolve(umf_flag, A.p, A.irow, A.R, A.I, &pdblXR[j * mb], &pdblXI[j * mb], &pdblBR[j * mb], &pdblBI[j * mb], Numeric, Control, Info, Wi, W);
}
}
if (isVarComplex(pvApiCtx, piAddr2) == 0)
{
FREE(pdblBI);
}
freeCcsSparse(A);
FREE(W);
FREE(Wi);
AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
ReturnArguments(pvApiCtx);
return 0;
}
