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 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 9 #define islocaltoglobalmappingview_ islocaltoglobalmappingview 10 #define islocaltoglobalmpnggetinfosize_ islocaltoglobalmpnggetinfosize 11 #define islocaltoglobalmappinggetinfo_ islocaltoglobalmappinggetinfo 12 #endif 13 14 EXTERN_C_BEGIN 15 16 void PETSC_STDCALL islocaltoglobalmappingview_(ISLocalToGlobalMapping *mapping,PetscViewer *viewer,PetscErrorCode *ierr) 17 { 18 PetscViewer v; 19 PetscPatchDefaultViewers_Fortran(viewer,v); 20 *ierr = ISLocalToGlobalMappingView(*mapping,v); 21 } 22 23 static PetscInt *sprocs, *snumprocs, **sindices; 24 static PetscTruth called; 25 void PETSC_STDCALL islocaltoglobalmpnggetinfosize_(ISLocalToGlobalMapping *mapping,PetscInt *nprocs,PetscInt *maxnumprocs,PetscErrorCode *ierr) 26 { 27 PetscInt i; 28 if (called) {*ierr = PETSC_ERR_ARG_WRONGSTATE; return;} 29 *ierr = ISLocalToGlobalMappingGetInfo(*mapping,nprocs,&sprocs,&snumprocs,&sindices); if (*ierr) return; 30 *maxnumprocs = 0; 31 for (i=0; i<*nprocs; i++) { 32 *maxnumprocs = PetscMax(*maxnumprocs,snumprocs[i]); 33 } 34 called = PETSC_TRUE; 35 } 36 37 void PETSC_STDCALL islocaltoglobalmappinggetinfo_(ISLocalToGlobalMapping *mapping,PetscInt *nprocs,PetscInt *procs,PetscInt *numprocs, 38 PetscInt *indices,PetscErrorCode *ierr) 39 { 40 PetscInt i,j; 41 if (!called) {*ierr = PETSC_ERR_ARG_WRONGSTATE; return;} 42 *ierr = PetscMemcpy(procs,sprocs,*nprocs*sizeof(PetscInt)); if (*ierr) return; 43 *ierr = PetscMemcpy(numprocs,snumprocs,*nprocs*sizeof(PetscInt)); if (*ierr) return; 44 for (i=0; i<*nprocs; i++) { 45 for (j=0; j<numprocs[i]; j++) { 46 indices[i + (*nprocs)*j] = sindices[i][j]; 47 } 48 } 49 *ierr = ISLocalToGlobalMappingRestoreInfo(*mapping,nprocs,&sprocs,&snumprocs,&sindices); if (*ierr) return; 50 called = PETSC_FALSE; 51 } 52 53 EXTERN_C_END 54