Actual source code: zvec.c
2: #include src/fortran/custom/zpetsc.h
3: #include petscvec.h
4: #ifdef PETSC_HAVE_FORTRAN_CAPS
5: #define vecsetfromoptions_ VECSETFROMOPTIONS
6: #define vecsettype_ VECSETTYPE
7: #define vecsetvalue_ VECSETVALUE
8: #define vecmaxpy_ VECMAXPY
9: #define vecmdot_ VECMDOT
10: #define veccreateseq_ VECCREATESEQ
11: #define veccreateseqwitharray_ VECCREATESEQWITHARRAY
12: #define veccreatempiwitharray_ VECCREATEMPIWITHARRAY
13: #define veccreate_ VECCREATE
14: #define vecduplicate_ VECDUPLICATE
15: #define veccreatempi_ VECCREATEMPI
16: #define veccreateshared_ VECCREATESHARED
17: #define vecscattercreate_ VECSCATTERCREATE
18: #define vecscattercopy_ VECSCATTERCOPY
19: #define vecdestroy_ VECDESTROY
20: #define vecdestroyvecs_ VECDESTROYVECS
21: #define vecscatterdestroy_ VECSCATTERDESTROY
22: #define vecrestorearray_ VECRESTOREARRAY
23: #define vecgetarray_ VECGETARRAY
24: #define vecload_ VECLOAD
25: #define vecgettype_ VECGETTYPE
26: #define vecduplicatevecs_ VECDUPLICATEVECS
27: #define vecview_ VECVIEW
28: #define mapgetlocalsize_ MAPGETLOCALSIZE
29: #define mapgetsize_ MAPGETSIZE
30: #define mapgetlocalrange_ MAPGETLOCALRANGE
31: #define mapgetglobalrange_ MAPGETGLOBALRANGE
32: #define mapdestroy_ MAPDESTROY
33: #define mapcreatempi_ MAPCREATEMPI
34: #define vecgetpetscmap_ VECGETPETSCMAP
35: #define vecghostgetlocalform_ VECGHOSTGETLOCALFORM
36: #define vecghostrestorelocalform_ VECGHOSTRESTORELOCALFORM
37: #define veccreateghostwitharray_ VECCREATEGHOSTWITHARRAY
38: #define veccreateghost_ VECCREATEGHOST
39: #define vecstridenorm_ VECSTRIDENORM
40: #define vecmax_ VECMAX
41: #define petscdrawtensorcontour_ PETSCDRAWTENSORCONTOUR
42: #define vecsetrandom_ VECSETRANDOM
43: #define veccreateghostblockwitharray_ VECCREATEGHOSTBLOCKWITHARRAY
44: #define veccreateghostblock_ VECCREATEGHOSTBLOCK
45: #define vecloadintovector_ VECLOADINTOVECTOR
46: #define vecscattercreatetoall_ VECSCATTERCREATETOALL
47: #define vecscattercreatetozero_ VECSCATTERCREATETOZERO
48: #define vecgetownershiprange_ VECGETOWNERSHIPRANGE
49: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
50: #define vecloadintovector_ vecloadintovector
51: #define veccreateghostblockwitharray_ veccreateghostblockwitharray
52: #define veccreateghostblock_ veccreateghostblock
53: #define petscdrawtensorcontour_ petscdrawtensorcontour
54: #define vecsetfromoptions_ vecsetfromoptions
55: #define vecsettype_ vecsettype
56: #define vecstridenorm_ vecstridenorm
57: #define vecghostrestorelocalform_ vecghostrestorelocalform
58: #define vecghostgetlocalform_ vecghostgetlocalform
59: #define veccreateghostwitharray_ veccreateghostwitharray
60: #define veccreateghost_ veccreateghost
61: #define vecgetpetscmap_ vecgetpetscmap
62: #define mapcreatempi_ mapcreatempi
63: #define mapgetglobalrange_ mapgetglobalrange
64: #define mapgetsize_ mapgetsize
65: #define mapgetlocalsize_ mapgetlocalsize
66: #define mapgetlocalrange_ mapgetlocalrange
67: #define mapdestroy_ mapdestroy
68: #define vecsetvalue_ vecsetvalue
69: #define vecview_ vecview
70: #define vecmaxpy_ vecmaxpy
71: #define vecmdot_ vecmdot
72: #define veccreateseq_ veccreateseq
73: #define veccreateseqwitharray_ veccreateseqwitharray
74: #define veccreatempiwitharray_ veccreatempiwitharray
75: #define veccreate_ veccreate
76: #define vecduplicate_ vecduplicate
77: #define veccreatempi_ veccreatempi
78: #define veccreateshared_ veccreateshared
79: #define vecscattercreate_ vecscattercreate
80: #define vecscattercopy_ vecscattercopy
81: #define vecdestroy_ vecdestroy
82: #define vecdestroyvecs_ vecdestroyvecs
83: #define vecscatterdestroy_ vecscatterdestroy
84: #define vecrestorearray_ vecrestorearray
85: #define vecgetarray_ vecgetarray
86: #define vecload_ vecload
87: #define vecgettype_ vecgettype
88: #define vecduplicatevecs_ vecduplicatevecs
89: #define vecmax_ vecmax
90: #define vecsetrandom_ vecsetrandom
91: #define vecscattercreatetoall_ vecscattercreatetoall
92: #define vecscattercreatetozero_ vecscattercreatetozero
93: #define vecgetownershiprange_ vecgetownershiprange
94: #endif
98: void PETSC_STDCALL vecloadintovector_(PetscViewer *viewer,Vec *vec,PetscErrorCode *ierr)
99: {
100: PetscViewer v;
101: PetscPatchDefaultViewers_Fortran(viewer,v);
102: *VecLoadIntoVector(v,*vec);
103: }
105: void PETSC_STDCALL vecsetrandom_(PetscRandom *r,Vec *x,PetscErrorCode *ierr)
106: {
107: *VecSetRandom(*r,*x);
108: }
109: void PETSC_STDCALL petscdrawtensorcontour_(PetscDraw *win,int *m,int *n,PetscReal *x,PetscReal *y,PetscReal *V,PetscErrorCode *ierr)
110: {
111: CHKFORTRANNULLDOUBLE(x);
112: CHKFORTRANNULLDOUBLE(y);
113: *PetscDrawTensorContour(*win,*m,*n,x,y,V);
114: }
116: void PETSC_STDCALL vecsetfromoptions_(Vec *x,PetscErrorCode *ierr)
117: {
118: *VecSetFromOptions(*x);
119: }
121: void PETSC_STDCALL vecsettype_(Vec *x,CHAR type_name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
122: {
123: char *t;
125: FIXCHAR(type_name,len,t);
126: *VecSetType(*x,t);
127: FREECHAR(type_name,t);
128: }
130: void PETSC_STDCALL vecgetpetscmap_(Vec *x,PetscMap *map,PetscErrorCode *ierr)
131: {
132: *VecGetPetscMap(*x,map);
133: }
135: void PETSC_STDCALL mapgetlocalsize_(PetscMap *m,PetscInt *n,PetscErrorCode *ierr)
136: {
137: *PetscMapGetLocalSize(*m,n);
138: }
140: void PETSC_STDCALL mapgetsize_(PetscMap *m,PetscInt *N,PetscErrorCode *ierr)
141: {
142: *PetscMapGetSize(*m,N);
143: }
145: void PETSC_STDCALL mapgetlocalrange_(PetscMap *m,PetscInt *rstart,PetscInt *rend,PetscErrorCode *ierr)
146: {
147: *PetscMapGetLocalRange(*m,rstart,rend);
148: }
150: void PETSC_STDCALL mapgetglobalrange_(PetscMap *m,PetscInt **range,PetscErrorCode *ierr)
151: {
152: *PetscMapGetGlobalRange(*m,range);
153: }
155: void PETSC_STDCALL mapdestroy_(PetscMap *m,PetscErrorCode *ierr)
156: {
157: *PetscMapDestroy(*m);
158: }
160: void PETSC_STDCALL vecsetvalue_(Vec *v,PetscInt *i,PetscScalar *va,InsertMode *mode,PetscErrorCode *ierr)
161: {
162: /* cannot use VecSetValue() here since that usesCHKERRQ() which has a return in it */
163: *VecSetValues(*v,1,i,va,*mode);
164: }
166: void PETSC_STDCALL vecview_(Vec *x,PetscViewer *vin,PetscErrorCode *ierr)
167: {
168: PetscViewer v;
170: PetscPatchDefaultViewers_Fortran(vin,v);
171: *VecView(*x,v);
172: }
174: void PETSC_STDCALL vecgettype_(Vec *vv,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
175: {
176: char *tname;
177: *VecGetType(*vv,&tname);
178: #if defined(PETSC_USES_CPTOFCD)
179: {
180: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
181: *PetscStrncpy(t,tname,len1);
182: }
183: #else
184: *PetscStrncpy(name,tname,len);
185: #endif
186: FIXRETURNCHAR(name,len);
187: }
189: void PETSC_STDCALL vecload_(PetscViewer *viewer,CHAR outtype PETSC_MIXED_LEN(len),Vec *newvec,PetscErrorCode *ierr PETSC_END_LEN(len))
190: {
191: char *t;
192: PetscViewer v;
193: FIXCHAR(outtype,len,t);
194: PetscPatchDefaultViewers_Fortran(viewer,v);
195: *VecLoad(v,t,newvec);
196: }
198: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
199: void PETSC_STDCALL vecrestorearray_(Vec *x,PetscScalar *fa,PetscInt *ia,PetscErrorCode *ierr)
200: {
201: PetscInt m;
202: PetscScalar *lx;
204: *VecGetLocalSize(*x,&m);if (*ierr) return;
205: *PetscScalarAddressFromFortran((PetscObject)*x,fa,*ia,m,&lx);if (*ierr) return;
206: *VecRestoreArray(*x,&lx);if (*ierr) return;
207: }
209: void PETSC_STDCALL vecgetarray_(Vec *x,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
210: {
211: PetscScalar *lx;
212: PetscInt m;
214: *VecGetArray(*x,&lx); if (*ierr) return;
215: *VecGetLocalSize(*x,&m);if (*ierr) return;
216: *PetscScalarAddressToFortran((PetscObject)*x,fa,lx,m,ia);
217: }
219: void PETSC_STDCALL vecscatterdestroy_(VecScatter *ctx,PetscErrorCode *ierr)
220: {
221: *VecScatterDestroy(*ctx);
222: }
224: void PETSC_STDCALL vecdestroy_(Vec *v,PetscErrorCode *ierr)
225: {
226: *VecDestroy(*v);
227: }
229: void PETSC_STDCALL vecscattercreate_(Vec *xin,IS *ix,Vec *yin,IS *iy,VecScatter *newctx,PetscErrorCode *ierr)
230: {
231: CHKFORTRANNULLOBJECT(ix);
232: CHKFORTRANNULLOBJECT(iy);
233: *VecScatterCreate(*xin,*ix,*yin,*iy,newctx);
234: }
236: void PETSC_STDCALL vecscattercopy_(VecScatter *sctx,VecScatter *ctx,PetscErrorCode *ierr)
237: {
238: *VecScatterCopy(*sctx,ctx);
239: }
241: void PETSC_STDCALL mapcreatempi_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscMap *vv,PetscErrorCode *ierr)
242: {
243: *PetscMapCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
244: }
246: void PETSC_STDCALL veccreatempi_(MPI_Comm *comm,PetscInt *n,PetscInt *N,Vec *vv,PetscErrorCode *ierr)
247: {
248: *VecCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
249: }
251: void PETSC_STDCALL veccreateshared_(MPI_Comm *comm,PetscInt *n,PetscInt *N,Vec *vv,PetscErrorCode *ierr)
252: {
253: *VecCreateShared((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
254: }
256: void PETSC_STDCALL veccreateseq_(MPI_Comm *comm,PetscInt *n,Vec *V,PetscErrorCode *ierr)
257: {
258: *VecCreateSeq((MPI_Comm)PetscToPointerComm(*comm),*n,V);
259: }
261: void PETSC_STDCALL veccreateseqwitharray_(MPI_Comm *comm,PetscInt *n,PetscScalar *s,Vec *V,PetscErrorCode *ierr)
262: {
263: CHKFORTRANNULLSCALAR(s);
264: *VecCreateSeqWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,s,V);
265: }
267: void PETSC_STDCALL veccreatempiwitharray_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscScalar *s,Vec *V,PetscErrorCode *ierr)
268: {
269: CHKFORTRANNULLSCALAR(s);
270: *VecCreateMPIWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,*N,s,V);
271: }
273: void PETSC_STDCALL veccreate_(MPI_Comm *comm,Vec *V,PetscErrorCode *ierr)
274: {
275: *VecCreate((MPI_Comm)PetscToPointerComm(*comm),V);
276: }
278: void PETSC_STDCALL vecduplicate_(Vec *v,Vec *newv,PetscErrorCode *ierr)
279: {
280: *VecDuplicate(*v,newv);
281: }
283: /*
284: vecduplicatevecs() and vecdestroyvecs() are slightly different from C since the
285: Fortran provides the array to hold the vector objects,while in C that
286: array is allocated by the VecDuplicateVecs()
287: */
288: void PETSC_STDCALL vecduplicatevecs_(Vec *v,PetscInt *m,Vec *newv,PetscErrorCode *ierr)
289: {
290: Vec *lV;
291: PetscInt i;
292: *VecDuplicateVecs(*v,*m,&lV); if (*ierr) return;
293: for (i=0; i<*m; i++) {
294: newv[i] = lV[i];
295: }
296: *PetscFree(lV);
297: }
299: void PETSC_STDCALL vecdestroyvecs_(Vec *vecs,PetscInt *m,PetscErrorCode *ierr)
300: {
301: PetscInt i;
302: for (i=0; i<*m; i++) {
303: *VecDestroy(vecs[i]);if (*ierr) return;
304: }
305: }
307: void PETSC_STDCALL vecmtdot_(PetscInt *nv,Vec *x,Vec *y,PetscScalar *val,PetscErrorCode *ierr)
308: {
309: *VecMTDot(*nv,*x,y,val);
310: }
312: void PETSC_STDCALL vecmdot_(PetscInt *nv,Vec *x,Vec *y,PetscScalar *val,PetscErrorCode *ierr)
313: {
314: *VecMDot(*nv,*x,y,val);
315: }
317: void PETSC_STDCALL vecmaxpy_(PetscInt *nv,PetscScalar *alpha,Vec *x,Vec *y,PetscErrorCode *ierr)
318: {
319: *VecMAXPY(*nv,alpha,*x,y);
320: }
322: void PETSC_STDCALL vecstridenorm_(Vec *x,PetscInt *start,NormType *type,PetscReal *val,PetscErrorCode *ierr)
323: {
324: *VecStrideNorm(*x,*start,*type,val);
325: }
327: /* ----------------------------------------------------------------------------------------------*/
328: void PETSC_STDCALL veccreateghostblockwitharray_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *N,PetscInt *nghost,PetscInt *ghosts,
329: PetscScalar *array,Vec *vv,PetscErrorCode *ierr)
330: {
331: CHKFORTRANNULLSCALAR(array);
332: *VecCreateGhostBlockWithArray((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,
333: ghosts,array,vv);
334: }
336: void PETSC_STDCALL veccreateghostblock_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *N,PetscInt *nghost,PetscInt *ghosts,Vec *vv,
337: PetscErrorCode *ierr)
338: {
339: *VecCreateGhostBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,ghosts,vv);
340: }
342: void PETSC_STDCALL veccreateghostwitharray_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscInt *nghost,PetscInt *ghosts,PetscScalar *array,
343: Vec *vv,PetscErrorCode *ierr)
344: {
345: CHKFORTRANNULLSCALAR(array);
346: *VecCreateGhostWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,
347: ghosts,array,vv);
348: }
350: void PETSC_STDCALL veccreateghost_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscInt *nghost,PetscInt *ghosts,Vec *vv,PetscErrorCode *ierr)
351: {
352: *VecCreateGhost((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,ghosts,vv);
353: }
355: void PETSC_STDCALL vecghostgetlocalform_(Vec *g,Vec *l,PetscErrorCode *ierr)
356: {
357: *VecGhostGetLocalForm(*g,l);
358: }
360: void PETSC_STDCALL vecghostrestorelocalform_(Vec *g,Vec *l,PetscErrorCode *ierr)
361: {
362: *VecGhostRestoreLocalForm(*g,l);
363: }
365: void PETSC_STDCALL vecmax_(Vec *x,PetscInt *p,PetscReal *val,PetscErrorCode *ierr)
366: {
367: CHKFORTRANNULLINTEGER(p);
368: *VecMax(*x,p,val);
369: }
371: void PETSC_STDCALL vecscattercreatetoall_(Vec *v,VecScatter *ctx,Vec *newv,PetscErrorCode *ierr)
372: {
373: *VecScatterCreateToAll(*v,ctx,newv);
374: }
376: void PETSC_STDCALL vecscattercreatetozero_(Vec *v,VecScatter *ctx,Vec *newv,PetscErrorCode *ierr)
377: {
378: *VecScatterCreateToZero(*v,ctx,newv);
379: }
381: void PETSC_STDCALL vecgetownershiprange_(Vec *x,PetscInt *low,PetscInt *high, PetscErrorCode *ierr)
382: {
383: CHKFORTRANNULLINTEGER(low);
384: CHKFORTRANNULLINTEGER(high);
385: *VecGetOwnershipRange(*x,low,high);
386: }