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