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