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); if (*ierr) return; 23 for (i=0; i<(*nr)*(*nc); i++) { 24 tmp = &(a[i]); 25 CHKFORTRANNULLOBJECT(tmp); 26 m[i] = (tmp == NULL ? NULL : a[i]); 27 } 28 *ierr = MatCreateNest(MPI_Comm_f2c(*comm),*nr,is_row,*nc,is_col,m,B); if (*ierr) return; 29 *ierr = PetscFree(m); 30 } 31 32 PETSC_EXTERN void matnestgetiss_(Mat *A,IS rows[],IS cols[], int *ierr) 33 { 34 CHKFORTRANNULLOBJECT(rows); 35 CHKFORTRANNULLOBJECT(cols); 36 *ierr = MatNestGetISs(*A,rows,cols); 37 } 38 39 PETSC_EXTERN void matnestgetsubmats_(Mat *A,PetscInt *M,PetscInt *N,Mat *sub,int *ierr) 40 { 41 PetscInt i,j,m,n; 42 Mat **mat; 43 44 CHKFORTRANNULLINTEGER(M); 45 CHKFORTRANNULLINTEGER(N); 46 CHKFORTRANNULLOBJECT(sub); 47 48 *ierr = MatNestGetSubMats(*A,&m,&n,&mat); 49 50 if (M) { 51 *M = m; 52 } 53 if (N) { 54 *N = n; 55 } 56 if (sub) { 57 for (i=0; i<m; i++) { 58 for (j=0; j<n; j++) { 59 if (mat[i][j]) { 60 sub[j + n * i] = mat[i][j]; 61 } else { 62 sub[j + n * i] = (Mat)-1; 63 } 64 } 65 } 66 } 67 } 68