xref: /petsc/src/vec/is/utils/ftn-custom/zisltogf.c (revision 2205254efee3a00a594e5e2a3a70f74dcb40bc03)
1 #include <petsc-private/fortranimpl.h>
2 #include <petscis.h>
3 
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5 #define islocaltoglobalmappingview_       ISLOCALTOGLOBALMAPPINGVIEW
6 #define islocaltoglobalmpnggetinfosize_   ISLOCALTOGLOBALMPNGGETINFOSIZE
7 #define islocaltoglobalmappinggetinfo_    ISLOCALTOGLOBALMAPPINGGETINFO
8 #define iscompressindicesgeneral_         ISCOMPRESSINDICESGENERAL
9 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
10 #define islocaltoglobalmappingview_       islocaltoglobalmappingview
11 #define islocaltoglobalmpnggetinfosize_   islocaltoglobalmpnggetinfosize
12 #define islocaltoglobalmappinggetinfo_    islocaltoglobalmappinggetinfo
13 #define iscompressindicesgeneral_         iscompressindicesgeneral
14 #endif
15 
16 EXTERN_C_BEGIN
17 
18 void PETSC_STDCALL iscompressindicesgeneral_(PetscInt *n,PetscInt *nkeys,PetscInt *bs,PetscInt *imax,IS *is_in,IS *is_out,PetscErrorCode *ierr)
19 {
20   *ierr = ISCompressIndicesGeneral(*n,*nkeys,*bs,*imax,is_in,is_out);
21 }
22 
23 void PETSC_STDCALL islocaltoglobalmappingview_(ISLocalToGlobalMapping *mapping,PetscViewer *viewer,PetscErrorCode *ierr)
24 {
25   PetscViewer v;
26   PetscPatchDefaultViewers_Fortran(viewer,v);
27   *ierr = ISLocalToGlobalMappingView(*mapping,v);
28 }
29 
30 static PetscInt  *sprocs, *snumprocs, **sindices;
31 static PetscBool called;
32 void PETSC_STDCALL islocaltoglobalmpnggetinfosize_(ISLocalToGlobalMapping *mapping,PetscInt *nprocs,PetscInt *maxnumprocs,PetscErrorCode *ierr)
33 {
34   PetscInt i;
35   if (called) {*ierr = PETSC_ERR_ARG_WRONGSTATE; return;}
36   *ierr        = ISLocalToGlobalMappingGetInfo(*mapping,nprocs,&sprocs,&snumprocs,&sindices); if (*ierr) return;
37   *maxnumprocs = 0;
38   for (i=0; i<*nprocs; i++) *maxnumprocs = PetscMax(*maxnumprocs,snumprocs[i]);
39   called = PETSC_TRUE;
40 }
41 
42 void PETSC_STDCALL islocaltoglobalmappinggetinfo_(ISLocalToGlobalMapping *mapping,PetscInt *nprocs,PetscInt *procs,PetscInt *numprocs,
43                                                   PetscInt *indices,PetscErrorCode *ierr)
44 {
45   PetscInt i,j;
46   if (!called) {*ierr = PETSC_ERR_ARG_WRONGSTATE; return;}
47   *ierr = PetscMemcpy(procs,sprocs,*nprocs*sizeof(PetscInt)); if (*ierr) return;
48   *ierr = PetscMemcpy(numprocs,snumprocs,*nprocs*sizeof(PetscInt)); if (*ierr) return;
49   for (i=0; i<*nprocs; i++) {
50     for (j=0; j<numprocs[i]; j++) indices[i + (*nprocs)*j] = sindices[i][j];
51   }
52   *ierr  = ISLocalToGlobalMappingRestoreInfo(*mapping,nprocs,&sprocs,&snumprocs,&sindices); if (*ierr) return;
53   called = PETSC_FALSE;
54 }
55 
56 EXTERN_C_END
57