10ec63f53SRichard Tran Mills #include <petsc-private/fortranimpl.h> 20ec63f53SRichard Tran Mills #include <petscdmshell.h> /*I "petscdmshell.h" I*/ 30ec63f53SRichard Tran Mills 40ec63f53SRichard Tran Mills #if defined(PETSC_HAVE_FORTRAN_CAPS) 50ec63f53SRichard Tran Mills #define dmshellsetcreatematrix_ DMSHELLSETCREATEMATRIX 60ec63f53SRichard Tran Mills #define dmshellsetcreateglobalvector_ DMSHELLSETCREATEGLOBALVECTOR_ 7*dc43b69eSJed Brown #define dmshellsetcreatelocalvector_ DMSHELLSETCREATELOCALVECTOR_ 80ec63f53SRichard Tran Mills #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 90ec63f53SRichard Tran Mills #define dmshellsetcreatematrix_ dmshellsetcreatematrix 100ec63f53SRichard Tran Mills #define dmshellsetcreateglobalvector_ dmshellsetcreateglobalvector 11*dc43b69eSJed Brown #define dmshellsetcreatelocalvector_ dmshellsetcreatelocalvector 120ec63f53SRichard Tran Mills #endif 130ec63f53SRichard Tran Mills 140ec63f53SRichard Tran Mills /* 15*dc43b69eSJed Brown * C routines are required for matrix and global vector creation. We define C routines here that call the corresponding 16*dc43b69eSJed Brown * Fortran routine (indexed by _cb) that was set by the user. 170ec63f53SRichard Tran Mills */ 180ec63f53SRichard Tran Mills 19*dc43b69eSJed Brown static struct { 20*dc43b69eSJed Brown PetscFortranCallbackId creatematrix; 21*dc43b69eSJed Brown PetscFortranCallbackId createglobalvector; 22*dc43b69eSJed Brown PetscFortranCallbackId createlocalvector; 23*dc43b69eSJed Brown } _cb; 24*dc43b69eSJed Brown 250ec63f53SRichard Tran Mills static PetscErrorCode ourcreatematrix(DM dm,MatType type,Mat *A) 260ec63f53SRichard Tran Mills { 27*dc43b69eSJed Brown int len; 28*dc43b69eSJed Brown char *ftype = (char*)type; 29*dc43b69eSJed Brown if (type) { 30*dc43b69eSJed Brown size_t slen; 31*dc43b69eSJed Brown PetscStrlen(type,&slen); 32*dc43b69eSJed Brown len = (int)slen; 33*dc43b69eSJed Brown } else { 34*dc43b69eSJed Brown type = PETSC_NULL_CHARACTER_Fortran; 35*dc43b69eSJed Brown len = 0; 36*dc43b69eSJed Brown } 37*dc43b69eSJed Brown PetscObjectUseFortranCallback(dm,_cb.creatematrix,(DM*,CHAR PETSC_MIXED_LEN(),Mat*,PetscErrorCode* PETSC_END_LEN()), 38*dc43b69eSJed Brown (&dm,ftype PETSC_MIXED_LEN_CALL(len),A,&ierr PETSC_END_LEN_CALL(len))); 39*dc43b69eSJed Brown return 0; 400ec63f53SRichard Tran Mills } 410ec63f53SRichard Tran Mills 420ec63f53SRichard Tran Mills static PetscErrorCode ourcreateglobalvector(DM dm,Vec *v) 430ec63f53SRichard Tran Mills { 44*dc43b69eSJed Brown PetscObjectUseFortranCallback(dm,_cb.createglobalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 45*dc43b69eSJed Brown return 0; 460ec63f53SRichard Tran Mills } 470ec63f53SRichard Tran Mills 48*dc43b69eSJed Brown static PetscErrorCode ourcreatelocalvector(DM dm,Vec *v) 490ec63f53SRichard Tran Mills { 50*dc43b69eSJed Brown PetscObjectUseFortranCallback(dm,_cb.createlocalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 51*dc43b69eSJed Brown return 0; 52*dc43b69eSJed Brown } 53*dc43b69eSJed Brown 54*dc43b69eSJed Brown 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*dc43b69eSJed Brown { 56*dc43b69eSJed Brown *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.creatematrix,(PetscVoidFunction)func,PETSC_NULL); 57*dc43b69eSJed Brown if (*ierr) return; 580ec63f53SRichard Tran Mills *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); 590ec63f53SRichard Tran Mills } 600ec63f53SRichard Tran Mills 61*dc43b69eSJed Brown PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreateglobalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 620ec63f53SRichard Tran Mills { 63*dc43b69eSJed Brown *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createglobalvector,(PetscVoidFunction)func,PETSC_NULL); 64*dc43b69eSJed Brown if (*ierr) return; 650ec63f53SRichard Tran Mills *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); 660ec63f53SRichard Tran Mills } 67fa59e805SSatish Balay 68*dc43b69eSJed Brown PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreatelocalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 69*dc43b69eSJed Brown { 70*dc43b69eSJed Brown *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createlocalvector,(PetscVoidFunction)func,PETSC_NULL); 71*dc43b69eSJed Brown if (*ierr) return; 72*dc43b69eSJed Brown *ierr = DMShellSetCreateLocalVector(*dm,ourcreatelocalvector); 73*dc43b69eSJed Brown } 74