Actual source code: zplexf90.c

      1: #include <petsc/private/ftnimpl.h>
      2: #include <petscdmplex.h>

      4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      5:   #define dmplexgetcone_                  DMPLEXGETCONE
      6:   #define dmplexrestorecone_              DMPLEXRESTORECONE
      7:   #define dmplexgetconeorientation_       DMPLEXGETCONEORIENTATION
      8:   #define dmplexrestoreconeorientation_   DMPLEXRESTORECONEORIENTATION
      9:   #define dmplexgetsupport_               DMPLEXGETSUPPORT
     10:   #define dmplexrestoresupport_           DMPLEXRESTORESUPPORT
     11:   #define dmplexgettransitiveclosure_     DMPLEXGETTRANSITIVECLOSURE
     12:   #define dmplexrestoretransitiveclosure_ DMPLEXRESTORETRANSITIVECLOSURE
     13:   #define dmplexvecgetclosure_            DMPLEXVECGETCLOSURE
     14:   #define dmplexvecrestoreclosure_        DMPLEXVECRESTORECLOSURE
     15:   #define dmplexvecsetclosure_            DMPLEXVECSETCLOSURE
     16:   #define dmplexmatsetclosure_            DMPLEXMATSETCLOSURE
     17:   #define dmplexgetclosureindices_        DMPLEXGETCLOSUREINDICES
     18:   #define dmplexrestoreclosureindices_    DMPLEXRESTORECLOSUREINDICES
     19:   #define dmplexgetjoin_                  DMPLEXGETJOIN
     20:   #define dmplexgetfulljoin_              DMPLEXGETFULLJOIN
     21:   #define dmplexrestorejoin_              DMPLEXRESTOREJOIN
     22:   #define dmplexgetmeet_                  DMPLEXGETMEET
     23:   #define dmplexgetfullmeet_              DMPLEXGETFULLMEET
     24:   #define dmplexrestoremeet_              DMPLEXRESTOREMEET
     25: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     26:   #define dmplexgetcone_                  dmplexgetcone
     27:   #define dmplexrestorecone_              dmplexrestorecone
     28:   #define dmplexgetconeorientation_       dmplexgetconeorientation
     29:   #define dmplexrestoreconeorientation_   dmplexrestoreconeorientation
     30:   #define dmplexgetsupport_               dmplexgetsupport
     31:   #define dmplexrestoresupport_           dmplexrestoresupport
     32:   #define dmplexgettransitiveclosure_     dmplexgettransitiveclosure
     33:   #define dmplexrestoretransitiveclosure_ dmplexrestoretransitiveclosure
     34:   #define dmplexvecgetclosure_            dmplexvecgetclosure
     35:   #define dmplexvecrestoreclosure_        dmplexvecrestoreclosure
     36:   #define dmplexvecsetclosure_            dmplexvecsetclosure
     37:   #define dmplexmatsetclosure_            dmplexmatsetclosure
     38:   #define dmplexgetclosureindices_        dmplexgetclosureindices
     39:   #define dmplexrestoreclosureindices_    dmplexrestoreclosureindices
     40:   #define dmplexgetjoin_                  dmplexgetjoin
     41:   #define dmplexgetfulljoin_              dmplexgetfulljoin
     42:   #define dmplexrestorejoin_              dmplexrestorejoin
     43:   #define dmplexgetmeet_                  dmplexgetmeet
     44:   #define dmplexgetfullmeet_              dmplexgetfullmeet
     45:   #define dmplexrestoremeet_              dmplexrestoremeet
     46: #endif

     48: PETSC_EXTERN void dmplexgetcone_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     49: {
     50:   const PetscInt *v;
     51:   PetscInt        n;

     53:   *ierr = DMPlexGetConeSize(*dm, *p, &n);
     54:   if (*ierr) return;
     55:   *ierr = DMPlexGetCone(*dm, *p, &v);
     56:   if (*ierr) return;
     57:   *ierr = F90Array1dCreate((void *)v, MPIU_INT, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
     58: }

     60: PETSC_EXTERN void dmplexrestorecone_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     61: {
     62:   *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
     63:   if (*ierr) return;
     64: }

     66: PETSC_EXTERN void dmplexgetconeorientation_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     67: {
     68:   const PetscInt *v;
     69:   PetscInt        n;

     71:   *ierr = DMPlexGetConeSize(*dm, *p, &n);
     72:   if (*ierr) return;
     73:   *ierr = DMPlexGetConeOrientation(*dm, *p, &v);
     74:   if (*ierr) return;
     75:   *ierr = F90Array1dCreate((void *)v, MPIU_INT, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
     76: }

     78: PETSC_EXTERN void dmplexrestoreconeorientation_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     79: {
     80:   *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
     81:   if (*ierr) return;
     82: }

     84: PETSC_EXTERN void dmplexgetsupport_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     85: {
     86:   const PetscInt *v;
     87:   PetscInt        n;

     89:   *ierr = DMPlexGetSupportSize(*dm, *p, &n);
     90:   if (*ierr) return;
     91:   *ierr = DMPlexGetSupport(*dm, *p, &v);
     92:   if (*ierr) return;
     93:   *ierr = F90Array1dCreate((void *)v, MPIU_INT, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
     94: }

     96: PETSC_EXTERN void dmplexrestoresupport_(DM *dm, PetscInt *p, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
     97: {
     98:   *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
     99:   if (*ierr) return;
    100: }

    102: PETSC_EXTERN void dmplexgettransitiveclosure_(DM *dm, PetscInt *p, PetscBool *useCone, PetscInt *N, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    103: {
    104:   PetscInt *v = NULL;
    105:   PetscInt  n;

    107:   CHKFORTRANNULL(N);
    108:   *ierr = DMPlexGetTransitiveClosure(*dm, *p, *useCone, &n, &v);
    109:   if (*ierr) return;
    110:   *ierr = F90Array1dCreate((void *)v, MPIU_INT, 1, n * 2, ptr PETSC_F90_2PTR_PARAM(ptrd));
    111:   if (N) *N = n;
    112: }

    114: PETSC_EXTERN void dmplexrestoretransitiveclosure_(DM *dm, PetscInt *p, PetscBool *useCone, PetscInt *N, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    115: {
    116:   PetscInt *array;

    118:   *ierr = F90Array1dAccess(ptr, MPIU_INT, (void **)&array PETSC_F90_2PTR_PARAM(ptrd));
    119:   if (*ierr) return;
    120:   *ierr = DMPlexRestoreTransitiveClosure(*dm, *p, *useCone, NULL, &array);
    121:   if (*ierr) return;
    122:   *ierr = F90Array1dDestroy(ptr, MPIU_INT PETSC_F90_2PTR_PARAM(ptrd));
    123:   if (*ierr) return;
    124: }

    126: PETSC_EXTERN void dmplexvecgetclosure_(DM *dm, PetscSection *section, Vec *x, PetscInt *point, PetscInt *N, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    127: {
    128:   PetscScalar *v = NULL;
    129:   PetscInt     n;

    131:   CHKFORTRANNULL(N);
    132:   *ierr = DMPlexVecGetClosure(*dm, *section, *x, *point, &n, &v);
    133:   if (*ierr) return;
    134:   *ierr = F90Array1dCreate((void *)v, MPIU_SCALAR, 1, n, ptr PETSC_F90_2PTR_PARAM(ptrd));
    135:   if (N) *N = n;
    136: }

    138: PETSC_EXTERN void dmplexvecrestoreclosure_(DM *dm, PetscSection *section, Vec *v, PetscInt *point, PetscInt *N, F90Array1d *ptr, int *ierr PETSC_F90_2PTR_PROTO(ptrd))
    139: {
    140:   PetscScalar *array;

    142:   *ierr = F90Array1dAccess(ptr, MPIU_SCALAR, (void **)&array PETSC_F90_2PTR_PARAM(ptrd));
    143:   if (*ierr) return;
    144:   *ierr = DMPlexVecRestoreClosure(*dm, *section, *v, *point, NULL, &array);
    145:   if (*ierr) return;
    146:   *ierr = F90Array1dDestroy(ptr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(ptrd));
    147:   if (*ierr) return;
    148: }

    150: PETSC_EXTERN void dmplexgetclosureindices_(DM *dm, PetscSection *section, PetscSection *idxSection, PetscInt *point, PetscBool *useClPerm, PetscInt *numIndices, F90Array1d *idxPtr, PetscInt *outOffsets, F90Array1d *valPtr, int *ierr PETSC_F90_2PTR_PROTO(idxPtrd) PETSC_F90_2PTR_PROTO(valPtrd))
    151: {
    152:   PetscInt    *indices;
    153:   PetscScalar *values;

    155:   CHKFORTRANNULL(outOffsets);
    156:   if (FORTRANNULLSCALARPOINTER(valPtr)) *ierr = DMPlexGetClosureIndices(*dm, *section, *idxSection, *point, *useClPerm, numIndices, &indices, outOffsets, NULL);
    157:   else *ierr = DMPlexGetClosureIndices(*dm, *section, *idxSection, *point, *useClPerm, numIndices, &indices, outOffsets, &values);
    158:   if (*ierr) return;
    159:   *ierr = F90Array1dCreate((void *)indices, MPIU_INT, 1, *numIndices, idxPtr PETSC_F90_2PTR_PARAM(idxPtrd));
    160:   if (*ierr) return;
    161:   if (FORTRANNULLSCALARPOINTER(valPtr)) *ierr = F90Array1dCreate((void *)values, MPIU_SCALAR, 1, *numIndices, valPtr PETSC_F90_2PTR_PARAM(valPtrd));
    162: }

    164: PETSC_EXTERN void dmplexrestoreclosureindices_(DM *dm, PetscSection *section, PetscSection *idxSection, PetscInt *point, PetscBool *useClPerm, PetscInt *numIndices, F90Array1d *idxPtr, PetscInt *outOffsets, F90Array1d *valPtr, int *ierr PETSC_F90_2PTR_PROTO(idxPtrd) PETSC_F90_2PTR_PROTO(valPtrd))
    165: {
    166:   PetscInt    *indices;
    167:   PetscScalar *values = NULL;

    169:   CHKFORTRANNULL(outOffsets);
    170:   *ierr = F90Array1dAccess(idxPtr, MPIU_INT, (void **)&indices PETSC_F90_2PTR_PARAM(idxPtrd));
    171:   if (*ierr) return;
    172:   if (!FORTRANNULLSCALARPOINTER(valPtr)) {
    173:     *ierr = F90Array1dAccess(valPtr, MPIU_SCALAR, (void **)&values PETSC_F90_2PTR_PARAM(valPtrd));
    174:     if (*ierr) return;
    175:     *ierr = DMPlexRestoreClosureIndices(*dm, *section, *idxSection, *point, *useClPerm, numIndices, &indices, outOffsets, &values);
    176:   } else *ierr = DMPlexRestoreClosureIndices(*dm, *section, *idxSection, *point, *useClPerm, numIndices, &indices, outOffsets, NULL);
    177:   if (*ierr) return;
    178:   *ierr = F90Array1dDestroy(idxPtr, MPIU_INT PETSC_F90_2PTR_PARAM(idxPtrd));
    179:   if (*ierr) return;
    180:   if (!FORTRANNULLSCALARPOINTER(valPtr)) *ierr = F90Array1dDestroy(valPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(valPtrd));
    181: }

    183: PETSC_EXTERN void dmplexgetjoin_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
    184: {
    185:   const PetscInt *coveredPoints;
    186:   PetscInt        n;

    188:   CHKFORTRANNULL(N);
    189:   *ierr = DMPlexGetJoin(*dm, *numPoints, points, &n, &coveredPoints);
    190:   if (*ierr) return;
    191:   *ierr = F90Array1dCreate((void *)coveredPoints, MPIU_INT, 1, n, cptr PETSC_F90_2PTR_PARAM(cptrd));
    192:   if (N) *N = n;
    193: }

    195: PETSC_EXTERN void dmplexgetfulljoin_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
    196: {
    197:   const PetscInt *coveredPoints;
    198:   PetscInt        n;

    200:   CHKFORTRANNULL(N);
    201:   *ierr = DMPlexGetFullJoin(*dm, *numPoints, points, &n, &coveredPoints);
    202:   if (*ierr) return;
    203:   *ierr = F90Array1dCreate((void *)coveredPoints, MPIU_INT, 1, n, cptr PETSC_F90_2PTR_PARAM(cptrd));
    204:   if (N) *N = n;
    205: }

    207: PETSC_EXTERN void dmplexrestorejoin_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
    208: {
    209:   PetscInt *coveredPoints;

    211:   *ierr = F90Array1dAccess(cptr, MPIU_INT, (void **)&coveredPoints PETSC_F90_2PTR_PARAM(cptrd));
    212:   if (*ierr) return;
    213:   *ierr = DMPlexRestoreJoin(*dm, 0, NULL, NULL, (const PetscInt **)&coveredPoints);
    214:   if (*ierr) return;
    215:   *ierr = F90Array1dDestroy(cptr, MPIU_INT PETSC_F90_2PTR_PARAM(cptrd));
    216:   if (*ierr) return;
    217: }

    219: PETSC_EXTERN void dmplexgetmeet_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
    220: {
    221:   const PetscInt *coveredPoints;
    222:   PetscInt        n;

    224:   CHKFORTRANNULL(N);
    225:   *ierr = DMPlexGetMeet(*dm, *numPoints, points, &n, &coveredPoints);
    226:   if (*ierr) return;
    227:   *ierr = F90Array1dCreate((void *)coveredPoints, MPIU_INT, 1, n, cptr PETSC_F90_2PTR_PARAM(cptrd));
    228:   if (N) *N = n;
    229: }

    231: PETSC_EXTERN void dmplexgetfullmeet_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
    232: {
    233:   const PetscInt *coveredPoints;
    234:   PetscInt        n;

    236:   CHKFORTRANNULL(N);
    237:   if (*ierr) return;
    238:   *ierr = DMPlexGetFullMeet(*dm, *numPoints, points, &n, &coveredPoints);
    239:   if (*ierr) return;
    240:   *ierr = F90Array1dCreate((void *)coveredPoints, MPIU_INT, 1, n, cptr PETSC_F90_2PTR_PARAM(cptrd));
    241:   if (N) *N = n;
    242: }

    244: PETSC_EXTERN void dmplexrestoremeet_(DM *dm, PetscInt *numPoints, PetscInt *points, PetscInt *N, F90Array1d *cptr, int *ierr PETSC_F90_2PTR_PROTO(cptrd))
    245: {
    246:   PetscInt *coveredPoints;

    248:   *ierr = F90Array1dAccess(cptr, MPIU_INT, (void **)&coveredPoints PETSC_F90_2PTR_PARAM(cptrd));
    249:   if (*ierr) return;
    250:   *ierr = DMPlexRestoreMeet(*dm, 0, NULL, NULL, (const PetscInt **)&coveredPoints);
    251:   if (*ierr) return;
    252:   *ierr = F90Array1dDestroy(cptr, MPIU_INT PETSC_F90_2PTR_PARAM(cptrd));
    253:   if (*ierr) return;
    254: }