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