1: #include <petsc/private/ftnimpl.h>
  2: #include <petscmat.h>
  3: #include <petscviewer.h>

  5: #if PetscDefined(HAVE_FORTRAN_CAPS)
  6:   #define matdestroymatrices_      MATDESTROYMATRICES
  7:   #define matdestroysubmatrices_   MATDESTROYSUBMATRICES
  8:   #define matcreatesubmatrices_    MATCREATESUBMATRICES
  9:   #define matcreatesubmatricesmpi_ MATCREATESUBMATRICESMPI
 10:   #define matnullspacesetfunction_ MATNULLSPACESETFUNCTION
 11:   #define matfindnonzerorows_      MATFINDNONZEROROWS
 12: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
 13:   #define matdestroymatrices_      matdestroymatrices
 14:   #define matdestroysubmatrices_   matdestroysubmatrices
 15:   #define matcreatesubmatrices_    matcreatesubmatrices
 16:   #define matcreatesubmatricesmpi_ matcreatesubmatricesmpi
 17:   #define matnullspacesetfunction_ matnullspacesetfunction
 18:   #define matfindnonzerorows_      matfindnonzerorows
 19: #endif

 21: static PetscErrorCode ournullfunction(MatNullSpace sp, Vec x, PetscCtx ctx)
 22: {
 23:   PetscCallFortranVoidFunction((*(void (*)(MatNullSpace *, Vec *, void *, PetscErrorCode *))(((PetscObject)sp)->fortran_func_pointers[0]))(&sp, &x, ctx, &ierr));
 24:   return PETSC_SUCCESS;
 25: }

 27: PETSC_EXTERN void matnullspacesetfunction_(MatNullSpace *sp, PetscErrorCode (*rem)(MatNullSpace, Vec, void *), PetscCtx ctx, PetscErrorCode *ierr)
 28: {
 29:   PetscObjectAllocateFortranPointers(*sp, 1);
 30:   ((PetscObject)*sp)->fortran_func_pointers[0] = (PetscFortranCallbackFn *)rem;

 32:   *ierr = MatNullSpaceSetFunction(*sp, ournullfunction, ctx);
 33: }

 35: PETSC_EXTERN void matcreatesubmatrices_(Mat *mat, PetscInt *n, IS *irow, IS *icol, MatReuse *scall, F90Array1d *submat, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
 36: {
 37:   Mat *lsmat;

 39:   if (*scall == MAT_INITIAL_MATRIX) {
 40:     *ierr = MatCreateSubMatrices(*mat, *n, irow, icol, *scall, &lsmat);
 41:     *ierr = F90Array1dCreate(lsmat, MPIU_FORTRANADDR, 1, *n + 1, submat PETSC_F90_2PTR_PARAM(ptrd));
 42:   } else {
 43:     *ierr = F90Array1dAccess(submat, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd));
 44:     *ierr = MatCreateSubMatrices(*mat, *n, irow, icol, *scall, &lsmat);
 45:   }
 46: }

 48: PETSC_EXTERN void matcreatesubmatricesmpi_(Mat *mat, PetscInt *n, IS *irow, IS *icol, MatReuse *scall, F90Array1d *submat, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
 49: {
 50:   Mat *lsmat;

 52:   if (*scall == MAT_INITIAL_MATRIX) {
 53:     *ierr = MatCreateSubMatricesMPI(*mat, *n, irow, icol, *scall, &lsmat);
 54:     if (*ierr) return;
 55:     *ierr = F90Array1dCreate(lsmat, MPIU_FORTRANADDR, 1, *n + 1, submat PETSC_F90_2PTR_PARAM(ptrd));
 56:   } else {
 57:     *ierr = F90Array1dAccess(submat, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd));
 58:     if (*ierr) return;
 59:     *ierr = MatCreateSubMatricesMPI(*mat, *n, irow, icol, *scall, &lsmat);
 60:   }
 61: }

 63: PETSC_EXTERN void matdestroymatrices_(PetscInt *n, F90Array1d *mat, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
 64: {
 65:   Mat *lsmat;

 67:   *ierr = F90Array1dAccess(mat, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd));
 68:   if (*ierr) return;
 69:   for (PetscInt i = 0; i < *n; i++) {
 70:     PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(&lsmat[i]);
 71:     *ierr = MatDestroy(&lsmat[i]);
 72:     if (*ierr) return;
 73:   }
 74:   *ierr = F90Array1dDestroy(mat, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
 75:   if (*ierr) return;
 76:   *ierr = PetscFree(lsmat);
 77: }

 79: PETSC_EXTERN void matdestroysubmatrices_(PetscInt *n, F90Array1d *mat, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
 80: {
 81:   Mat *lsmat;

 83:   if (*n == 0) return;
 84:   *ierr = F90Array1dAccess(mat, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd));
 85:   if (*ierr) return;
 86:   *ierr = MatDestroySubMatrices(*n, &lsmat);
 87:   if (*ierr) return;
 88:   *ierr = F90Array1dDestroy(mat, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
 89:   if (*ierr) return;
 90:   *ierr = PetscFree(lsmat);
 91: }