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 #undef __FUNCT__ 38 #define __FUNCT__ "ourcreatematrix" 39 static PetscErrorCode ourcreatematrix(DM dm,Mat *A) 40 { 41 PetscObjectUseFortranCallbackSubType(dm,_cb.creatematrix,(DM*,Mat*,PetscErrorCode*),(&dm,A,&ierr)); 42 } 43 44 #undef __FUNCT__ 45 #define __FUNCT__ "ourcreateglobalvector" 46 static PetscErrorCode ourcreateglobalvector(DM dm,Vec *v) 47 { 48 PetscObjectUseFortranCallbackSubType(dm,_cb.createglobalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 49 } 50 51 #undef __FUNCT__ 52 #define __FUNCT__ "ourcreatelocalvector" 53 static PetscErrorCode ourcreatelocalvector(DM dm,Vec *v) 54 { 55 PetscObjectUseFortranCallbackSubType(dm,_cb.createlocalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 56 } 57 58 #undef __FUNCT__ 59 #define __FUNCT__ "ourglobaltolocalbegin" 60 static PetscErrorCode ourglobaltolocalbegin(DM dm,Vec g,InsertMode mode,Vec l) 61 { 62 PetscObjectUseFortranCallbackSubType(dm,_cb.globaltolocalbegin,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&g,&mode,&l,&ierr)); 63 } 64 65 #undef __FUNCT__ 66 #define __FUNCT__ "ourglobaltolocalend" 67 static PetscErrorCode ourglobaltolocalend(DM dm,Vec g,InsertMode mode,Vec l) 68 { 69 PetscObjectUseFortranCallbackSubType(dm,_cb.globaltolocalend,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&g,&mode,&l,&ierr)); 70 } 71 72 #undef __FUNCT__ 73 #define __FUNCT__ "ourlocaltoglobalbegin" 74 static PetscErrorCode ourlocaltoglobalbegin(DM dm,Vec l,InsertMode mode,Vec g) 75 { 76 PetscObjectUseFortranCallbackSubType(dm,_cb.localtoglobalbegin,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&l,&mode,&g,&ierr)); 77 } 78 79 #undef __FUNCT__ 80 #define __FUNCT__ "ourlocaltoglobalend" 81 static PetscErrorCode ourlocaltoglobalend(DM dm,Vec l,InsertMode mode,Vec g) 82 { 83 PetscObjectUseFortranCallbackSubType(dm,_cb.localtoglobalend,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&l,&mode,&g,&ierr)); 84 } 85 86 #undef __FUNCT__ 87 #define __FUNCT__ "ourlocaltolocalbegin" 88 static PetscErrorCode ourlocaltolocalbegin(DM dm,Vec g,InsertMode mode,Vec l) 89 { 90 PetscObjectUseFortranCallbackSubType(dm,_cb.localtolocalbegin,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&g,&mode,&l,&ierr)); 91 } 92 93 #undef __FUNCT__ 94 #define __FUNCT__ "ourlocaltolocalend" 95 static PetscErrorCode ourlocaltolocalend(DM dm,Vec g,InsertMode mode,Vec l) 96 { 97 PetscObjectUseFortranCallbackSubType(dm,_cb.localtolocalend,(DM*,Vec*,InsertMode*,Vec*,PetscErrorCode*),(&dm,&g,&mode,&l,&ierr)); 98 } 99 100 101 PETSC_EXTERN void PETSC_STDCALL dmshellsetcreatematrix_(DM *dm,void (PETSC_STDCALL *func)(DM*,Mat*,PetscErrorCode* PETSC_END_LEN(len)),PetscErrorCode *ierr) 102 { 103 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.creatematrix,(PetscVoidFunction)func,NULL); 104 if (*ierr) return; 105 *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); 106 } 107 108 PETSC_EXTERN void PETSC_STDCALL dmshellsetcreateglobalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 109 { 110 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createglobalvector,(PetscVoidFunction)func,NULL); 111 if (*ierr) return; 112 *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); 113 } 114 115 PETSC_EXTERN void PETSC_STDCALL dmshellsetcreatelocalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 116 { 117 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createlocalvector,(PetscVoidFunction)func,NULL); 118 if (*ierr) return; 119 *ierr = DMShellSetCreateLocalVector(*dm,ourcreatelocalvector); 120 } 121 122 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) 123 { 124 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.globaltolocalbegin,(PetscVoidFunction)begin,NULL); 125 if (*ierr) return; 126 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.globaltolocalend,(PetscVoidFunction)end,NULL); 127 if (*ierr) return; 128 *ierr = DMShellSetGlobalToLocal(*dm,ourglobaltolocalbegin,ourglobaltolocalend); 129 } 130 131 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) 132 { 133 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtoglobalbegin,(PetscVoidFunction)begin,NULL); 134 if (*ierr) return; 135 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtoglobalend,(PetscVoidFunction)end,NULL); 136 if (*ierr) return; 137 *ierr = DMShellSetLocalToGlobal(*dm,ourlocaltoglobalbegin,ourlocaltoglobalend); 138 } 139 140 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) 141 { 142 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtolocalbegin,(PetscVoidFunction)begin,NULL); 143 if (*ierr) return; 144 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.localtolocalend,(PetscVoidFunction)end,NULL); 145 if (*ierr) return; 146 *ierr = DMShellSetLocalToLocal(*dm,ourlocaltolocalbegin,ourlocaltolocalend); 147 } 148