Actual source code: zvec.c
1: /*$Id: zvec.c,v 1.66 2001/02/19 16:28:29 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 vecgetmap_ VECGETMAP
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: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
48: #define vecloadintovector_ vecloadintovector
49: #define veccreateghostblockwitharray_ veccreateghostblockwitharray
50: #define veccreateghostblock_ veccreateghostblock
51: #define petscdrawtensorcontour_ petscdrawtensorcontour
52: #define vecsetfromoptions_ vecsetfromoptions
53: #define vecsettype_ vecsettype
54: #define vecstridenorm_ vecstridenorm
55: #define vecghostrestorelocalform_ vecghostrestorelocalform
56: #define vecghostgetlocalform_ vecghostgetlocalform
57: #define veccreateghostwitharray_ veccreateghostwitharray
58: #define veccreateghost_ veccreateghost
59: #define vecgetmap_ vecgetmap
60: #define mapcreatempi_ mapcreatempi
61: #define mapgetglobalrange_ mapgetglobalrange
62: #define mapgetsize_ mapgetsize
63: #define mapgetlocalsize_ mapgetlocalsize
64: #define mapgetlocalrange_ mapgetlocalrange
65: #define mapdestroy_ mapdestroy
66: #define vecsetvalue_ vecsetvalue
67: #define vecview_ vecview
68: #define vecmaxpy_ vecmaxpy
69: #define vecmdot_ vecmdot
70: #define veccreateseq_ veccreateseq
71: #define veccreateseqwitharray_ veccreateseqwitharray
72: #define veccreatempiwitharray_ veccreatempiwitharray
73: #define veccreate_ veccreate
74: #define vecduplicate_ vecduplicate
75: #define veccreatempi_ veccreatempi
76: #define veccreateshared_ veccreateshared
77: #define vecscattercreate_ vecscattercreate
78: #define vecscattercopy_ vecscattercopy
79: #define vecdestroy_ vecdestroy
80: #define vecdestroyvecs_ vecdestroyvecs
81: #define vecscatterdestroy_ vecscatterdestroy
82: #define vecrestorearray_ vecrestorearray
83: #define vecgetarray_ vecgetarray
84: #define vecload_ vecload
85: #define vecgettype_ vecgettype
86: #define vecduplicatevecs_ vecduplicatevecs
87: #define vecmax_ vecmax
88: #define vecsetrandom_ vecsetrandom
89: #endif
91: EXTERN_C_BEGIN
93: void PETSC_STDCALL vecloadintovector_(PetscViewer *viewer,Vec *vec,int *ierr)
94: {
95: PetscViewer v;
96: PetscPatchDefaultViewers_Fortran(viewer,v);
97: *VecLoadIntoVector(v,*vec);
98: }
100: void PETSC_STDCALL vecsetrandom_(PetscRandom *r,Vec *x,int *ierr)
101: {
102: *VecSetRandom(*r,*x);
103: }
105: void PETSC_STDCALL petscdrawtensorcontour_(PetscDraw *win,int *m,int *n,double *x,double *y,Scalar *V,int *ierr)
106: {
107: double *xx,*yy;
108: if (FORTRANNULLDOUBLE(x)) xx = PETSC_NULL;
109: else xx = x;
110: if (FORTRANNULLDOUBLE(y)) yy = PETSC_NULL;
111: else yy = y;
113: *PetscDrawTensorContour(*win,*m,*n,xx,yy,V);
114: }
116: void PETSC_STDCALL vecsetfromoptions_(Vec *x,int *ierr)
117: {
118: *VecSetFromOptions(*x);
119: }
121: void PETSC_STDCALL vecsettype_(Vec *x,CHAR type_name PETSC_MIXED_LEN(len),int *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 vecgetmap_(Vec *x,Map *map,int *ierr)
131: {
132: *VecGetMap(*x,map);
133: }
135: void PETSC_STDCALL mapgetlocalsize_(Map *m,int *n,int *ierr)
136: {
137: *MapGetLocalSize(*m,n);
138: }
140: void PETSC_STDCALL mapgetsize_(Map *m,int *N,int *ierr)
141: {
142: *MapGetSize(*m,N);
143: }
145: void PETSC_STDCALL mapgetlocalrange_(Map *m,int *rstart,int *rend,int *ierr)
146: {
147: *MapGetLocalRange(*m,rstart,rend);
148: }
150: void PETSC_STDCALL mapgetglobalrange_(Map *m,int **range,int *ierr)
151: {
152: *MapGetGlobalRange(*m,range);
153: }
155: void PETSC_STDCALL mapdestroy_(Map *m,int *ierr)
156: {
157: *MapDestroy(*m);
158: }
160: void PETSC_STDCALL vecsetvalue_(Vec *v,int *i,Scalar *va,InsertMode *mode)
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,int *ierr)
167: {
168: PetscViewer v;
169: PetscPatchDefaultViewers_Fortran(vin,v);
170: *VecView(*x,v);
171: }
173: void PETSC_STDCALL vecgettype_(Vec *vv,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
174: {
175: char *tname;
176: *VecGetType(*vv,&tname);
177: #if defined(PETSC_USES_CPTOFCD)
178: {
179: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
180: *PetscStrncpy(t,tname,len1);
181: }
182: #else
183: *PetscStrncpy(name,tname,len);
184: #endif
186: }
188: void PETSC_STDCALL vecload_(PetscViewer *viewer,Vec *newvec,int *ierr)
189: {
190: PetscViewer v;
191: PetscPatchDefaultViewers_Fortran(viewer,v);
192: *VecLoad(v,newvec);
193: }
195: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
196: void PETSC_STDCALL vecrestorearray_(Vec *x,Scalar *fa,long *ia,int *ierr)
197: {
198: int m;
199: Scalar *lx;
201: *VecGetLocalSize(*x,&m);if (*ierr) return;
202: *PetscScalarAddressFromFortran((PetscObject)*x,fa,*ia,m,&lx);if (*ierr) return;
203: *VecRestoreArray(*x,&lx);if (*ierr) return;
204: }
206: void PETSC_STDCALL vecgetarray_(Vec *x,Scalar *fa,long *ia,int *ierr)
207: {
208: Scalar *lx;
209: int m;
211: *VecGetArray(*x,&lx); if (*ierr) return;
212: *VecGetLocalSize(*x,&m);if (*ierr) return;
213: *PetscScalarAddressToFortran((PetscObject)*x,fa,lx,m,ia);
214: }
216: void PETSC_STDCALL vecscatterdestroy_(VecScatter *ctx,int *ierr)
217: {
218: *VecScatterDestroy(*ctx);
219: }
221: void PETSC_STDCALL vecdestroy_(Vec *v,int *ierr)
222: {
223: *VecDestroy(*v);
224: }
226: void PETSC_STDCALL vecscattercreate_(Vec *xin,IS *ix,Vec *yin,IS *iy,VecScatter *newctx,int *ierr)
227: {
228: if (FORTRANNULLOBJECT(ix)) ix = PETSC_NULL;
229: if (FORTRANNULLOBJECT(iy)) iy = PETSC_NULL;
230: *VecScatterCreate(*xin,*ix,*yin,*iy,newctx);
231: }
233: void PETSC_STDCALL vecscattercopy_(VecScatter *sctx,VecScatter *ctx,int *ierr)
234: {
235: *VecScatterCopy(*sctx,ctx);
236: }
238: void PETSC_STDCALL mapcreatempi_(MPI_Comm *comm,int *n,int *N,Map *vv,int *ierr)
239: {
240: *MapCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
241: }
243: void PETSC_STDCALL veccreatempi_(MPI_Comm *comm,int *n,int *N,Vec *vv,int *ierr)
244: {
245: *VecCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
246: }
248: void PETSC_STDCALL veccreateshared_(MPI_Comm *comm,int *n,int *N,Vec *vv,int *ierr)
249: {
250: *VecCreateShared((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
251: }
253: void PETSC_STDCALL veccreateseq_(MPI_Comm *comm,int *n,Vec *V,int *ierr)
254: {
255: *VecCreateSeq((MPI_Comm)PetscToPointerComm(*comm),*n,V);
256: }
258: void PETSC_STDCALL veccreateseqwitharray_(MPI_Comm *comm,int *n,Scalar *s,Vec *V,int *ierr)
259: {
260: if (FORTRANNULLSCALAR(s)) s = PETSC_NULL;
261: *VecCreateSeqWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,s,V);
262: }
264: void PETSC_STDCALL veccreatempiwitharray_(MPI_Comm *comm,int *n,int *N,Scalar *s,Vec *V,int *ierr)
265: {
266: if (FORTRANNULLSCALAR(s)) s = PETSC_NULL;
267: *VecCreateMPIWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,*N,s,V);
268: }
270: void PETSC_STDCALL veccreate_(MPI_Comm *comm,int *n,int *N,Vec *V,int *ierr)
271: {
272: *VecCreate((MPI_Comm)PetscToPointerComm(*comm),*n,*N,V);
273: }
275: void PETSC_STDCALL vecduplicate_(Vec *v,Vec *newv,int *ierr)
276: {
277: *VecDuplicate(*v,newv);
278: }
280: /*
281: vecduplicatevecs() and vecdestroyvecs() are slightly different from C since the
282: Fortran provides the array to hold the vector objects,while in C that
283: array is allocated by the VecDuplicateVecs()
284: */
285: void PETSC_STDCALL vecduplicatevecs_(Vec *v,int *m,Vec *newv,int *ierr)
286: {
287: Vec *lV;
288: int i;
289: *VecDuplicateVecs(*v,*m,&lV);
290: for (i=0; i<*m; i++) {
291: newv[i] = lV[i];
292: }
293: PetscFree(lV);
294: }
296: void PETSC_STDCALL vecdestroyvecs_(Vec *vecs,int *m,int *ierr)
297: {
298: int i;
299: for (i=0; i<*m; i++) {
300: *VecDestroy(vecs[i]);if (*ierr) return;
301: }
302: }
304: void PETSC_STDCALL vecmtdot_(int *nv,Vec *x,Vec *y,Scalar *val,int *ierr)
305: {
306: *VecMTDot(*nv,*x,y,val);
307: }
309: void PETSC_STDCALL vecmdot_(int *nv,Vec *x,Vec *y,Scalar *val,int *ierr)
310: {
311: *VecMDot(*nv,*x,y,val);
312: }
314: void PETSC_STDCALL vecmaxpy_(int *nv,Scalar *alpha,Vec *x,Vec *y,int *ierr)
315: {
316: *VecMAXPY(*nv,alpha,*x,y);
317: }
319: void PETSC_STDCALL vecstridenorm_(Vec *x,int *start,NormType *type,double *val,int *ierr)
320: {
321: *VecStrideNorm(*x,*start,*type,val);
322: }
324: /* ----------------------------------------------------------------------------------------------*/
325: void PETSC_STDCALL veccreateghostblockwitharray_(MPI_Comm *comm,int *bs,int *n,int *N,int *nghost,int *ghosts,
326: Scalar *array,Vec *vv,int *ierr)
327: {
328: if (FORTRANNULLSCALAR(array)) array = PETSC_NULL;
329: *VecCreateGhostBlockWithArray((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,
330: ghosts,array,vv);
331: }
333: void PETSC_STDCALL veccreateghostblock_(MPI_Comm *comm,int *bs,int *n,int *N,int *nghost,int *ghosts,Vec *vv,
334: int *ierr)
335: {
336: *VecCreateGhostBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,ghosts,vv);
337: }
339: void PETSC_STDCALL veccreateghostwitharray_(MPI_Comm *comm,int *n,int *N,int *nghost,int *ghosts,Scalar *array,
340: Vec *vv,int *ierr)
341: {
342: if (FORTRANNULLSCALAR(array)) array = PETSC_NULL;
343: *VecCreateGhostWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,
344: ghosts,array,vv);
345: }
347: void PETSC_STDCALL veccreateghost_(MPI_Comm *comm,int *n,int *N,int *nghost,int *ghosts,Vec *vv,int *ierr)
348: {
349: *VecCreateGhost((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,ghosts,vv);
350: }
352: void PETSC_STDCALL vecghostgetlocalform_(Vec *g,Vec *l,int *ierr)
353: {
354: *VecGhostGetLocalForm(*g,l);
355: }
357: void PETSC_STDCALL vecghostrestorelocalform_(Vec *g,Vec *l,int *ierr)
358: {
359: *VecGhostRestoreLocalForm(*g,l);
360: }
362: void PETSC_STDCALL vecmax_(Vec *x,int *p,double *val,int *ierr)
363: {
364: if (FORTRANNULLINTEGER(p)) p = PETSC_NULL;
365: *VecMax(*x,p,val);
366: }
368: EXTERN_C_END