1 #include <petsc/private/ftnimpl.h> 2 #include <petscmat.h> 3 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 11 12 PETSC_EXTERN void matcreatenestNOTTODAY_(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; 16 17 CHKFORTRANNULLOBJECT(is_row); 18 CHKFORTRANNULLOBJECT(is_col); 19 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 } 31 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; 36 37 CHKFORTRANNULLINTEGER(M); 38 CHKFORTRANNULLINTEGER(N); 39 CHKFORTRANNULLOBJECT(sub); 40 41 *ierr = MatNestGetSubMats(*A, &m, &n, &mat); 42 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 } 57