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 #undef __FUNCT__ 26 #define __FUNCT__ "ourcreatematrix" 27 static PetscErrorCode ourcreatematrix(DM dm,MatType type,Mat *A) 28 { 29 int len; 30 char *ftype = (char*)type; 31 if (type) { 32 size_t slen; 33 PetscStrlen(type,&slen); 34 len = (int)slen; 35 } else { 36 type = PETSC_NULL_CHARACTER_Fortran; 37 len = 0; 38 } 39 PetscObjectUseFortranCallback(dm,_cb.creatematrix,(DM*,CHAR PETSC_MIXED_LEN_PROTO,Mat*,PetscErrorCode* PETSC_END_LEN_PROTO), 40 (&dm,ftype PETSC_MIXED_LEN_CALL(len),A,&ierr PETSC_END_LEN_CALL(len))); 41 return 0; 42 } 43 44 #undef __FUNCT__ 45 #define __FUNCT__ "ourcreateglobalvector" 46 static PetscErrorCode ourcreateglobalvector(DM dm,Vec *v) 47 { 48 PetscObjectUseFortranCallback(dm,_cb.createglobalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 49 return 0; 50 } 51 52 #undef __FUNCT__ 53 #define __FUNCT__ "ourcreatelocalvector" 54 static PetscErrorCode ourcreatelocalvector(DM dm,Vec *v) 55 { 56 PetscObjectUseFortranCallback(dm,_cb.createlocalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 57 return 0; 58 } 59 60 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) 61 { 62 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.creatematrix,(PetscVoidFunction)func,NULL); 63 if (*ierr) return; 64 *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); 65 } 66 67 PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreateglobalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 68 { 69 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createglobalvector,(PetscVoidFunction)func,NULL); 70 if (*ierr) return; 71 *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); 72 } 73 74 PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreatelocalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 75 { 76 *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createlocalvector,(PetscVoidFunction)func,NULL); 77 if (*ierr) return; 78 *ierr = DMShellSetCreateLocalVector(*dm,ourcreatelocalvector); 79 } 80