1 #include <petsc/private/fortranimpl.h> 2 #include <petscdmshell.h> /*I "petscdmshell.h" I*/ 3 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 19 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 */ 24 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; 36 37 static PetscErrorCode ourcreatematrix(DM dm,Mat *A) 38 { 39 PetscObjectUseFortranCallbackSubType(dm,_cb.creatematrix,(DM*,Mat*,PetscErrorCode*),(&dm,A,&ierr)); 40 } 41 42 static PetscErrorCode ourcreateglobalvector(DM dm,Vec *v) 43 { 44 PetscObjectUseFortranCallbackSubType(dm,_cb.createglobalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 45 } 46 47 static PetscErrorCode ourcreatelocalvector(DM dm,Vec *v) 48 { 49 PetscObjectUseFortranCallbackSubType(dm,_cb.createlocalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 50 } 51 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 } 56 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 } 61 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 } 66 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 } 71 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 } 76 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 } 81 82 83 PETSC_EXTERN void dmshellsetcreatematrix_(DM *dm,void (*func)(DM*,Mat*,PetscErrorCode*,PETSC_FORTRAN_CHARLEN_T len),PetscErrorCode *ierr) 84 { 85 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.creatematrix,(PetscVoidFunction)func,NULL);if (*ierr) return; 86 *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); 87 } 88 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,(PetscVoidFunction)func,NULL);if (*ierr) return; 92 *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); 93 } 94 95 PETSC_EXTERN void dmshellsetcreatelocalvector_(DM *dm,void (*func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 96 { 97 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createlocalvector,(PetscVoidFunction)func,NULL);if (*ierr) return; 98 *ierr = DMShellSetCreateLocalVector(*dm,ourcreatelocalvector); 99 } 100 101 PETSC_EXTERN void dmshellsetglobaltolocal_(DM *dm,void (*begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (*end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 102 { 103 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.globaltolocalbegin,(PetscVoidFunction)begin,NULL);if (*ierr) return; 104 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.globaltolocalend,(PetscVoidFunction)end,NULL);if (*ierr) return; 105 *ierr = DMShellSetGlobalToLocal(*dm,ourglobaltolocalbegin,ourglobaltolocalend); 106 } 107 108 PETSC_EXTERN void dmshellsetlocaltoglobal_(DM *dm,void (*begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (*end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 109 { 110 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtoglobalbegin,(PetscVoidFunction)begin,NULL);if (*ierr) return; 111 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtoglobalend,(PetscVoidFunction)end,NULL);if (*ierr) return; 112 *ierr = DMShellSetLocalToGlobal(*dm,ourlocaltoglobalbegin,ourlocaltoglobalend); 113 } 114 115 PETSC_EXTERN void dmshellsetlocaltolocal_(DM *dm,void (*begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (*end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 116 { 117 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtolocalbegin,(PetscVoidFunction)begin,NULL);if (*ierr) return; 118 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtolocalend,(PetscVoidFunction)end,NULL);if (*ierr) return; 119 *ierr = DMShellSetLocalToLocal(*dm,ourlocaltolocalbegin,ourlocaltolocalend); 120 } 121