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 matnestgetiss_ MATNESTGETISS
7: #define matnestgetsubmats_ MATNESTGETSUBMATS
8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
9: #define matcreatenest_ matcreatenest
10: #define matnestgetiss_ matnestgetiss
11: #define matnestgetsubmats_ matnestgetsubmats
12: #endif
14: PETSC_EXTERN void matcreatenest_(MPI_Fint *comm, PetscInt *nr, IS is_row[], PetscInt *nc, IS is_col[], Mat a[], Mat *B, int *ierr)
15: {
16: Mat *m, *tmp;
17: PetscInt i;
19: CHKFORTRANNULLOBJECT(is_row);
20: CHKFORTRANNULLOBJECT(is_col);
22: *ierr = PetscMalloc1((*nr) * (*nc), &m);
23: if (*ierr) return;
24: for (i = 0; i < (*nr) * (*nc); i++) {
25: tmp = &a[i];
26: CHKFORTRANNULLOBJECT(tmp);
27: m[i] = (tmp == NULL ? NULL : a[i]);
28: }
29: *ierr = MatCreateNest(MPI_Comm_f2c(*comm), *nr, is_row, *nc, is_col, m, B);
30: if (*ierr) return;
31: *ierr = PetscFree(m);
32: }
34: PETSC_EXTERN void matnestgetiss_(Mat *A, IS rows[], IS cols[], int *ierr)
35: {
36: CHKFORTRANNULLOBJECT(rows);
37: CHKFORTRANNULLOBJECT(cols);
38: *ierr = MatNestGetISs(*A, rows, cols);
39: }
41: PETSC_EXTERN void matnestgetsubmats_(Mat *A, PetscInt *M, PetscInt *N, Mat *sub, int *ierr)
42: {
43: PetscInt i, j, m, n;
44: Mat **mat;
46: CHKFORTRANNULLINTEGER(M);
47: CHKFORTRANNULLINTEGER(N);
48: CHKFORTRANNULLOBJECT(sub);
50: *ierr = MatNestGetSubMats(*A, &m, &n, &mat);
52: if (M) { *M = m; }
53: if (N) { *N = n; }
54: if (sub) {
55: for (i = 0; i < m; i++) {
56: for (j = 0; j < n; j++) {
57: if (mat[i][j]) {
58: sub[j + n * i] = mat[i][j];
59: } else {
60: sub[j + n * i] = (Mat)-1;
61: }
62: }
63: }
64: }
65: }