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: }