Actual source code: zis.c

  1: /*$Id: zis.c,v 1.40 2001/04/10 19:37:46 bsmith Exp $*/

 3:  #include src/fortran/custom/zpetsc.h
 4:  #include petscis.h
  5: #ifdef PETSC_HAVE_FORTRAN_CAPS
  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: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 32: #define islocaltoglobalmappingapply_  islocaltoglobalmappingapply
 33: #define iscoloringview_        iscoloringview
 34: #define iscoloringdestroy_     iscoloringdestroy
 35: #define isview_                isview
 36: #define isinvertpermutation_   isinvertpermutation
 37: #define isdestroy_             isdestroy
 38: #define iscreatestride_        iscreatestride
 39: #define iscreategeneral_       iscreategeneral
 40: #define isgetindices_          isgetindices
 41: #define isrestoreindices_      isrestoreindices
 42: #define isblockgetindices_     isblockgetindices
 43: #define isblockrestoreindices_ isblockrestoreindices
 44: #define iscreateblock_         iscreateblock
 45: #define isblock_               isblock
 46: #define isstride_              isstride
 47: #define ispermutation_         ispermutation
 48: #define isidentity_            isidentity
 49: #define issorted_              issorted
 50: #define isequal_               isequal
 51: #define iscoloringcreate_      iscoloringcreate
 52: #define islocaltoglobalmappingcreate_ islocaltoglobalmappingcreate
 53: #define islocaltoglobalmappingblock_ islocaltoglobalmappingblock
 54: #define isallgather_                  isallgather
 55: #define ispartitioningcount_          ispartitioningcount
 56: #define ispartitioningtonumbering_    ispartitioningtonumbering
 57: #endif

 59: EXTERN_C_BEGIN

 61: /*
 62:    This is the same as the macro ISLocalToGlobalMappingApply() except it does not
 63:   return error codes.
 64: */
 65: void PETSC_STDCALL islocaltoglobalmappingapply_(ISLocalToGlobalMapping *mapping,int *N,int *in,int *out,int *ierr)
 66: {
 67:   int i,*idx = (*mapping)->indices,Nmax = (*mapping)->n;
 68:   for (i=0; i<(*N); i++) {
 69:     if (in[i] < 0) {out[i] = in[i]; continue;}
 70:     if (in[i] >= Nmax) {
 71:       *PetscError(__LINE__,"ISLocalToGlobalMappingApply_Fortran",__FILE__,__SDIR__,1,1,"Index out of range");
 72:       return;
 73:     }
 74:     out[i] = idx[in[i]];
 75:   }
 76: }

 78: void PETSC_STDCALL ispartitioningtonumbering_(IS *is,IS *isout,int *ierr)
 79: {
 80:   *ISPartitioningToNumbering(*is,isout);
 81: }

 83: void PETSC_STDCALL ispartitioningcount_(IS *is,int *count,int *ierr)
 84: {
 85:   *ISPartitioningCount(*is,count);
 86: }

 88: void PETSC_STDCALL iscoloringdestroy_(ISColoring *iscoloring,int *ierr)
 89: {
 90:   *ISColoringDestroy(*iscoloring);
 91: }

 93: void PETSC_STDCALL iscoloringview_(ISColoring *iscoloring,PetscViewer *viewer,int *ierr)
 94: {
 95:   PetscViewer v;
 96:   PetscPatchDefaultViewers_Fortran(viewer,v);
 97:   *ISColoringView(*iscoloring,v);
 98: }

100: void PETSC_STDCALL isview_(IS *is,PetscViewer *vin,int *ierr)
101: {
102:   PetscViewer v;
103:   PetscPatchDefaultViewers_Fortran(vin,v);
104:   *ISView(*is,v);
105: }

107: void PETSC_STDCALL isequal_(IS *is1,IS *is2,PetscTruth *flg,int *ierr)
108: {
109:   *ISEqual(*is1,*is2,flg);
110: }

112: void PETSC_STDCALL isidentity_(IS *is,PetscTruth *ident,int *ierr)
113: {
114:   *ISIdentity(*is,ident);
115: }

117: void PETSC_STDCALL issorted_(IS *is,PetscTruth *flg,int *ierr)
118: {
119:   *ISSorted(*is,flg);
120: }

122: void PETSC_STDCALL ispermutation_(IS *is,PetscTruth *perm,int *ierr){
123:   *ISPermutation(*is,perm);
124: }

126: void PETSC_STDCALL isstride_(IS *is,PetscTruth *flag,int *ierr)
127: {
128:   *ISStride(*is,flag);
129: }

131: void PETSC_STDCALL isblockgetindices_(IS *x,int *fa,long *ia,int *ierr)
132: {
133:   int   *lx;

135:   *ISGetIndices(*x,&lx); if (*ierr) return;
136:   *ia      = PetscIntAddressToFortran(fa,lx);
137: }

139: void PETSC_STDCALL isblockrestoreindices_(IS *x,int *fa,long *ia,int *ierr)
140: {
141:   int *lx = PetscIntAddressFromFortran(fa,*ia);

143:   *ISRestoreIndices(*x,&lx);
144: }

146: void PETSC_STDCALL isblock_(IS *is,PetscTruth *flag,int *ierr)
147: {
148:   *ISBlock(*is,flag);
149: }

151: void PETSC_STDCALL isgetindices_(IS *x,int *fa,long *ia,int *ierr)
152: {
153:   int   *lx;

155:   *ISGetIndices(*x,&lx); if (*ierr) return;
156:   *ia      = PetscIntAddressToFortran(fa,lx);
157: }

159: void PETSC_STDCALL isrestoreindices_(IS *x,int *fa,long *ia,int *ierr)
160: {
161:   int *lx = PetscIntAddressFromFortran(fa,*ia);

163:   *ISRestoreIndices(*x,&lx);
164: }

166: void PETSC_STDCALL iscreategeneral_(MPI_Comm *comm,int *n,int *idx,IS *is,int *ierr)
167: {
168:   *ISCreateGeneral((MPI_Comm)PetscToPointerComm(*comm),*n,idx,is);
169: }

171: void PETSC_STDCALL isinvertpermutation_(IS *is,int *nlocal,IS *isout,int *ierr)
172: {
173:   *ISInvertPermutation(*is,*nlocal,isout);
174: }

176: void PETSC_STDCALL iscreateblock_(MPI_Comm *comm,int *bs,int *n,int *idx,IS *is,int *ierr)
177: {
178:   *ISCreateBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,idx,is);
179: }

181: void PETSC_STDCALL iscreatestride_(MPI_Comm *comm,int *n,int *first,int *step,
182:                                IS *is,int *ierr)
183: {
184:   *ISCreateStride((MPI_Comm)PetscToPointerComm(*comm),*n,*first,*step,is);
185: }

187: void PETSC_STDCALL isdestroy_(IS *is,int *ierr)
188: {
189:   *ISDestroy(*is);
190: }

192: void PETSC_STDCALL iscoloringcreate_(MPI_Comm *comm,int *n,int *colors,ISColoring *iscoloring,int *ierr)
193: {
194:   int *color;
195:   /* copies the colors[] array since that is kept by the ISColoring that is created */
196:   *PetscMalloc((*n+1)*sizeof(int),&color);if (*ierr) return;
197:   *PetscMemcpy(color,colors,(*n)*sizeof(int));if (*ierr) return;
198:   *ISColoringCreate((MPI_Comm)PetscToPointerComm(*comm),*n,color,iscoloring);
199: }

201: void PETSC_STDCALL islocaltoglobalmappingcreate_(MPI_Comm *comm,int *n,int *indices,ISLocalToGlobalMapping *mapping,int *ierr)
202: {
203:   *ISLocalToGlobalMappingCreate((MPI_Comm)PetscToPointerComm(*comm),*n,indices,mapping);
204: }

206: void PETSC_STDCALL islocaltoglobalmappingblock_(ISLocalToGlobalMapping *inmap,int bs,ISLocalToGlobalMapping *outmap,int *ierr)
207: {
208:   *ISLocalToGlobalMappingBlock(*inmap,bs,outmap);
209: }

211: void PETSC_STDCALL isallgather_(IS *is,IS *isout,int *ierr)
212: {
213:   *ISAllGather(*is,isout);

215: }

217: EXTERN_C_END