1*f4e70085SSatish Balay #include "zpetsc.h" 2*f4e70085SSatish Balay #include "petscmat.h" 3*f4e70085SSatish Balay 4*f4e70085SSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS) 5*f4e70085SSatish Balay #define matshellsetoperation_ MATSHELLSETOPERATION 6*f4e70085SSatish Balay #define matcreateshell_ MATCREATESHELL 7*f4e70085SSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 8*f4e70085SSatish Balay #define matcreateshell_ matcreateshell 9*f4e70085SSatish Balay #define matshellsetoperation_ matshellsetoperation 10*f4e70085SSatish Balay #endif 11*f4e70085SSatish Balay 12*f4e70085SSatish Balay EXTERN_C_BEGIN 13*f4e70085SSatish Balay 14*f4e70085SSatish Balay /* 15*f4e70085SSatish Balay The MatShell Matrix Vector product requires a C routine. 16*f4e70085SSatish Balay This C routine then calls the corresponding Fortran routine that was 17*f4e70085SSatish Balay set by the user. 18*f4e70085SSatish Balay */ 19*f4e70085SSatish Balay void PETSC_STDCALL matcreateshell_(MPI_Comm *comm,PetscInt *m,PetscInt *n,PetscInt *M,PetscInt *N,void **ctx,Mat *mat,PetscErrorCode *ierr) 20*f4e70085SSatish Balay { 21*f4e70085SSatish Balay *ierr = MatCreateShell((MPI_Comm)PetscToPointerComm(*comm),*m,*n,*M,*N,*ctx,mat); 22*f4e70085SSatish Balay if (*ierr) return; 23*f4e70085SSatish Balay *ierr = PetscMalloc(4*sizeof(void*),&((PetscObject)*mat)->fortran_func_pointers); 24*f4e70085SSatish Balay } 25*f4e70085SSatish Balay 26*f4e70085SSatish Balay static PetscErrorCode ourmult(Mat mat,Vec x,Vec y) 27*f4e70085SSatish Balay { 28*f4e70085SSatish Balay PetscErrorCode ierr = 0; 29*f4e70085SSatish Balay (*(PetscErrorCode (PETSC_STDCALL *)(Mat*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[0]))(&mat,&x,&y,&ierr); 30*f4e70085SSatish Balay return ierr; 31*f4e70085SSatish Balay } 32*f4e70085SSatish Balay 33*f4e70085SSatish Balay static PetscErrorCode ourmulttranspose(Mat mat,Vec x,Vec y) 34*f4e70085SSatish Balay { 35*f4e70085SSatish Balay PetscErrorCode ierr = 0; 36*f4e70085SSatish Balay (*(PetscErrorCode (PETSC_STDCALL *)(Mat*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[2]))(&mat,&x,&y,&ierr); 37*f4e70085SSatish Balay return ierr; 38*f4e70085SSatish Balay } 39*f4e70085SSatish Balay 40*f4e70085SSatish Balay static PetscErrorCode ourmultadd(Mat mat,Vec x,Vec y,Vec z) 41*f4e70085SSatish Balay { 42*f4e70085SSatish Balay PetscErrorCode ierr = 0; 43*f4e70085SSatish Balay (*(PetscErrorCode (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[1]))(&mat,&x,&y,&z,&ierr); 44*f4e70085SSatish Balay return ierr; 45*f4e70085SSatish Balay } 46*f4e70085SSatish Balay 47*f4e70085SSatish Balay static PetscErrorCode ourmulttransposeadd(Mat mat,Vec x,Vec y,Vec z) 48*f4e70085SSatish Balay { 49*f4e70085SSatish Balay PetscErrorCode ierr = 0; 50*f4e70085SSatish Balay (*(PetscErrorCode (PETSC_STDCALL *)(Mat*,Vec*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)mat)->fortran_func_pointers[3]))(&mat,&x,&y,&z,&ierr); 51*f4e70085SSatish Balay return ierr; 52*f4e70085SSatish Balay } 53*f4e70085SSatish Balay 54*f4e70085SSatish Balay void PETSC_STDCALL matshellsetoperation_(Mat *mat,MatOperation *op,PetscErrorCode (PETSC_STDCALL *f)(Mat*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr) 55*f4e70085SSatish Balay { 56*f4e70085SSatish Balay if (*op == MATOP_MULT) { 57*f4e70085SSatish Balay *ierr = MatShellSetOperation(*mat,*op,(FCNVOID)ourmult); 58*f4e70085SSatish Balay ((PetscObject)*mat)->fortran_func_pointers[0] = (FCNVOID)f; 59*f4e70085SSatish Balay } else if (*op == MATOP_MULT_TRANSPOSE) { 60*f4e70085SSatish Balay *ierr = MatShellSetOperation(*mat,*op,(FCNVOID)ourmulttranspose); 61*f4e70085SSatish Balay ((PetscObject)*mat)->fortran_func_pointers[2] = (FCNVOID)f; 62*f4e70085SSatish Balay } else if (*op == MATOP_MULT_ADD) { 63*f4e70085SSatish Balay *ierr = MatShellSetOperation(*mat,*op,(FCNVOID)ourmultadd); 64*f4e70085SSatish Balay ((PetscObject)*mat)->fortran_func_pointers[1] = (FCNVOID)f; 65*f4e70085SSatish Balay } else if (*op == MATOP_MULT_TRANSPOSE_ADD) { 66*f4e70085SSatish Balay *ierr = MatShellSetOperation(*mat,*op,(FCNVOID)ourmulttransposeadd); 67*f4e70085SSatish Balay ((PetscObject)*mat)->fortran_func_pointers[3] = (FCNVOID)f; 68*f4e70085SSatish Balay } else { 69*f4e70085SSatish Balay PetscError(__LINE__,"MatShellSetOperation_Fortran",__FILE__,__SDIR__,1,0, 70*f4e70085SSatish Balay "Cannot set that matrix operation"); 71*f4e70085SSatish Balay *ierr = 1; 72*f4e70085SSatish Balay } 73*f4e70085SSatish Balay } 74*f4e70085SSatish Balay 75*f4e70085SSatish Balay EXTERN_C_END 76