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_(Vec *x,PetscRandom *r,PetscErrorCode *ierr)
106: {
107: *VecSetRandom(*x,*r);
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: const char *tname;
178: *VecGetType(*vv,&tname);
179: #if defined(PETSC_USES_CPTOFCD)
180: {
181: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
182: *PetscStrncpy(t,tname,len1);
183: }
184: #else
185: *PetscStrncpy(name,tname,len);
186: #endif
187: FIXRETURNCHAR(name,len);
188: }
190: void PETSC_STDCALL vecload_(PetscViewer *viewer,CHAR outtype PETSC_MIXED_LEN(len),Vec *newvec,PetscErrorCode *ierr PETSC_END_LEN(len))
191: {
192: char *t;
193: PetscViewer v;
194: FIXCHAR(outtype,len,t);
195: PetscPatchDefaultViewers_Fortran(viewer,v);
196: *VecLoad(v,t,newvec);
197: }
199: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
200: void PETSC_STDCALL vecrestorearray_(Vec *x,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
201: {
202: PetscInt m;
203: PetscScalar *lx;
205: *VecGetLocalSize(*x,&m);if (*ierr) return;
206: *PetscScalarAddressFromFortran((PetscObject)*x,fa,*ia,m,&lx);if (*ierr) return;
207: *VecRestoreArray(*x,&lx);if (*ierr) return;
208: }
210: void PETSC_STDCALL vecgetarray_(Vec *x,PetscScalar *fa,size_t *ia,PetscErrorCode *ierr)
211: {
212: PetscScalar *lx;
213: PetscInt m;
215: *VecGetArray(*x,&lx); if (*ierr) return;
216: *VecGetLocalSize(*x,&m);if (*ierr) return;
217: *PetscScalarAddressToFortran((PetscObject)*x,fa,lx,m,ia);
218: }
220: void PETSC_STDCALL vecscatterdestroy_(VecScatter *ctx,PetscErrorCode *ierr)
221: {
222: *VecScatterDestroy(*ctx);
223: }
225: void PETSC_STDCALL vecdestroy_(Vec *v,PetscErrorCode *ierr)
226: {
227: *VecDestroy(*v);
228: }
230: void PETSC_STDCALL vecscattercreate_(Vec *xin,IS *ix,Vec *yin,IS *iy,VecScatter *newctx,PetscErrorCode *ierr)
231: {
232: CHKFORTRANNULLOBJECTDEREFERENCE(ix);
233: CHKFORTRANNULLOBJECTDEREFERENCE(iy);
234: *VecScatterCreate(*xin,*ix,*yin,*iy,newctx);
235: }
237: void PETSC_STDCALL vecscattercopy_(VecScatter *sctx,VecScatter *ctx,PetscErrorCode *ierr)
238: {
239: *VecScatterCopy(*sctx,ctx);
240: }
242: void PETSC_STDCALL mapcreatempi_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscMap *vv,PetscErrorCode *ierr)
243: {
244: *PetscMapCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
245: }
247: void PETSC_STDCALL veccreatempi_(MPI_Comm *comm,PetscInt *n,PetscInt *N,Vec *vv,PetscErrorCode *ierr)
248: {
249: *VecCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
250: }
252: void PETSC_STDCALL veccreateshared_(MPI_Comm *comm,PetscInt *n,PetscInt *N,Vec *vv,PetscErrorCode *ierr)
253: {
254: *VecCreateShared((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
255: }
257: void PETSC_STDCALL veccreateseq_(MPI_Comm *comm,PetscInt *n,Vec *V,PetscErrorCode *ierr)
258: {
259: *VecCreateSeq((MPI_Comm)PetscToPointerComm(*comm),*n,V);
260: }
262: void PETSC_STDCALL veccreateseqwitharray_(MPI_Comm *comm,PetscInt *n,PetscScalar *s,Vec *V,PetscErrorCode *ierr)
263: {
264: CHKFORTRANNULLSCALAR(s);
265: *VecCreateSeqWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,s,V);
266: }
268: void PETSC_STDCALL veccreatempiwitharray_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscScalar *s,Vec *V,PetscErrorCode *ierr)
269: {
270: CHKFORTRANNULLSCALAR(s);
271: *VecCreateMPIWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,*N,s,V);
272: }
274: void PETSC_STDCALL veccreate_(MPI_Comm *comm,Vec *V,PetscErrorCode *ierr)
275: {
276: *VecCreate((MPI_Comm)PetscToPointerComm(*comm),V);
277: }
279: void PETSC_STDCALL vecduplicate_(Vec *v,Vec *newv,PetscErrorCode *ierr)
280: {
281: *VecDuplicate(*v,newv);
282: }
284: /*
285: vecduplicatevecs() and vecdestroyvecs() are slightly different from C since the
286: Fortran provides the array to hold the vector objects,while in C that
287: array is allocated by the VecDuplicateVecs()
288: */
289: void PETSC_STDCALL vecduplicatevecs_(Vec *v,PetscInt *m,Vec *newv,PetscErrorCode *ierr)
290: {
291: Vec *lV;
292: PetscInt i;
293: *VecDuplicateVecs(*v,*m,&lV); if (*ierr) return;
294: for (i=0; i<*m; i++) {
295: newv[i] = lV[i];
296: }
297: *PetscFree(lV);
298: }
300: void PETSC_STDCALL vecdestroyvecs_(Vec *vecs,PetscInt *m,PetscErrorCode *ierr)
301: {
302: PetscInt i;
303: for (i=0; i<*m; i++) {
304: *VecDestroy(vecs[i]);if (*ierr) return;
305: }
306: }
308: void PETSC_STDCALL vecmtdot_(PetscInt *nv,Vec *x,Vec *y,PetscScalar *val,PetscErrorCode *ierr)
309: {
310: *VecMTDot(*nv,*x,y,val);
311: }
313: void PETSC_STDCALL vecmdot_(PetscInt *nv,Vec *x,Vec *y,PetscScalar *val,PetscErrorCode *ierr)
314: {
315: *VecMDot(*nv,*x,y,val);
316: }
318: void PETSC_STDCALL vecmaxpy_(Vec *y,PetscInt *nv,PetscScalar *alpha,Vec *x,PetscErrorCode *ierr)
319: {
320: *VecMAXPY(*y,*nv,alpha,x);
321: }
323: void PETSC_STDCALL vecstridenorm_(Vec *x,PetscInt *start,NormType *type,PetscReal *val,PetscErrorCode *ierr)
324: {
325: *VecStrideNorm(*x,*start,*type,val);
326: }
328: /* ----------------------------------------------------------------------------------------------*/
329: void PETSC_STDCALL veccreateghostblockwitharray_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *N,PetscInt *nghost,PetscInt *ghosts,
330: PetscScalar *array,Vec *vv,PetscErrorCode *ierr)
331: {
332: CHKFORTRANNULLSCALAR(array);
333: *VecCreateGhostBlockWithArray((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,
334: ghosts,array,vv);
335: }
337: void PETSC_STDCALL veccreateghostblock_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *N,PetscInt *nghost,PetscInt *ghosts,Vec *vv,
338: PetscErrorCode *ierr)
339: {
340: *VecCreateGhostBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,ghosts,vv);
341: }
343: void PETSC_STDCALL veccreateghostwitharray_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscInt *nghost,PetscInt *ghosts,PetscScalar *array,
344: Vec *vv,PetscErrorCode *ierr)
345: {
346: CHKFORTRANNULLSCALAR(array);
347: *VecCreateGhostWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,
348: ghosts,array,vv);
349: }
351: void PETSC_STDCALL veccreateghost_(MPI_Comm *comm,PetscInt *n,PetscInt *N,PetscInt *nghost,PetscInt *ghosts,Vec *vv,PetscErrorCode *ierr)
352: {
353: *VecCreateGhost((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,ghosts,vv);
354: }
356: void PETSC_STDCALL vecghostgetlocalform_(Vec *g,Vec *l,PetscErrorCode *ierr)
357: {
358: *VecGhostGetLocalForm(*g,l);
359: }
361: void PETSC_STDCALL vecghostrestorelocalform_(Vec *g,Vec *l,PetscErrorCode *ierr)
362: {
363: *VecGhostRestoreLocalForm(*g,l);
364: }
366: void PETSC_STDCALL vecmax_(Vec *x,PetscInt *p,PetscReal *val,PetscErrorCode *ierr)
367: {
368: CHKFORTRANNULLINTEGER(p);
369: *VecMax(*x,p,val);
370: }
372: void PETSC_STDCALL vecscattercreatetoall_(Vec *v,VecScatter *ctx,Vec *newv,PetscErrorCode *ierr)
373: {
374: *VecScatterCreateToAll(*v,ctx,newv);
375: }
377: void PETSC_STDCALL vecscattercreatetozero_(Vec *v,VecScatter *ctx,Vec *newv,PetscErrorCode *ierr)
378: {
379: *VecScatterCreateToZero(*v,ctx,newv);
380: }
382: void PETSC_STDCALL vecgetownershiprange_(Vec *x,PetscInt *low,PetscInt *high, PetscErrorCode *ierr)
383: {
384: CHKFORTRANNULLINTEGER(low);
385: CHKFORTRANNULLINTEGER(high);
386: *VecGetOwnershipRange(*x,low,high);
387: }