1 #include <petsc/private/ftnimpl.h>
2 #include <petscmat.h>
3 #include <petscviewer.h>
4
5 #if defined(PETSC_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 !defined(PETSC_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
20
ournullfunction(MatNullSpace sp,Vec x,PetscCtx ctx)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 }
26
matnullspacesetfunction_(MatNullSpace * sp,PetscErrorCode (* rem)(MatNullSpace,Vec,void *),PetscCtx ctx,PetscErrorCode * ierr)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;
31
32 *ierr = MatNullSpaceSetFunction(*sp, ournullfunction, ctx);
33 }
34
matcreatesubmatrices_(Mat * mat,PetscInt * n,IS * isrow,IS * iscol,MatReuse * scall,F90Array1d * ptr,PetscErrorCode * ierr PETSC_F90_2PTR_PROTO (ptrd))35 PETSC_EXTERN void matcreatesubmatrices_(Mat *mat, PetscInt *n, IS *isrow, IS *iscol, MatReuse *scall, F90Array1d *ptr, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
36 {
37 Mat *lsmat;
38
39 if (*scall == MAT_INITIAL_MATRIX) {
40 *ierr = MatCreateSubMatrices(*mat, *n, isrow, iscol, *scall, &lsmat);
41 *ierr = F90Array1dCreate(lsmat, MPIU_FORTRANADDR, 1, *n + 1, ptr PETSC_F90_2PTR_PARAM(ptrd));
42 } else {
43 *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd));
44 *ierr = MatCreateSubMatrices(*mat, *n, isrow, iscol, *scall, &lsmat);
45 }
46 }
47
matcreatesubmatricesmpi_(Mat * mat,PetscInt * n,IS * isrow,IS * iscol,MatReuse * scall,F90Array1d * ptr,PetscErrorCode * ierr PETSC_F90_2PTR_PROTO (ptrd))48 PETSC_EXTERN void matcreatesubmatricesmpi_(Mat *mat, PetscInt *n, IS *isrow, IS *iscol, MatReuse *scall, F90Array1d *ptr, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
49 {
50 Mat *lsmat;
51
52 if (*scall == MAT_INITIAL_MATRIX) {
53 *ierr = MatCreateSubMatricesMPI(*mat, *n, isrow, iscol, *scall, &lsmat);
54 if (*ierr) return;
55 *ierr = F90Array1dCreate(lsmat, MPIU_FORTRANADDR, 1, *n + 1, ptr PETSC_F90_2PTR_PARAM(ptrd));
56 } else {
57 *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd));
58 if (*ierr) return;
59 *ierr = MatCreateSubMatricesMPI(*mat, *n, isrow, iscol, *scall, &lsmat);
60 }
61 }
62
matdestroymatrices_(PetscInt * n,F90Array1d * ptr,PetscErrorCode * ierr PETSC_F90_2PTR_PROTO (ptrd))63 PETSC_EXTERN void matdestroymatrices_(PetscInt *n, F90Array1d *ptr, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
64 {
65 PetscInt i;
66 Mat *lsmat;
67
68 *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd));
69 if (*ierr) return;
70 for (i = 0; i < *n; i++) {
71 PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(&lsmat[i]);
72 *ierr = MatDestroy(&lsmat[i]);
73 if (*ierr) return;
74 }
75 *ierr = F90Array1dDestroy(ptr, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
76 if (*ierr) return;
77 *ierr = PetscFree(lsmat);
78 }
79
matdestroysubmatrices_(PetscInt * n,F90Array1d * ptr,PetscErrorCode * ierr PETSC_F90_2PTR_PROTO (ptrd))80 PETSC_EXTERN void matdestroysubmatrices_(PetscInt *n, F90Array1d *ptr, PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptrd))
81 {
82 Mat *lsmat;
83
84 if (*n == 0) return;
85 *ierr = F90Array1dAccess(ptr, MPIU_FORTRANADDR, (void **)&lsmat PETSC_F90_2PTR_PARAM(ptrd));
86 if (*ierr) return;
87 *ierr = MatDestroySubMatrices(*n, &lsmat);
88 if (*ierr) return;
89 *ierr = F90Array1dDestroy(ptr, MPIU_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));
90 if (*ierr) return;
91 *ierr = PetscFree(lsmat);
92 }
93