//==============================================================================
Epetra_MsrMatrix::Epetra_MsrMatrix(int * proc_config, AZ_MATRIX * a_mat)
: Epetra_Object("Epetra::MsrMatrix"),
Amat_(a_mat),
proc_config_(proc_config),
Values_(0),
Indices_(0),
MaxNumEntries_(-1),
ImportVector_(0),
NormInf_(-1.0),
NormOne_(-1.0)
{
#ifdef AZTEC_MPI
MPI_Comm * mpicomm = (MPI_Comm * ) AZ_get_comm(proc_config);
Comm_ = new Epetra_MpiComm(*mpicomm);
#else
Comm_ = new Epetra_SerialComm();
#endif
if (a_mat->data_org[AZ_matrix_type]!=AZ_MSR_MATRIX)
throw Comm_->ReportError("AZ_matrix_type must be AZ_MSR_MATRIX", -1);
int * bindx = a_mat->bindx;
NumMyRows_ = a_mat->data_org[AZ_N_internal] + a_mat->data_org[AZ_N_border];
int NumExternal = a_mat->data_org[AZ_N_external];
NumMyCols_ = NumMyRows_ + NumExternal;
NumMyNonzeros_ = bindx[NumMyRows_] - bindx[0] + NumMyRows_;
//Comm_->SumAll(&NumMyNonzeros_, &NumGlobalNonzeros_, 1);
long long NumMyNonzerosLL_ = (long long) NumMyNonzeros_;
Comm_->SumAll(&NumMyNonzerosLL_, &NumGlobalNonzeros_, 1);
int * MyGlobalElements = a_mat->update;
if (MyGlobalElements==0)
throw Comm_->ReportError("Aztec matrix has no update list: Check if AZ_Transform was called.", -2);
DomainMap_ = new Epetra_Map(-1, NumMyRows_, MyGlobalElements, 0, *Comm_);
double * dbleColGIDs = new double[NumMyCols_];
int * ColGIDs = new int[NumMyCols_];
for (int i=0; i<NumMyRows_; i++) dbleColGIDs[i] = (double) MyGlobalElements[i];
AZ_exchange_bdry(dbleColGIDs, a_mat->data_org, proc_config);
{for (int i=0; i<NumMyCols_; i++) ColGIDs[i] = (int) dbleColGIDs[i];}
ColMap_ = new Epetra_Map(-1, NumMyCols_, ColGIDs, 0, *Comm_);
Importer_ = new Epetra_Import(*ColMap_, *DomainMap_);
delete [] dbleColGIDs;
delete [] ColGIDs;
}
void AZ_solve_subdomain(double x[],int N, struct context *context)
{
/****************************************************************************
Given a vector 'x' representing the right hand side, solve the system
using whatever subdomain solver is indicated by 'context->which'
and whatever factorization information has already been computed.
Author: Ray Tuminaro, SNL, 9222 (3/98)
Return code: void
============
Parameter list:
===============
x On input, the right hand side of the subdomain system that
is to be solved.
On output, the solution of the subdomain system.
N On input, the size of the linear system to be solved.
bindx2,val2 On input, matrix or factorization information to be used
by the solver. For most schemes, this information is in
MSR format. However, the lu and bilu scheme would have
this information in another format.
Note: additional array information can be passed through
context.
context On input, the various fields are set to solver specific
information corresponding to algorithm parameters as
well as a previously done factorization.
*******************************************************************************/
double *val2;
int *bindx2;
int N_blk_rows;
#ifdef HAVE_AZLU
int ifail;
#endif
int *sub_options, sub_proc_config[AZ_PROC_SIZE], *hold_data_org, *new_data_org;
double *sub_params, *sub_status;
AZ_MATRIX *sub_matrix;
AZ_PRECOND *sub_precond;
struct AZ_SCALING *sub_scaling;
#ifdef AZTEC_MPI
MPI_AZComm *tptr;
#endif
double *y;
char label[80];
int t1, t2, t3, i, t4, t5 = 0;
/* Begin Aztec 2.1 mheroux mod */
#ifdef IFPACK
int ione = 1;
void *precon;
#endif
/* End Aztec 2.1 mheroux mod */
val2 = context->A_overlapped->val;
bindx2 = context->A_overlapped->bindx;
switch(context->aztec_choices->options[AZ_subdomain_solve]) {
/* Begin Aztec 2.1 mheroux mod */
case AZ_bilu_ifp:
#ifdef IFPACK
y = (double *) malloc (N * sizeof(double));
DCOPY_F77(&N, x, &ione, y, &ione);
precon = context->precon;
ifp_apply(precon, N, 1, y, N, x, N);
free((void *) y);
#endif
break;
/* End Aztec 2.1 mheroux mod */
case AZ_bilu:
N_blk_rows = context->N_blk_rows;
AZ_lower_triang_vbr_solve(N_blk_rows, context->A_overlapped->cpntr,
context->A_overlapped->bpntr,
context->A_overlapped->indx,
bindx2, val2, x);
AZ_upper_triang_vbr_solve(N_blk_rows, context->A_overlapped->cpntr,
context->A_overlapped->bpntr,
context->A_overlapped->indx, bindx2,
val2, x, context->ipvt, context->dblock);
break;
case AZ_ilut:
case AZ_rilu:
case AZ_ilu:
AZ_lower_tsolve(x,N, val2, bindx2, context->iu, x );
AZ_upper_tsolve( x, N, val2, bindx2, context->iu);
break;
case AZ_icc:
AZ_lower_icc(bindx2,val2,N,x);
AZ_upper_icc(bindx2,val2,N,x);
break;
case AZ_lu:
#ifdef HAVE_AZLU
if (N == 0) return;
else if (N== 1) {
x[0] *= val2[0];
ifail = 0;
}
else AZ_backsolve(val2, context->pivot,x, bindx2,
context->ha, context->iflag,
&ifail, &(context->N_nz_factors),
&N, &N);
#else
AZ_printf_err("AZ_lu unavailable: configure with --enable-aztecoo-azlu to make available\n");
exit(1);
#endif
break;
default:
if (context->aztec_choices->options[AZ_subdomain_solve]
>= AZ_SOLVER_PARAMS) {
AZ_printf_out("ERROR: Unknown subdomain solver %d\n",
context->aztec_choices->options[AZ_subdomain_solve]);
exit(1);
}
else {
/* better to put most of this in the factorization */
AZ_recover_sol_params(context->aztec_choices->options[
AZ_subdomain_solve], &sub_options,
&sub_params, &sub_status, &sub_matrix,
&sub_precond, &sub_scaling);
t1 = sub_options[AZ_recursion_level];
sub_options[AZ_recursion_level]++;
t2 = sub_options[AZ_output];
if (context->proc_config[AZ_node] != 0 )
sub_options[AZ_output] = AZ_none;
t3 = context->proc_config[AZ_MPI_Tag];
/* fix data_org */
hold_data_org = context->A_overlapped->data_org;
new_data_org = (int *) AZ_allocate( sizeof(int) * AZ_send_list );
if (new_data_org == NULL) {
AZ_printf_out("Error: Not enough space for subdomain matrix\n");
exit(1);
}
context->A_overlapped->data_org = new_data_org;
context->A_overlapped->matvec = AZ_MSR_matvec_mult;
new_data_org[AZ_matrix_type] = AZ_MSR_MATRIX;
new_data_org[AZ_N_internal] = N;
new_data_org[AZ_N_border ] = 0;
new_data_org[AZ_N_external] = 0;
new_data_org[AZ_N_int_blk ] = N;
new_data_org[AZ_N_bord_blk] = 0;
new_data_org[AZ_N_ext_blk ] = 0;
new_data_org[AZ_N_neigh ] = 0;
new_data_org[AZ_total_send] = 0;
new_data_org[AZ_name ] = hold_data_org[AZ_name];
new_data_org[AZ_internal_use]= 0;
new_data_org[AZ_N_rows ]= N;
sub_precond->Pmat = context->A_overlapped;
sub_precond->prec_function = AZ_precondition;
sub_proc_config[AZ_node] = 0;
sub_proc_config[AZ_N_procs] = 1;
#ifdef AZTEC_MPI
tptr = AZ_get_comm(context->proc_config);
AZ_set_comm(sub_proc_config, *tptr);
#endif
sprintf(label,"y in ssolve%d", sub_options[AZ_recursion_level]);
y = AZ_manage_memory((N+1)*sizeof(double),
AZ_ALLOC, AZ_SYS+az_iterate_id, label, &i);
for (i = 0 ; i < N ; i++ ) y[i] = x[i];
for (i = 0 ; i < N ; i++ ) x[i] = 0.0;
t4 = sub_options[AZ_keep_info];
sub_options[AZ_keep_info] = 1;
if (context->aztec_choices->options[AZ_pre_calc] >= AZ_reuse) {
t5 = sub_options[AZ_pre_calc];
sub_options[AZ_pre_calc] = AZ_sys_reuse;
}
AZ_oldsolve(x, y,sub_options,sub_params, sub_status, sub_proc_config,
context->A_overlapped, sub_precond, sub_scaling);
sub_options[AZ_keep_info] = t4;
if (context->aztec_choices->options[AZ_pre_calc] == AZ_sys_reuse)
sub_options[AZ_pre_calc] = t5;
sub_options[AZ_recursion_level] = t1;
sub_options[AZ_output] = t2;
context->A_overlapped->data_org = hold_data_org;
AZ_free(new_data_org);
context->proc_config[AZ_MPI_Tag] = t3;
}
}
}
int Aztec2Petra(int * proc_config,
AZ_MATRIX * Amat, double * az_x, double * az_b,
Epetra_Comm * & comm,
Epetra_BlockMap * & map,
Epetra_RowMatrix * &A,
Epetra_Vector * & x,
Epetra_Vector * & b,
int ** global_indices) {
bool do_throw = false;
#ifdef EPETRA_NO_32BIT_GLOBAL_INDICES
do_throw = true;
#else
do_throw =
map->GlobalIndicesLongLong() ||
A->RowMatrixRowMap().GlobalIndicesLongLong();
#endif
if(do_throw) {
// We throw rather than let the compiler error out so that the
// rest of the library is available and all possible tests can run.
const char* error = "Aztec2Petra: Not available for 64-bit Maps.";
std::cerr << error << std::endl;
throw error;
}
#ifndef EPETRA_NO_32BIT_GLOBAL_INDICES // REMOVE BEGIN
// If no 32 bit indices, remove the code below using the preprocessor
// otherwise VbrMatrix functions cause linker issues.
// Build Epetra_Comm object
#ifdef AZTEC_MPI
MPI_Comm * mpicomm = (MPI_Comm * ) AZ_get_comm(proc_config);
comm = (Epetra_Comm *) new Epetra_MpiComm(*mpicomm);
#else
comm = (Epetra_Comm *) new Epetra_SerialComm();
#endif
int * MyGlobalElements, *global_bindx, *update;
if (!Amat->has_global_indices) {
//create a global bindx
AZ_revert_to_global(proc_config, Amat, &global_bindx, &update);
MyGlobalElements = update;
}
else // Already have global ordering
{
global_bindx = Amat->bindx;
MyGlobalElements = Amat->update;
if (MyGlobalElements==0) EPETRA_CHK_ERR(-1);
}
// Get matrix information
int NumMyElements = 0;
if (Amat->data_org[AZ_matrix_type] == AZ_VBR_MATRIX)
NumMyElements = Amat->data_org[AZ_N_int_blk] + Amat->data_org[AZ_N_bord_blk];
else
NumMyElements = Amat->data_org[AZ_N_internal] + Amat->data_org[AZ_N_border];
// int NumMyElements = Amat->N_update; // Note: This "official" way does not always work
int * bpntr = Amat->bpntr;
int * rpntr = Amat->rpntr;
int * indx = Amat->indx;
double * val = Amat->val;
int NumGlobalElements;
comm->SumAll(&NumMyElements, &NumGlobalElements, 1);
// Make ElementSizeList (if VBR) - number of block entries in each block row
int * ElementSizeList = 0;
if (Amat->data_org[AZ_matrix_type] == AZ_VBR_MATRIX) {
ElementSizeList = new int[NumMyElements];
if (ElementSizeList==0) EPETRA_CHK_ERR(-1); // Ran out of memory
for (int i=0; i<NumMyElements; i++) ElementSizeList[i] = rpntr[i+1] - rpntr[i];
#ifdef EPETRA_NO_32BIT_GLOBAL_INDICES
map = 0;
#else
map = new Epetra_BlockMap(NumGlobalElements, NumMyElements, MyGlobalElements,
ElementSizeList, 0, *comm);
#endif
if (map==0) EPETRA_CHK_ERR(-2); // Ran out of memory
delete [] ElementSizeList;
Epetra_VbrMatrix * AA = new Epetra_VbrMatrix(View, *map, 0);
if (AA==0) EPETRA_CHK_ERR(-3); // Ran out of memory
/* Add block rows one-at-a-time */
{for (int i=0; i<NumMyElements; i++) {
int BlockRow = MyGlobalElements[i];
int NumBlockEntries = bpntr[i+1] - bpntr[i];
int *BlockIndices = global_bindx + bpntr[i];
int ierr = AA->BeginInsertGlobalValues(BlockRow, NumBlockEntries, BlockIndices);
if (ierr!=0) {
cerr << "Error in BeginInsertGlobalValues(GlobalBlockRow = " << BlockRow
<< ") = " << ierr << endl;
EPETRA_CHK_ERR(ierr);
}
int LDA = rpntr[i+1] - rpntr[i];
int NumRows = LDA;
for (int j=bpntr[i]; j<bpntr[i+1]; j++) {
int NumCols = (indx[j+1] - indx[j])/LDA;
double * Values = val + indx[j];
ierr = AA->SubmitBlockEntry(Values, LDA, NumRows, NumCols);
if (ierr!=0) {
cerr << "Error in SubmitBlockEntry, GlobalBlockRow = " << BlockRow
<< "GlobalBlockCol = " << BlockIndices[j] << "Error = " << ierr << endl;
EPETRA_CHK_ERR(ierr);
}
}
ierr = AA->EndSubmitEntries();
if (ierr!=0) {
cerr << "Error in EndSubmitEntries(GlobalBlockRow = " << BlockRow
<< ") = " << ierr << endl;
EPETRA_CHK_ERR(ierr);
}
}}
int ierr=AA->FillComplete();
if (ierr!=0) {
cerr <<"Error in Epetra_VbrMatrix FillComplete" << ierr << endl;
EPETRA_CHK_ERR(ierr);
}
A = dynamic_cast<Epetra_RowMatrix *> (AA); // cast VBR pointer to RowMatrix pointer
}
else if (Amat->data_org[AZ_matrix_type] == AZ_MSR_MATRIX) {
/* Make numNzBlks - number of block entries in each block row */
int * numNz = new int[NumMyElements];
for (int i=0; i<NumMyElements; i++) numNz[i] = global_bindx[i+1] - global_bindx[i] + 1;
#ifdef EPETRA_NO_32BIT_GLOBAL_INDICES
Epetra_Map * map1 = 0;
#else
Epetra_Map * map1 = new Epetra_Map(NumGlobalElements, NumMyElements,
MyGlobalElements, 0, *comm);
#endif
Epetra_CrsMatrix * AA = new Epetra_CrsMatrix(Copy, *map1, numNz);
map = (Epetra_BlockMap *) map1; // cast Epetra_Map to Epetra_BlockMap
/* Add rows one-at-a-time */
for (int row=0; row<NumMyElements; row++) {
double * row_vals = val + global_bindx[row];
int * col_inds = global_bindx + global_bindx[row];
int numEntries = global_bindx[row+1] - global_bindx[row];
#ifdef EPETRA_NO_32BIT_GLOBAL_INDICES
int ierr = 1;
#else
int ierr = AA->InsertGlobalValues(MyGlobalElements[row], numEntries, row_vals, col_inds);
#endif
if (ierr!=0) {
cerr << "Error puting row " << MyGlobalElements[row] << endl;
EPETRA_CHK_ERR(ierr);
}
#ifdef EPETRA_NO_32BIT_GLOBAL_INDICES
ierr = 1;
#else
ierr = AA->InsertGlobalValues(MyGlobalElements[row], 1, val+row, MyGlobalElements+row);
#endif
if (ierr!=0) {
cerr << "Error putting diagonal" << endl;
EPETRA_CHK_ERR(ierr);
}
}
int ierr=AA->FillComplete();
if (ierr!=0) {
cerr << "Error in Epetra_CrsMatrix_FillComplete" << endl;
EPETRA_CHK_ERR(ierr);
}
A = dynamic_cast<Epetra_RowMatrix *> (AA); // cast CRS pointer to RowMatrix pointer
}
else cerr << "Not a supported AZ_MATRIX data type" << endl;
// Create x vector
x = new Epetra_Vector(View, *map,az_x);
// RPP: Can not use the OperatorRangeMap in the ctor of the "b" vector
// below. In MPSalsa, we delete the VbrMatrix yet still use the vector "b".
// Deleting the matrix deletes the OperatorRangeMap that the b vector is
// based on. Losing the map means "b" and all vectors that are created
// with the copy constructor of "b" break. Mike has suggested
// using reference counting (Boost smart pointers) so the map is not
// deleted. For now we will use the "map" variable as the base map for "b".
//b = new Epetra_Vector (View, A->OperatorRangeMap(), az_b);
b = new Epetra_Vector (View, *map, az_b);
*global_indices = 0; // Assume return array will be empty
if (!Amat->has_global_indices) {
AZ_free((void *) update);
if (Amat->data_org[AZ_matrix_type] != AZ_VBR_MATRIX)
AZ_free((void *) global_bindx);
else
global_indices = &global_bindx;
}
#endif // EPETRA_NO_32BIT_GLOBAL_INDICES REMOVE END
return 0;
}
//==============================================================================
Epetra_MsrMatrix::Epetra_MsrMatrix(int * proc_config, AZ_MATRIX * a_mat)
: Epetra_Object("Epetra::MsrMatrix"),
Amat_(a_mat),
proc_config_(proc_config),
Values_(0),
Indices_(0),
MaxNumEntries_(-1),
ImportVector_(0),
NormInf_(-1.0),
NormOne_(-1.0)
{
#ifdef EPETRA_NO_32BIT_GLOBAL_INDICES
// We throw rather than let the compiler error out so that the
// rest of the library is available and all possible tests can run.
const char* error = "Epetra_MsrMatrix::Epetra_MsrMatrix: Not available for 64-bit Maps.";
std::cerr << error << std::endl;
throw Comm_->ReportError(error, -2);
#endif
#ifdef AZTEC_MPI
MPI_Comm * mpicomm = (MPI_Comm * ) AZ_get_comm(proc_config);
Comm_ = new Epetra_MpiComm(*mpicomm);
#else
Comm_ = new Epetra_SerialComm();
#endif
if (a_mat->data_org[AZ_matrix_type]!=AZ_MSR_MATRIX)
throw Comm_->ReportError("AZ_matrix_type must be AZ_MSR_MATRIX", -1);
int * bindx = a_mat->bindx;
NumMyRows_ = a_mat->data_org[AZ_N_internal] + a_mat->data_org[AZ_N_border];
int NumExternal = a_mat->data_org[AZ_N_external];
NumMyCols_ = NumMyRows_ + NumExternal;
NumMyNonzeros_ = bindx[NumMyRows_] - bindx[0] + NumMyRows_;
#ifndef EPETRA_NO_64BIT_GLOBAL_INDICES
long long tmp_NumMyNonzeros = NumMyNonzeros_;
Comm_->SumAll(&tmp_NumMyNonzeros, &NumGlobalNonzeros_, 1);
#else
int tmp_NumGlobalNonzeros = 0;
Comm_->SumAll(&NumMyNonzeros_, &tmp_NumGlobalNonzeros, 1);
NumGlobalNonzeros_ = tmp_NumGlobalNonzeros;
#endif
int * MyGlobalElements = a_mat->update;
if (MyGlobalElements==0)
throw Comm_->ReportError("Aztec matrix has no update list: Check if AZ_Transform was called.", -2);
#ifdef EPETRA_NO_32BIT_GLOBAL_INDICES
DomainMap_ = 0;
#else
DomainMap_ = new Epetra_Map(-1, NumMyRows_, MyGlobalElements, 0, *Comm_);
#endif
double * dbleColGIDs = new double[NumMyCols_];
int * ColGIDs = new int[NumMyCols_];
for (int i=0; i<NumMyRows_; i++) dbleColGIDs[i] = (double) MyGlobalElements[i];
AZ_exchange_bdry(dbleColGIDs, a_mat->data_org, proc_config);
{for (int i=0; i<NumMyCols_; i++) ColGIDs[i] = (int) dbleColGIDs[i];}
#ifdef EPETRA_NO_32BIT_GLOBAL_INDICES
ColMap_ = 0;
#else
ColMap_ = new Epetra_Map(-1, NumMyCols_, ColGIDs, 0, *Comm_);
#endif
Importer_ = new Epetra_Import(*ColMap_, *DomainMap_);
delete [] dbleColGIDs;
delete [] ColGIDs;
}