Actual source code: zmatnestf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscmat.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define matcreatenest_ MATCREATENEST
6: #define matnestgetsubmats_ MATNESTGETSUBMATS
7: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
8: #define matcreatenest_ matcreatenest
9: #define matnestgetsubmats_ matnestgetsubmats
10: #endif
12: PETSC_EXTERN void matcreatenest_(MPI_Fint *comm, PetscInt *nr, IS is_row[], PetscInt *nc, IS is_col[], Mat a[], Mat *B, int *ierr)
13: {
14: Mat *m, *tmp;
15: PetscInt i;
17: CHKFORTRANNULLOBJECT(is_row);
18: CHKFORTRANNULLOBJECT(is_col);
20: *ierr = PetscMalloc1((*nr) * (*nc), &m);
21: if (*ierr) return;
22: for (i = 0; i < (*nr) * (*nc); i++) {
23: tmp = &a[i];
24: CHKFORTRANNULLOBJECT(tmp);
25: m[i] = (tmp == NULL ? NULL : a[i]);
26: }
27: *ierr = MatCreateNest(MPI_Comm_f2c(*comm), *nr, is_row, *nc, is_col, m, B);
28: if (*ierr) return;
29: *ierr = PetscFree(m);
30: }
32: PETSC_EXTERN void matnestgetsubmats_(Mat *A, PetscInt *M, PetscInt *N, Mat *sub, int *ierr)
33: {
34: PetscInt i, j, m, n;
35: Mat **mat;
37: CHKFORTRANNULLINTEGER(M);
38: CHKFORTRANNULLINTEGER(N);
39: CHKFORTRANNULLOBJECT(sub);
41: *ierr = MatNestGetSubMats(*A, &m, &n, &mat);
43: if (M) { *M = m; }
44: if (N) { *N = n; }
45: if (sub) {
46: for (i = 0; i < m; i++) {
47: for (j = 0; j < n; j++) {
48: if (mat[i][j]) {
49: sub[j + n * i] = mat[i][j];
50: } else {
51: sub[j + n * i] = (Mat)-1;
52: }
53: }
54: }
55: }
56: }