Date: 2025-03-28T21:11:02+00:00

Actual source code: zmatrixf90.c

      1: #include <petscmat.h>
      2: #include <petsc/private/f90impl.h>

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define matmpiaijgetseqaijf90_        MATMPIAIJGETSEQAIJF90
      6:   #define matmpiaijrestoreseqaijf90_    MATMPIAIJRESTORESEQAIJF90
      7:   #define matdensegetarrayf90_          MATDENSEGETARRAYF90
      8:   #define matdenserestorearrayf90_      MATDENSERESTOREARRAYF90
      9:   #define matdensegetarrayreadf90_      MATDENSEGETARRAYREADF90
     10:   #define matdenserestorearrayreadf90_  MATDENSERESTOREARRAYREADF90
     11:   #define matdensegetarraywritef90_     MATDENSEGETARRAYWRITEF90
     12:   #define matdenserestorearraywritef90_ MATDENSERESTOREARRAYWRITEF90
     13:   #define matdensegetcolumnf90_         MATDENSEGETCOLUMNF90
     14:   #define matdenserestorecolumnf90_     MATDENSERESTORECOLUMNF90
     15:   #define matseqaijgetarrayf90_         MATSEQAIJGETARRAYF90
     16:   #define matseqaijrestorearrayf90_     MATSEQAIJRESTOREARRAYF90
     17:   #define matgetghostsf90_              MATGETGHOSTSF90
     18:   #define matgetrowijf90_               MATGETROWIJF90
     19:   #define matrestorerowijf90_           MATRESTOREROWIJF90
     20: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     21:   #define matmpiaijgetseqaijf90_        matmpiaijgetseqaijf90
     22:   #define matmpiaijrestoreseqaijf90_    matmpiaijrestoreseqaijf90
     23:   #define matdensegetarrayf90_          matdensegetarrayf90
     24:   #define matdenserestorearrayf90_      matdenserestorearrayf90
     25:   #define matdensegetarrayreadf90_      matdensegetarrayreadf90
     26:   #define matdenserestorearrayreadf90_  matdenserestorearrayreadf90
     27:   #define matdensegetarraywritef90_     matdensegetarraywritef90
     28:   #define matdenserestorearraywritef90_ matdenserestorearraywritef90
     29:   #define matdensegetcolumnf90_         matdensegetcolumnf90
     30:   #define matdenserestorecolumnf90_     matdenserestorecolumnf90
     31:   #define matseqaijgetarrayf90_         matseqaijgetarrayf90
     32:   #define matseqaijrestorearrayf90_     matseqaijrestorearrayf90
     33:   #define matgetghostsf90_              matgetghostsf90
     34:   #define matgetrowijf90_               matgetrowijf90
     35:   #define matrestorerowijf90_           matrestorerowijf90
     36: #endif

     38: PETSC_EXTERN void matgetghostsf90_(Mat *mat, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     39: {
     40:   const PetscInt *ghosts;
     41:   PetscInt        N;

     43:   *ierr = MatGetGhosts(*mat, &N, &ghosts);
     44:   if (*ierr) return;
     45:   *ierr = F90Array1dCreate((PetscInt *)ghosts, MPIU_INT, 1, N, ptr PETSC_F90_2PTR_PARAM(ptrd));
     46: }
     47: PETSC_EXTERN void matdensegetarrayf90_(Mat *mat, F90Array2d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     48: {
     49:   PetscScalar *fa;
     50:   PetscInt     m, N, lda;
     51:   *ierr = MatDenseGetArray(*mat, &fa);
     52:   if (*ierr) return;
     53:   *ierr = MatGetLocalSize(*mat, &m, NULL);
     54:   if (*ierr) return;
     55:   *ierr = MatGetSize(*mat, NULL, &N);
     56:   if (*ierr) return;
     57:   *ierr = MatDenseGetLDA(*mat, &lda);
     58:   if (*ierr) return;
     59:   if (m != lda) { // TODO: add F90Array2dLDACreate()
     60:     *ierr = PetscError(((PetscObject)*mat)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "Array lda %" PetscInt_FMT " must match number of local rows %" PetscInt_FMT, lda, m);
     61:     return;
     62:   }
     63:   *ierr = F90Array2dCreate(fa, MPIU_SCALAR, 1, m, 1, N, ptr PETSC_F90_2PTR_PARAM(ptrd));
     64: }
     65: PETSC_EXTERN void matdenserestorearrayf90_(Mat *mat, F90Array2d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     66: {
     67:   PetscScalar *fa;
     68:   *ierr = F90Array2dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
     69:   if (*ierr) return;
     70:   *ierr = F90Array2dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
     71:   if (*ierr) return;
     72:   *ierr = MatDenseRestoreArray(*mat, &fa);
     73: }
     74: PETSC_EXTERN void matdensegetarrayreadf90_(Mat *mat, F90Array2d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     75: {
     76:   const PetscScalar *fa;
     77:   PetscInt           m, N, lda;
     78:   *ierr = MatDenseGetArrayRead(*mat, &fa);
     79:   if (*ierr) return;
     80:   *ierr = MatGetLocalSize(*mat, &m, NULL);
     81:   if (*ierr) return;
     82:   *ierr = MatGetSize(*mat, NULL, &N);
     83:   if (*ierr) return;
     84:   *ierr = MatDenseGetLDA(*mat, &lda);
     85:   if (*ierr) return;
     86:   if (m != lda) { // TODO: add F90Array2dLDACreate()
     87:     *ierr = PetscError(((PetscObject)*mat)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "Array lda %" PetscInt_FMT " must match number of local rows %" PetscInt_FMT, lda, m);
     88:     return;
     89:   }
     90:   *ierr = F90Array2dCreate((void **)fa, MPIU_SCALAR, 1, m, 1, N, ptr PETSC_F90_2PTR_PARAM(ptrd));
     91: }
     92: PETSC_EXTERN void matdenserestorearrayreadf90_(Mat *mat, F90Array2d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     93: {
     94:   const PetscScalar *fa;
     95:   *ierr = F90Array2dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
     96:   if (*ierr) return;
     97:   *ierr = F90Array2dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
     98:   if (*ierr) return;
     99:   *ierr = MatDenseRestoreArrayRead(*mat, &fa);
    100: }
    101: PETSC_EXTERN void matdensegetarraywritef90_(Mat *mat, F90Array2d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    102: {
    103:   PetscScalar *fa;
    104:   PetscInt     m, N, lda;
    105:   *ierr = MatDenseGetArrayWrite(*mat, &fa);
    106:   if (*ierr) return;
    107:   *ierr = MatGetLocalSize(*mat, &m, NULL);
    108:   if (*ierr) return;
    109:   *ierr = MatGetSize(*mat, NULL, &N);
    110:   if (*ierr) return;
    111:   *ierr = MatDenseGetLDA(*mat, &lda);
    112:   if (*ierr) return;
    113:   if (m != lda) { // TODO: add F90Array2dLDACreate()
    114:     *ierr = PetscError(((PetscObject)*mat)->comm, __LINE__, PETSC_FUNCTION_NAME, __FILE__, PETSC_ERR_ARG_BADPTR, PETSC_ERROR_INITIAL, "Array lda %" PetscInt_FMT " must match number of local rows %" PetscInt_FMT, lda, m);
    115:     return;
    116:   }
    117:   *ierr = F90Array2dCreate(fa, MPIU_SCALAR, 1, m, 1, N, ptr PETSC_F90_2PTR_PARAM(ptrd));
    118: }
    119: PETSC_EXTERN void matdenserestorearraywritef90_(Mat *mat, F90Array2d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    120: {
    121:   PetscScalar *fa;
    122:   *ierr = F90Array2dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    123:   if (*ierr) return;
    124:   *ierr = F90Array2dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    125:   if (*ierr) return;
    126:   *ierr = MatDenseRestoreArrayWrite(*mat, &fa);
    127: }
    128: PETSC_EXTERN void matdensegetcolumnf90_(Mat *mat, PetscInt *col, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    129: {
    130:   PetscScalar *fa;
    131:   PetscInt     m;
    132:   *ierr = MatDenseGetColumn(*mat, *col, &fa);
    133:   if (*ierr) return;
    134:   *ierr = MatGetLocalSize(*mat, &m, NULL);
    135:   if (*ierr) return;
    136:   *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, m, ptr PETSC_F90_2PTR_PARAM(ptrd));
    137: }
    138: PETSC_EXTERN void matdenserestorecolumnf90_(Mat *mat, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    139: {
    140:   PetscScalar *fa;
    141:   *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    142:   if (*ierr) return;
    143:   *ierr = MatDenseRestoreColumn(*mat, &fa);
    144: }
    145: PETSC_EXTERN void matseqaijgetarrayf90_(Mat *mat, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    146: {
    147:   PetscScalar *fa;
    148:   PetscInt     m, n;
    149:   *ierr = MatSeqAIJGetArray(*mat, &fa);
    150:   if (*ierr) return;
    151:   *ierr = MatGetLocalSize(*mat, &m, &n);
    152:   if (*ierr) return;
    153:   *ierr = F90Array1dCreate(fa, MPIU_SCALAR, 1, m * n, ptr PETSC_F90_2PTR_PARAM(ptrd));
    154: }
    155: PETSC_EXTERN void matseqaijrestorearrayf90_(Mat *mat, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    156: {
    157:   PetscScalar *fa;
    158:   *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&fa PETSC_F90_2PTR_PARAM(ptrd));
    159:   if (*ierr) return;
    160:   *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    161:   if (*ierr) return;
    162:   *ierr = MatSeqAIJRestoreArray(*mat, &fa);
    163: }
    164: PETSC_EXTERN void matgetrowijf90_(Mat *B, PetscInt *shift, PetscBool *sym, PetscBool *blockcompressed, PetscInt *n, F90Array1d *ia, F90Array1d *ja, PetscBool *done, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(iad) PETSC_F90_2PTR_PROTO(jad))
    165: {
    166:   const PetscInt *IA, *JA;
    167:   *ierr = MatGetRowIJ(*B, *shift, *sym, *blockcompressed, n, &IA, &JA, done);
    168:   if (*ierr) return;
    169:   if (!*done) return;
    170:   *ierr = F90Array1dCreate((PetscInt *)IA, MPIU_INT, 1, *n + 1, ia PETSC_F90_2PTR_PARAM(iad));
    171:   *ierr = F90Array1dCreate((PetscInt *)JA, MPIU_INT, 1, IA[*n], ja PETSC_F90_2PTR_PARAM(jad));
    172: }
    173: PETSC_EXTERN void matrestorerowijf90_(Mat *B, PetscInt *shift, PetscBool *sym, PetscBool *blockcompressed, PetscInt *n, F90Array1d *ia, F90Array1d *ja, PetscBool *done, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(iad) PETSC_F90_2PTR_PROTO(jad))
    174: {
    175:   const PetscInt *IA, *JA;
    176:   *ierr = F90Array1dAccess(ia, MPIU_INT, (void **)&IA PETSC_F90_2PTR_PARAM(iad));
    177:   if (*ierr) return;
    178:   *ierr = F90Array1dDestroy(ia, MPIU_INT PETSC_F90_2PTR_PARAM(iad));
    179:   if (*ierr) return;
    180:   *ierr = F90Array1dAccess(ja, MPIU_INT, (void **)&JA PETSC_F90_2PTR_PARAM(jad));
    181:   if (*ierr) return;
    182:   *ierr = F90Array1dDestroy(ja, MPIU_INT PETSC_F90_2PTR_PARAM(jad));
    183:   if (*ierr) return;
    184:   *ierr = MatRestoreRowIJ(*B, *shift, *sym, *blockcompressed, n, &IA, &JA, done);
    185: }
    186: PETSC_EXTERN void matmpiaijgetseqaijf90_(Mat *mat, Mat *A, Mat *B, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    187: {
    188:   const PetscInt *fa;
    189:   PetscInt        n;
    190:   *ierr = MatMPIAIJGetSeqAIJ(*mat, A, B, &fa);
    191:   if (*ierr) return;
    192:   *ierr = MatGetLocalSize(*B, NULL, &n);
    193:   if (*ierr) return;
    194:   *ierr = F90Array1dCreate((void *)fa, MPIU_INT, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
    195: }
    196: PETSC_EXTERN void matmpiaijrestoreseqaijf90_(Mat *mat, Mat *A, Mat *B, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    197: {
    198:   *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
    199:   if (*ierr) return;
    200: }