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: }