Actual source code: zdmshellf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscdmshell.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define dmshellsetcreatematrix_ DMSHELLSETCREATEMATRIX
6: #define dmshellsetcreateglobalvector_ DMSHELLSETCREATEGLOBALVECTOR_
7: #define dmshellsetcreatelocalvector_ DMSHELLSETCREATELOCALVECTOR_
8: #define dmshellsetglobaltolocal_ DMSHELLSETGLOBALTOLOCAL_
9: #define dmshellsetlocaltoglobal_ DMSHELLSETLOCALTOGLOBAL_
10: #define dmshellsetlocaltolocal_ DMSHELLSETLOCALTOLOCAL_
11: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
12: #define dmshellsetcreatematrix_ dmshellsetcreatematrix
13: #define dmshellsetcreateglobalvector_ dmshellsetcreateglobalvector
14: #define dmshellsetcreatelocalvector_ dmshellsetcreatelocalvector
15: #define dmshellsetglobaltolocal_ dmshellsetglobaltolocal
16: #define dmshellsetlocaltoglobal_ dmshellsetlocaltoglobal
17: #define dmshellsetlocaltolocal_ dmshellsetlocaltolocal_
18: #endif
20: /*
21: * C routines are required for matrix and global vector creation. We define C routines here that call the corresponding
22: * Fortran routine (indexed by _cb) that was set by the user.
23: */
25: static struct {
26: PetscFortranCallbackId creatematrix;
27: PetscFortranCallbackId createglobalvector;
28: PetscFortranCallbackId createlocalvector;
29: PetscFortranCallbackId globaltolocalbegin;
30: PetscFortranCallbackId globaltolocalend;
31: PetscFortranCallbackId localtoglobalbegin;
32: PetscFortranCallbackId localtoglobalend;
33: PetscFortranCallbackId localtolocalbegin;
34: PetscFortranCallbackId localtolocalend;
35: } _cb;
37: static PetscErrorCode ourcreatematrix(DM dm, Mat *A)
38: {
39: PetscObjectUseFortranCallbackSubType(dm, _cb.creatematrix, (DM *, Mat *, PetscErrorCode *), (&dm, A, &ierr));
40: }
42: static PetscErrorCode ourcreateglobalvector(DM dm, Vec *v)
43: {
44: PetscObjectUseFortranCallbackSubType(dm, _cb.createglobalvector, (DM *, Vec *, PetscErrorCode *), (&dm, v, &ierr));
45: }
47: static PetscErrorCode ourcreatelocalvector(DM dm, Vec *v)
48: {
49: PetscObjectUseFortranCallbackSubType(dm, _cb.createlocalvector, (DM *, Vec *, PetscErrorCode *), (&dm, v, &ierr));
50: }
52: static PetscErrorCode ourglobaltolocalbegin(DM dm, Vec g, InsertMode mode, Vec l)
53: {
54: PetscObjectUseFortranCallbackSubType(dm, _cb.globaltolocalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
55: }
57: static PetscErrorCode ourglobaltolocalend(DM dm, Vec g, InsertMode mode, Vec l)
58: {
59: PetscObjectUseFortranCallbackSubType(dm, _cb.globaltolocalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
60: }
62: static PetscErrorCode ourlocaltoglobalbegin(DM dm, Vec l, InsertMode mode, Vec g)
63: {
64: PetscObjectUseFortranCallbackSubType(dm, _cb.localtoglobalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &l, &mode, &g, &ierr));
65: }
67: static PetscErrorCode ourlocaltoglobalend(DM dm, Vec l, InsertMode mode, Vec g)
68: {
69: PetscObjectUseFortranCallbackSubType(dm, _cb.localtoglobalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &l, &mode, &g, &ierr));
70: }
72: static PetscErrorCode ourlocaltolocalbegin(DM dm, Vec g, InsertMode mode, Vec l)
73: {
74: PetscObjectUseFortranCallbackSubType(dm, _cb.localtolocalbegin, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
75: }
77: static PetscErrorCode ourlocaltolocalend(DM dm, Vec g, InsertMode mode, Vec l)
78: {
79: PetscObjectUseFortranCallbackSubType(dm, _cb.localtolocalend, (DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), (&dm, &g, &mode, &l, &ierr));
80: }
82: PETSC_EXTERN void dmshellsetcreatematrix_(DM *dm, void (*func)(DM *, Mat *, PetscErrorCode *, PETSC_FORTRAN_CHARLEN_T len), PetscErrorCode *ierr)
83: {
84: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.creatematrix, (PetscVoidFn *)func, NULL);
85: if (*ierr) return;
86: *ierr = DMShellSetCreateMatrix(*dm, ourcreatematrix);
87: }
89: PETSC_EXTERN void dmshellsetcreateglobalvector_(DM *dm, void (*func)(DM *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
90: {
91: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createglobalvector, (PetscVoidFn *)func, NULL);
92: if (*ierr) return;
93: *ierr = DMShellSetCreateGlobalVector(*dm, ourcreateglobalvector);
94: }
96: PETSC_EXTERN void dmshellsetcreatelocalvector_(DM *dm, void (*func)(DM *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
97: {
98: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.createlocalvector, (PetscVoidFn *)func, NULL);
99: if (*ierr) return;
100: *ierr = DMShellSetCreateLocalVector(*dm, ourcreatelocalvector);
101: }
103: PETSC_EXTERN void dmshellsetglobaltolocal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
104: {
105: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.globaltolocalbegin, (PetscVoidFn *)begin, NULL);
106: if (*ierr) return;
107: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.globaltolocalend, (PetscVoidFn *)end, NULL);
108: if (*ierr) return;
109: *ierr = DMShellSetGlobalToLocal(*dm, ourglobaltolocalbegin, ourglobaltolocalend);
110: }
112: PETSC_EXTERN void dmshellsetlocaltoglobal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
113: {
114: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtoglobalbegin, (PetscVoidFn *)begin, NULL);
115: if (*ierr) return;
116: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtoglobalend, (PetscVoidFn *)end, NULL);
117: if (*ierr) return;
118: *ierr = DMShellSetLocalToGlobal(*dm, ourlocaltoglobalbegin, ourlocaltoglobalend);
119: }
121: PETSC_EXTERN void dmshellsetlocaltolocal_(DM *dm, void (*begin)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), void (*end)(DM *, Vec *, InsertMode *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
122: {
123: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtolocalbegin, (PetscVoidFn *)begin, NULL);
124: if (*ierr) return;
125: *ierr = PetscObjectSetFortranCallback((PetscObject)*dm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.localtolocalend, (PetscVoidFn *)end, NULL);
126: if (*ierr) return;
127: *ierr = DMShellSetLocalToLocal(*dm, ourlocaltolocalbegin, ourlocaltolocalend);
128: }