/* Numerics Matrix wrapper for y <- alpha A x + beta y */
void NM_gemv(const double alpha, NumericsMatrix* A, const double *x,
const double beta, double *y)
{
switch (A->storageType)
{
case NM_DENSE:
{
cblas_dgemv(CblasColMajor, CblasNoTrans, A->size0, A->size1,
alpha, A->matrix0, A->size0, x, 1, beta, y, 1);
break;
}
case NM_SPARSE_BLOCK:
{
prodSBM(A->size1, A->size0, alpha, A->matrix1, x, beta, y);
break;
}
default:
{
assert(A->storageType == NM_SPARSE);
CHECK_RETURN(cs_aaxpy(alpha, NM_csc(A), x, beta, y));
}
}
}
void prodNumericsMatrix(int sizeX, int sizeY, double alpha, NumericsMatrix* A, const double* const x, double beta, double* y)
{
assert(A);
assert(x);
assert(y);
assert(A->size0 == sizeY);
assert(A->size1 == sizeX);
int storage = A->storageType;
/* double* storage */
switch (storage)
{
case NM_DENSE:
cblas_dgemv(CblasColMajor, CblasNoTrans, sizeY, sizeX, alpha, A->matrix0, sizeY, x, 1, beta, y, 1);
break;
/* SparseBlock storage */
case NM_SPARSE_BLOCK:
prodSBM(sizeX, sizeY, alpha, A->matrix1, x, beta, y);
break;
/* coordinate */
case NM_SPARSE:
cs_aaxpy(alpha, NM_csc(A), x, beta, y);
break;
default:
fprintf(stderr, "Numerics, NumericsMatrix, product matrix - vector prod(A,x,y) failed, unknown storage type for A.\n");
exit(EXIT_FAILURE);
}
}
NM_UMFPACK_WS* NM_UMFPACK_factorize(NumericsMatrix* A)
{
NumericsSparseLinearSolverParams* params = NM_linearSolverParams(A);
if (params->solver_data)
{
return (NM_UMFPACK_WS*) params->solver_data;
}
params->solver_data = (NM_UMFPACK_WS*)calloc(1, sizeof(NM_UMFPACK_WS));
NM_UMFPACK_WS* umfpack_ws = (NM_UMFPACK_WS*) params->solver_data;
UMFPACK_FN(defaults) (umfpack_ws->control);
umfpack_ws->control[UMFPACK_PRL] = verbose;
/* TODO UMFPACK_PIVOT_TOLERANCE, UMFPACK_ORDERING, UMFPACK_SCALE
* UMFPACK_DROPTOL, UMFPACK_STRATEGY, UMFPACK_IRSTEP*/
CSparseMatrix* C = NM_csc(A);
csi status;
status = UMFPACK_FN(symbolic) (C->m, C->n, C->p, C->i, C->x, &(umfpack_ws->symbolic), umfpack_ws->control, umfpack_ws->info);
if (status)
{
umfpack_ws->control[UMFPACK_PRL] = 1;
UMFPACK_FN(report_status) (umfpack_ws->control, status);
return NULL;
}
status = UMFPACK_FN(numeric) (C->p, C->i, C->x, umfpack_ws->symbolic, &(umfpack_ws->numeric), umfpack_ws->control, umfpack_ws->info);
if (status)
{
umfpack_ws->control[UMFPACK_PRL] = 1;
UMFPACK_FN(report_status) (umfpack_ws->control, status);
return NULL;
}
umfpack_ws->wi = (csi*)malloc(C->n * sizeof(csi));
csi size_wd;
if (umfpack_ws->control[UMFPACK_IRSTEP] > 0)
{
size_wd = 5 * C->n;
}
else
{
size_wd = C->n;
}
umfpack_ws->wd = (double*)malloc(size_wd * sizeof(double));
umfpack_ws->x = (double*)malloc(C->n * sizeof(double));
return umfpack_ws;
}
CSparseMatrix* NM_csc_trans(NumericsMatrix* A)
{
if(!NM_sparse(A)->trans_csc)
{
assert(A->matrix2);
A->matrix2->trans_csc = cs_transpose(NM_csc(A), 1); /* value = 1
* ->
* allocation */
}
return A->matrix2->trans_csc;
}
int* NM_MUMPS_jcn(NumericsMatrix* A)
{
if (NM_sparse(A)->triplet)
{
return NM_iWork(A, 0) + NM_sparse(A)->triplet->nz;
}
else
{
csi nzmax = NM_csc(A)->nzmax;
return NM_iWork(A, 0) + nzmax;
}
}
void NM_gemm(const double alpha, NumericsMatrix* A, NumericsMatrix* B,
const double beta, NumericsMatrix* C)
{
switch(A->storageType)
{
case NM_DENSE:
{
cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, A->size0, B->size1, B->size1, alpha, A->matrix0, A->size0, B->matrix0, B->size0, beta, C->matrix0, A->size0);
NM_clearSparseBlock(C);
NM_clearSparseStorage(C);
break;
}
case NM_SPARSE_BLOCK:
{
prodNumericsMatrixNumericsMatrix(alpha, A, B, beta, C);
NM_clearDense(C);
NM_clearSparseStorage(C);
break;
}
case NM_SPARSE:
{
CSparseMatrix* result = cs_add(cs_multiply(NM_csc(A), NM_csc(B)),
NM_csc(C), alpha, beta);
NM_clearDense(C);
NM_clearSparseBlock(C);
NM_clearSparseStorage(C);
NM_sparse(C)->csc = result;
C->size0 = (int)C->matrix2->csc->m;
C->size1 = (int)C->matrix2->csc->n;
break;
}
}
}
int NM_gesv(NumericsMatrix* A, double *b)
{
assert(A->size0 == A->size1);
int info = 1;
switch (A->storageType)
{
case NM_DENSE:
{
assert(A->matrix0);
DGESV(A->size0, 1, A->matrix0, A->size0, NM_iWork(A, A->size0), b,
A->size0, &info);
break;
}
case NM_SPARSE_BLOCK: /* sparse block -> triplet -> csc */
case NM_SPARSE:
{
switch (NM_linearSolverParams(A)->solver)
{
case NS_CS_LUSOL:
info = !cs_lusol(1, NM_csc(A), b, DBL_EPSILON);
break;
#ifdef WITH_MUMPS
case NS_MUMPS:
{
/* the mumps instance is initialized (call with job=-1) */
DMUMPS_STRUC_C* mumps_id = NM_MUMPS_id(A);
mumps_id->rhs = b;
mumps_id->job = 6;
/* compute the solution */
dmumps_c(mumps_id);
/* clean the mumps instance */
mumps_id->job = -2;
dmumps_c(mumps_id);
info = mumps_id->info[0];
if (info > 0)
{
if (verbose > 0)
{
printf("NM_gesv: MUMPS fails : info(1)=%d, info(2)=%d\n", info, mumps_id->info[1]);
}
}
if (verbose > 1)
{
printf("MUMPS : condition number %g\n", mumps_id->rinfog[9]);
printf("MUMPS : component wise scaled residual %g\n", mumps_id->rinfog[6]);
printf("MUMPS : \n");
}
/* Here we free mumps_id ... */
free(NM_linearSolverParams(A)->solver_data);
NM_linearSolverParams(A)->solver_data = NULL;
break;
}
#endif
default:
{
fprintf(stderr, "NM_gesv: unknown sparse linearsolver : %d\n", NM_linearSolverParams(A)->solver);
exit(EXIT_FAILURE);
}
}
break;
}
default:
assert (0 && "NM_gesv unknown storageType");
}
/* some time we cannot find a solution to a linear system, and its fine, for
* instance with the minFBLSA. Therefore, we should not check here for
* problems, but the calling function has to check the return code.*/
// CHECK_RETURN(info);
return info;
}
DMUMPS_STRUC_C* NM_MUMPS_id(NumericsMatrix* A)
{
NumericsSparseLinearSolverParams* params = NM_linearSolverParams(A);
if (!params->solver_data)
{
params->solver_data = malloc(sizeof(DMUMPS_STRUC_C));
DMUMPS_STRUC_C* mumps_id = (DMUMPS_STRUC_C*) params->solver_data;
// Initialize a MUMPS instance. Use MPI_COMM_WORLD.
mumps_id->job = JOB_INIT;
mumps_id->par = 1;
mumps_id->sym = 0;
if (NM_MPI_com(A) == MPI_COMM_WORLD)
{
mumps_id->comm_fortran = USE_COMM_WORLD;
}
else
{
mumps_id->comm_fortran = MPI_Comm_c2f(NM_MPI_com(A));
}
dmumps_c(mumps_id);
if (verbose == 1)
{
mumps_id->ICNTL(1) = -1; // Error messages, standard output stream.
mumps_id->ICNTL(2) = -1; // Diagnostics, standard output stream.
mumps_id->ICNTL(3) = -1; // Global infos, standard output stream.
mumps_id->ICNTL(11) = 1; // Error analysis
}
else if (verbose == 2)
{
mumps_id->ICNTL(1) = -1; // Error messages, standard output stream.
mumps_id->ICNTL(2) = -1; // Diagnostics, standard output stream.
mumps_id->ICNTL(3) = 6; // Global infos, standard output stream.
// mumps_id->ICNTL(4) = 4; // Errors, warnings and information on
// input, output parameters printed.
// mumps_id->ICNTL(10) = 1; // One step of iterative refinment
mumps_id->ICNTL(11) = 1; // Error analysis
}
else if (verbose >= 3)
{
mumps_id->ICNTL(1) = 6; // Error messages, standard output stream.
mumps_id->ICNTL(2) = 6; // Diagnostics, standard output stream.
mumps_id->ICNTL(3) = 6; // Global infos, standard output stream.
// mumps_id->ICNTL(4) = 4; // Errors, warnings and information on
// input, output parameters printed.
// mumps_id->ICNTL(10) = 1; // One step of iterative refinment
mumps_id->ICNTL(11) = 1; // Error analysis
}
else
{
mumps_id->ICNTL(1) = -1;
mumps_id->ICNTL(2) = -1;
mumps_id->ICNTL(3) = -1;
}
mumps_id->ICNTL(24) = 1; // Null pivot row detection see also CNTL(3) & CNTL(5)
// ok for a cube on a plane & four contact points
// computeAlartCurnierSTD != generated in this case...
//mumps_id->CNTL(3) = ...;
//mumps_id->CNTL(5) = ...;
}
DMUMPS_STRUC_C* mumps_id = (DMUMPS_STRUC_C*) params->solver_data;
mumps_id->n = (int) NM_triplet(A)->n;
mumps_id->irn = NM_MUMPS_irn(A);
mumps_id->jcn = NM_MUMPS_jcn(A);
int nz;
if (NM_sparse(A)->triplet)
{
nz = (int) NM_sparse(A)->triplet->nz;
mumps_id->nz = nz;
mumps_id->a = NM_sparse(A)->triplet->x;
}
else
{
nz = NM_linearSolverParams(A)->iWork[2 * NM_csc(A)->nzmax];
mumps_id->nz = nz;
mumps_id->a = NM_sparse(A)->csc->x;
}
return (DMUMPS_STRUC_C*) params->solver_data;
}
static int globalFrictionContact3D_AVI_gams_base(GlobalFrictionContactProblem* problem, double *reaction, double *velocity, SolverOptions* options, const char* solverName)
{
assert(problem);
assert(problem->numberOfContacts > 0);
assert(problem->M);
assert(problem->q);
/* Handles to the GAMSX, GDX, and Option objects */
gamsxHandle_t Gptr = NULL;
idxHandle_t Xptr = NULL;
optHandle_t Optr = NULL;
optHandle_t solverOptPtr = NULL;
int status;
char sysdir[GMS_SSSIZE], model[GMS_SSSIZE], msg[GMS_SSSIZE];
const char defModel[] = SPACE_CONC(GAMS_MODELS_SHARE_DIR, "/fc_vi.gms");
const char defGAMSdir[] = GAMS_DIR;
int size = problem->dimension*problem->numberOfContacts;
NumericsMatrix Htmat;
fillNumericsMatrix(&Htmat, NM_SPARSE, problem->H->size0, problem->H->size1, NULL);
SN_Gams_set_dirs(options->solverParameters, defModel, defGAMSdir, model, sysdir, "/fc_vi.gms");
/* Create objects */
if (! gamsxCreateD (&Gptr, sysdir, msg, sizeof(msg))) {
printf("Could not create gamsx object: %s\n", msg);
return 1;
}
if (! idxCreateD (&Xptr, sysdir, msg, sizeof(msg))) {
printf("Could not create gdx object: %s\n", msg);
return 1;
}
if (! optCreateD (&Optr, sysdir, msg, sizeof(msg))) {
printf("Could not create opt object: %s\n", msg);
return 1;
}
if (! optCreateD (&solverOptPtr, sysdir, msg, sizeof(msg))) {
printf("Could not create opt object: %s\n", msg);
return 1;
}
getGamsSolverOpt(solverOptPtr, sysdir, solverName);
optSetDblStr(solverOptPtr, "convergence_tolerance", options->dparam[0]);
// strncpy(msg, "./", sizeof(deffile));
strncpy(msg, solverName, sizeof(msg));
strncat(msg, ".opt", sizeof(msg));
optWriteParameterFile(solverOptPtr, msg);
FILE* f = fopen("jams.opt", "w");
if (f)
{
char contents[] = "subsolveropt 1";
fprintf(f, contents);
fclose(f);
}
else
{
printf("Failed to create jams.opt!\n");
}
getGamsOpt(Optr, sysdir);
if (strcmp(solverName, "path"))
{
optSetStrStr(Optr, "emp", solverName);
}
idxOpenWrite(Xptr, "fc3d_avi.gdx", "Siconos/Numerics NM_to_GDX", &status);
if (status)
idxerrorR(status, "idxOpenWrite");
DEBUG_PRINT("GFC3D_AVI_GAMS :: fc3d_avi.gdx opened");
if ((status=NM_to_GDX(Xptr, "M", "M matrix", problem->M))) {
printf("Model data not written\n");
goto TERMINATE;
}
DEBUG_PRINT("FC3D_AVI_GAMS :: M matrix written");
if ((status=NM_to_GDX(Xptr, "H", "H matrix", problem->H))) {
printf("Model data not written\n");
goto TERMINATE;
}
DEBUG_PRINT("FC3D_AVI_GAMS :: H matrix written");
NM_copy_to_sparse(problem->H, &Htmat);
cs_fkeep(NM_csc(&Htmat), &SN_rm_normal_part, NULL);
cblas_dcopy(size, problem->b, 1, reaction, 1);
for (unsigned i = 0; i < size; i += 3)
{
reaction[i] = 0.;
}
if ((status=NM_to_GDX(Xptr, "Ht", "Ht matrix", &Htmat))) {
printf("Model data not written\n");
goto TERMINATE;
}
if ((status=NV_to_GDX(Xptr, "q", "q vector", problem->q, size))) {
printf("Model data not written\n");
goto TERMINATE;
}
if ((status=NV_to_GDX(Xptr, "b", "b vector", problem->b, size))) {
printf("Model data not written\n");
goto TERMINATE;
}
if ((status=NV_to_GDX(Xptr, "bt", "bt vector", reaction, size))) {
printf("Model data not written\n");
goto TERMINATE;
}
if (idxClose(Xptr))
idxerrorR(idxGetLastError(Xptr), "idxClose");
if ((status=CallGams(Gptr, Optr, sysdir, model))) {
printf("Call to GAMS failed\n");
goto TERMINATE;
}
/************************************************
* Read back solution
************************************************/
idxOpenRead(Xptr, "fc3d_avi_sol.gdx", &status);
if (status)
idxerrorR(status, "idxOpenRead");
if ((status=GDX_to_NV(Xptr, "reaction", reaction, size))) {
printf("Model data not read\n");
goto TERMINATE;
}
if ((status=GDX_to_NV(Xptr, "velocities", reaction, size))) {
printf("Model data not read\n");
goto TERMINATE;
}
if (idxClose(Xptr))
idxerrorR(idxGetLastError(Xptr), "idxClose");
TERMINATE:
optFree(&Optr);
optFree(&solverOptPtr);
idxFree(&Xptr);
gamsxFree(&Gptr);
freeNumericsMatrix(&Htmat);
return status;
}
