Date: 2025-03-28T21:10:46+00:00

Actual source code: zplexfemf90.c

      1: #include <petsc/private/fortranimpl.h>
      2: #include <petscdmplex.h>
      3: #include <petscds.h>
      4: #include <petsc/private/f90impl.h>

      6: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      7:   #define dmplexgetcellfields_       DMPLEXGETCELLFIELDS
      8:   #define dmplexrestorecellfields_   DMPLEXRESTORECELLFIELDS
      9:   #define dmplexgetfacefields_       DMPLEXGETFACEFIELDS
     10:   #define dmplexrestorefacefields_   DMPLEXRESTOREFACEFIELDS
     11:   #define dmplexgetfacegeometry_     DMPLEXGETFACEGEOMETRY
     12:   #define dmplexrestorefacegeometry_ DMPLEXRESTOREFACEGEOMETRY
     13: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) && !defined(FORTRANDOUBLEUNDERSCORE)
     14:   #define dmplexgetcellfields_       dmplexgetcellfields
     15:   #define dmplexrestorecellfields_   dmplexrestorecellfields
     16:   #define dmplexgetfacefields_       dmplexgetfacefields
     17:   #define dmplexrestorefacefields_   dmplexrestorefacefields
     18:   #define dmplexgetfacegeometry_     dmplexgetfacegeometry
     19:   #define dmplexrestorefacegeometry_ dmplexrestorefacegeometry
     20: #endif

     22: PETSC_EXTERN void dmplexgetcellfields_(DM *dm, IS *cellIS, Vec *locX, Vec *locX_t, Vec *locA, F90Array1d *uPtr, F90Array1d *utPtr, F90Array1d *aPtr, int *ierr PETSC_F90_2PTR_PROTO(uPtrd) PETSC_F90_2PTR_PROTO(utPtrd) PETSC_F90_2PTR_PROTO(aPtrd))
     23: {
     24:   PetscDS      prob;
     25:   PetscScalar *u, *u_t, *a;
     26:   PetscInt     numCells, totDim, totDimAux = 0;

     28:   *ierr = ISGetLocalSize(*cellIS, &numCells);
     29:   if (*ierr) return;
     30:   *ierr = DMPlexGetCellFields(*dm, *cellIS, *locX, *locX_t, *locA, &u, &u_t, &a);
     31:   if (*ierr) return;
     32:   *ierr = DMGetDS(*dm, &prob);
     33:   if (*ierr) return;
     34:   *ierr = PetscDSGetTotalDimension(prob, &totDim);
     35:   if (*ierr) return;
     36:   if (locA) {
     37:     DM      dmAux;
     38:     PetscDS probAux;

     40:     *ierr = VecGetDM(*locA, &dmAux);
     41:     if (*ierr) return;
     42:     *ierr = DMGetDS(dmAux, &probAux);
     43:     if (*ierr) return;
     44:     *ierr = PetscDSGetTotalDimension(probAux, &totDimAux);
     45:     if (*ierr) return;
     46:   }
     47:   *ierr = F90Array1dCreate((void *)u, MPIU_SCALAR, 1, numCells * totDim, uPtr PETSC_F90_2PTR_PARAM(uPtrd));
     48:   if (*ierr) return;
     49:   *ierr = F90Array1dCreate((void *)u_t, MPIU_SCALAR, 1, locX_t ? numCells * totDim : 0, utPtr PETSC_F90_2PTR_PARAM(utPtrd));
     50:   if (*ierr) return;
     51:   *ierr = F90Array1dCreate((void *)a, MPIU_SCALAR, 1, locA ? numCells * totDimAux : 0, aPtr PETSC_F90_2PTR_PARAM(aPtrd));
     52: }

     54: PETSC_EXTERN void dmplexrestorecellfields_(DM *dm, IS *cellIS, Vec *locX, Vec *locX_t, Vec *locA, F90Array1d *uPtr, F90Array1d *utPtr, F90Array1d *aPtr, int *ierr PETSC_F90_2PTR_PROTO(uPtrd) PETSC_F90_2PTR_PROTO(utPtrd) PETSC_F90_2PTR_PROTO(aPtrd))
     55: {
     56:   PetscScalar *u, *u_t, *a;

     58:   *ierr = F90Array1dAccess(uPtr, MPIU_SCALAR, (void **)&u PETSC_F90_2PTR_PARAM(uPtrd));
     59:   if (*ierr) return;
     60:   *ierr = F90Array1dAccess(utPtr, MPIU_SCALAR, (void **)&u_t PETSC_F90_2PTR_PARAM(utPtrd));
     61:   if (*ierr) return;
     62:   *ierr = F90Array1dAccess(aPtr, MPIU_SCALAR, (void **)&a PETSC_F90_2PTR_PARAM(aPtrd));
     63:   if (*ierr) return;
     64:   *ierr = DMPlexRestoreCellFields(*dm, *cellIS, *locX, NULL, NULL, &u, u_t ? &u_t : NULL, a ? &a : NULL);
     65:   if (*ierr) return;
     66:   *ierr = F90Array1dDestroy(uPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(uPtrd));
     67:   if (*ierr) return;
     68:   *ierr = F90Array1dDestroy(utPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(utPtrd));
     69:   if (*ierr) return;
     70:   *ierr = F90Array1dDestroy(aPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(aPtrd));
     71:   if (*ierr) return;
     72: }

     74: PETSC_EXTERN void dmplexgetfacefields_(DM *dm, PetscInt *fStart, PetscInt *fEnd, Vec *locX, Vec *locX_t, Vec *faceGeometry, Vec *cellGeometry, Vec *locGrad, PetscInt *Nface, F90Array1d *uLPtr, F90Array1d *uRPtr, int *ierr PETSC_F90_2PTR_PROTO(uLPtrd) PETSC_F90_2PTR_PROTO(uRPtrd))
     75: {
     76:   PetscDS      prob;
     77:   PetscScalar *uL, *uR;
     78:   PetscInt     numFaces = *fEnd - *fStart, totDim;

     80:   *ierr = DMPlexGetFaceFields(*dm, *fStart, *fEnd, *locX, *locX_t, *faceGeometry, *cellGeometry, *locGrad, Nface, &uL, &uR);
     81:   if (*ierr) return;
     82:   *ierr = DMGetDS(*dm, &prob);
     83:   if (*ierr) return;
     84:   *ierr = PetscDSGetTotalDimension(prob, &totDim);
     85:   if (*ierr) return;
     86:   *ierr = F90Array1dCreate((void *)uL, MPIU_SCALAR, 1, numFaces * totDim, uLPtr PETSC_F90_2PTR_PARAM(uLPtrd));
     87:   if (*ierr) return;
     88:   *ierr = F90Array1dCreate((void *)uR, MPIU_SCALAR, 1, numFaces * totDim, uRPtr PETSC_F90_2PTR_PARAM(uRPtrd));
     89:   if (*ierr) return;
     90: }

     92: PETSC_EXTERN void dmplexrestorefacefields_(DM *dm, PetscInt *fStart, PetscInt *fEnd, Vec *locX, Vec *locX_t, Vec *faceGeometry, Vec *cellGeometry, Vec *locGrad, PetscInt *Nface, F90Array1d *uLPtr, F90Array1d *uRPtr, int *ierr PETSC_F90_2PTR_PROTO(uLPtrd) PETSC_F90_2PTR_PROTO(uRPtrd))
     93: {
     94:   PetscScalar *uL, *uR;

     96:   *ierr = F90Array1dAccess(uLPtr, MPIU_SCALAR, (void **)&uL PETSC_F90_2PTR_PARAM(uLPtrd));
     97:   if (*ierr) return;
     98:   *ierr = F90Array1dAccess(uRPtr, MPIU_SCALAR, (void **)&uR PETSC_F90_2PTR_PARAM(uRPtrd));
     99:   if (*ierr) return;
    100:   *ierr = DMPlexRestoreFaceFields(*dm, *fStart, *fEnd, *locX, NULL, *faceGeometry, *cellGeometry, NULL, Nface, &uL, &uR);
    101:   if (*ierr) return;
    102:   *ierr = F90Array1dDestroy(uLPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(uLPtrd));
    103:   if (*ierr) return;
    104:   *ierr = F90Array1dDestroy(uRPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(uRPtrd));
    105:   if (*ierr) return;
    106: }

    108: PETSC_EXTERN void dmplexgetfacegeometry_(DM *dm, PetscInt *fStart, PetscInt *fEnd, Vec *faceGeometry, Vec *cellGeometry, PetscInt *Nface, F90Array1d *gPtr, F90Array1d *vPtr, int *ierr PETSC_F90_2PTR_PROTO(gPtrd) PETSC_F90_2PTR_PROTO(vPtrd))
    109: {
    110:   PetscFVFaceGeom *g;
    111:   PetscReal       *v;
    112:   PetscInt         numFaces = *fEnd - *fStart, structSize = sizeof(PetscFVFaceGeom) / sizeof(PetscScalar);

    114:   *ierr = DMPlexGetFaceGeometry(*dm, *fStart, *fEnd, *faceGeometry, *cellGeometry, Nface, &g, &v);
    115:   if (*ierr) return;
    116:   *ierr = F90Array1dCreate((void *)g, MPIU_SCALAR, 1, numFaces * structSize, gPtr PETSC_F90_2PTR_PARAM(gPtrd));
    117:   if (*ierr) return;
    118:   *ierr = F90Array1dCreate((void *)v, MPIU_REAL, 1, numFaces * 2, vPtr PETSC_F90_2PTR_PARAM(vPtrd));
    119:   if (*ierr) return;
    120: }

    122: PETSC_EXTERN void dmplexrestorefacegeometry_(DM *dm, PetscInt *fStart, PetscInt *fEnd, Vec *faceGeometry, Vec *cellGeometry, PetscInt *Nface, F90Array1d *gPtr, F90Array1d *vPtr, int *ierr PETSC_F90_2PTR_PROTO(gPtrd) PETSC_F90_2PTR_PROTO(vPtrd))
    123: {
    124:   PetscFVFaceGeom *g;
    125:   PetscReal       *v;

    127:   *ierr = F90Array1dAccess(gPtr, MPIU_SCALAR, (void **)&g PETSC_F90_2PTR_PARAM(gPtrd));
    128:   if (*ierr) return;
    129:   *ierr = F90Array1dAccess(vPtr, MPIU_REAL, (void **)&v PETSC_F90_2PTR_PARAM(vPtrd));
    130:   if (*ierr) return;
    131:   *ierr = DMPlexRestoreFaceGeometry(*dm, *fStart, *fEnd, *faceGeometry, *cellGeometry, Nface, &g, &v);
    132:   if (*ierr) return;
    133:   *ierr = F90Array1dDestroy(gPtr, MPIU_SCALAR PETSC_F90_2PTR_PARAM(vPtrd));
    134:   if (*ierr) return;
    135:   *ierr = F90Array1dDestroy(vPtr, MPIU_REAL PETSC_F90_2PTR_PARAM(gPtrd));
    136:   if (*ierr) return;
    137: }