/*! \brief Gather A from the distributed compressed row format to global A in compressed column format.
*/
int pzCompRow_loc_to_CompCol_global
(
int_t need_value, /* Input. Whether need to gather numerical values */
SuperMatrix *A, /* Input. Distributed matrix in NRformat_loc format. */
gridinfo_t *grid, /* Input */
SuperMatrix *GA /* Output */
)
{
NRformat_loc *Astore;
NCformat *GAstore;
doublecomplex *a, *a_loc;
int_t *colind, *rowptr;
int_t *colptr_loc, *rowind_loc;
int_t m_loc, n, i, j, k, l;
int_t colnnz, fst_row, nnz_loc, nnz;
doublecomplex *a_recv; /* Buffer to receive the blocks of values. */
doublecomplex *a_buf; /* Buffer to merge blocks into block columns. */
int_t *itemp;
int_t *colptr_send; /* Buffer to redistribute the column pointers of the
local block rows.
Use n_loc+1 pointers for each block. */
int_t *colptr_blk; /* The column pointers for each block, after
redistribution to the local block columns.
Use n_loc+1 pointers for each block. */
int_t *rowind_recv; /* Buffer to receive the blocks of row indices. */
int_t *rowind_buf; /* Buffer to merge blocks into block columns. */
int_t *fst_rows, *n_locs;
int *sendcnts, *sdispls, *recvcnts, *rdispls, *itemp_32;
int it, n_loc, procs;
#if ( DEBUGlevel>=1 )
CHECK_MALLOC(grid->iam, "Enter pzCompRow_loc_to_CompCol_global");
#endif
/* Initialization. */
n = A->ncol;
Astore = (NRformat_loc *) A->Store;
nnz_loc = Astore->nnz_loc;
m_loc = Astore->m_loc;
fst_row = Astore->fst_row;
a = Astore->nzval;
rowptr = Astore->rowptr;
colind = Astore->colind;
n_loc = m_loc; /* NOTE: CURRENTLY ONLY WORK FOR SQUARE MATRIX */
/* ------------------------------------------------------------
FIRST PHASE: TRANSFORM A INTO DISTRIBUTED COMPRESSED COLUMN.
------------------------------------------------------------*/
zCompRow_to_CompCol_dist(m_loc, n, nnz_loc, a, colind, rowptr, &a_loc,
&rowind_loc, &colptr_loc);
/* Change local row index numbers to global numbers. */
for (i = 0; i < nnz_loc; ++i) rowind_loc[i] += fst_row;
#if ( DEBUGlevel>=2 )
printf("Proc %d\n", grid->iam);
PrintInt10("rowind_loc", nnz_loc, rowind_loc);
PrintInt10("colptr_loc", n+1, colptr_loc);
#endif
procs = grid->nprow * grid->npcol;
if ( !(fst_rows = (int_t *) intMalloc_dist(2*procs)) )
ABORT("Malloc fails for fst_rows[]");
n_locs = fst_rows + procs;
MPI_Allgather(&fst_row, 1, mpi_int_t, fst_rows, 1, mpi_int_t,
grid->comm);
for (i = 0; i < procs-1; ++i) n_locs[i] = fst_rows[i+1] - fst_rows[i];
n_locs[procs-1] = n - fst_rows[procs-1];
if ( !(recvcnts = SUPERLU_MALLOC(5*procs * sizeof(int))) )
ABORT("Malloc fails for recvcnts[]");
sendcnts = recvcnts + procs;
rdispls = sendcnts + procs;
sdispls = rdispls + procs;
itemp_32 = sdispls + procs;
/* All-to-all transfer column pointers of each block.
Now the matrix view is P-by-P block-partition. */
/* n column starts for each column, and procs column ends for each block */
if ( !(colptr_send = intMalloc_dist(n + procs)) )
ABORT("Malloc fails for colptr_send[]");
if ( !(colptr_blk = intMalloc_dist( (((size_t) n_loc)+1)*procs)) )
ABORT("Malloc fails for colptr_blk[]");
for (i = 0, j = 0; i < procs; ++i) {
for (k = j; k < j + n_locs[i]; ++k) colptr_send[i+k] = colptr_loc[k];
colptr_send[i+k] = colptr_loc[k]; /* Add an END marker */
sendcnts[i] = n_locs[i] + 1;
#if ( DEBUGlevel>=1 )
assert(j == fst_rows[i]);
#endif
sdispls[i] = j + i;
recvcnts[i] = n_loc + 1;
rdispls[i] = i * (n_loc + 1);
j += n_locs[i]; /* First column of next block in colptr_loc[] */
}
MPI_Alltoallv(colptr_send, sendcnts, sdispls, mpi_int_t,
colptr_blk, recvcnts, rdispls, mpi_int_t, grid->comm);
/* Adjust colptr_blk[] so that they contain the local indices of the
column pointers in the receive buffer. */
nnz = 0; /* The running sum of the nonzeros counted by far */
k = 0;
for (i = 0; i < procs; ++i) {
for (j = rdispls[i]; j < rdispls[i] + n_loc; ++j) {
colnnz = colptr_blk[j+1] - colptr_blk[j];
/*assert(k<=j);*/
colptr_blk[k] = nnz;
nnz += colnnz; /* Start of the next column */
++k;
}
colptr_blk[k++] = nnz; /* Add an END marker for each block */
}
/*assert(k == (n_loc+1)*procs);*/
/* Now prepare to transfer row indices and values. */
sdispls[0] = 0;
for (i = 0; i < procs-1; ++i) {
sendcnts[i] = colptr_loc[fst_rows[i+1]] - colptr_loc[fst_rows[i]];
sdispls[i+1] = sdispls[i] + sendcnts[i];
}
sendcnts[procs-1] = colptr_loc[n] - colptr_loc[fst_rows[procs-1]];
for (i = 0; i < procs; ++i) {
j = rdispls[i]; /* Point to this block in colptr_blk[]. */
recvcnts[i] = colptr_blk[j+n_loc] - colptr_blk[j];
}
rdispls[0] = 0; /* Recompute rdispls[] for row indices. */
for (i = 0; i < procs-1; ++i) rdispls[i+1] = rdispls[i] + recvcnts[i];
k = rdispls[procs-1] + recvcnts[procs-1]; /* Total received */
if ( !(rowind_recv = (int_t *) intMalloc_dist(2*k)) )
ABORT("Malloc fails for rowind_recv[]");
rowind_buf = rowind_recv + k;
MPI_Alltoallv(rowind_loc, sendcnts, sdispls, mpi_int_t,
rowind_recv, recvcnts, rdispls, mpi_int_t, grid->comm);
if ( need_value ) {
if ( !(a_recv = (doublecomplex *) doublecomplexMalloc_dist(2*k)) )
ABORT("Malloc fails for rowind_recv[]");
a_buf = a_recv + k;
MPI_Alltoallv(a_loc, sendcnts, sdispls, SuperLU_MPI_DOUBLE_COMPLEX,
a_recv, recvcnts, rdispls, SuperLU_MPI_DOUBLE_COMPLEX,
grid->comm);
}
/* Reset colptr_loc[] to point to the n_loc global columns. */
colptr_loc[0] = 0;
itemp = colptr_send;
for (j = 0; j < n_loc; ++j) {
colnnz = 0;
for (i = 0; i < procs; ++i) {
k = i * (n_loc + 1) + j; /* j-th column in i-th block */
colnnz += colptr_blk[k+1] - colptr_blk[k];
}
colptr_loc[j+1] = colptr_loc[j] + colnnz;
itemp[j] = colptr_loc[j]; /* Save a copy of the column starts */
}
itemp[n_loc] = colptr_loc[n_loc];
/* Merge blocks of row indices into columns of row indices. */
for (i = 0; i < procs; ++i) {
k = i * (n_loc + 1);
for (j = 0; j < n_loc; ++j) { /* i-th block */
for (l = colptr_blk[k+j]; l < colptr_blk[k+j+1]; ++l) {
rowind_buf[itemp[j]] = rowind_recv[l];
++itemp[j];
}
}
}
if ( need_value ) {
for (j = 0; j < n_loc+1; ++j) itemp[j] = colptr_loc[j];
for (i = 0; i < procs; ++i) {
k = i * (n_loc + 1);
for (j = 0; j < n_loc; ++j) { /* i-th block */
for (l = colptr_blk[k+j]; l < colptr_blk[k+j+1]; ++l) {
a_buf[itemp[j]] = a_recv[l];
++itemp[j];
}
}
}
}
/* ------------------------------------------------------------
SECOND PHASE: GATHER TO GLOBAL A IN COMPRESSED COLUMN FORMAT.
------------------------------------------------------------*/
GA->nrow = A->nrow;
GA->ncol = A->ncol;
GA->Stype = SLU_NC;
GA->Dtype = A->Dtype;
GA->Mtype = A->Mtype;
GAstore = GA->Store = (NCformat *) SUPERLU_MALLOC ( sizeof(NCformat) );
if ( !GAstore ) ABORT ("SUPERLU_MALLOC fails for GAstore");
/* First gather the size of each piece. */
nnz_loc = colptr_loc[n_loc];
MPI_Allgather(&nnz_loc, 1, mpi_int_t, itemp, 1, mpi_int_t, grid->comm);
for (i = 0, nnz = 0; i < procs; ++i) nnz += itemp[i];
GAstore->nnz = nnz;
if ( !(GAstore->rowind = (int_t *) intMalloc_dist (nnz)) )
ABORT ("SUPERLU_MALLOC fails for GAstore->rowind[]");
if ( !(GAstore->colptr = (int_t *) intMalloc_dist (n+1)) )
ABORT ("SUPERLU_MALLOC fails for GAstore->colptr[]");
/* Allgatherv for row indices. */
rdispls[0] = 0;
for (i = 0; i < procs-1; ++i) {
rdispls[i+1] = rdispls[i] + itemp[i];
itemp_32[i] = itemp[i];
}
itemp_32[procs-1] = itemp[procs-1];
it = nnz_loc;
MPI_Allgatherv(rowind_buf, it, mpi_int_t, GAstore->rowind,
itemp_32, rdispls, mpi_int_t, grid->comm);
if ( need_value ) {
if ( !(GAstore->nzval = (doublecomplex *) doublecomplexMalloc_dist (nnz)) )
ABORT ("SUPERLU_MALLOC fails for GAstore->rnzval[]");
MPI_Allgatherv(a_buf, it, SuperLU_MPI_DOUBLE_COMPLEX, GAstore->nzval,
itemp_32, rdispls, SuperLU_MPI_DOUBLE_COMPLEX, grid->comm);
} else GAstore->nzval = NULL;
/* Now gather the column pointers. */
rdispls[0] = 0;
for (i = 0; i < procs-1; ++i) {
rdispls[i+1] = rdispls[i] + n_locs[i];
itemp_32[i] = n_locs[i];
}
itemp_32[procs-1] = n_locs[procs-1];
MPI_Allgatherv(colptr_loc, n_loc, mpi_int_t, GAstore->colptr,
itemp_32, rdispls, mpi_int_t, grid->comm);
/* Recompute column pointers. */
for (i = 1; i < procs; ++i) {
k = rdispls[i];
for (j = 0; j < n_locs[i]; ++j) GAstore->colptr[k++] += itemp[i-1];
itemp[i] += itemp[i-1]; /* prefix sum */
}
GAstore->colptr[n] = nnz;
#if ( DEBUGlevel>=2 )
if ( !grid->iam ) {
printf("After pdCompRow_loc_to_CompCol_global()\n");
zPrint_CompCol_Matrix_dist(GA);
}
#endif
SUPERLU_FREE(a_loc);
SUPERLU_FREE(rowind_loc);
SUPERLU_FREE(colptr_loc);
SUPERLU_FREE(fst_rows);
SUPERLU_FREE(recvcnts);
SUPERLU_FREE(colptr_send);
SUPERLU_FREE(colptr_blk);
SUPERLU_FREE(rowind_recv);
if ( need_value) SUPERLU_FREE(a_recv);
#if ( DEBUGlevel>=1 )
if ( !grid->iam ) printf("sizeof(NCformat) %lu\n", sizeof(NCformat));
CHECK_MALLOC(grid->iam, "Exit pzCompRow_loc_to_CompCol_global");
#endif
return 0;
} /* pzCompRow_loc_to_CompCol_global */
PetscErrorCode MatLUFactorNumeric_SuperLU_DIST(Mat F,Mat A,const MatFactorInfo *info)
{
Mat *tseq,A_seq = NULL;
Mat_SeqAIJ *aa,*bb;
Mat_SuperLU_DIST *lu = (Mat_SuperLU_DIST*)(F)->spptr;
PetscErrorCode ierr;
PetscInt M=A->rmap->N,N=A->cmap->N,i,*ai,*aj,*bi,*bj,nz,rstart,*garray,
m=A->rmap->n, colA_start,j,jcol,jB,countA,countB,*bjj,*ajj;
int sinfo; /* SuperLU_Dist info flag is always an int even with long long indices */
PetscMPIInt size;
SuperLUStat_t stat;
double *berr=0;
IS isrow;
Mat F_diag=NULL;
#if defined(PETSC_USE_COMPLEX)
doublecomplex *av, *bv;
#else
double *av, *bv;
#endif
PetscFunctionBegin;
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)A),&size);CHKERRQ(ierr);
if (lu->MatInputMode == GLOBAL) { /* global mat input */
if (size > 1) { /* convert mpi A to seq mat A */
ierr = ISCreateStride(PETSC_COMM_SELF,M,0,1,&isrow);CHKERRQ(ierr);
ierr = MatGetSubMatrices(A,1,&isrow,&isrow,MAT_INITIAL_MATRIX,&tseq);CHKERRQ(ierr);
ierr = ISDestroy(&isrow);CHKERRQ(ierr);
A_seq = *tseq;
ierr = PetscFree(tseq);CHKERRQ(ierr);
aa = (Mat_SeqAIJ*)A_seq->data;
} else {
PetscBool flg;
ierr = PetscObjectTypeCompare((PetscObject)A,MATMPIAIJ,&flg);CHKERRQ(ierr);
if (flg) {
Mat_MPIAIJ *At = (Mat_MPIAIJ*)A->data;
A = At->A;
}
aa = (Mat_SeqAIJ*)A->data;
}
/* Convert Petsc NR matrix to SuperLU_DIST NC.
Note: memories of lu->val, col and row are allocated by CompRow_to_CompCol_dist()! */
if (lu->options.Fact != DOFACT) {/* successive numeric factorization, sparsity pattern is reused. */
PetscStackCall("SuperLU_DIST:Destroy_CompCol_Matrix_dist",Destroy_CompCol_Matrix_dist(&lu->A_sup));
if (lu->FactPattern == SamePattern_SameRowPerm) {
lu->options.Fact = SamePattern_SameRowPerm; /* matrix has similar numerical values */
} else { /* lu->FactPattern == SamePattern */
PetscStackCall("SuperLU_DIST:Destroy_LU",Destroy_LU(N, &lu->grid, &lu->LUstruct));
lu->options.Fact = SamePattern;
}
}
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:zCompRow_to_CompCol_dist",zCompRow_to_CompCol_dist(M,N,aa->nz,(doublecomplex*)aa->a,(int_t*)aa->j,(int_t*)aa->i,&lu->val,&lu->col, &lu->row));
#else
PetscStackCall("SuperLU_DIST:dCompRow_to_CompCol_dist",dCompRow_to_CompCol_dist(M,N,aa->nz,aa->a,(int_t*)aa->j,(int_t*)aa->i,&lu->val, &lu->col, &lu->row));
#endif
/* Create compressed column matrix A_sup. */
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:zCreate_CompCol_Matrix_dist",zCreate_CompCol_Matrix_dist(&lu->A_sup, M, N, aa->nz, lu->val, lu->col, lu->row, SLU_NC, SLU_Z, SLU_GE));
#else
PetscStackCall("SuperLU_DIST:dCreate_CompCol_Matrix_dist",dCreate_CompCol_Matrix_dist(&lu->A_sup, M, N, aa->nz, lu->val, lu->col, lu->row, SLU_NC, SLU_D, SLU_GE));
#endif
} else { /* distributed mat input */
Mat_MPIAIJ *mat = (Mat_MPIAIJ*)A->data;
aa=(Mat_SeqAIJ*)(mat->A)->data;
bb=(Mat_SeqAIJ*)(mat->B)->data;
ai=aa->i; aj=aa->j;
bi=bb->i; bj=bb->j;
#if defined(PETSC_USE_COMPLEX)
av=(doublecomplex*)aa->a;
bv=(doublecomplex*)bb->a;
#else
av=aa->a;
bv=bb->a;
#endif
rstart = A->rmap->rstart;
nz = aa->nz + bb->nz;
garray = mat->garray;
if (lu->options.Fact == DOFACT) { /* first numeric factorization */
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:zallocateA_dist",zallocateA_dist(m, nz, &lu->val, &lu->col, &lu->row));
#else
PetscStackCall("SuperLU_DIST:dallocateA_dist",dallocateA_dist(m, nz, &lu->val, &lu->col, &lu->row));
#endif
} else { /* successive numeric factorization, sparsity pattern and perm_c are reused. */
/* Destroy_CompRowLoc_Matrix_dist(&lu->A_sup); */ /* this leads to crash! However, see SuperLU_DIST_2.5/EXAMPLE/pzdrive2.c */
if (lu->FactPattern == SamePattern_SameRowPerm) {
lu->options.Fact = SamePattern_SameRowPerm; /* matrix has similar numerical values */
} else {
PetscStackCall("SuperLU_DIST:Destroy_LU",Destroy_LU(N, &lu->grid, &lu->LUstruct)); /* Deallocate storage associated with the L and U matrices. */
lu->options.Fact = SamePattern;
}
}
nz = 0;
for (i=0; i<m; i++) {
lu->row[i] = nz;
countA = ai[i+1] - ai[i];
countB = bi[i+1] - bi[i];
ajj = aj + ai[i]; /* ptr to the beginning of this row */
bjj = bj + bi[i];
/* B part, smaller col index */
colA_start = rstart + ajj[0]; /* the smallest global col index of A */
jB = 0;
for (j=0; j<countB; j++) {
jcol = garray[bjj[j]];
if (jcol > colA_start) {
jB = j;
break;
}
lu->col[nz] = jcol;
lu->val[nz++] = *bv++;
if (j==countB-1) jB = countB;
}
/* A part */
for (j=0; j<countA; j++) {
lu->col[nz] = rstart + ajj[j];
lu->val[nz++] = *av++;
}
/* B part, larger col index */
for (j=jB; j<countB; j++) {
lu->col[nz] = garray[bjj[j]];
lu->val[nz++] = *bv++;
}
}
lu->row[m] = nz;
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:zCreate_CompRowLoc_Matrix_dist",zCreate_CompRowLoc_Matrix_dist(&lu->A_sup, M, N, nz, m, rstart,lu->val, lu->col, lu->row, SLU_NR_loc, SLU_Z, SLU_GE));
#else
PetscStackCall("SuperLU_DIST:dCreate_CompRowLoc_Matrix_dist",dCreate_CompRowLoc_Matrix_dist(&lu->A_sup, M, N, nz, m, rstart,lu->val, lu->col, lu->row, SLU_NR_loc, SLU_D, SLU_GE));
#endif
}
/* Factor the matrix. */
PetscStackCall("SuperLU_DIST:PStatInit",PStatInit(&stat)); /* Initialize the statistics variables. */
if (lu->MatInputMode == GLOBAL) { /* global mat input */
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:pzgssvx_ABglobal",pzgssvx_ABglobal(&lu->options, &lu->A_sup, &lu->ScalePermstruct, 0, M, 0,&lu->grid, &lu->LUstruct, berr, &stat, &sinfo));
#else
PetscStackCall("SuperLU_DIST:pdgssvx_ABglobal",pdgssvx_ABglobal(&lu->options, &lu->A_sup, &lu->ScalePermstruct, 0, M, 0,&lu->grid, &lu->LUstruct, berr, &stat, &sinfo));
#endif
} else { /* distributed mat input */
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:pzgssvx",pzgssvx(&lu->options, &lu->A_sup, &lu->ScalePermstruct, 0, m, 0, &lu->grid,&lu->LUstruct, &lu->SOLVEstruct, berr, &stat, &sinfo));
if (sinfo) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"pzgssvx fails, info: %d\n",sinfo);
#else
PetscStackCall("SuperLU_DIST:pdgssvx",pdgssvx(&lu->options, &lu->A_sup, &lu->ScalePermstruct, 0, m, 0, &lu->grid,&lu->LUstruct, &lu->SOLVEstruct, berr, &stat, &sinfo));
if (sinfo) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"pdgssvx fails, info: %d\n",sinfo);
#endif
}
if (lu->MatInputMode == GLOBAL && size > 1) {
ierr = MatDestroy(&A_seq);CHKERRQ(ierr);
}
if (lu->options.PrintStat) {
PStatPrint(&lu->options, &stat, &lu->grid); /* Print the statistics. */
}
PStatFree(&stat);
if (size > 1) {
F_diag = ((Mat_MPIAIJ*)(F)->data)->A;
F_diag->assembled = PETSC_TRUE;
}
(F)->assembled = PETSC_TRUE;
(F)->preallocated = PETSC_TRUE;
lu->options.Fact = FACTORED; /* The factored form of A is supplied. Local option used by this func. only */
PetscFunctionReturn(0);
}
