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: }