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); }