Actual source code: zis.c

  1: /*$Id: zis.c,v 1.41 2001/06/21 21:19:50 bsmith Exp $*/

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

 63: EXTERN_C_BEGIN

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

 70: void PETSC_STDCALL islocaltoglobalmappingview_(ISLocalToGlobalMapping *mapping,PetscViewer *viewer,int *ierr)
 71: {
 72:   CHKFORTRANNULLOBJECT(viewer);
 73:   *ISLocalToGlobalMappingView(*mapping,*viewer);
 74: }

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

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

 98: void PETSC_STDCALL ispartitioningcount_(IS *is,int *count,int *ierr)
 99: {
100:   *ISPartitioningCount(*is,count);
101: }

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

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

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

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

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

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

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

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

146: void PETSC_STDCALL isblockgetindices_(IS *x,int *fa,long *ia,int *ierr)
147: {
148:   int   *lx;

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

154: void PETSC_STDCALL isblockrestoreindices_(IS *x,int *fa,long *ia,int *ierr)
155: {
156:   int *lx = PetscIntAddressFromFortran(fa,*ia);

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

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

166: void PETSC_STDCALL isgetindices_(IS *x,int *fa,long *ia,int *ierr)
167: {
168:   int   *lx;

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

174: void PETSC_STDCALL isrestoreindices_(IS *x,int *fa,long *ia,int *ierr)
175: {
176:   int *lx = PetscIntAddressFromFortran(fa,*ia);

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

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

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

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

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

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

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

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

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

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

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

242: }

244: EXTERN_C_END