Actual source code: petscscalapack.h
1: #pragma once
3: #include <petsc/private/matimpl.h>
4: #include <petscblaslapack.h>
6: typedef struct {
7: PetscBLASInt ictxt; /* process grid context */
8: PetscBLASInt nprow, npcol; /* number of process rows and columns */
9: PetscBLASInt myrow, mycol; /* coordinates of local process on the grid */
10: PetscInt grid_refct; /* reference count */
11: PetscBLASInt ictxrow, ictxcol; /* auxiliary 1d process grid contexts */
12: } Mat_ScaLAPACK_Grid;
14: typedef struct {
15: Mat_ScaLAPACK_Grid *grid; /* process grid */
16: PetscBLASInt desc[9]; /* ScaLAPACK descriptor */
17: PetscBLASInt M, N; /* global dimensions, for rows and columns */
18: PetscBLASInt locr, locc; /* dimensions of local array */
19: PetscBLASInt mb, nb; /* block size, for rows and columns */
20: PetscBLASInt rsrc, csrc; /* coordinates of process owning first row and column */
21: PetscScalar *loc; /* pointer to local array */
22: PetscBLASInt lld; /* local leading dimension */
23: PetscBLASInt *pivots; /* pivots in LU factorization */
24: PetscBool roworiented; /* if true, row-oriented input (default) */
25: } Mat_ScaLAPACK;
27: PETSC_INTERN PetscErrorCode MatMatMultSymbolic_ScaLAPACK(Mat, Mat, PetscReal, Mat);
28: PETSC_INTERN PetscErrorCode MatMatMultNumeric_ScaLAPACK(Mat, Mat, Mat);
30: /*MC
31: PetscCallScaLAPACKInfo - Calls a ScaLAPACK routine that has an `info` return flag so that the stack trace returned from any signal received
32: inside the function call includes the name of the ScaLAPACK routine. Also checks the `info` flag.
34: Synopsis:
35: #include <petscscalapack.h>
36: void PetscCallScaLAPACKInfo(char *name, routine)
38: Not Collective
40: Input Parameters:
41: + name - string that gives the name of the function being called
42: - routine - actual call to the routine including its arguments
44: Level: developer
46: Notes:
47: The calling routine should not declare the argument `info` but must call it `info` in the calling sequence.
49: In a small number of cases, calls to ScaLAPACK routines that return a positive `info` code are allowed without ending the PETSc program.
50: In these situations the macro `PetscCallBLAS()` should be used, not `PetscCallScaLAPACKInfo()`.
52: .seealso: `PetscCall()`, `PetscCallBLAS()`, `PetscCallLAPACKInfo()`
53: M*/
54: #define PetscCallScaLAPACKInfo(name, routine) \
55: do { \
56: PetscBLASInt info = -1000; \
57: PetscCallBLAS(name, routine); \
58: PetscCheck(info >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "ScaLAPACK routine %s %" PetscBLASInt_FMT "-th argument had an illegal value", name, -info); \
59: PetscCheck(info <= 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "ScaLAPACK routine %s failed with INFO = %" PetscBLASInt_FMT ". Search at https://www.netlib.org/scalapack/explore-html/index.html to decode the error code.", name, info); \
60: } while (0)
62: #define PETSC_PASTE4_(a, b, c, d) a##b##c##d
63: #define PETSC_PASTE4(a, b, c, d) PETSC_PASTE4_(a, b, c, d)
65: #if defined(PETSC_BLASLAPACK_CAPS)
66: #define PETSC_SCALAPACK_PREFIX_ P
67: #define PETSCBLASNOTYPE(x, X) PETSC_PASTE2(X, PETSC_BLASLAPACK_SUFFIX_)
68: #define PETSCSCALAPACK(x, X) PETSC_PASTE4(PETSC_SCALAPACK_PREFIX_, PETSC_BLASLAPACK_PREFIX_, X, PETSC_BLASLAPACK_SUFFIX_)
69: #else
70: #define PETSC_SCALAPACK_PREFIX_ p
71: #define PETSCBLASNOTYPE(x, X) PETSC_PASTE2(x, PETSC_BLASLAPACK_SUFFIX_)
72: #define PETSCSCALAPACK(x, X) PETSC_PASTE4(PETSC_SCALAPACK_PREFIX_, PETSC_BLASLAPACK_PREFIX_, x, PETSC_BLASLAPACK_SUFFIX_)
73: #endif
75: /* BLACS routines (C interface) */
76: BLAS_EXTERN PetscBLASInt Csys2blacs_handle(MPI_Comm syscontext);
77: BLAS_EXTERN void Cblacs_pinfo(PetscBLASInt *mypnum, PetscBLASInt *nprocs);
78: BLAS_EXTERN void Cblacs_get(PetscBLASInt context, PetscBLASInt request, PetscBLASInt *value);
79: BLAS_EXTERN PetscBLASInt Cblacs_pnum(PetscBLASInt context, PetscBLASInt prow, PetscBLASInt pcol);
80: BLAS_EXTERN PetscBLASInt Cblacs_gridinit(PetscBLASInt *context, const char *order, PetscBLASInt np_row, PetscBLASInt np_col);
81: BLAS_EXTERN void Cblacs_gridinfo(PetscBLASInt context, PetscBLASInt *np_row, PetscBLASInt *np_col, PetscBLASInt *my_row, PetscBLASInt *my_col);
82: BLAS_EXTERN void Cblacs_gridexit(PetscBLASInt context);
83: BLAS_EXTERN void Cblacs_exit(PetscBLASInt error_code);
84: BLAS_EXTERN void Cdgebs2d(PetscBLASInt ctxt, const char *scope, const char *top, PetscBLASInt m, PetscBLASInt n, PetscScalar *A, PetscBLASInt lda);
85: BLAS_EXTERN void Cdgebr2d(PetscBLASInt ctxt, const char *scope, const char *top, PetscBLASInt m, PetscBLASInt n, PetscScalar *A, PetscBLASInt lda, PetscBLASInt rsrc, PetscBLASInt csrc);
86: BLAS_EXTERN void Cdgsum2d(PetscBLASInt ctxt, const char *scope, const char *top, PetscBLASInt m, PetscBLASInt n, PetscScalar *A, PetscBLASInt lda, PetscBLASInt rsrc, PetscBLASInt csrc);
88: /* PBLAS */
89: #define PBLASgemv_ PETSCSCALAPACK(gemv, GEMV)
90: #define PBLASgemm_ PETSCSCALAPACK(gemm, GEMM)
91: #if defined(PETSC_USE_COMPLEX)
92: #define PBLAStran_ PETSCSCALAPACK(tranc, TRANC)
93: #else
94: #define PBLAStran_ PETSCSCALAPACK(tran, TRAN)
95: #endif
97: BLAS_EXTERN void PBLASgemv_(const char *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
98: BLAS_EXTERN void PBLASgemm_(const char *, const char *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
99: BLAS_EXTERN void PBLAStran_(PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
101: /* ScaLAPACK */
102: #define SCALAPACKlange_ PETSCSCALAPACK(lange, LANGE)
103: #define SCALAPACKpotrf_ PETSCSCALAPACK(potrf, POTRF)
104: #define SCALAPACKpotrs_ PETSCSCALAPACK(potrs, POTRS)
105: #define SCALAPACKgetrf_ PETSCSCALAPACK(getrf, GETRF)
106: #define SCALAPACKgetrs_ PETSCSCALAPACK(getrs, GETRS)
108: BLAS_EXTERN PetscReal SCALAPACKlange_(const char *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *);
109: BLAS_EXTERN void SCALAPACKpotrf_(const char *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
110: BLAS_EXTERN void SCALAPACKpotrs_(const char *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
111: BLAS_EXTERN void SCALAPACKgetrf_(PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
112: BLAS_EXTERN void SCALAPACKgetrs_(const char *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
114: /* auxiliary routines */
115: #define SCALAPACKnumroc_ PETSCBLASNOTYPE(numroc, NUMROC)
116: #define SCALAPACKdescinit_ PETSCBLASNOTYPE(descinit, DESCINIT)
117: #define SCALAPACKinfog2l_ PETSCBLASNOTYPE(infog2l, INFOG2L)
118: #define SCALAPACKgemr2d_ PETSCSCALAPACK(gemr2d, GEMR2D)
119: #define SCALAPACKmatadd_ PETSCSCALAPACK(matadd, MATADD)
120: #define SCALAPACKelset_ PETSCSCALAPACK(elset, ELSET)
121: #define SCALAPACKelget_ PETSCSCALAPACK(elget, ELGET)
123: BLAS_EXTERN PetscBLASInt SCALAPACKnumroc_(PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
124: BLAS_EXTERN void SCALAPACKdescinit_(PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
125: BLAS_EXTERN void SCALAPACKinfog2l_(PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
126: BLAS_EXTERN void SCALAPACKgemr2d_(PetscBLASInt *, PetscBLASInt *, const PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
127: BLAS_EXTERN void SCALAPACKmatadd_(PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
128: BLAS_EXTERN void SCALAPACKelset_(PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *, PetscScalar *);
129: BLAS_EXTERN void SCALAPACKelget_(const char *, const char *, PetscScalar *, PetscScalar *, PetscBLASInt *, PetscBLASInt *, PetscBLASInt *);
131: /*
132: Macros to test valid arguments
133: */
134: #if !defined(PETSC_USE_DEBUG)
136: #define MatScaLAPACKCheckDistribution(a, arga, b, argb) \
137: do { \
138: (void)(a); \
139: (void)(b); \
140: } while (0)
142: #else
144: #define MatScaLAPACKCheckDistribution(a, arga, b, argb) \
145: do { \
146: Mat_ScaLAPACK *_aa = (Mat_ScaLAPACK *)(a)->data, *_bb = (Mat_ScaLAPACK *)(b)->data; \
147: PetscCheck(_aa->mb == _bb->mb && _aa->nb == _bb->nb && _aa->rsrc == _bb->rsrc && _aa->csrc == _bb->csrc && _aa->grid->nprow == _bb->grid->nprow && _aa->grid->npcol == _bb->grid->npcol && _aa->grid->myrow == _bb->grid->myrow && \
148: _aa->grid->mycol == _bb->grid->mycol, \
149: PetscObjectComm((PetscObject)(a)), PETSC_ERR_ARG_INCOMP, "Arguments #%d and #%d have different ScaLAPACK distribution", arga, argb); \
150: } while (0)
152: #endif