PetscErrorCode MatDestroy_SuperLU_DIST(Mat A) { PetscErrorCode ierr; Mat_SuperLU_DIST *lu = (Mat_SuperLU_DIST*)A->spptr; PetscBool flg; PetscFunctionBegin; if (lu && lu->CleanUpSuperLU_Dist) { /* Deallocate SuperLU_DIST storage */ if (lu->MatInputMode == GLOBAL) { Destroy_CompCol_Matrix_dist(&lu->A_sup); } else { Destroy_CompRowLoc_Matrix_dist(&lu->A_sup); if ( lu->options.SolveInitialized ) { #if defined(PETSC_USE_COMPLEX) zSolveFinalize(&lu->options, &lu->SOLVEstruct); #else dSolveFinalize(&lu->options, &lu->SOLVEstruct); #endif } } Destroy_LU(A->cmap->N, &lu->grid, &lu->LUstruct); ScalePermstructFree(&lu->ScalePermstruct); LUstructFree(&lu->LUstruct); /* Release the SuperLU_DIST process grid. */ superlu_gridexit(&lu->grid); ierr = MPI_Comm_free(&(lu->comm_superlu));CHKERRQ(ierr); } ierr = PetscFree(A->spptr);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&flg);CHKERRQ(ierr); if (flg) { ierr = MatDestroy_SeqAIJ(A);CHKERRQ(ierr); } else { ierr = MatDestroy_MPIAIJ(A);CHKERRQ(ierr); } PetscFunctionReturn(0); }
int main(int argc, char *argv[]) { superlu_options_t options; SuperLUStat_t stat; SuperMatrix A; NRformat_loc *Astore; ScalePermstruct_t ScalePermstruct; LUstruct_t LUstruct; SOLVEstruct_t SOLVEstruct; gridinfo_t grid; double *berr; double *b, *b1, *xtrue, *nzval, *nzval1; int_t *colind, *colind1, *rowptr, *rowptr1; int_t i, j, m, n, nnz_loc, m_loc, fst_row; int nprow, npcol; int iam, info, ldb, ldx, nrhs; char **cpp, c; FILE *fp, *fopen(); nprow = 1; /* Default process rows. */ npcol = 1; /* Default process columns. */ nrhs = 1; /* Number of right-hand side. */ /* ------------------------------------------------------------ INITIALIZE MPI ENVIRONMENT. ------------------------------------------------------------*/ MPI_Init( &argc, &argv ); /* Parse command line argv[]. */ for (cpp = argv+1; *cpp; ++cpp) { if ( **cpp == '-' ) { c = *(*cpp+1); ++cpp; switch (c) { case 'h': printf("Options:\n"); printf("\t-r <int>: process rows (default %d)\n", nprow); printf("\t-c <int>: process columns (default %d)\n", npcol); exit(0); break; case 'r': nprow = atoi(*cpp); break; case 'c': npcol = atoi(*cpp); break; } } else { /* Last arg is considered a filename */ if ( !(fp = fopen(*cpp, "r")) ) { ABORT("File does not exist"); } break; } } /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ superlu_gridinit(MPI_COMM_WORLD, nprow, npcol, &grid); /* Bail out if I do not belong in the grid. */ iam = grid.iam; if ( iam >= nprow * npcol ) goto out; if ( !iam ) { printf("Input matrix file: %s\n", *cpp); printf("\tProcess grid\t%d X %d\n", grid.nprow, grid.npcol); } #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Enter main()"); #endif /* ------------------------------------------------------------ GET THE MATRIX FROM FILE AND SETUP THE RIGHT HAND SIDE. ------------------------------------------------------------*/ dcreate_matrix(&A, nrhs, &b, &ldb, &xtrue, &ldx, fp, &grid); if ( !(b1 = doubleMalloc_dist(ldb * nrhs)) ) ABORT("Malloc fails for b1[]"); for (j = 0; j < nrhs; ++j) for (i = 0; i < ldb; ++i) b1[i+j*ldb] = b[i+j*ldb]; if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); m = A.nrow; n = A.ncol; /* Save a copy of the matrix A. */ Astore = (NRformat_loc *) A.Store; nnz_loc = Astore->nnz_loc; m_loc = Astore->m_loc; fst_row = Astore->fst_row; nzval = Astore->nzval; colind = Astore->colind; rowptr = Astore->rowptr; nzval1 = doubleMalloc_dist(nnz_loc); colind1 = intMalloc_dist(nnz_loc); rowptr1 = intMalloc_dist(m_loc+1); for (i = 0; i < nnz_loc; ++i) { nzval1[i] = nzval[i]; colind1[i] = colind[i]; } for (i = 0; i < m_loc+1; ++i) rowptr1[i] = rowptr[i]; /* ------------------------------------------------------------ WE SOLVE THE LINEAR SYSTEM FOR THE FIRST TIME. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = METIS_AT_PLUS_A; options.RowPerm = LargeDiag; options.ReplaceTinyPivot = YES; options.Trans = NOTRANS; options.IterRefine = DOUBLE; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); if (!iam) { print_sp_ienv_dist(&options); print_options_dist(&options); } /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver: factorize and solve. */ pdgssvx(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid, &LUstruct, &SOLVEstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ pdinf_norm_error(iam, m_loc, nrhs, b, ldb, xtrue, ldx, &grid); PStatPrint(&options, &stat, &grid); /* Print the statistics. */ PStatFree(&stat); Destroy_CompRowLoc_Matrix_dist(&A); /* Deallocate storage of matrix A. */ SUPERLU_FREE(b); /* Free storage of right-hand side. */ /* ------------------------------------------------------------ NOW WE SOLVE ANOTHER LINEAR SYSTEM. THE MATRIX A HAS THE SAME SPARSITY PATTERN AND THE SIMILAR NUMERICAL VALUES AS THAT IN A PREVIOUS SYSTEM. ------------------------------------------------------------*/ options.Fact = SamePattern_SameRowPerm; PStatInit(&stat); /* Initialize the statistics variables. */ /* Set up the local A in NR_loc format */ dCreate_CompRowLoc_Matrix_dist(&A, m, n, nnz_loc, m_loc, fst_row, nzval1, colind1, rowptr1, SLU_NR_loc, SLU_D, SLU_GE); /* Solve the linear system. */ pdgssvx(&options, &A, &ScalePermstruct, b1, ldb, nrhs, &grid, &LUstruct, &SOLVEstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ if ( !iam ) printf("Solve a system with the same pattern and similar values.\n"); pdinf_norm_error(iam, m_loc, nrhs, b1, ldb, xtrue, ldx, &grid); /* Print the statistics. */ PStatPrint(&options, &stat, &grid); /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompRowLoc_Matrix_dist(&A); /* Deallocate storage of matrix A. */ Destroy_LU(n, &grid, &LUstruct); /* Deallocate storage associated with the L and U matrices. */ ScalePermstructFree(&ScalePermstruct); LUstructFree(&LUstruct); /* Deallocate the structure of L and U.*/ if ( options.SolveInitialized ) { dSolveFinalize(&options, &SOLVEstruct); } SUPERLU_FREE(b1); /* Free storage of right-hand side. */ SUPERLU_FREE(xtrue); /* Free storage of the exact solution. */ SUPERLU_FREE(berr); /* ------------------------------------------------------------ RELEASE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ out: superlu_gridexit(&grid); /* ------------------------------------------------------------ TERMINATES THE MPI EXECUTION ENVIRONMENT. ------------------------------------------------------------*/ MPI_Finalize(); #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Exit main()"); #endif }
void f_Destroy_LU(int_t *n, fptr *grid, fptr *LUstruct) { Destroy_LU(*n, (gridinfo_t *) *grid, (LUstruct_t *) *LUstruct); }
int main(int argc, char *argv[]) { superlu_dist_options_t options; SuperLUStat_t stat; SuperMatrix A; ScalePermstruct_t ScalePermstruct; LUstruct_t LUstruct; gridinfo_t grid1, grid2; double *berr; double *a, *b, *xtrue; int_t *asub, *xa; int_t i, j, m, n, nnz; int_t nprow, npcol, ldumap, p; int_t usermap[6]; int iam, info, ldb, ldx, nprocs; int nrhs = 1; /* Number of right-hand side. */ char trans[1]; char **cpp, c; FILE *fp, *fopen(); /* prototypes */ extern void LUstructInit(const int_t, LUstruct_t *); extern void LUstructFree(LUstruct_t *); extern void Destroy_LU(int_t, gridinfo_t *, LUstruct_t *); /* ------------------------------------------------------------ INITIALIZE MPI ENVIRONMENT. ------------------------------------------------------------*/ MPI_Init( &argc, &argv ); MPI_Comm_size( MPI_COMM_WORLD, &nprocs ); if ( nprocs < 10 ) { fprintf(stderr, "Requires at least 10 processes\n"); exit(-1); } /* Parse command line argv[]. */ for (cpp = argv+1; *cpp; ++cpp) { if ( **cpp == '-' ) { c = *(*cpp+1); ++cpp; switch (c) { case 'h': printf("Options:\n"); printf("\t-r <int>: process rows (default %d)\n", nprow); printf("\t-c <int>: process columns (default %d)\n", npcol); exit(0); break; case 'r': nprow = atoi(*cpp); break; case 'c': npcol = atoi(*cpp); break; } } else { /* Last arg is considered a filename */ if ( !(fp = fopen(*cpp, "r")) ) { ABORT("File does not exist"); } break; } } /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID 1. ------------------------------------------------------------*/ nprow = 2; npcol = 3; ldumap = 2; p = 0; /* Grid 1 starts from process 0. */ for (i = 0; i < nprow; ++i) for (j = 0; j < npcol; ++j) usermap[i+j*ldumap] = p++; superlu_gridmap(MPI_COMM_WORLD, nprow, npcol, usermap, ldumap, &grid1); /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID 2. ------------------------------------------------------------*/ nprow = 2; npcol = 2; ldumap = 2; p = 6; /* Grid 2 starts from process 6. */ for (i = 0; i < nprow; ++i) for (j = 0; j < npcol; ++j) usermap[i+j*ldumap] = p++; superlu_gridmap(MPI_COMM_WORLD, nprow, npcol, usermap, ldumap, &grid2); /* Bail out if I do not belong in any of the 2 grids. */ MPI_Comm_rank( MPI_COMM_WORLD, &iam ); if ( iam >= 10 ) goto out; #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Enter main()"); #endif if ( iam >= 0 && iam < 6 ) { /* I am in grid 1. */ iam = grid1.iam; /* Get the logical number in the new grid. */ /* ------------------------------------------------------------ PROCESS 0 READS THE MATRIX A, AND THEN BROADCASTS IT TO ALL THE OTHER PROCESSES. ------------------------------------------------------------*/ if ( !iam ) { /* Read the matrix stored on disk in Harwell-Boeing format. */ dreadhb_dist(iam, fp, &m, &n, &nnz, &a, &asub, &xa); printf("\tDimension\t%dx%d\t # nonzeros %d\n", m, n, nnz); printf("\tProcess grid\t%d X %d\n", (int) grid1.nprow, (int) grid1.npcol); /* Broadcast matrix A to the other PEs. */ MPI_Bcast( &m, 1, mpi_int_t, 0, grid1.comm ); MPI_Bcast( &n, 1, mpi_int_t, 0, grid1.comm ); MPI_Bcast( &nnz, 1, mpi_int_t, 0, grid1.comm ); MPI_Bcast( a, nnz, MPI_DOUBLE, 0, grid1.comm ); MPI_Bcast( asub, nnz, mpi_int_t, 0, grid1.comm ); MPI_Bcast( xa, n+1, mpi_int_t, 0, grid1.comm ); } else { /* Receive matrix A from PE 0. */ MPI_Bcast( &m, 1, mpi_int_t, 0, grid1.comm ); MPI_Bcast( &n, 1, mpi_int_t, 0, grid1.comm ); MPI_Bcast( &nnz, 1, mpi_int_t, 0, grid1.comm ); /* Allocate storage for compressed column representation. */ dallocateA_dist(n, nnz, &a, &asub, &xa); MPI_Bcast( a, nnz, MPI_DOUBLE, 0, grid1.comm ); MPI_Bcast( asub, nnz, mpi_int_t, 0, grid1.comm ); MPI_Bcast( xa, n+1, mpi_int_t, 0, grid1.comm ); } /* Create compressed column matrix for A. */ dCreate_CompCol_Matrix_dist(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE); /* Generate the exact solution and compute the right-hand side. */ if (!(b=doubleMalloc_dist(m*nrhs))) ABORT("Malloc fails for b[]"); if (!(xtrue=doubleMalloc_dist(n*nrhs))) ABORT("Malloc fails for xtrue[]"); *trans = 'N'; ldx = n; ldb = m; dGenXtrue_dist(n, nrhs, xtrue, ldx); dFillRHS_dist(trans, nrhs, xtrue, ldx, &A, b, ldb); if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); /* ------------------------------------------------------------ NOW WE SOLVE THE LINEAR SYSTEM. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = METIS_AT_PLUS_A; options.RowPerm = LargeDiag; options.ReplaceTinyPivot = YES; options.Trans = NOTRANS; options.IterRefine = DOUBLE; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); if (!iam) { print_sp_ienv_dist(&options); print_options_dist(&options); } /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver: factorize and solve. */ pdgssvx_ABglobal(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid1, &LUstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ if ( !iam ) { dinf_norm_error_dist(n, nrhs, b, ldb, xtrue, ldx, &grid1); } /* Print the statistics. */ PStatPrint(&options, &stat, &grid1); /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompCol_Matrix_dist(&A); Destroy_LU(n, &grid1, &LUstruct); ScalePermstructFree(&ScalePermstruct); LUstructFree(&LUstruct); SUPERLU_FREE(b); SUPERLU_FREE(xtrue); SUPERLU_FREE(berr); } else { /* I am in grid 2. */ iam = grid2.iam; /* Get the logical number in the new grid. */ /* ------------------------------------------------------------ PROCESS 0 READS THE MATRIX A, AND THEN BROADCASTS IT TO ALL THE OTHER PROCESSES. ------------------------------------------------------------*/ if ( !iam ) { /* Read the matrix stored on disk in Harwell-Boeing format. */ dreadhb_dist(iam, fp, &m, &n, &nnz, &a, &asub, &xa); printf("\tDimension\t%dx%d\t # nonzeros %d\n", m, n, nnz); printf("\tProcess grid\t%d X %d\n", (int) grid2.nprow, (int) grid2.npcol); /* Broadcast matrix A to the other PEs. */ MPI_Bcast( &m, 1, mpi_int_t, 0, grid2.comm ); MPI_Bcast( &n, 1, mpi_int_t, 0, grid2.comm ); MPI_Bcast( &nnz, 1, mpi_int_t, 0, grid2.comm ); MPI_Bcast( a, nnz, MPI_DOUBLE, 0, grid2.comm ); MPI_Bcast( asub, nnz, mpi_int_t, 0, grid2.comm ); MPI_Bcast( xa, n+1, mpi_int_t, 0, grid2.comm ); } else { /* Receive matrix A from PE 0. */ MPI_Bcast( &m, 1, mpi_int_t, 0, grid2.comm ); MPI_Bcast( &n, 1, mpi_int_t, 0, grid2.comm ); MPI_Bcast( &nnz, 1, mpi_int_t, 0, grid2.comm ); /* Allocate storage for compressed column representation. */ dallocateA_dist(n, nnz, &a, &asub, &xa); MPI_Bcast( a, nnz, MPI_DOUBLE, 0, grid2.comm ); MPI_Bcast( asub, nnz, mpi_int_t, 0, grid2.comm ); MPI_Bcast( xa, n+1, mpi_int_t, 0, grid2.comm ); } /* Create compressed column matrix for A. */ dCreate_CompCol_Matrix_dist(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE); /* Generate the exact solution and compute the right-hand side. */ if (!(b=doubleMalloc_dist(m*nrhs))) ABORT("Malloc fails for b[]"); if (!(xtrue=doubleMalloc_dist(n*nrhs))) ABORT("Malloc fails for xtrue[]"); *trans = 'N'; ldx = n; ldb = m; dGenXtrue_dist(n, nrhs, xtrue, ldx); dFillRHS_dist(trans, nrhs, xtrue, ldx, &A, b, ldb); if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); /* ------------------------------------------------------------ NOW WE SOLVE THE LINEAR SYSTEM. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = MMD_AT_PLUS_A; options.RowPerm = LargeDiag; options.ReplaceTinyPivot = YES; options.Trans = NOTRANS; options.IterRefine = DOUBLE; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver: factorize and solve. */ pdgssvx_ABglobal(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid2, &LUstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ if ( !iam ) { dinf_norm_error_dist(n, nrhs, b, ldb, xtrue, ldx, &grid2); } /* Print the statistics. */ PStatPrint(&options, &stat, &grid2); /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompCol_Matrix_dist(&A); Destroy_LU(n, &grid2, &LUstruct); ScalePermstructFree(&ScalePermstruct); LUstructFree(&LUstruct); SUPERLU_FREE(b); SUPERLU_FREE(xtrue); SUPERLU_FREE(berr); } /* ------------------------------------------------------------ RELEASE THE SUPERLU PROCESS GRIDS. ------------------------------------------------------------*/ superlu_gridexit(&grid1); superlu_gridexit(&grid2); out: /* ------------------------------------------------------------ TERMINATES THE MPI EXECUTION ENVIRONMENT. ------------------------------------------------------------*/ MPI_Finalize(); #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Exit main()"); #endif }
int c_fortran_pdgssvx_ABglobal_(int *iopt, int_t *n, int_t *nnz, int *nrhs, double *values, int_t *rowind, int_t *colptr, double *b, int *ldb, int grid_handle[HANDLE_SIZE], double *berr, int factors[HANDLE_SIZE], int *info) { /* * Purpose * ======= * * This is a Fortran wrapper to use pdgssvx_ABglobal(). * * Arguments * ========= * * iopt (input) int * Specifies the operation to be performed: * = 1, performs LU decomposition for the first time * = 2, performs a subsequent LU decomposition for a new matrix * with the same sparsity pattern * = 3, performs triangular solve * = 4, frees all the storage in the end * * n (input) int, order of the matrix A * * nnz (input) int, number of nonzeros in matrix A * * nrhs (input) int, number of right-hand sides in the system AX = B * * values/rowind/colptr (input) column compressed data structure for A * * b (input/output) double * On input, the right-hand side matrix of dimension (ldb, nrhs) * On output, the solution matrix * * ldb (input) int, leading dimension of the matrix B * * grid_handle (input) int array of size 8, holds a pointer to the process * grid structure, which is created and freed separately. * * berr (output) double, the backward error of each right-hand side * * factors (input/output) int array of size 8 * If iopt == 1, it is an output and contains the pointer pointing to * the structure of the factored matrices. * Otherwise, it it an input. * * info (output) int * */ superlu_options_t options; SuperLUStat_t stat; SuperMatrix A; ScalePermstruct_t *ScalePermstruct; LUstruct_t *LUstruct; int_t nprow, npcol; int iam; int report; int i; gridinfo_t *grid; factors_dist_t *LUfactors; /* * Set option for printing statistics. * report = 0: no reporting * report = 1: reporting */ report = 0; /* Locate the process grid. */ grid = (gridinfo_t *) grid_handle[0]; iam = (*grid).iam; nprow = (int_t) grid->nprow; npcol = (int_t) grid->npcol; if ( *iopt == 1 ) { /* LU decomposition */ if ( !iam ) printf(".. Process grid: %d X %d\n", nprow, npcol); /* Initialize the statistics variables. */ PStatInit(&stat); dCreate_CompCol_Matrix_dist(&A, *n, *n, *nnz, values, rowind, colptr, SLU_NC, SLU_D, SLU_GE); /* Set options. */ set_default_options(&options); /* Initialize ScalePermstruct and LUstruct. */ ScalePermstruct = (ScalePermstruct_t *) SUPERLU_MALLOC(sizeof(ScalePermstruct_t)); ScalePermstructInit(*n, *n, ScalePermstruct); LUstruct = (LUstruct_t *) SUPERLU_MALLOC(sizeof(LUstruct_t)); LUstructInit(*n, *n, LUstruct); /* Call global routine with nrhs=0 to perform the factorization. */ pdgssvx_ABglobal(&options, &A, ScalePermstruct, NULL, *ldb, 0, grid, LUstruct, berr, &stat, info); if ( *info == 0 ) { if ( report == 1 ) PStatPrint(&options, &stat, grid); } else { printf("pdgssvx_ABglobal() error returns INFO= %d\n", *info); } /* Save the LU factors in the factors handle */ LUfactors = (factors_dist_t*) SUPERLU_MALLOC(sizeof(factors_dist_t)); LUfactors->ScalePermstruct = ScalePermstruct; LUfactors->LUstruct = LUstruct; factors[0] = (int) LUfactors; /* Free un-wanted storage */ Destroy_SuperMatrix_Store_dist(&A); PStatFree(&stat); } else if ( *iopt == 2 ) { /* Factor a modified matrix with the same sparsity pattern using existing permutations and L U storage */ /* Extract the LU factors in the factors handle */ LUfactors = (factors_dist_t*) factors[0]; ScalePermstruct = LUfactors->ScalePermstruct; LUstruct = LUfactors->LUstruct; PStatInit(&stat); /* Reset SuperMatrix pointers. */ dCreate_CompCol_Matrix_dist(&A, *n, *n, *nnz, values, rowind, colptr, SLU_NC, SLU_D, SLU_GE); /* Set options. */ set_default_options(&options); options.Fact = SamePattern_SameRowPerm; /* Call the routine with nrhs=0 to perform the factorization. */ pdgssvx_ABglobal(&options, &A, ScalePermstruct, NULL, *ldb, 0, grid, LUstruct, berr, &stat, info); if ( *info == 0 ) { if ( report == 1 ) PStatPrint(&options, &stat, grid); } else { printf("pdgssvx_ABglobal() error returns INFO= %d\n", *info); } /* Free un-wanted storage */ Destroy_SuperMatrix_Store_dist(&A); PStatFree(&stat); } else if ( *iopt == 3 ) { /* Triangular solve */ /* Extract the LU factors in the factors handle */ LUfactors = (factors_dist_t*) factors[0]; ScalePermstruct = LUfactors->ScalePermstruct; LUstruct = LUfactors->LUstruct; PStatInit(&stat); /* Reset SuperMatrix pointers. */ dCreate_CompCol_Matrix_dist(&A, *n, *n, *nnz, values, rowind, colptr, SLU_NC, SLU_D, SLU_GE); /* Set options. */ set_default_options(&options); options.Fact = FACTORED; /* Solve the system A*X=B, overwriting B with X. */ pdgssvx_ABglobal(&options, &A, ScalePermstruct, b, *ldb, *nrhs, grid, LUstruct, berr, &stat, info); /* Free un-wanted storage */ Destroy_SuperMatrix_Store_dist(&A); PStatFree(&stat); } else if ( *iopt == 4 ) { /* Free storage */ /* Free the LU factors in the factors handle */ LUfactors = (factors_dist_t*) factors[0]; Destroy_LU(*n, grid, LUfactors->LUstruct); LUstructFree(LUfactors->LUstruct); ScalePermstructFree(LUfactors->ScalePermstruct); SUPERLU_FREE(LUfactors->ScalePermstruct); SUPERLU_FREE(LUfactors->LUstruct); SUPERLU_FREE(LUfactors); } else { fprintf(stderr, "Invalid iopt=%d passed to c_fortran_pdgssvx_ABglobal()\n", *iopt); exit(-1); } }
int main(int argc, char *argv[]) { superlu_dist_options_t options; SuperLUStat_t stat; SuperMatrix A; ScalePermstruct_t ScalePermstruct; LUstruct_t LUstruct; gridinfo_t grid; double *berr; doublecomplex *a, *b, *xtrue; int_t *asub, *xa; int_t m, n, nnz; int_t nprow, npcol; int iam, info, ldb, ldx, nrhs; char trans[1]; char **cpp, c; FILE *fp, *fopen(); extern int cpp_defs(); /* prototypes */ extern void LUstructInit(const int_t, LUstruct_t *); extern void LUstructFree(LUstruct_t *); extern void Destroy_LU(int_t, gridinfo_t *, LUstruct_t *); nprow = 1; /* Default process rows. */ npcol = 1; /* Default process columns. */ nrhs = 1; /* Number of right-hand side. */ /* ------------------------------------------------------------ INITIALIZE MPI ENVIRONMENT. ------------------------------------------------------------*/ MPI_Init( &argc, &argv ); /* Parse command line argv[]. */ for (cpp = argv+1; *cpp; ++cpp) { if ( **cpp == '-' ) { c = *(*cpp+1); ++cpp; switch (c) { case 'h': printf("Options:\n"); printf("\t-r <int>: process rows (default " IFMT ")\n", nprow); printf("\t-c <int>: process columns (default " IFMT ")\n", npcol); exit(0); break; case 'r': nprow = atoi(*cpp); break; case 'c': npcol = atoi(*cpp); break; } } else { /* Last arg is considered a filename */ if ( !(fp = fopen(*cpp, "r")) ) { ABORT("File does not exist"); } break; } } /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ superlu_gridinit(MPI_COMM_WORLD, nprow, npcol, &grid); /* Bail out if I do not belong in the grid. */ iam = grid.iam; if ( iam >= nprow * npcol ) goto out; #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Enter main()"); #endif /* ------------------------------------------------------------ PROCESS 0 READS THE MATRIX A, AND THEN BROADCASTS IT TO ALL THE OTHER PROCESSES. ------------------------------------------------------------*/ if ( !iam ) { /* Print the CPP definitions. */ cpp_defs(); /* Read the matrix stored on disk in Harwell-Boeing format. */ zreadhb_dist(iam, fp, &m, &n, &nnz, &a, &asub, &xa); printf("Input matrix file: %s\n", *cpp); printf("\tDimension\t" IFMT "x" IFMT "\t # nonzeros " IFMT "\n", m, n, nnz); printf("\tProcess grid\t%d X %d\n", (int) grid.nprow, (int) grid.npcol); /* Broadcast matrix A to the other PEs. */ MPI_Bcast( &m, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( &n, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( &nnz, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( a, nnz, SuperLU_MPI_DOUBLE_COMPLEX, 0, grid.comm ); MPI_Bcast( asub, nnz, mpi_int_t, 0, grid.comm ); MPI_Bcast( xa, n+1, mpi_int_t, 0, grid.comm ); } else { /* Receive matrix A from PE 0. */ MPI_Bcast( &m, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( &n, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( &nnz, 1, mpi_int_t, 0, grid.comm ); /* Allocate storage for compressed column representation. */ zallocateA_dist(n, nnz, &a, &asub, &xa); MPI_Bcast( a, nnz, SuperLU_MPI_DOUBLE_COMPLEX, 0, grid.comm ); MPI_Bcast( asub, nnz, mpi_int_t, 0, grid.comm ); MPI_Bcast( xa, n+1, mpi_int_t, 0, grid.comm ); } /* Create compressed column matrix for A. */ zCreate_CompCol_Matrix_dist(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_Z, SLU_GE); /* Generate the exact solution and compute the right-hand side. */ if (!(b=doublecomplexMalloc_dist(m*nrhs))) ABORT("Malloc fails for b[]"); if (!(xtrue=doublecomplexMalloc_dist(n*nrhs))) ABORT("Malloc fails for xtrue[]"); *trans = 'N'; ldx = n; ldb = m; zGenXtrue_dist(n, nrhs, xtrue, ldx); zFillRHS_dist(trans, nrhs, xtrue, ldx, &A, b, ldb); if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); /* ------------------------------------------------------------ NOW WE SOLVE THE LINEAR SYSTEM. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = METIS_AT_PLUS_A; options.RowPerm = LargeDiag_MC64; options.ReplaceTinyPivot = YES; options.Trans = NOTRANS; options.IterRefine = DOUBLE; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); if (!iam) { print_sp_ienv_dist(&options); print_options_dist(&options); } /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver. */ pzgssvx_ABglobal(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid, &LUstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ if ( !iam ) { zinf_norm_error_dist(n, nrhs, b, ldb, xtrue, ldx, &grid); } PStatPrint(&options, &stat, &grid); /* Print the statistics. */ /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompCol_Matrix_dist(&A); Destroy_LU(n, &grid, &LUstruct); ScalePermstructFree(&ScalePermstruct); LUstructFree(&LUstruct); SUPERLU_FREE(b); SUPERLU_FREE(xtrue); SUPERLU_FREE(berr); /* ------------------------------------------------------------ RELEASE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ out: superlu_gridexit(&grid); /* ------------------------------------------------------------ TERMINATES THE MPI EXECUTION ENVIRONMENT. ------------------------------------------------------------*/ MPI_Finalize(); #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Exit main()"); #endif }
int main(int argc, char *argv[]) { superlu_dist_options_t options; SuperLUStat_t stat; SuperMatrix A; ScalePermstruct_t ScalePermstruct; LUstruct_t LUstruct; gridinfo_t grid; double *berr; double *a, *a1, *b, *b1, *xtrue; int_t *asub, *asub1, *xa, *xa1; int_t i, j, m, n, nnz; int_t nprow, npcol; int iam, info, ldb, ldx, nrhs; char trans[1]; char **cpp, c; FILE *fp, *fopen(); extern int cpp_defs(); /* prototypes */ extern void LUstructInit(const int_t, LUstruct_t *); extern void LUstructFree(LUstruct_t *); extern void Destroy_LU(int_t, gridinfo_t *, LUstruct_t *); nprow = 1; /* Default process rows. */ npcol = 1; /* Default process columns. */ nrhs = 1; /* Number of right-hand side. */ /* ------------------------------------------------------------ INITIALIZE MPI ENVIRONMENT. ------------------------------------------------------------*/ MPI_Init( &argc, &argv ); /* Parse command line argv[]. */ for (cpp = argv+1; *cpp; ++cpp) { if ( **cpp == '-' ) { c = *(*cpp+1); ++cpp; switch (c) { case 'h': printf("Options:\n"); printf("\t-r <int>: process rows (default %d)\n", nprow); printf("\t-c <int>: process columns (default %d)\n", npcol); exit(0); break; case 'r': nprow = atoi(*cpp); break; case 'c': npcol = atoi(*cpp); break; } } else { /* Last arg is considered a filename */ if ( !(fp = fopen(*cpp, "r")) ) { ABORT("File does not exist"); } break; } } /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ superlu_gridinit(MPI_COMM_WORLD, nprow, npcol, &grid); /* Bail out if I do not belong in the grid. */ iam = grid.iam; if ( iam >= nprow * npcol ) goto out; #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Enter main()"); #endif /* ------------------------------------------------------------ Process 0 reads the matrix A, and then broadcasts it to all the other processes. ------------------------------------------------------------*/ if ( !iam ) { /* Print the CPP definitions. */ cpp_defs(); /* Read the matrix stored on disk in Harwell-Boeing format. */ dreadhb_dist(iam, fp, &m, &n, &nnz, &a, &asub, &xa); printf("Input matrix file: %s\n", *cpp); printf("\tDimension\t%dx%d\t # nonzeros %d\n", m, n, nnz); printf("\tProcess grid\t%d X %d\n", (int) grid.nprow, (int) grid.npcol); /* Broadcast matrix A to the other PEs. */ MPI_Bcast( &m, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( &n, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( &nnz, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( a, nnz, MPI_DOUBLE, 0, grid.comm ); MPI_Bcast( asub, nnz, mpi_int_t, 0, grid.comm ); MPI_Bcast( xa, n+1, mpi_int_t, 0, grid.comm ); } else { /* Receive matrix A from PE 0. */ MPI_Bcast( &m, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( &n, 1, mpi_int_t, 0, grid.comm ); MPI_Bcast( &nnz, 1, mpi_int_t, 0, grid.comm ); /* Allocate storage for compressed column representation. */ dallocateA_dist(n, nnz, &a, &asub, &xa); MPI_Bcast( a, nnz, MPI_DOUBLE, 0, grid.comm ); MPI_Bcast( asub, nnz, mpi_int_t, 0, grid.comm ); MPI_Bcast( xa, n+1, mpi_int_t, 0, grid.comm ); } /* Create compressed column matrix for A. */ dCreate_CompCol_Matrix_dist(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE); /* Generate the exact solution and compute the right-hand side. */ if (!(b=doubleMalloc_dist(m * nrhs))) ABORT("Malloc fails for b[]"); if (!(xtrue=doubleMalloc_dist(n*nrhs))) ABORT("Malloc fails for xtrue[]"); *trans = 'N'; ldx = n; ldb = m; dGenXtrue_dist(n, nrhs, xtrue, ldx); dFillRHS_dist(trans, nrhs, xtrue, ldx, &A, b, ldb); /* Save a copy of the right-hand side. */ if ( !(b1 = doubleMalloc_dist(m * nrhs)) ) ABORT("Malloc fails for b1[]"); for (j = 0; j < nrhs; ++j) for (i = 0; i < m; ++i) b1[i+j*ldb] = b[i+j*ldb]; if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); /* Save a copy of the matrix A. */ dallocateA_dist(n, nnz, &a1, &asub1, &xa1); for (i = 0; i < nnz; ++i) { a1[i] = a[i]; asub1[i] = asub[i]; } for (i = 0; i < n+1; ++i) xa1[i] = xa[i]; /* ------------------------------------------------------------ WE SOLVE THE LINEAR SYSTEM FOR THE FIRST TIME. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = METIS_AT_PLUS_A; options.RowPerm = LargeDiag; options.ReplaceTinyPivot = YES; options.Trans = NOTRANS; options.IterRefine = DOUBLE; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); if (!iam) { print_sp_ienv_dist(&options); print_options_dist(&options); } /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver: factorize and solve. */ pdgssvx_ABglobal(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid, &LUstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ if ( !iam ) { dinf_norm_error_dist(n, nrhs, b, ldb, xtrue, ldx, &grid); } PStatPrint(&options, &stat, &grid); /* Print the statistics. */ PStatFree(&stat); Destroy_CompCol_Matrix_dist(&A); /* Deallocate storage of matrix A. */ Destroy_LU(n, &grid, &LUstruct); /* Deallocate storage associated with the L and U matrices. */ SUPERLU_FREE(b); /* Free storage of right-hand side. */ /* ------------------------------------------------------------ NOW WE SOLVE ANOTHER LINEAR SYSTEM. ONLY THE SPARSITY PATTERN OF MATRIX A IS THE SAME. ------------------------------------------------------------*/ options.Fact = SamePattern; PStatInit(&stat); /* Initialize the statistics variables. */ /* Create compressed column matrix for A. */ dCreate_CompCol_Matrix_dist(&A, m, n, nnz, a1, asub1, xa1, SLU_NC, SLU_D, SLU_GE); /* Solve the linear system. */ pdgssvx_ABglobal(&options, &A, &ScalePermstruct, b1, ldb, nrhs, &grid, &LUstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ if ( !iam ) { printf("Solve the system with the same sparsity pattern.\n"); dinf_norm_error_dist(n, nrhs, b1, ldb, xtrue, ldx, &grid); } /* Print the statistics. */ PStatPrint(&options, &stat, &grid); /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompCol_Matrix_dist(&A); /* Deallocate storage of matrix A. */ Destroy_LU(n, &grid, &LUstruct); /* Deallocate storage associated with the L and U matrices. */ ScalePermstructFree(&ScalePermstruct); LUstructFree(&LUstruct); /* Deallocate the structure of L and U.*/ SUPERLU_FREE(b1); /* Free storage of right-hand side. */ SUPERLU_FREE(xtrue); /* Free storage of the exact solution. */ SUPERLU_FREE(berr); /* ------------------------------------------------------------ RELEASE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ out: superlu_gridexit(&grid); /* ------------------------------------------------------------ TERMINATES THE MPI EXECUTION ENVIRONMENT. ------------------------------------------------------------*/ MPI_Finalize(); #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Exit main()"); #endif }
int main(int argc, char *argv[]) { superlu_dist_options_t options; SuperLUStat_t stat; SuperMatrix A; ScalePermstruct_t ScalePermstruct; LUstruct_t LUstruct; SOLVEstruct_t SOLVEstruct; gridinfo_t grid1, grid2; double *berr; double *a, *b, *xtrue; int_t *asub, *xa; int_t i, j, m, n; int nprow, npcol, ldumap, p; int_t usermap[6]; int iam, info, ldb, ldx, nprocs; int nrhs = 1; /* Number of right-hand side. */ char **cpp, c; FILE *fp, *fopen(); int cpp_defs(); /* ------------------------------------------------------------ INITIALIZE MPI ENVIRONMENT. ------------------------------------------------------------*/ MPI_Init( &argc, &argv ); MPI_Comm_size( MPI_COMM_WORLD, &nprocs ); if ( nprocs < 10 ) { fprintf(stderr, "Requires at least 10 processes\n"); exit(-1); } /* Parse command line argv[]. */ for (cpp = argv+1; *cpp; ++cpp) { if ( **cpp == '-' ) { c = *(*cpp+1); ++cpp; switch (c) { case 'h': printf("Options:\n"); printf("\t-r <int>: process rows (default %d)\n", nprow); printf("\t-c <int>: process columns (default %d)\n", npcol); exit(0); break; case 'r': nprow = atoi(*cpp); break; case 'c': npcol = atoi(*cpp); break; } } else { /* Last arg is considered a filename */ if ( !(fp = fopen(*cpp, "r")) ) { ABORT("File does not exist"); } break; } } /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID 1. ------------------------------------------------------------*/ nprow = 2; npcol = 3; ldumap = 2; p = 0; /* Grid 1 starts from process 0. */ for (i = 0; i < nprow; ++i) for (j = 0; j < npcol; ++j) usermap[i+j*ldumap] = p++; superlu_gridmap(MPI_COMM_WORLD, nprow, npcol, usermap, ldumap, &grid1); /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID 2. ------------------------------------------------------------*/ nprow = 2; npcol = 2; ldumap = 2; p = 6; /* Grid 2 starts from process 6. */ for (i = 0; i < nprow; ++i) for (j = 0; j < npcol; ++j) usermap[i+j*ldumap] = p++; superlu_gridmap(MPI_COMM_WORLD, nprow, npcol, usermap, ldumap, &grid2); /* Bail out if I do not belong in any of the 2 grids. */ MPI_Comm_rank( MPI_COMM_WORLD, &iam ); if ( iam >= 10 ) goto out; #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Enter main()"); #endif if ( iam >= 0 && iam < 6 ) { /* I am in grid 1. */ iam = grid1.iam; /* Get the logical number in the new grid. */ /* ------------------------------------------------------------ GET THE MATRIX FROM FILE AND SETUP THE RIGHT HAND SIDE. ------------------------------------------------------------*/ dcreate_matrix(&A, nrhs, &b, &ldb, &xtrue, &ldx, fp, &grid1); if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); /* ------------------------------------------------------------ NOW WE SOLVE THE LINEAR SYSTEM. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = METIS_AT_PLUS_A; options.RowPerm = LargeDiag; options.ReplaceTinyPivot = NO; options.Trans = NOTRANS; options.IterRefine = DOUBLE; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); if (!iam) { print_sp_ienv_dist(&options); print_options_dist(&options); } m = A.nrow; n = A.ncol; /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver. */ pdgssvx(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid1, &LUstruct, &SOLVEstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ pdinf_norm_error(iam, ((NRformat_loc *)A.Store)->m_loc, nrhs, b, ldb, xtrue, ldx, &grid1); /* Print the statistics. */ PStatPrint(&options, &stat, &grid1); /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompRowLoc_Matrix_dist(&A); ScalePermstructFree(&ScalePermstruct); Destroy_LU(n, &grid1, &LUstruct); LUstructFree(&LUstruct); if ( options.SolveInitialized ) { dSolveFinalize(&options, &SOLVEstruct); } SUPERLU_FREE(b); SUPERLU_FREE(xtrue); SUPERLU_FREE(berr); } else { /* I am in grid 2. */ iam = grid2.iam; /* Get the logical number in the new grid. */ /* ------------------------------------------------------------ GET THE MATRIX FROM FILE AND SETUP THE RIGHT HAND SIDE. ------------------------------------------------------------*/ dcreate_matrix(&A, nrhs, &b, &ldb, &xtrue, &ldx, fp, &grid2); if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); /* ------------------------------------------------------------ NOW WE SOLVE THE LINEAR SYSTEM. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = MMD_AT_PLUS_A; options.RowPerm = LargeDiag; options.ReplaceTinyPivot = YES; options.Trans = NOTRANS; options.IterRefine = DOUBLE; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); m = A.nrow; n = A.ncol; /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver. */ pdgssvx(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid2, &LUstruct, &SOLVEstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ pdinf_norm_error(iam, ((NRformat_loc *)A.Store)->m_loc, nrhs, b, ldb, xtrue, ldx, &grid2); /* Print the statistics. */ PStatPrint(&options, &stat, &grid2); /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompRowLoc_Matrix_dist(&A); ScalePermstructFree(&ScalePermstruct); Destroy_LU(n, &grid2, &LUstruct); LUstructFree(&LUstruct); if ( options.SolveInitialized ) { dSolveFinalize(&options, &SOLVEstruct); } SUPERLU_FREE(b); SUPERLU_FREE(xtrue); SUPERLU_FREE(berr); } /* ------------------------------------------------------------ RELEASE THE SUPERLU PROCESS GRIDS. ------------------------------------------------------------*/ superlu_gridexit(&grid1); superlu_gridexit(&grid2); out: /* ------------------------------------------------------------ TERMINATES THE MPI EXECUTION ENVIRONMENT. ------------------------------------------------------------*/ MPI_Finalize(); #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Exit main()"); #endif }
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); }
/*! \brief * * <pre> * Purpose * ======= * * The driver program PDDRIVE1. * * This example illustrates how to use PDGSSVX to * solve systems with the same A but different right-hand side. * In this case, we factorize A only once in the first call to * PDGSSVX, and reuse the following data structures * in the subsequent call to PDGSSVX: * ScalePermstruct : DiagScale, R, C, perm_r, perm_c * LUstruct : Glu_persist, Llu * * With MPICH, program may be run by typing: * mpiexec -n <np> pddrive1 -r <proc rows> -c <proc columns> big.rua * </pre> */ int main(int argc, char *argv[]) { superlu_dist_options_t options; SuperLUStat_t stat; SuperMatrix A; ScalePermstruct_t ScalePermstruct; LUstruct_t LUstruct; SOLVEstruct_t SOLVEstruct; gridinfo_t grid; double *berr; double *b, *xtrue, *b1; int i, j, m, n; int nprow, npcol; int iam, info, ldb, ldx, nrhs; char **cpp, c, *postfix; int ii, omp_mpi_level; FILE *fp, *fopen(); int cpp_defs(); nprow = 1; /* Default process rows. */ npcol = 1; /* Default process columns. */ nrhs = 1; /* Number of right-hand side. */ /* ------------------------------------------------------------ INITIALIZE MPI ENVIRONMENT. ------------------------------------------------------------*/ MPI_Init_thread( &argc, &argv, MPI_THREAD_MULTIPLE, &omp_mpi_level); /* Parse command line argv[]. */ for (cpp = argv+1; *cpp; ++cpp) { if ( **cpp == '-' ) { c = *(*cpp+1); ++cpp; switch (c) { case 'h': printf("Options:\n"); printf("\t-r <int>: process rows (default %d)\n", nprow); printf("\t-c <int>: process columns (default %d)\n", npcol); exit(0); break; case 'r': nprow = atoi(*cpp); break; case 'c': npcol = atoi(*cpp); break; } } else { /* Last arg is considered a filename */ if ( !(fp = fopen(*cpp, "r")) ) { ABORT("File does not exist"); } break; } } /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ superlu_gridinit(MPI_COMM_WORLD, nprow, npcol, &grid); /* Bail out if I do not belong in the grid. */ iam = grid.iam; if ( iam >= nprow * npcol ) goto out; if ( !iam ) { int v_major, v_minor, v_bugfix; #ifdef __INTEL_COMPILER printf("__INTEL_COMPILER is defined\n"); #endif printf("__STDC_VERSION__ %ld\n", __STDC_VERSION__); superlu_dist_GetVersionNumber(&v_major, &v_minor, &v_bugfix); printf("Library version:\t%d.%d.%d\n", v_major, v_minor, v_bugfix); printf("Input matrix file:\t%s\n", *cpp); printf("Process grid:\t\t%d X %d\n", (int)grid.nprow, (int)grid.npcol); fflush(stdout); } #if ( VAMPIR>=1 ) VT_traceoff(); #endif #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Enter main()"); #endif for(ii = 0;ii<strlen(*cpp);ii++){ if((*cpp)[ii]=='.'){ postfix = &((*cpp)[ii+1]); } } // printf("%s\n", postfix); /* ------------------------------------------------------------ GET THE MATRIX FROM FILE AND SETUP THE RIGHT HAND SIDE. ------------------------------------------------------------*/ dcreate_matrix_postfix(&A, nrhs, &b, &ldb, &xtrue, &ldx, fp, postfix, &grid); if ( !(b1 = doubleMalloc_dist(ldb * nrhs)) ) ABORT("Malloc fails for b1[]"); for (j = 0; j < nrhs; ++j) for (i = 0; i < ldb; ++i) b1[i+j*ldb] = b[i+j*ldb]; if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); /* ------------------------------------------------------------ WE SOLVE THE LINEAR SYSTEM FOR THE FIRST TIME. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ColPerm = METIS_AT_PLUS_A; options.RowPerm = LargeDiag_MC64; options.ReplaceTinyPivot = NO; options.Trans = NOTRANS; options.IterRefine = DOUBLE; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); if (!iam) { print_sp_ienv_dist(&options); print_options_dist(&options); fflush(stdout); } m = A.nrow; n = A.ncol; /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver. */ pdgssvx(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid, &LUstruct, &SOLVEstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ if ( !iam ) printf("\tSolve the first system:\n"); pdinf_norm_error(iam, ((NRformat_loc *)A.Store)->m_loc, nrhs, b, ldb, xtrue, ldx, &grid); PStatPrint(&options, &stat, &grid); /* Print the statistics. */ PStatFree(&stat); /* ------------------------------------------------------------ NOW WE SOLVE ANOTHER SYSTEM WITH THE SAME A BUT DIFFERENT RIGHT-HAND SIDE, WE WILL USE THE EXISTING L AND U FACTORS IN LUSTRUCT OBTAINED FROM A PREVIOUS FATORIZATION. ------------------------------------------------------------*/ options.Fact = FACTORED; /* Indicate the factored form of A is supplied. */ PStatInit(&stat); /* Initialize the statistics variables. */ pdgssvx(&options, &A, &ScalePermstruct, b1, ldb, nrhs, &grid, &LUstruct, &SOLVEstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ if ( !iam ) printf("\tSolve the system with a different B:\n"); pdinf_norm_error(iam, ((NRformat_loc *)A.Store)->m_loc, nrhs, b1, ldb, xtrue, ldx, &grid); PStatPrint(&options, &stat, &grid); /* Print the statistics. */ /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompRowLoc_Matrix_dist(&A); ScalePermstructFree(&ScalePermstruct); Destroy_LU(n, &grid, &LUstruct); LUstructFree(&LUstruct); if ( options.SolveInitialized ) { dSolveFinalize(&options, &SOLVEstruct); } SUPERLU_FREE(b); SUPERLU_FREE(b1); SUPERLU_FREE(xtrue); SUPERLU_FREE(berr); /* ------------------------------------------------------------ RELEASE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ out: superlu_gridexit(&grid); /* ------------------------------------------------------------ TERMINATES THE MPI EXECUTION ENVIRONMENT. ------------------------------------------------------------*/ MPI_Finalize(); #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Exit main()"); #endif }
int main(int argc, char *argv[]) { superlu_options_t options; SuperLUStat_t stat; SuperMatrix A; ScalePermstruct_t ScalePermstruct; LUstruct_t LUstruct; SOLVEstruct_t SOLVEstruct; gridinfo_t grid; double *berr; doublecomplex *b, *xtrue; int_t m, n; int_t nprow, npcol; int iam, info, ldb, ldx, nrhs; char **cpp, c; FILE *fp, *fopen(); extern int cpp_defs(); nprow = 1; /* Default process rows. */ npcol = 1; /* Default process columns. */ nrhs = 1; /* Number of right-hand side. */ /* ------------------------------------------------------------ INITIALIZE MPI ENVIRONMENT. ------------------------------------------------------------*/ MPI_Init( &argc, &argv ); /* Parse command line argv[]. */ for (cpp = argv+1; *cpp; ++cpp) { if ( **cpp == '-' ) { c = *(*cpp+1); ++cpp; switch (c) { case 'h': printf("Options:\n"); printf("\t-r <int>: process rows (default %d)\n", nprow); printf("\t-c <int>: process columns (default %d)\n", npcol); exit(0); break; case 'r': nprow = atoi(*cpp); break; case 'c': npcol = atoi(*cpp); break; } } else { /* Last arg is considered a filename */ if ( !(fp = fopen(*cpp, "r")) ) { ABORT("File does not exist"); } break; } } /* ------------------------------------------------------------ INITIALIZE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ superlu_gridinit(MPI_COMM_WORLD, nprow, npcol, &grid); /* Bail out if I do not belong in the grid. */ iam = grid.iam; if ( iam >= nprow * npcol ) goto out; if ( !iam ) printf("\tProcess grid\t%d X %d\n", grid.nprow, grid.npcol); #if ( VAMPIR>=1 ) VT_traceoff(); #endif #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Enter main()"); #endif /* ------------------------------------------------------------ GET THE MATRIX FROM FILE AND SETUP THE RIGHT HAND SIDE. ------------------------------------------------------------*/ zcreate_matrix(&A, nrhs, &b, &ldb, &xtrue, &ldx, fp, &grid); if ( !(berr = doubleMalloc_dist(nrhs)) ) ABORT("Malloc fails for berr[]."); /* ------------------------------------------------------------ NOW WE SOLVE THE LINEAR SYSTEM. ------------------------------------------------------------*/ /* Set the default input options: options.Fact = DOFACT; options.Equil = YES; options.ParSymbFact = NO; options.ColPerm = MMD_AT_PLUS_A; options.RowPerm = LargeDiag; options.ReplaceTinyPivot = YES; options.IterRefine = DOUBLE; options.Trans = NOTRANS; options.SolveInitialized = NO; options.RefineInitialized = NO; options.PrintStat = YES; */ set_default_options_dist(&options); #if 0 options.RowPerm = NOROWPERM; options.IterRefine = NOREFINE; options.ColPerm = NATURAL; options.Equil = NO; options.ReplaceTinyPivot = NO; #endif m = A.nrow; n = A.ncol; /* Initialize ScalePermstruct and LUstruct. */ ScalePermstructInit(m, n, &ScalePermstruct); LUstructInit(m, n, &LUstruct); /* Initialize the statistics variables. */ PStatInit(&stat); /* Call the linear equation solver. */ pzgssvx(&options, &A, &ScalePermstruct, b, ldb, nrhs, &grid, &LUstruct, &SOLVEstruct, berr, &stat, &info); /* Check the accuracy of the solution. */ pzinf_norm_error(iam, ((NRformat_loc *)A.Store)->m_loc, nrhs, b, ldb, xtrue, ldx, &grid); PStatPrint(&options, &stat, &grid); /* Print the statistics. */ /* ------------------------------------------------------------ DEALLOCATE STORAGE. ------------------------------------------------------------*/ PStatFree(&stat); Destroy_CompRowLoc_Matrix_dist(&A); ScalePermstructFree(&ScalePermstruct); Destroy_LU(n, &grid, &LUstruct); LUstructFree(&LUstruct); if ( options.SolveInitialized ) { zSolveFinalize(&options, &SOLVEstruct); } SUPERLU_FREE(b); SUPERLU_FREE(xtrue); SUPERLU_FREE(berr); /* ------------------------------------------------------------ RELEASE THE SUPERLU PROCESS GRID. ------------------------------------------------------------*/ out: superlu_gridexit(&grid); /* ------------------------------------------------------------ TERMINATES THE MPI EXECUTION ENVIRONMENT. ------------------------------------------------------------*/ MPI_Finalize(); #if ( DEBUGlevel>=1 ) CHECK_MALLOC(iam, "Exit main()"); #endif }
int DistributedSuperLU::setSize() { int n = theSOE->size; // // init the super lu process grid // if (gridInit == false) { MPI_Comm comm_world; // MPI_Group group_world; // group_worker; comm_world = MPI_COMM_WORLD; MPI_Comm_group(comm_world, &group_world); // MPI_Group_excl(group_world, 1, 0, &group_worker); /* process 0 not member */ MPI_Comm_create(comm_world, group_world, &comm_SuperLU); superlu_gridinit(comm_SuperLU, npRow, npCol, &grid); // free old structures if resize already called } else { Destroy_LU(theSOE->size, &grid, &LUstruct); ScalePermstructFree(&ScalePermstruct); LUstructFree(&LUstruct); } // // Initialize the statistics variables. // PStatInit(&stat); // // Create compressed column matrix for A. // if (n > 0) { // create the SuperMatrix A int nnz = theSOE->nnz; rowA = new int[nnz]; for (int i=0; i<nnz; i++) rowA[i] = theSOE->rowA[i]; dCreate_CompCol_Matrix_dist(&A, n, n, nnz, theSOE->A, rowA, theSOE->colStartA, SLU_NC, SLU_D, SLU_GE); // // Initialize ScalePermstruct and LUstruct. // ScalePermstructInit(n, n, &ScalePermstruct); LUstructInit(n, n, &LUstruct); } // // set default options // set_default_options_dist(&options); options.PrintStat=NO; // // Initialize the statistics variables. // PStatInit(&stat); return 0; }