xref: /petsc/src/vec/is/utils/ftn-custom/zisltogf.c (revision 84df9cb40eca90ea9b18a456fab7a4ecc7f6c1a4)
1 #include <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++) {
39     *maxnumprocs = PetscMax(*maxnumprocs,snumprocs[i]);
40   }
41   called = PETSC_TRUE;
42 }
43 
44 void PETSC_STDCALL islocaltoglobalmappinggetinfo_(ISLocalToGlobalMapping *mapping,PetscInt *nprocs,PetscInt *procs,PetscInt *numprocs,
45                                                   PetscInt *indices,PetscErrorCode *ierr)
46 {
47   PetscInt i,j;
48   if (!called) {*ierr = PETSC_ERR_ARG_WRONGSTATE; return;}
49   *ierr = PetscMemcpy(procs,sprocs,*nprocs*sizeof(PetscInt)); if (*ierr) return;
50   *ierr = PetscMemcpy(numprocs,snumprocs,*nprocs*sizeof(PetscInt)); if (*ierr) return;
51   for (i=0; i<*nprocs; i++) {
52     for (j=0; j<numprocs[i]; j++) {
53       indices[i + (*nprocs)*j] = sindices[i][j];
54     }
55   }
56   *ierr = ISLocalToGlobalMappingRestoreInfo(*mapping,nprocs,&sprocs,&snumprocs,&sindices); if (*ierr) return;
57   called = PETSC_FALSE;
58 }
59 
60 EXTERN_C_END
61