Actual source code: zindexf.c

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

  5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  6:   #define petsclayoutfindowner_                      PETSCLAYOUTFINDOWNER
  7:   #define petsclayoutfindownerindex_                 PETSCLAYOUTFINDOWNERINDEX
  8:   #define isview_                                    ISVIEW
  9:   #define isgetindices_                              ISGETINDICES
 10:   #define isrestoreindices_                          ISRESTOREINDICES
 11:   #define isgettotalindices_                         ISGETTOTALINDICES
 12:   #define isrestoretotalindices_                     ISRESTORETOTALINDICES
 13:   #define isgetnonlocalindices_                      ISGETNONLOCALINDICES
 14:   #define isrestorenonlocalindices_                  ISRESTORENONLOCALINDICES
 15:   #define islocaltoglobalmappinggetindices_          ISLOCALTOGLOBALMAPPINGGETINDICES
 16:   #define islocaltoglobalmappingrestoreindices_      ISLOCALTOGLOBALMAPPINGRESTOREINDICES
 17:   #define islocaltoglobalmappinggetblockindices_     ISLOCALTOGLOBALMAPPINGGETBLOCKINDICES
 18:   #define islocaltoglobalmappingrestoreblockindices_ ISLOCALTOGLOBALMAPPINGRESTOREBLOCKINDICES
 19:   #define isviewfromoptions_                         ISVIEWFROMOPTIONS
 20: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 21:   #define petsclayoutfindowner_                      petsclayoutfindowner
 22:   #define petsclayoutfindownerindex_                 petsclayoutfindownerindex
 23:   #define isview_                                    isview
 24:   #define isgetindices_                              isgetindices
 25:   #define isrestoreindices_                          isrestoreindices
 26:   #define isgettotalindices_                         isgettotalindices
 27:   #define isrestoretotalindices_                     isrestoretotalindices
 28:   #define isgetnonlocalindices_                      isgetnonlocalindices
 29:   #define isrestorenonlocalindices_                  isrestorenonlocalindices
 30:   #define islocaltoglobalmappinggetindices_          islocaltoglobalmappinggetindices
 31:   #define islocaltoglobalmappingrestoreindices_      islocaltoglobalmappingrestoreindices
 32:   #define islocaltoglobalmappinggetblockindices_     islocaltoglobalmappinggetblockindices
 33:   #define islocaltoglobalmappingrestoreblockindices_ islocaltoglobalmappingrestoreblockindices
 34:   #define isviewfromoptions_                         isviewfromoptions
 35: #endif

 37: PETSC_EXTERN void petsclayoutfindowner_(PetscLayout *map, PetscInt *idx, PetscMPIInt *owner, PetscErrorCode *ierr)
 38: {
 39:   *ierr = PetscLayoutFindOwner(*map, *idx, owner);
 40: }

 42: PETSC_EXTERN void petsclayoutfindownerindex_(PetscLayout *map, PetscInt *idx, PetscMPIInt *owner, PetscInt *ridx, PetscErrorCode *ierr)
 43: {
 44:   *ierr = PetscLayoutFindOwnerIndex(*map, *idx, owner, ridx);
 45: }

 47: PETSC_EXTERN void isview_(IS *is, PetscViewer *vin, PetscErrorCode *ierr)
 48: {
 49:   PetscViewer v;
 50:   PetscPatchDefaultViewers_Fortran(vin, v);
 51:   *ierr = ISView(*is, v);
 52: }

 54: PETSC_EXTERN void isgetindices_(IS *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
 55: {
 56:   const PetscInt *lx;

 58:   *ierr = ISGetIndices(*x, &lx);
 59:   if (*ierr) return;
 60:   *ia = PetscIntAddressToFortran(fa, (PetscInt *)lx);
 61: }

 63: PETSC_EXTERN void isrestoreindices_(IS *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
 64: {
 65:   const PetscInt *lx = PetscIntAddressFromFortran(fa, *ia);
 66:   *ierr              = ISRestoreIndices(*x, &lx);
 67: }

 69: PETSC_EXTERN void isgettotalindices_(IS *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
 70: {
 71:   const PetscInt *lx;

 73:   *ierr = ISGetTotalIndices(*x, &lx);
 74:   if (*ierr) return;
 75:   *ia = PetscIntAddressToFortran(fa, (PetscInt *)lx);
 76: }

 78: PETSC_EXTERN void isrestoretotalindices_(IS *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
 79: {
 80:   const PetscInt *lx = PetscIntAddressFromFortran(fa, *ia);
 81:   *ierr              = ISRestoreTotalIndices(*x, &lx);
 82: }

 84: PETSC_EXTERN void isgetnonlocalindices_(IS *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
 85: {
 86:   const PetscInt *lx;

 88:   *ierr = ISGetNonlocalIndices(*x, &lx);
 89:   if (*ierr) return;
 90:   *ia = PetscIntAddressToFortran(fa, (PetscInt *)lx);
 91: }

 93: PETSC_EXTERN void isrestorenonlocalindices_(IS *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
 94: {
 95:   const PetscInt *lx = PetscIntAddressFromFortran(fa, *ia);
 96:   *ierr              = ISRestoreNonlocalIndices(*x, &lx);
 97: }

 99: PETSC_EXTERN void islocaltoglobalmappinggetindices_(ISLocalToGlobalMapping *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
100: {
101:   const PetscInt *lx;

103:   *ierr = ISLocalToGlobalMappingGetIndices(*x, &lx);
104:   if (*ierr) return;
105:   *ia = PetscIntAddressToFortran(fa, (PetscInt *)lx);
106: }

108: PETSC_EXTERN void islocaltoglobalmappingrestoreindices_(ISLocalToGlobalMapping *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
109: {
110:   const PetscInt *lx = PetscIntAddressFromFortran(fa, *ia);
111:   *ierr              = ISLocalToGlobalMappingRestoreIndices(*x, &lx);
112: }

114: PETSC_EXTERN void islocaltoglobalmappinggetblockindices_(ISLocalToGlobalMapping *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
115: {
116:   const PetscInt *lx;

118:   *ierr = ISLocalToGlobalMappingGetBlockIndices(*x, &lx);
119:   if (*ierr) return;
120:   *ia = PetscIntAddressToFortran(fa, (PetscInt *)lx);
121: }

123: PETSC_EXTERN void islocaltoglobalmappingrestoreblockindices_(ISLocalToGlobalMapping *x, PetscInt *fa, size_t *ia, PetscErrorCode *ierr)
124: {
125:   const PetscInt *lx = PetscIntAddressFromFortran(fa, *ia);
126:   *ierr              = ISLocalToGlobalMappingRestoreBlockIndices(*x, &lx);
127: }

129: PETSC_EXTERN void isviewfromoptions_(IS *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
130: {
131:   char *t;

133:   FIXCHAR(type, len, t);
134:   CHKFORTRANNULLOBJECT(obj);
135:   *ierr = ISViewFromOptions(*ao, obj, t);
136:   if (*ierr) return;
137:   FREECHAR(type, t);
138: }