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 25de64c4c2SJed Brown #undef __FUNCT__ 26de64c4c2SJed Brown #define __FUNCT__ "ourcreatematrix" 270ec63f53SRichard Tran Mills static PetscErrorCode ourcreatematrix(DM dm,MatType type,Mat *A) 280ec63f53SRichard Tran Mills { 29dc43b69eSJed Brown int len; 30dc43b69eSJed Brown char *ftype = (char*)type; 31dc43b69eSJed Brown if (type) { 32dc43b69eSJed Brown size_t slen; 33dc43b69eSJed Brown PetscStrlen(type,&slen); 34dc43b69eSJed Brown len = (int)slen; 35dc43b69eSJed Brown } else { 36dc43b69eSJed Brown type = PETSC_NULL_CHARACTER_Fortran; 37dc43b69eSJed Brown len = 0; 38dc43b69eSJed Brown } 39f83b4887SSatish Balay PetscObjectUseFortranCallback(dm,_cb.creatematrix,(DM*,CHAR PETSC_MIXED_LEN_PROTO,Mat*,PetscErrorCode* PETSC_END_LEN_PROTO), 40dc43b69eSJed Brown (&dm,ftype PETSC_MIXED_LEN_CALL(len),A,&ierr PETSC_END_LEN_CALL(len))); 41dc43b69eSJed Brown return 0; 420ec63f53SRichard Tran Mills } 430ec63f53SRichard Tran Mills 44de64c4c2SJed Brown #undef __FUNCT__ 45de64c4c2SJed Brown #define __FUNCT__ "ourcreateglobalvector" 460ec63f53SRichard Tran Mills static PetscErrorCode ourcreateglobalvector(DM dm,Vec *v) 470ec63f53SRichard Tran Mills { 48dc43b69eSJed Brown PetscObjectUseFortranCallback(dm,_cb.createglobalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 49dc43b69eSJed Brown return 0; 500ec63f53SRichard Tran Mills } 510ec63f53SRichard Tran Mills 52de64c4c2SJed Brown #undef __FUNCT__ 53de64c4c2SJed Brown #define __FUNCT__ "ourcreatelocalvector" 54dc43b69eSJed Brown static PetscErrorCode ourcreatelocalvector(DM dm,Vec *v) 550ec63f53SRichard Tran Mills { 56dc43b69eSJed Brown PetscObjectUseFortranCallback(dm,_cb.createlocalvector,(DM*,Vec*,PetscErrorCode*),(&dm,v,&ierr)); 57dc43b69eSJed Brown return 0; 58dc43b69eSJed Brown } 59dc43b69eSJed Brown 60dc43b69eSJed 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) 61dc43b69eSJed Brown { 62*0298fd71SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.creatematrix,(PetscVoidFunction)func,NULL); 63dc43b69eSJed Brown if (*ierr) return; 640ec63f53SRichard Tran Mills *ierr = DMShellSetCreateMatrix(*dm,ourcreatematrix); 650ec63f53SRichard Tran Mills } 660ec63f53SRichard Tran Mills 67dc43b69eSJed Brown PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreateglobalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 680ec63f53SRichard Tran Mills { 69*0298fd71SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createglobalvector,(PetscVoidFunction)func,NULL); 70dc43b69eSJed Brown if (*ierr) return; 710ec63f53SRichard Tran Mills *ierr = DMShellSetCreateGlobalVector(*dm,ourcreateglobalvector); 720ec63f53SRichard Tran Mills } 73fa59e805SSatish Balay 74dc43b69eSJed Brown PETSC_EXTERN_C void PETSC_STDCALL dmshellsetcreatelocalvector_(DM *dm,void (PETSC_STDCALL *func)(DM*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 75dc43b69eSJed Brown { 76*0298fd71SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)*dm,PETSC_FORTRAN_CALLBACK_SUBTYPE,&_cb.createlocalvector,(PetscVoidFunction)func,NULL); 77dc43b69eSJed Brown if (*ierr) return; 78dc43b69eSJed Brown *ierr = DMShellSetCreateLocalVector(*dm,ourcreatelocalvector); 79dc43b69eSJed Brown } 80