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