16dd63270SBarry Smith #include <petsc/private/ftnimpl.h> 2c6db04a5SJed Brown #include <petscmat.h> 3665c2dedSJed Brown #include <petscviewer.h> 4f4e70085SSatish Balay 5f4e70085SSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS) 67d6bfa3bSBarry Smith #define matdestroymatrices_ MATDESTROYMATRICES 7df750dc8SHong Zhang #define matdestroysubmatrices_ MATDESTROYSUBMATRICES 87dae84e0SHong Zhang #define matcreatesubmatrices_ MATCREATESUBMATRICES 981ec7b92Smarius #define matcreatesubmatricesmpi_ MATCREATESUBMATRICESMPI 10b22b330cSBarry Smith #define matnullspacesetfunction_ MATNULLSPACESETFUNCTION 110905d9aaSJed Brown #define matfindnonzerorows_ MATFINDNONZEROROWS 12f4e70085SSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 135928be6bSBarry Smith #define matdestroymatrices_ matdestroymatrices 14df750dc8SHong Zhang #define matdestroysubmatrices_ matdestroysubmatrices 157dae84e0SHong Zhang #define matcreatesubmatrices_ matcreatesubmatrices 1681ec7b92Smarius #define matcreatesubmatricesmpi_ matcreatesubmatricesmpi 17b22b330cSBarry Smith #define matnullspacesetfunction_ matnullspacesetfunction 180905d9aaSJed Brown #define matfindnonzerorows_ matfindnonzerorows 19f4e70085SSatish Balay #endif 20f4e70085SSatish Balay 21*2a8381b2SBarry Smith static PetscErrorCode ournullfunction(MatNullSpace sp, Vec x, PetscCtx ctx) 22b22b330cSBarry Smith { 239566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*(void (*)(MatNullSpace *, Vec *, void *, PetscErrorCode *))(((PetscObject)sp)->fortran_func_pointers[0]))(&sp, &x, ctx, &ierr)); 243ba16761SJacob Faibussowitsch return PETSC_SUCCESS; 25b22b330cSBarry Smith } 26b22b330cSBarry Smith 27*2a8381b2SBarry Smith PETSC_EXTERN void matnullspacesetfunction_(MatNullSpace *sp, PetscErrorCode (*rem)(MatNullSpace, Vec, void *), PetscCtx ctx, PetscErrorCode *ierr) 28b22b330cSBarry Smith { 29b22b330cSBarry Smith PetscObjectAllocateFortranPointers(*sp, 1); 305ebfa9e9SBarry Smith ((PetscObject)*sp)->fortran_func_pointers[0] = (PetscFortranCallbackFn *)rem; 3126fbe8dcSKarl Rupp 32b22b330cSBarry Smith *ierr = MatNullSpaceSetFunction(*sp, ournullfunction, ctx); 33b22b330cSBarry Smith } 34b22b330cSBarry Smith 35ce78bad3SBarry Smith PETSC_EXTERN void matcreatesubmatrices_(Mat *mat, PetscInt *n, IS *isrow, IS *iscol, MatReuse *scall, F90Array1d *ptr, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd)) 36f4e70085SSatish Balay { 37f4e70085SSatish Balay Mat *lsmat; 38f4e70085SSatish Balay 39f4e70085SSatish Balay if (*scall == MAT_INITIAL_MATRIX) { 407dae84e0SHong Zhang *ierr = MatCreateSubMatrices(*mat, *n, isrow, iscol, *scall, &lsmat); 41ce78bad3SBarry Smith *ierr = F90Array1dCreate(lsmat, MPIU_FORTRANADDR, 1, *n + 1, ptr PETSC_F90_2PTR_PARAM(ptrd)); 42f4e70085SSatish Balay } else { 43ce78bad3SBarry Smith *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd)); 44ce78bad3SBarry Smith *ierr = MatCreateSubMatrices(*mat, *n, isrow, iscol, *scall, &lsmat); 45f4e70085SSatish Balay } 46f4e70085SSatish Balay } 47f4e70085SSatish Balay 48ce78bad3SBarry Smith PETSC_EXTERN void matcreatesubmatricesmpi_(Mat *mat, PetscInt *n, IS *isrow, IS *iscol, MatReuse *scall, F90Array1d *ptr, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd)) 4981ec7b92Smarius { 5081ec7b92Smarius Mat *lsmat; 5181ec7b92Smarius 5281ec7b92Smarius if (*scall == MAT_INITIAL_MATRIX) { 5381ec7b92Smarius *ierr = MatCreateSubMatricesMPI(*mat, *n, isrow, iscol, *scall, &lsmat); 54ce78bad3SBarry Smith if (*ierr) return; 55ce78bad3SBarry Smith *ierr = F90Array1dCreate(lsmat, MPIU_FORTRANADDR, 1, *n + 1, ptr PETSC_F90_2PTR_PARAM(ptrd)); 5681ec7b92Smarius } else { 57ce78bad3SBarry Smith *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd)); 58ce78bad3SBarry Smith if (*ierr) return; 59ce78bad3SBarry Smith *ierr = MatCreateSubMatricesMPI(*mat, *n, isrow, iscol, *scall, &lsmat); 6081ec7b92Smarius } 6181ec7b92Smarius } 6281ec7b92Smarius 63ce78bad3SBarry Smith PETSC_EXTERN void matdestroymatrices_(PetscInt *n, F90Array1d *ptr, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd)) 64de7ef04eSHong Zhang { 65de7ef04eSHong Zhang PetscInt i; 66ce78bad3SBarry Smith Mat *lsmat; 67de7ef04eSHong Zhang 68ce78bad3SBarry Smith *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd)); 695975b3b6SBarry Smith if (*ierr) return; 70ce78bad3SBarry Smith for (i = 0; i < *n; i++) { 71ce78bad3SBarry Smith PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(&lsmat[i]); 72ce78bad3SBarry Smith *ierr = MatDestroy(&lsmat[i]); 73ce78bad3SBarry Smith if (*ierr) return; 74de7ef04eSHong Zhang } 75ce78bad3SBarry Smith *ierr = F90Array1dDestroy(ptr, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd)); 76ce78bad3SBarry Smith if (*ierr) return; 77ce78bad3SBarry Smith *ierr = PetscFree(lsmat); 78de7ef04eSHong Zhang } 79de7ef04eSHong Zhang 80ce78bad3SBarry Smith PETSC_EXTERN void matdestroysubmatrices_(PetscInt *n, F90Array1d *ptr, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd)) 817d6bfa3bSBarry Smith { 82de7ef04eSHong Zhang Mat *lsmat; 837d6bfa3bSBarry Smith 840764c050SBarry Smith if (*n == 0) return; 85ce78bad3SBarry Smith *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd)); 865d83a8b1SBarry Smith if (*ierr) return; 87de7ef04eSHong Zhang *ierr = MatDestroySubMatrices(*n, &lsmat); 885d83a8b1SBarry Smith if (*ierr) return; 89ce78bad3SBarry Smith *ierr = F90Array1dDestroy(ptr, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd)); 90ce78bad3SBarry Smith if (*ierr) return; 91ce78bad3SBarry Smith *ierr = PetscFree(lsmat); 921fb7b255SJunchao Zhang } 93