int Amesos_Scalapack::PerformNumericFactorization( ) {
if( debug_ == 1 ) std::cout << "Entering `PerformNumericFactorization()'" << std::endl;
Time_->ResetStartTime();
Ipiv_.resize(NumGlobalElements_) ;
for (int i=0; i <NumGlobalElements_ ; i++)
Ipiv_[i] = 0 ; // kludge - just to see if this makes valgrind happy
if ( false) std::cout << " Amesos_Scalapack.cpp: 711 iam_ = " << iam_ << " DescA = "
<< DescA_[0] << " "
<< DescA_[1] << " "
<< DescA_[2] << " "
<< DescA_[3] << " "
<< DescA_[4] << " "
<< DescA_[5] << " "
<< DescA_[6] << " "
<< DescA_[7] << " "
<< DescA_[8] << " "
<< std::endl ;
#if 1
if( NumGlobalElements_ < 10 && nprow_ == 1 && npcol_ == 1 && debug_ == 1 ) {
assert( lda_ == NumGlobalElements_ ) ;
std::cout << " DenseA = " << std::endl ;
for (int i=0 ; i < NumGlobalElements_; i++ ) {
for (int j=0 ; j < NumGlobalElements_; j++ ) {
if ( DenseA_[ i+j*lda_ ] < 0 ) {
DenseA_[ i+j*lda_ ] *= (1+1e-5) ; // kludge fixme debugxx - just to let vaglrind check to be sure that DenseA is initialized
}
// std::cout << DenseA_[ i+j*lda_ ] << "\t";
}
// std::cout << std::endl ;
}
}
#endif
int Ierr[1] ;
Ierr[0] = 0 ;
const int one = 1 ;
if ( iam_ < nprow_ * npcol_ ) {
if ( nprow_ * npcol_ == 1 ) {
DGETRF_F77(&NumGlobalElements_,
&NumGlobalElements_,
&DenseA_[0],
&lda_,
&Ipiv_[0],
Ierr) ;
} else {
PDGETRF_F77(&NumGlobalElements_,
&NumGlobalElements_,
&DenseA_[0],
&one,
&one,
DescA_,
&Ipiv_[0],
Ierr) ;
}
}
if ( debug_ == 1 && Ierr[0] != 0 )
std::cout << " Amesos_Scalapack.cpp:738 iam_ = " << iam_
<< " Ierr = " << Ierr[0] << std::endl ;
// All processes should return the same error code
if ( nprow_ * npcol_ < Comm().NumProc() )
Comm().Broadcast( Ierr, 1, 0 ) ;
NumTime_ += Time_->ElapsedTime();
return Ierr[0];
}
void AZ_calc_blk_diag_LU(double *val, int *indx, int *bindx, int *rpntr,
int *cpntr, int *bpntr, double *d_inv, int *d_indx,
int *d_bindx, int *d_rpntr, int *d_bpntr,
int *data_org, int *ipvt)
/*******************************************************************************
Routine to calculate the LU factors of the block-diagonal portion of sparse
matrix in 'val' and the associated integer pointer vectors. This is used for
scaling.
Author: Scott A. Hutchinson, SNL, 1421
=======
Return code: void
============
Parameter list:
===============
val: Array containing the nonzero entries of the matrix (see
Aztec User's Guide).
indx,
bindx,
rpntr,
cpntr,
bpntr: Arrays used for DMSR and DVBR sparse matrix storage (see
file Aztec User's Guide).
d_inv: Vector containing the LU of the diagonal blocks.
d_indx: The 'indx' array corresponding to the LU-block
diagonals.
d_bindx: The 'bindx' array corresponding to the LU-block
diagonals.
d_rpntr: The 'rpntr' array corresponding to the LU-block
diagonals.
d_bpntr: The 'bpntr' array corresponding to the LU-block
diagonals.
data_org: Array containing information on the distribution of the
matrix to this processor as well as communication parameters
(see Aztec User's Guide).
*******************************************************************************/
{
/* local variables */
register int i, j, iblk_row, jblk, icount = 0, iblk_count = 0, ival;
int m1, n1, itemp;
int m;
int bpoff, idoff;
int info;
double *work;
char *yo = "AZ_calc_blk_diag_inv: ";
/**************************** execution begins ******************************/
m = data_org[AZ_N_int_blk] + data_org[AZ_N_bord_blk];
if (m == 0) return;
/* allocate vectors for lapack routines */
work = (double *) AZ_allocate(rpntr[m]*sizeof(double));
if (work == NULL) AZ_perror("Not enough space for Block Jacobi\n");
/* offset of the first block */
bpoff = *bpntr;
idoff = *indx;
/* loop over block rows */
for (iblk_row = 0; iblk_row < m; iblk_row++) {
/* number of rows in the current row block */
m1 = rpntr[iblk_row+1] - rpntr[iblk_row];
/* starting index of current row block */
ival = indx[bpntr[iblk_row] - bpoff] - idoff;
/* loop over column block numbers, looking for the diagonal block */
for (j = bpntr[iblk_row] - bpoff; j < bpntr[iblk_row+1] - bpoff; j++) {
jblk = bindx[j];
/* determine the number of columns in this block */
n1 = cpntr[jblk+1] - cpntr[jblk];
itemp = m1*n1;
if (jblk == iblk_row) { /* diagonal block */
/* error check */
if (n1 != m1) {
(void) AZ_printf_err( "%sERROR: diagonal blocks are not square\n.",
yo);
exit(-1);
}
else {
/* fill the vectors */
d_indx[iblk_count] = icount;
d_rpntr[iblk_count] = rpntr[iblk_row];
d_bpntr[iblk_count] = iblk_row;
d_bindx[iblk_count] = iblk_row;
for (i = 0; i < itemp; i++) d_inv[icount++] = val[ival + i];
/* invert the dense matrix */
DGETRF_F77(&m1, &m1, &d_inv[d_indx[iblk_count]], &m1, &(ipvt[rpntr[iblk_row]]), &info);
if (info < 0) {
(void) AZ_printf_err( "%sERROR: argument %d is illegal.\n", yo,
-info);
exit(-1);
}
else if (info > 0) {
(void) AZ_printf_err( "%sERROR: the factorization has produced a "
"singular U with U[%d][%d] being exactly zero.\n",
yo, info, info);
exit(-1);
}
iblk_count++;
}
break;
}
else
ival += itemp;
}
}
d_indx[iblk_count] = icount;
d_rpntr[iblk_count] = rpntr[iblk_row];
d_bpntr[iblk_count] = iblk_row;
AZ_free((void *) work);
} /* AZ_calc_blk_diag_inv */
//=============================================================================
void Epetra_LAPACK::GETRF( const int M, const int N, double * A, const int LDA, int * IPIV, int * INFO) const {
DGETRF_F77(&M, &N, A, &LDA, IPIV, INFO);
}
