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 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9 #define dmshellsetcreatematrix_ dmshellsetcreatematrix 10 #define dmshellsetcreateglobalvector_ dmshellsetcreateglobalvector 11 #define dmshellsetcreatelocalvector_ dmshellsetcreatelocalvector 12 #endif 13 14 /* 15 * C routines are required for matrix and global vector creation. We define C routines here that call the corresponding 16 * Fortran routine (indexed by _cb) that was set by the user. 17 */ 18 19 static struct { 20 PetscFortranCallbackId creatematrix; 21 PetscFortranCallbackId createglobalvector; 22 PetscFortranCallbackId createlocalvector; 23 } _cb; 24 25 static PetscErrorCode ourcreatematrix(DM dm,MatType type,Mat *A) 26 { 27 int len; 28 char *ftype = (char*)type; 29 if (type) { 30 size_t slen; 31 PetscStrlen(type,&slen); 32 len = (int)slen; 33 } else { 34 type = PETSC_NULL_CHARACTER_Fortran; 35 len = 0; 36 } 37 PetscObjectUseFortranCallback(dm,_cb.creatematrix,(DM*,CHAR PETSC_MIXED_LEN_PROTO,Mat*,PetscErrorCode* PETSC_END_LEN_PROTO), 38 (&dm,ftype PETSC_MIXED_LEN_CALL(len),A,&ierr PETSC_END_LEN_CALL(len))); 39 return 0; 40 } 41 42 static PetscErrorCode ourcreateglobalvector(DM dm,Vec *v) 43 { 44 PetscObjectUseFortranCallback(dm,_cb.createglobalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 45 return 0; 46 } 47 48 static PetscErrorCode ourcreatelocalvector(DM dm,Vec *v) 49 { 50 PetscObjectUseFortranCallback(dm,_cb.createlocalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 51 return 0; 52 } 53 54 PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreatematrix_(DM *dm,void (PETSC_STDCALL *func)(DM*,CHAR type PETSC_MIXED_LEN(len),Mat*,PetscErrorCode* PETSC_END_LEN(len)),PetscErrorCode *ierr) 55 { 56 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.creatematrix,(PetscVoidFunction)func,PETSC_NULL); 57 if (*ierr) return; 58 *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); 59 } 60 61 PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreateglobalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 62 { 63 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createglobalvector,(PetscVoidFunction)func,PETSC_NULL); 64 if (*ierr) return; 65 *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); 66 } 67 68 PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreatelocalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 69 { 70 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createlocalvector,(PetscVoidFunction)func,PETSC_NULL); 71 if (*ierr) return; 72 *ierr = DMShellSetCreateLocalVector(*dm,ourcreatelocalvector); 73 } 74