Date: 2025-03-29T05:58:53+00:00

Actual source code: zisltogf.c

      1: #include <petsc/private/ftnimpl.h>
      2: #include <petscis.h>
      3: #include <petscviewer.h>

      5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
      6:   #define islocaltoglobalmpnggetinfosize_ ISLOCALTOGLOBALMPNGGETINFOSIZE
      7:   #define islocaltoglobalmappinggetinfo_  ISLOCALTOGLOBALMAPPINGGETINFO
      8: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
      9:   #define islocaltoglobalmpnggetinfosize_ islocaltoglobalmpnggetinfosize
     10:   #define islocaltoglobalmappinggetinfo_  islocaltoglobalmappinggetinfo
     11: #endif

     13: static PetscInt  *sprocs, *snumprocs, **sindices;
     14: static PetscBool  called;
     15: PETSC_EXTERN void islocaltoglobalmpnggetinfosize_(ISLocalToGlobalMapping *mapping, PetscInt *size, PetscInt *maxnumprocs, PetscErrorCode *ierr)
     16: {
     17:   PetscInt i;
     18:   if (called) {
     19:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
     20:     return;
     21:   }
     22:   *ierr = ISLocalToGlobalMappingGetInfo(*mapping, size, &sprocs, &snumprocs, &sindices);
     23:   if (*ierr) return;
     24:   *maxnumprocs = 0;
     25:   for (i = 0; i < *size; i++) *maxnumprocs = PetscMax(*maxnumprocs, snumprocs[i]);
     26:   called = PETSC_TRUE;
     27: }

     29: PETSC_EXTERN void islocaltoglobalmappinggetinfo_(ISLocalToGlobalMapping *mapping, PetscInt *size, PetscInt *procs, PetscInt *numprocs, PetscInt *indices, PetscErrorCode *ierr)
     30: {
     31:   PetscInt i, j;
     32:   if (!called) {
     33:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
     34:     return;
     35:   }
     36:   *ierr = PetscArraycpy(procs, sprocs, *size);
     37:   if (*ierr) return;
     38:   *ierr = PetscArraycpy(numprocs, snumprocs, *size);
     39:   if (*ierr) return;
     40:   for (i = 0; i < *size; i++) {
     41:     for (j = 0; j < numprocs[i]; j++) indices[i + (*size) * j] = sindices[i][j];
     42:   }
     43:   *ierr = ISLocalToGlobalMappingRestoreInfo(*mapping, size, &sprocs, &snumprocs, &sindices);
     44:   if (*ierr) return;
     45:   called = PETSC_FALSE;
     46: }