Actual source code: zis.c

 2:  #include src/fortran/custom/zpetsc.h
 3:  #include petscis.h
  4: #ifdef PETSC_HAVE_FORTRAN_CAPS
  5: #define isduplicate_           ISDUPLICATE
  6: #define ispartitioningcount_   ISPARTITIONINGCOUNT
  7: #define isdestroy_             ISDESTROY
  8: #define iscreatestride_        ISCREATESTRIDE
  9: #define iscreategeneral_       ISCREATEGENERAL
 10: #define isgetindices_          ISGETINDICES
 11: #define isrestoreindices_      ISRESTOREINDICES
 12: #define isblockgetindices_     ISBLOCKGETINDICES
 13: #define isblockrestoreindices_ ISBLOCKRESTOREINDICES
 14: #define iscreateblock_         ISCREATEBLOCK
 15: #define isblock_               ISBLOCK
 16: #define isstride_              ISSTRIDE
 17: #define ispermutation_         ISPERMUTATION
 18: #define isidentity_            ISIDENTITY
 19: #define issorted_              ISSORTED
 20: #define isequal_               ISEQUAL
 21: #define isinvertpermutation_   ISINVERTPERMUTATION
 22: #define isview_                ISVIEW
 23: #define iscoloringcreate_      ISCOLORINGCREATE
 24: #define islocaltoglobalmappingcreate_ ISLOCALTOGLOBALMAPPINGCREATE
 25: #define islocaltoglobalmappingblock_ ISLOCALTOGLOBALMAPPINGBLOCK
 26: #define isallgather_                  ISALLGATHER
 27: #define iscoloringdestroy_            ISCOLORINGDESTROY
 28: #define iscoloringview_               ISCOLORINGVIEW
 29: #define ispartitioningtonumbering_    ISPARTITIONINGTONUMBERING
 30: #define islocaltoglobalmappingapply_  ISLOCALTOGLOBALMAPPINGAPPLY
 31: #define islocaltoglobalmappingview_  ISLOCALTOGLOBALMAPPINGVIEW
 32: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 33: #define isduplicate_           isduplicate
 34: #define islocaltoglobalmappingview_   islocaltoglobalmappingview
 35: #define islocaltoglobalmappingapply_  islocaltoglobalmappingapply
 36: #define iscoloringview_        iscoloringview
 37: #define iscoloringdestroy_     iscoloringdestroy
 38: #define isview_                isview
 39: #define isinvertpermutation_   isinvertpermutation
 40: #define isdestroy_             isdestroy
 41: #define iscreatestride_        iscreatestride
 42: #define iscreategeneral_       iscreategeneral
 43: #define isgetindices_          isgetindices
 44: #define isrestoreindices_      isrestoreindices
 45: #define isblockgetindices_     isblockgetindices
 46: #define isblockrestoreindices_ isblockrestoreindices
 47: #define iscreateblock_         iscreateblock
 48: #define isblock_               isblock
 49: #define isstride_              isstride
 50: #define ispermutation_         ispermutation
 51: #define isidentity_            isidentity
 52: #define issorted_              issorted
 53: #define isequal_               isequal
 54: #define iscoloringcreate_      iscoloringcreate
 55: #define islocaltoglobalmappingcreate_ islocaltoglobalmappingcreate
 56: #define islocaltoglobalmappingblock_ islocaltoglobalmappingblock
 57: #define isallgather_                  isallgather
 58: #define ispartitioningcount_          ispartitioningcount
 59: #define ispartitioningtonumbering_    ispartitioningtonumbering
 60: #endif


 64: void PETSC_STDCALL isduplicate_(IS *is,IS *newis,PetscErrorCode *ierr)
 65: {
 66:   *ISDuplicate(*is,newis);
 67: }

 69: void PETSC_STDCALL islocaltoglobalmappingview_(ISLocalToGlobalMapping *mapping,PetscViewer *viewer,PetscErrorCode *ierr)
 70: {
 71:   CHKFORTRANNULLOBJECTDEREFERENCE(viewer);
 72:   *ISLocalToGlobalMappingView(*mapping,*viewer);
 73: }

 75: /*
 76:    This is the same as the macro ISLocalToGlobalMappingApply() except it does not
 77:   return error codes.
 78: */
 79: void PETSC_STDCALL islocaltoglobalmappingapply_(ISLocalToGlobalMapping *mapping,PetscInt *N,PetscInt *in,PetscInt *out,PetscErrorCode *ierr)
 80: {
 81:   PetscInt i,*idx = (*mapping)->indices,Nmax = (*mapping)->n;
 82:   for (i=0; i<(*N); i++) {
 83:     if (in[i] < 0) {out[i] = in[i]; continue;}
 84:     if (in[i] >= Nmax) {
 85:       *PetscError(__LINE__,"ISLocalToGlobalMappingApply_Fortran",__FILE__,__SDIR__,1,1,"Index out of range");
 86:       return;
 87:     }
 88:     out[i] = idx[in[i]];
 89:   }
 90: }

 92: void PETSC_STDCALL ispartitioningtonumbering_(IS *is,IS *isout,PetscErrorCode *ierr)
 93: {
 94:   *ISPartitioningToNumbering(*is,isout);
 95: }

 97: void PETSC_STDCALL ispartitioningcount_(IS *is,PetscInt *count,PetscErrorCode *ierr)
 98: {
 99:   *ISPartitioningCount(*is,count);
100: }

102: void PETSC_STDCALL iscoloringdestroy_(ISColoring *iscoloring,PetscErrorCode *ierr)
103: {
104:   *ISColoringDestroy(*iscoloring);
105: }

107: void PETSC_STDCALL iscoloringview_(ISColoring *iscoloring,PetscViewer *viewer,PetscErrorCode *ierr)
108: {
109:   PetscViewer v;
110:   PetscPatchDefaultViewers_Fortran(viewer,v);
111:   *ISColoringView(*iscoloring,v);
112: }

114: void PETSC_STDCALL isview_(IS *is,PetscViewer *vin,PetscErrorCode *ierr)
115: {
116:   PetscViewer v;
117:   PetscPatchDefaultViewers_Fortran(vin,v);
118:   *ISView(*is,v);
119: }

121: void PETSC_STDCALL isequal_(IS *is1,IS *is2,PetscTruth *flg,PetscErrorCode *ierr)
122: {
123:   *ISEqual(*is1,*is2,flg);
124: }

126: void PETSC_STDCALL isidentity_(IS *is,PetscTruth *ident,PetscErrorCode *ierr)
127: {
128:   *ISIdentity(*is,ident);
129: }

131: void PETSC_STDCALL issorted_(IS *is,PetscTruth *flg,PetscErrorCode *ierr)
132: {
133:   *ISSorted(*is,flg);
134: }

136: void PETSC_STDCALL ispermutation_(IS *is,PetscTruth *perm,PetscErrorCode *ierr){
137:   *ISPermutation(*is,perm);
138: }

140: void PETSC_STDCALL isstride_(IS *is,PetscTruth *flag,PetscErrorCode *ierr)
141: {
142:   *ISStride(*is,flag);
143: }

145: void PETSC_STDCALL isblockgetindices_(IS *x,PetscInt *fa,size_t *ia,PetscErrorCode *ierr)
146: {
147:   PetscInt   *lx;

149:   *ISGetIndices(*x,&lx); if (*ierr) return;
150:   *ia      = PetscIntAddressToFortran(fa,lx);
151: }

153: void PETSC_STDCALL isblockrestoreindices_(IS *x,PetscInt *fa,size_t *ia,PetscErrorCode *ierr)
154: {
155:   PetscInt *lx = PetscIntAddressFromFortran(fa,*ia);

157:   *ISRestoreIndices(*x,&lx);
158: }

160: void PETSC_STDCALL isblock_(IS *is,PetscTruth *flag,PetscErrorCode *ierr)
161: {
162:   *ISBlock(*is,flag);
163: }

165: void PETSC_STDCALL isgetindices_(IS *x,PetscInt *fa,size_t *ia,PetscErrorCode *ierr)
166: {
167:   PetscInt   *lx;

169:   *ISGetIndices(*x,&lx); if (*ierr) return;
170:   *ia      = PetscIntAddressToFortran(fa,lx);
171: }

173: void PETSC_STDCALL isrestoreindices_(IS *x,PetscInt *fa,size_t *ia,PetscErrorCode *ierr)
174: {
175:   PetscInt *lx = PetscIntAddressFromFortran(fa,*ia);

177:   *ISRestoreIndices(*x,&lx);
178: }

180: void PETSC_STDCALL iscreategeneral_(MPI_Comm *comm,PetscInt *n,PetscInt *idx,IS *is,PetscErrorCode *ierr)
181: {
182:   *ISCreateGeneral((MPI_Comm)PetscToPointerComm(*comm),*n,idx,is);
183: }

185: void PETSC_STDCALL isinvertpermutation_(IS *is,PetscInt *nlocal,IS *isout,PetscErrorCode *ierr)
186: {
187:   *ISInvertPermutation(*is,*nlocal,isout);
188: }

190: void PETSC_STDCALL iscreateblock_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *idx,IS *is,PetscErrorCode *ierr)
191: {
192:   *ISCreateBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,idx,is);
193: }

195: void PETSC_STDCALL iscreatestride_(MPI_Comm *comm,PetscInt *n,PetscInt *first,PetscInt *step,
196:                                IS *is,PetscErrorCode *ierr)
197: {
198:   *ISCreateStride((MPI_Comm)PetscToPointerComm(*comm),*n,*first,*step,is);
199: }

201: void PETSC_STDCALL isdestroy_(IS *is,PetscErrorCode *ierr)
202: {
203:   *ISDestroy(*is);
204: }

206: void PETSC_STDCALL iscoloringcreate_(MPI_Comm *comm,PetscInt *n,PetscInt *colors,ISColoring *iscoloring,PetscErrorCode *ierr)
207: {
208:   ISColoringValue *color;
209:   PetscInt             i;

211:   /* copies the colors[] array since that is kept by the ISColoring that is created */
212:   *PetscMalloc((*n+1)*sizeof(ISColoringValue),&color);if (*ierr) return;
213:   for (i=0; i<(*n); i++) {
214:     if (colors[i] > IS_COLORING_MAX) {
215:       *PetscError(__LINE__,"ISColoringCreate_Fortran",__FILE__,__SDIR__,1,1,"Color too large");
216:       return;
217:     }
218:     if (colors[i] < 0) {
219:       *PetscError(__LINE__,"ISColoringCreate_Fortran",__FILE__,__SDIR__,1,1,"Color cannot be negative");
220:       return;
221:     }
222:     color[i] = (ISColoringValue)colors[i];
223:   }
224:   *ISColoringCreate((MPI_Comm)PetscToPointerComm(*comm),*n,color,iscoloring);
225: }

227: void PETSC_STDCALL islocaltoglobalmappingcreate_(MPI_Comm *comm,PetscInt *n,PetscInt *indices,ISLocalToGlobalMapping *mapping,PetscErrorCode *ierr)
228: {
229:   *ISLocalToGlobalMappingCreate((MPI_Comm)PetscToPointerComm(*comm),*n,indices,mapping);
230: }

232: void PETSC_STDCALL islocaltoglobalmappingblock_(ISLocalToGlobalMapping *inmap,PetscInt bs,ISLocalToGlobalMapping *outmap,PetscErrorCode *ierr)
233: {
234:   *ISLocalToGlobalMappingBlock(*inmap,bs,outmap);
235: }

237: void PETSC_STDCALL isallgather_(IS *is,IS *isout,PetscErrorCode *ierr)
238: {
239:   *ISAllGather(*is,isout);

241: }