1 #include <petsc/private/fortranimpl.h> 2 #include <petscmat.h> 3 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 13 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; 18 19 CHKFORTRANNULLOBJECT(is_row); 20 CHKFORTRANNULLOBJECT(is_col); 21 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 } 33 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 } 40 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; 45 46 CHKFORTRANNULLINTEGER(M); 47 CHKFORTRANNULLINTEGER(N); 48 CHKFORTRANNULLOBJECT(sub); 49 50 *ierr = MatNestGetSubMats(*A, &m, &n, &mat); 51 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 } 66