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