Date: 2026-07-30T21:14:05+00:00

Actual source code: zdmf.c

      1: #include <petsc/private/ftnimpl.h>
      2: #include <petscdm.h>
      3: #include <petscviewer.h>

      5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      6:   #define dmcreatesuperdm_                       DMCREATESUPERDM
      7:   #define dmcreatefielddecompositiongetname_     DMCREATEFIELDDECOMPOSITIONGETNAME
      8:   #define dmcreatefielddecompositiongetisdm_     DMCREATEFIELDDECOMPOSITIONGETISDM
      9:   #define dmcreatefielddecompositionrestoreisdm_ DMCREATEFIELDDECOMPOSITIONRESTOREISDM
     10: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     11:   #define dmcreatesuperdm_                       dmreatesuperdm
     12:   #define dmcreatefielddecompositiongetname_     dmcreatefielddecompositiongetname
     13:   #define dmcreatefielddecompositiongetisdm_     dmcreatefielddecompositiongetisdm
     14:   #define dmcreatefielddecompositionrestoreisdm_ dmcreatefielddecompositionrestoreisdm
     15: #endif

     17: PETSC_EXTERN void dmcreatesuperdm_(DM dms[], PetscInt *len, IS ***is, DM *superdm, PetscErrorCode *ierr)
     18: {
     19:   *ierr = DMCreateSuperDM(dms, *len, *is, superdm);
     20: }

     22: PETSC_EXTERN void dmcreatefielddecompositiongetname_(DM *dm, PetscInt *i, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l_b)
     23: {
     24:   PetscInt n;
     25:   char   **names;
     26:   *ierr = DMCreateFieldDecomposition(*dm, &n, &names, NULL, NULL);
     27:   if (*ierr) return;
     28:   *ierr = PetscStrncpy((char *)name, names[*i - 1], l_b);
     29:   if (*ierr) return;
     30:   FIXRETURNCHAR(PETSC_TRUE, name, l_b);
     31:   for (PetscInt j = 0; j < n; j++) *ierr = PetscFree(names[j]);
     32:   *ierr = PetscFree(names);
     33: }

     35: PETSC_EXTERN void dmcreatefielddecompositiongetisdm_(DM *dm, F90Array1d *iss, F90Array1d *dms, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
     36: {
     37:   PetscInt n;
     38:   IS      *tis;
     39:   DM      *tdm;

     41:   if (iss && dms) {
     42:     *ierr = DMCreateFieldDecomposition(*dm, &n, NULL, &tis, &tdm);
     43:   } else if (iss) {
     44:     *ierr = DMCreateFieldDecomposition(*dm, &n, NULL, &tis, NULL);
     45:   } else if (dms) {
     46:     *ierr = DMCreateFieldDecomposition(*dm, &n, NULL, NULL, &tdm);
     47:   }
     48:   if (*ierr) return;
     49:   if (iss) *ierr = F90Array1dCreate(tis, MPIU_FORTRANADDR, 1, n, iss PETSC_F90_2PTR_PARAM(ptrd1));
     50:   if (*ierr) return;
     51:   if (dms) *ierr = F90Array1dCreate(tdm, MPIU_FORTRANADDR, 1, n, dms PETSC_F90_2PTR_PARAM(ptrd2));
     52: }

     54: PETSC_EXTERN void dmcreatefielddecompositionrestoreisdm_(DM *dm, F90Array1d *iss, F90Array1d *dms, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd1) PETSC_F90_2PTR_PROTO(ptrd2))
     55: {
     56:   PetscInt n;

     58:   *ierr = DMGetNumFields(*dm, &n);
     59:   if (*ierr) return;
     60:   if (iss) {
     61:     IS *tis;
     62:     *ierr = F90Array1dAccess(iss, MPIU_FORTRANADDR, (void **)&tis PETSC_F90_2PTR_PARAM(ptrd1));
     63:     if (*ierr) return;
     64:     *ierr = F90Array1dDestroy(iss, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd1));
     65:     if (*ierr) return;
     66:     for (PetscInt i = 0; i < n; i++) *ierr = ISDestroy(&tis[i]);
     67:     *ierr = PetscFree(tis);
     68:     if (*ierr) return;
     69:   }
     70:   if (dms) {
     71:     DM *tdm;
     72:     *ierr = F90Array1dAccess(dms, MPIU_FORTRANADDR, (void **)&tdm PETSC_F90_2PTR_PARAM(ptrd2));
     73:     if (*ierr) return;
     74:     *ierr = F90Array1dDestroy(dms, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd2));
     75:     if (*ierr) return;
     76:     for (PetscInt i = 0; i < n; i++) *ierr = DMDestroy(&tdm[i]);
     77:     *ierr = PetscFree(tdm);
     78:     if (*ierr) return;
     79:   }
     80: }