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 PETSC_STDCALL dmshellsetcreatematrix_(DM *dm,void (PETSC_STDCALL *func)(DM*,Mat*,PetscErrorCode* PETSC_END_LEN(len)),PetscErrorCode *ierr) 84 { 85 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.creatematrix,(PetscVoidFunction)func,NULL); 86 if (*ierr) return; 87 *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); 88 } 89 90 PETSC_EXTERN void PETSC_STDCALL dmshellsetcreateglobalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 91 { 92 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createglobalvector,(PetscVoidFunction)func,NULL); 93 if (*ierr) return; 94 *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); 95 } 96 97 PETSC_EXTERN void PETSC_STDCALL dmshellsetcreatelocalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 98 { 99 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createlocalvector,(PetscVoidFunction)func,NULL); 100 if (*ierr) return; 101 *ierr = DMShellSetCreateLocalVector(*dm,ourcreatelocalvector); 102 } 103 104 PETSC_EXTERN void PETSC_STDCALL dmshellsetglobaltolocal_(DM *dm,void (PETSC_STDCALL *begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (PETSC_STDCALL *end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 105 { 106 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.globaltolocalbegin,(PetscVoidFunction)begin,NULL); 107 if (*ierr) return; 108 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.globaltolocalend,(PetscVoidFunction)end,NULL); 109 if (*ierr) return; 110 *ierr = DMShellSetGlobalToLocal(*dm,ourglobaltolocalbegin,ourglobaltolocalend); 111 } 112 113 PETSC_EXTERN void PETSC_STDCALL dmshellsetlocaltoglobal_(DM *dm,void (PETSC_STDCALL *begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (PETSC_STDCALL *end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 114 { 115 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtoglobalbegin,(PetscVoidFunction)begin,NULL); 116 if (*ierr) return; 117 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtoglobalend,(PetscVoidFunction)end,NULL); 118 if (*ierr) return; 119 *ierr = DMShellSetLocalToGlobal(*dm,ourlocaltoglobalbegin,ourlocaltoglobalend); 120 } 121 122 PETSC_EXTERN void PETSC_STDCALL dmshellsetlocaltolocal_(DM *dm,void (PETSC_STDCALL *begin)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),void (PETSC_STDCALL *end)(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 123 { 124 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtolocalbegin,(PetscVoidFunction)begin,NULL); 125 if (*ierr) return; 126 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtolocalend,(PetscVoidFunction)end,NULL); 127 if (*ierr) return; 128 *ierr = DMShellSetLocalToLocal(*dm,ourlocaltolocalbegin,ourlocaltolocalend); 129 } 130