int sci_umf_luget(char* fname, void* pvApiCtx)
{
/*
* LU_ptr is (a pointer to) a factorization of A, we have:
* -1
* P R A Q = L U
*
* A is n_row x n_col
* L is n_row x n
* U is n x n_col n = min(n_row, n_col)
*/
SciErr sciErr;
void* Numeric = NULL;
int lnz = 0, unz = 0, n_row = 0, n_col = 0, n = 0, nz_udiag = 0, i = 0, stat = 0, do_recip = 0, it_flag = 0;
int *L_mnel = NULL, *L_icol = NULL, *L_ptrow = NULL, *U_mnel = NULL, *U_icol = NULL, *U_ptrow = NULL, *V_irow = NULL, *V_ptcol = NULL;
double *L_R = NULL, *L_I = NULL, *U_R = NULL, *U_I = NULL, *V_R = NULL, *V_I = NULL, *Rs = NULL;
int *p = NULL, *q = NULL, pl_miss = 0, error_flag = 0 ;
int* piAddr1 = NULL;
int iType1 = 0;
/* Check numbers of input/output arguments */
CheckInputArgument(pvApiCtx, 1, 1);
CheckOutputArgument(pvApiCtx, 1, 5);
/* get the pointer to the LU factors */
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* Check if the first argument is a pointer */
sciErr = getVarType(pvApiCtx, piAddr1, &iType1);
if (sciErr.iErr || iType1 != sci_pointer)
{
printError(&sciErr, 0);
Scierror(999, _("%s: Wrong type for input argument #%d: A pointer expected.\n"), fname, 1);
return 1;
}
sciErr = getPointer(pvApiCtx, piAddr1, &Numeric);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
/* Check if the pointer is a valid ref to ... */
if ( IsAdrInList(Numeric, ListNumeric, &it_flag) )
{
if (it_flag == 0 )
{
umfpack_di_get_lunz(&lnz, &unz, &n_row, &n_col, &nz_udiag, Numeric);
}
else
{
umfpack_zi_get_lunz(&lnz, &unz, &n_row, &n_col, &nz_udiag, Numeric);
}
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: Must be a valid reference to (umf) LU factors.\n"), fname, 1);
return 1;
}
if (n_row <= n_col)
{
n = n_row;
}
else
{
n = n_col;
}
L_mnel = (int*)MALLOC(n_row * sizeof(int));
L_icol = (int*)MALLOC(lnz * sizeof(int));
L_ptrow = (int*)MALLOC((n_row + 1) * sizeof(int));
L_R = (double*)MALLOC( lnz * sizeof(double));
U_mnel = (int*)MALLOC(n * sizeof(int));
U_icol = (int*)MALLOC(unz * sizeof(int));
U_ptrow = (int*)MALLOC((n + 1) * sizeof(int));
U_R = (double*)MALLOC( unz * sizeof(double));
V_irow = (int*)MALLOC(unz * sizeof(int));
V_ptcol = (int*)MALLOC((n_col + 1) * sizeof(int));
V_R = (double*)MALLOC( unz * sizeof(double));
p = (int*)MALLOC(n_row * sizeof(int));
q = (int*)MALLOC(n_col * sizeof(int));
Rs = (double*)MALLOC(n_row * sizeof(double));
if ( it_flag == 1 )
{
L_I = (double*)MALLOC(lnz * sizeof(double));
U_I = (double*)MALLOC(unz * sizeof(double));
V_I = (double*)MALLOC(unz * sizeof(double));
}
else
{
L_I = U_I = V_I = NULL;
}
if ( !(L_mnel && L_icol && L_R && L_ptrow && p &&
U_mnel && U_icol && U_R && U_ptrow && q &&
V_irow && V_R && V_ptcol && Rs)
|| (it_flag && !(L_I && U_I && V_I)) )
{
error_flag = 1;
goto the_end;
}
if ( it_flag == 0 )
{
stat = umfpack_di_get_numeric(L_ptrow, L_icol, L_R, V_ptcol, V_irow, V_R,
p, q, (double *)NULL, &do_recip, Rs, Numeric);
}
else
{
stat = umfpack_zi_get_numeric(L_ptrow, L_icol, L_R, L_I, V_ptcol, V_irow, V_R, V_I,
p, q, (double *)NULL, (double *)NULL, &do_recip, Rs, Numeric);
}
if ( stat != UMFPACK_OK )
{
error_flag = 2;
goto the_end;
};
if ( do_recip )
{
for ( i = 0 ; i < n_row ; i++ )
{
Rs[i] = 1.0 / Rs[i];
}
}
if ( it_flag == 0 )
{
stat = umfpack_di_transpose(n, n_col, V_ptcol, V_irow, V_R, (int *) NULL,
(int*) NULL, U_ptrow, U_icol, U_R);
}
else
{
stat = umfpack_zi_transpose(n, n_col, V_ptcol, V_irow, V_R, V_I, (int *) NULL,
(int*) NULL, U_ptrow, U_icol, U_R, U_I, 0);
}
if ( stat != UMFPACK_OK )
{
error_flag = 2;
goto the_end;
};
for ( i = 0 ; i < n_row ; i++ )
{
L_mnel[i] = L_ptrow[i + 1] - L_ptrow[i];
}
for ( i = 0 ; i < n ; i++ )
{
U_mnel[i] = U_ptrow[i + 1] - U_ptrow[i];
}
for ( i = 0 ; i < lnz ; i++ )
{
L_icol[i]++;
}
for ( i = 0 ; i < unz ; i++ )
{
U_icol[i]++;
}
for ( i = 0 ; i < n_row ; i++ )
{
p[i]++;
}
for ( i = 0 ; i < n_col ; i++ )
{
q[i]++;
}
/* output L */
if (it_flag) // complex
{
sciErr = createComplexSparseMatrix(pvApiCtx, 2, n_row, n, lnz, L_mnel, L_icol, L_R, L_I);
}
else
{
sciErr = createSparseMatrix(pvApiCtx, 2, n_row, n, lnz, L_mnel, L_icol, L_R);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
FREE(L_mnel);
FREE(U_mnel);
return 1;
}
/* output U */
if (it_flag) // complex
{
sciErr = createComplexSparseMatrix(pvApiCtx, 3, n, n_col, unz, U_mnel, U_icol, U_R, U_I);
}
else
{
sciErr = createSparseMatrix(pvApiCtx, 3, n, n_col, unz, U_mnel, U_icol, U_R);
}
if (sciErr.iErr)
{
printError(&sciErr, 0);
FREE(L_mnel);
FREE(U_mnel);
return 1;
}
/* output p */
sciErr = createMatrixOfDoubleAsInteger(pvApiCtx, 4, n_row, 1, p);
if (sciErr.iErr)
{
printError(&sciErr, 0);
FREE(L_mnel);
FREE(U_mnel);
return 1;
}
/* output q */
sciErr = createMatrixOfDoubleAsInteger(pvApiCtx, 5, n_col, 1, q);
if (sciErr.iErr)
{
printError(&sciErr, 0);
FREE(L_mnel);
FREE(U_mnel);
return 1;
}
/* output res */
sciErr = createMatrixOfDouble(pvApiCtx, 6, n_row, 1, Rs);
if (sciErr.iErr)
{
printError(&sciErr, 0);
FREE(L_mnel);
FREE(U_mnel);
return 1;
}
the_end:
FREE(L_mnel);
FREE(L_icol);
FREE(L_R);
FREE(L_ptrow);
FREE(p);
FREE(U_mnel);
FREE(U_icol);
FREE(U_R);
FREE(U_ptrow);
FREE(q);
FREE(V_irow);
FREE(V_R);
FREE(V_ptcol);
FREE(Rs);
if ( it_flag == 1 )
{
FREE(L_I);
FREE(V_I);
FREE(U_I);
}
switch (error_flag)
{
case 0: /* no error */
AssignOutputVariable(pvApiCtx, 1) = 2;
AssignOutputVariable(pvApiCtx, 2) = 3;
AssignOutputVariable(pvApiCtx, 3) = 4;
AssignOutputVariable(pvApiCtx, 4) = 5;
AssignOutputVariable(pvApiCtx, 5) = 6;
ReturnArguments(pvApiCtx);
return 0;
case 1: /* enough memory (with malloc) */
Scierror(999, _("%s: No more memory.\n"), fname);
break;
case 2: /* a problem with one umfpack routine */
Scierror(999, "%s: %s\n", fname, UmfErrorMes(stat));
break;
}
return 1;
}
/* This returns an integer identifier that should be unique to your
* system. There were problems with UMF mixing up systems becuase it
* would identify unique systems just by its size.
*
* This unique identifier is passed in as system_id. If you're
* creating the matrix for the first time, then you should pass in a
* -1, otherwise you should pass in the returned value from SL_UMF
* when you created your system.
*
* Note that we don't do this very intelligently. We simply use
* indices sequentially. There is no mechanism to allow re-use.
*/
int
SL_UMF ( int system_id,
int *first,
int *fact_optn,
int *matr_form,
int *nj,
int *nnz_j,
int *row,
int *col,
double *a,
double *b,
double *x )
{
/* Static struct holds all linear systems also keep track of number
* of systems we have set up */
static struct UMF_Linear_Solver_System ums_a[UMF_MAX_SYSTEMS];
static int number_systems = 0;
double Control[UMFPACK_CONTROL], Info[UMFPACK_INFO];
struct UMF_Linear_Solver_System *ums = 0; /* pointer to current system */
int i, j, k, umf_option = 0;
int hit_diag, err;
for (i = 0; i < UMFPACK_CONTROL; i++) {
Control[i] = 0;
}
for (i = 0; i < UMFPACK_INFO; i++) {
Info[i] = 0;
}
#ifdef DEBUG_SL_UMF
fprintf(stderr, "SL_UMF: system_id = %d, *first = %d, *fact_optn = %d\n",
system_id, *first, *fact_optn);
#endif
/* MEMORY */
switch (*first) {
case 1:
/* If *first == 1, then we're creating a new matrix. */
/* If system_id isn't -1, then we're probably making some sort of mistake... */
if(system_id != -1)
EH(-1, "Entered SL_UMF with *first == 1, but system_id != -1");
/* If we've already gone through all of our slots, get out. */
if(number_systems == UMF_MAX_SYSTEMS)
EH(-1, "Already created UMF_MAX_SYSTEMS systems");
system_id = number_systems;
ums = &ums_a[number_systems++];
ums->n = *nj;
ums->nnz = *nnz_j;
/* MATRIX VECTORS */
ums->ap = Ivector_birth(ums->n + 1);
ums->ai = Ivector_birth(ums->nnz);
ums->ax = Dvector_birth(ums->nnz);
/* MSR needs extra allocation for A-transpose */
ums->atp = NULL;
ums->ati = NULL;
ums->atx = NULL;
if ( *matr_form == 1 ) {
ums->atp = Ivector_birth(ums->n + 1);
ums->ati = Ivector_birth(ums->nnz);
ums->atx = Dvector_birth(ums->nnz);
}
break;
case 0:
/* If *first == 0, then we want to just reuse a previously created
* system. */
/* system_id should have the appropriate identifier. */
if(system_id == -1)
EH(-1, "Conflicting orders: system_id == -1 and *first != 1");
if(system_id < 0 || system_id >= UMF_MAX_SYSTEMS)
EH(-1, "Index out of range: system_id");
/* Grab the hopeful system. */
ums = &ums_a[system_id];
/* Run through some sanity checks to help ensure we're dealing
* with the correct system. */
if(ums->n != *nj || ums->nnz != *nnz_j)
EH(-1, "Tried to access a bad system");
break;
case -1:
/* If *first == -1, then we want to free space. */
/* system_id should have the appropriate identifier. */
if(system_id == -1)
EH(-1, "Conflicting orders: system_id == -1 and *first != 1");
if(system_id < 0 || system_id >= UMF_MAX_SYSTEMS)
EH(-1, "Index out of range: system_id");
ums = &ums_a[system_id];
/* Run through some sanity checks to help ensure we're dealing
* with the correct system. */
if(ums->n != *nj || ums->nnz != *nnz_j)
EH(-1, "Tried to free a bad system");
umfpack_di_free_symbolic(&ums->symbolic);
ums->symbolic = NULL;
umfpack_di_free_numeric(&ums->numeric);
ums->numeric = NULL;
Ivector_death(ums->ap, ums->n + 1);
Ivector_death(ums->ai, ums->nnz);
Dvector_death(ums->ax, ums->nnz);
if ( ums->atp != NULL ) {
Ivector_death(ums->atp, ums->n + 1);
Ivector_death(ums->ati, ums->nnz);
Dvector_death(ums->atx, ums->nnz);
}
/* MMH: The fix that changed the world... */
ums->n = 0;
ums->nnz = 0;
/* So things break later in case we actually use the return value
* after deallocating space. */
system_id = -1;
break;
}
/* CONVERT MSR FORMAT TO MATLAB FORMAT IF NEEDED */
if (abs(*fact_optn) < 3) {
switch (*matr_form) {
case 0: /* COORDINATE FORMAT */
umfpack_di_triplet_to_col( ums->n, ums->n, ums->nnz,
row, col, a,
ums->ap, ums->ai, ums->ax,
NULL );
break;
case 1: /* MSR FORMAT */
/* Note: MSR is row-oriented and UMF wants column-oriented data.
So, assemble A-transpose in UMF format, and use umf utility
to get back A in UMF format.
Note also that UMF can operate directly on A-transpose. This
can save having to make another copy of the matrix, but it limited
experiments, I found it to be slower. -DRN
To form A-transpose in UMF format, merge the diagonal entries
back into the rows.
*/
k = 0;
for (i=0;i<ums->n;i++) { /* loop over rows */
ums->atp[i] = k;
hit_diag = FALSE;
for (j=col[i];j<col[i+1];j++) { /* loop over colums within row */
/* if we get to the spot where the diagonal term belongs, merge it in */
if (!hit_diag && col[j] > i ) {
ums->ati[k] = i;
ums->atx[k] = a[i];
k++;
hit_diag = TRUE;
}
ums->ati[k] = col[j];
ums->atx[k] = a[j];
k++;
}
/* if we never got to the diagonal, merge it in now */
if (!hit_diag) {
ums->ati[k] = i;
ums->atx[k] = a[i];
k++;
hit_diag = TRUE;
}
}
ums->atp[ums->n] = ums->nnz;
if (ums->nnz != k) {
DPRINTF(stderr, "E: NNZ=%12d CT=%12d\n", ums->nnz, k);
exit(0);
}
/* transpose matrix */
err = umfpack_di_transpose (ums->n, ums->n, ums->atp, ums->ati, ums->atx,
(int *) NULL, (int *) NULL, ums->ap, ums->ai, ums->ax);
if ( err != UMFPACK_OK )
{
fprintf(stderr,"UMFPACK error = %d\n",err);
EH(-1,"Error computing matrix transpose using umfpack_di_transpose\n");
}
break;
case 2: /* CSR FORMAT - NOT DONE YET */
EH(-1, "Sorry, cannot convert CSR systems");
break;
}
/* SET OPTIONS */
switch (*fact_optn) {
case -2: /* FULL ANALYSIS AND FACTORIZATION */
umf_option = 1;
break;
case -1: /* FACTORIZATION WITH PAST ANALYSIS */
umf_option = 0;
break;
case 0: /* FULL ANALYSIS AND FACTORIZATION */
umf_option = 1;
break;
case 1: /* FACTORIZATION WITH PAST ANALYSIS */
umf_option = 0;
break;
case 3:
umf_option = 0;
break;
default:
EH(-1, "Bad *fact_optn");
}
/* load default control parameters for UMF */
umfpack_di_defaults( Control );
/* optionally can ask for feedback from routines by uncommenting below */
/*Control[UMFPACK_PRL] = 2.;*/
/* optionally force solution strategy */
Control[UMFPACK_STRATEGY] = UMFPACK_STRATEGY_UNSYMMETRIC;
if ( umf_option == 1 ) {
/* analysis */
if ( ums->symbolic != NULL ) {
umfpack_di_free_symbolic(&ums->symbolic);
ums->symbolic = NULL;
}
err = umfpack_di_symbolic( ums->n, ums->n,
ums->ap, ums->ai, ums->ax,
&ums->symbolic, Control, Info );
umfpack_di_report_status(Control, err);
umfpack_di_report_info(Control, Info);
}
/* factorization */
if ( ums->numeric != NULL ) {
umfpack_di_free_numeric(&ums->numeric);
ums->numeric = NULL;
}
err = umfpack_di_numeric( ums->ap, ums->ai, ums->ax,
ums->symbolic, &ums->numeric, Control, Info );
umfpack_di_report_status(Control, err);
umfpack_di_report_info(Control, Info);
}
/* solve */
if ( *fact_optn >= 0 ) {
err = umfpack_di_solve( UMFPACK_A, ums->ap, ums->ai, ums->ax,
x, b,
ums->numeric, Control, Info );
umfpack_di_report_status(Control, err);
umfpack_di_report_info(Control, Info);
}
return system_id;
} /* END of routine SL_UMF */
