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