Actual source code: zvec.c
1: /*$Id: zvec.c,v 1.76 2001/09/24 21:02:04 balay Exp $*/
3: #include src/fortran/custom/zpetsc.h
4: #include petscvec.h
5: #ifdef PETSC_HAVE_FORTRAN_CAPS
6: #define vecsetfromoptions_ VECSETFROMOPTIONS
7: #define vecsettype_ VECSETTYPE
8: #define vecsetvalue_ VECSETVALUE
9: #define vecmaxpy_ VECMAXPY
10: #define vecmdot_ VECMDOT
11: #define veccreateseq_ VECCREATESEQ
12: #define veccreateseqwitharray_ VECCREATESEQWITHARRAY
13: #define veccreatempiwitharray_ VECCREATEMPIWITHARRAY
14: #define veccreate_ VECCREATE
15: #define vecduplicate_ VECDUPLICATE
16: #define veccreatempi_ VECCREATEMPI
17: #define veccreateshared_ VECCREATESHARED
18: #define vecscattercreate_ VECSCATTERCREATE
19: #define vecscattercopy_ VECSCATTERCOPY
20: #define vecdestroy_ VECDESTROY
21: #define vecdestroyvecs_ VECDESTROYVECS
22: #define vecscatterdestroy_ VECSCATTERDESTROY
23: #define vecrestorearray_ VECRESTOREARRAY
24: #define vecgetarray_ VECGETARRAY
25: #define vecload_ VECLOAD
26: #define vecgettype_ VECGETTYPE
27: #define vecduplicatevecs_ VECDUPLICATEVECS
28: #define vecview_ VECVIEW
29: #define mapgetlocalsize_ MAPGETLOCALSIZE
30: #define mapgetsize_ MAPGETSIZE
31: #define mapgetlocalrange_ MAPGETLOCALRANGE
32: #define mapgetglobalrange_ MAPGETGLOBALRANGE
33: #define mapdestroy_ MAPDESTROY
34: #define mapcreatempi_ MAPCREATEMPI
35: #define vecgetpetscmap_ VECGETPETSCMAP
36: #define vecghostgetlocalform_ VECGHOSTGETLOCALFORM
37: #define vecghostrestorelocalform_ VECGHOSTRESTORELOCALFORM
38: #define veccreateghostwitharray_ VECCREATEGHOSTWITHARRAY
39: #define veccreateghost_ VECCREATEGHOST
40: #define vecstridenorm_ VECSTRIDENORM
41: #define vecmax_ VECMAX
42: #define petscdrawtensorcontour_ PETSCDRAWTENSORCONTOUR
43: #define vecsetrandom_ VECSETRANDOM
44: #define veccreateghostblockwitharray_ VECCREATEGHOSTBLOCKWITHARRAY
45: #define veccreateghostblock_ VECCREATEGHOSTBLOCK
46: #define vecloadintovector_ VECLOADINTOVECTOR
47: #define vecconvertmpitoseqall_ VECCONVERTMPITOSEQALL
48: #define vecconvertmpitompizero_ VECCONVERTMPITOMPIZERO
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 vecconvertmpitoseqall_ vecconvertmpitoseqall
92: #define vecconvertmpitompizero_ vecconvertmpitompizero
93: #endif
95: EXTERN_C_BEGIN
97: void PETSC_STDCALL vecloadintovector_(PetscViewer *viewer,Vec *vec,int *ierr)
98: {
99: PetscViewer v;
100: PetscPatchDefaultViewers_Fortran(viewer,v);
101: *VecLoadIntoVector(v,*vec);
102: }
104: void PETSC_STDCALL vecsetrandom_(PetscRandom *r,Vec *x,int *ierr)
105: {
106: *VecSetRandom(*r,*x);
107: }
108: void PETSC_STDCALL petscdrawtensorcontour_(PetscDraw *win,int *m,int *n,PetscReal *x,PetscReal *y,PetscReal *V,int *ierr)
109: {
110: PetscReal *xx = PETSC_NULL;
111: PetscReal *yy = PETSC_NULL;
112: CHKFORTRANNULLDOUBLE(x) else xx = x;
113: CHKFORTRANNULLDOUBLE(y) else yy = y;
115: *PetscDrawTensorContour(*win,*m,*n,xx,yy,V);
116: }
118: void PETSC_STDCALL vecsetfromoptions_(Vec *x,int *ierr)
119: {
120: *VecSetFromOptions(*x);
121: }
123: void PETSC_STDCALL vecsettype_(Vec *x,CHAR type_name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
124: {
125: char *t;
127: FIXCHAR(type_name,len,t);
128: *VecSetType(*x,t);
129: FREECHAR(type_name,t);
130: }
132: void PETSC_STDCALL vecgetpetscmap_(Vec *x,PetscMap *map,int *ierr)
133: {
134: *VecGetPetscMap(*x,map);
135: }
137: void PETSC_STDCALL mapgetlocalsize_(PetscMap *m,int *n,int *ierr)
138: {
139: *PetscMapGetLocalSize(*m,n);
140: }
142: void PETSC_STDCALL mapgetsize_(PetscMap *m,int *N,int *ierr)
143: {
144: *PetscMapGetSize(*m,N);
145: }
147: void PETSC_STDCALL mapgetlocalrange_(PetscMap *m,int *rstart,int *rend,int *ierr)
148: {
149: *PetscMapGetLocalRange(*m,rstart,rend);
150: }
152: void PETSC_STDCALL mapgetglobalrange_(PetscMap *m,int **range,int *ierr)
153: {
154: *PetscMapGetGlobalRange(*m,range);
155: }
157: void PETSC_STDCALL mapdestroy_(PetscMap *m,int *ierr)
158: {
159: *PetscMapDestroy(*m);
160: }
162: void PETSC_STDCALL vecsetvalue_(Vec *v,int *i,PetscScalar *va,InsertMode *mode,int *ierr)
163: {
164: /* cannot use VecSetValue() here since that usesCHKERRQ() which has a return in it */
165: *VecSetValues(*v,1,i,va,*mode);
166: }
168: void PETSC_STDCALL vecview_(Vec *x,PetscViewer *vin,int *ierr)
169: {
170: PetscViewer v;
172: PetscPatchDefaultViewers_Fortran(vin,v);
173: *VecView(*x,v);
174: }
176: void PETSC_STDCALL vecgettype_(Vec *vv,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
177: {
178: char *tname;
179: *VecGetType(*vv,&tname);
180: #if defined(PETSC_USES_CPTOFCD)
181: {
182: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
183: *PetscStrncpy(t,tname,len1);
184: }
185: #else
186: *PetscStrncpy(name,tname,len);
187: #endif
189: }
191: void PETSC_STDCALL vecload_(PetscViewer *viewer,Vec *newvec,int *ierr)
192: {
193: PetscViewer v;
194: PetscPatchDefaultViewers_Fortran(viewer,v);
195: *VecLoad(v,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,long *ia,int *ierr)
200: {
201: int 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,long *ia,int *ierr)
210: {
211: PetscScalar *lx;
212: int 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,int *ierr)
220: {
221: *VecScatterDestroy(*ctx);
222: }
224: void PETSC_STDCALL vecdestroy_(Vec *v,int *ierr)
225: {
226: *VecDestroy(*v);
227: }
229: void PETSC_STDCALL vecscattercreate_(Vec *xin,IS *ix,Vec *yin,IS *iy,VecScatter *newctx,int *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,int *ierr)
237: {
238: *VecScatterCopy(*sctx,ctx);
239: }
241: void PETSC_STDCALL mapcreatempi_(MPI_Comm *comm,int *n,int *N,PetscMap *vv,int *ierr)
242: {
243: *PetscMapCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
244: }
246: void PETSC_STDCALL veccreatempi_(MPI_Comm *comm,int *n,int *N,Vec *vv,int *ierr)
247: {
248: *VecCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
249: }
251: void PETSC_STDCALL veccreateshared_(MPI_Comm *comm,int *n,int *N,Vec *vv,int *ierr)
252: {
253: *VecCreateShared((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
254: }
256: void PETSC_STDCALL veccreateseq_(MPI_Comm *comm,int *n,Vec *V,int *ierr)
257: {
258: *VecCreateSeq((MPI_Comm)PetscToPointerComm(*comm),*n,V);
259: }
261: void PETSC_STDCALL veccreateseqwitharray_(MPI_Comm *comm,int *n,PetscScalar *s,Vec *V,int *ierr)
262: {
263: CHKFORTRANNULLSCALAR(s);
264: *VecCreateSeqWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,s,V);
265: }
267: void PETSC_STDCALL veccreatempiwitharray_(MPI_Comm *comm,int *n,int *N,PetscScalar *s,Vec *V,int *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,int *ierr)
274: {
275: *VecCreate((MPI_Comm)PetscToPointerComm(*comm),V);
276: }
278: void PETSC_STDCALL vecduplicate_(Vec *v,Vec *newv,int *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,int *m,Vec *newv,int *ierr)
289: {
290: Vec *lV;
291: int i;
292: *VecDuplicateVecs(*v,*m,&lV);
293: for (i=0; i<*m; i++) {
294: newv[i] = lV[i];
295: }
296: PetscFree(lV);
297: }
299: void PETSC_STDCALL vecdestroyvecs_(Vec *vecs,int *m,int *ierr)
300: {
301: int i;
302: for (i=0; i<*m; i++) {
303: *VecDestroy(vecs[i]);if (*ierr) return;
304: }
305: }
307: void PETSC_STDCALL vecmtdot_(int *nv,Vec *x,Vec *y,PetscScalar *val,int *ierr)
308: {
309: *VecMTDot(*nv,*x,y,val);
310: }
312: void PETSC_STDCALL vecmdot_(int *nv,Vec *x,Vec *y,PetscScalar *val,int *ierr)
313: {
314: *VecMDot(*nv,*x,y,val);
315: }
317: void PETSC_STDCALL vecmaxpy_(int *nv,PetscScalar *alpha,Vec *x,Vec *y,int *ierr)
318: {
319: *VecMAXPY(*nv,alpha,*x,y);
320: }
322: void PETSC_STDCALL vecstridenorm_(Vec *x,int *start,NormType *type,PetscReal *val,int *ierr)
323: {
324: *VecStrideNorm(*x,*start,*type,val);
325: }
327: /* ----------------------------------------------------------------------------------------------*/
328: void PETSC_STDCALL veccreateghostblockwitharray_(MPI_Comm *comm,int *bs,int *n,int *N,int *nghost,int *ghosts,
329: PetscScalar *array,Vec *vv,int *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,int *bs,int *n,int *N,int *nghost,int *ghosts,Vec *vv,
337: int *ierr)
338: {
339: *VecCreateGhostBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,ghosts,vv);
340: }
342: void PETSC_STDCALL veccreateghostwitharray_(MPI_Comm *comm,int *n,int *N,int *nghost,int *ghosts,PetscScalar *array,
343: Vec *vv,int *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,int *n,int *N,int *nghost,int *ghosts,Vec *vv,int *ierr)
351: {
352: *VecCreateGhost((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,ghosts,vv);
353: }
355: void PETSC_STDCALL vecghostgetlocalform_(Vec *g,Vec *l,int *ierr)
356: {
357: *VecGhostGetLocalForm(*g,l);
358: }
360: void PETSC_STDCALL vecghostrestorelocalform_(Vec *g,Vec *l,int *ierr)
361: {
362: *VecGhostRestoreLocalForm(*g,l);
363: }
365: void PETSC_STDCALL vecmax_(Vec *x,int *p,PetscReal *val,int *ierr)
366: {
367: CHKFORTRANNULLINTEGER(p);
368: *VecMax(*x,p,val);
369: }
371: void PETSC_STDCALL vecconvertmpitoseqall_(Vec *v,Vec *newv,int *ierr)
372: {
373: *VecConvertMPIToSeqAll(*v,newv);
374: }
376: void PETSC_STDCALL vecconvertmpitompizero_(Vec *v,Vec *newv,int *ierr)
377: {
378: *VecConvertMPIToMPIZero(*v,newv);
379: }
381: EXTERN_C_END