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: #define vecgetownershiprange_         VECGETOWNERSHIPRANGE
 50: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 51: #define vecloadintovector_            vecloadintovector
 52: #define veccreateghostblockwitharray_ veccreateghostblockwitharray
 53: #define veccreateghostblock_      veccreateghostblock
 54: #define petscdrawtensorcontour_   petscdrawtensorcontour
 55: #define vecsetfromoptions_        vecsetfromoptions
 56: #define vecsettype_               vecsettype
 57: #define vecstridenorm_            vecstridenorm
 58: #define vecghostrestorelocalform_ vecghostrestorelocalform
 59: #define vecghostgetlocalform_     vecghostgetlocalform
 60: #define veccreateghostwitharray_  veccreateghostwitharray
 61: #define veccreateghost_           veccreateghost
 62: #define vecgetpetscmap_           vecgetpetscmap
 63: #define mapcreatempi_             mapcreatempi
 64: #define mapgetglobalrange_        mapgetglobalrange
 65: #define mapgetsize_               mapgetsize
 66: #define mapgetlocalsize_          mapgetlocalsize
 67: #define mapgetlocalrange_         mapgetlocalrange
 68: #define mapdestroy_               mapdestroy
 69: #define vecsetvalue_              vecsetvalue
 70: #define vecview_                  vecview
 71: #define vecmaxpy_                 vecmaxpy
 72: #define vecmdot_                  vecmdot
 73: #define veccreateseq_             veccreateseq
 74: #define veccreateseqwitharray_    veccreateseqwitharray
 75: #define veccreatempiwitharray_    veccreatempiwitharray
 76: #define veccreate_                veccreate
 77: #define vecduplicate_             vecduplicate
 78: #define veccreatempi_             veccreatempi
 79: #define veccreateshared_          veccreateshared
 80: #define vecscattercreate_         vecscattercreate
 81: #define vecscattercopy_           vecscattercopy
 82: #define vecdestroy_               vecdestroy
 83: #define vecdestroyvecs_           vecdestroyvecs
 84: #define vecscatterdestroy_        vecscatterdestroy
 85: #define vecrestorearray_          vecrestorearray
 86: #define vecgetarray_              vecgetarray
 87: #define vecload_                  vecload
 88: #define vecgettype_               vecgettype
 89: #define vecduplicatevecs_         vecduplicatevecs
 90: #define vecmax_                   vecmax
 91: #define vecsetrandom_             vecsetrandom
 92: #define vecconvertmpitoseqall_    vecconvertmpitoseqall
 93: #define vecconvertmpitompizero_   vecconvertmpitompizero
 94: #define vecgetownershiprange_     vecgetownershiprange
 95: #endif

 97: EXTERN_C_BEGIN

 99: void PETSC_STDCALL vecloadintovector_(PetscViewer *viewer,Vec *vec,int *ierr)
100: {
101:   PetscViewer v;
102:   PetscPatchDefaultViewers_Fortran(viewer,v);
103:   *VecLoadIntoVector(v,*vec);
104: }

106: void PETSC_STDCALL vecsetrandom_(PetscRandom *r,Vec *x,int *ierr)
107: {
108:   *VecSetRandom(*r,*x);
109: }
110: void PETSC_STDCALL petscdrawtensorcontour_(PetscDraw *win,int *m,int *n,PetscReal *x,PetscReal *y,PetscReal *V,int *ierr)
111: {
112:   CHKFORTRANNULLDOUBLE(x);
113:   CHKFORTRANNULLDOUBLE(y);
114:   *PetscDrawTensorContour(*win,*m,*n,x,y,V);
115: }

117: void PETSC_STDCALL vecsetfromoptions_(Vec *x,int *ierr)
118: {
119:   *VecSetFromOptions(*x);
120: }

122: void PETSC_STDCALL vecsettype_(Vec *x,CHAR type_name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
123: {
124:   char *t;

126:   FIXCHAR(type_name,len,t);
127:   *VecSetType(*x,t);
128:   FREECHAR(type_name,t);
129: }

131: void PETSC_STDCALL vecgetpetscmap_(Vec *x,PetscMap *map,int *ierr)
132: {
133:   *VecGetPetscMap(*x,map);
134: }

136: void PETSC_STDCALL mapgetlocalsize_(PetscMap *m,int *n,int *ierr)
137: {
138:   *PetscMapGetLocalSize(*m,n);
139: }

141: void PETSC_STDCALL mapgetsize_(PetscMap *m,int *N,int *ierr)
142: {
143:   *PetscMapGetSize(*m,N);
144: }

146: void PETSC_STDCALL mapgetlocalrange_(PetscMap *m,int *rstart,int *rend,int *ierr)
147: {
148:   *PetscMapGetLocalRange(*m,rstart,rend);
149: }

151: void PETSC_STDCALL mapgetglobalrange_(PetscMap *m,int **range,int *ierr)
152: {
153:   *PetscMapGetGlobalRange(*m,range);
154: }

156: void PETSC_STDCALL mapdestroy_(PetscMap *m,int *ierr)
157: {
158:   *PetscMapDestroy(*m);
159: }

161: void PETSC_STDCALL vecsetvalue_(Vec *v,int *i,PetscScalar *va,InsertMode *mode,int *ierr)
162: {
163:   /* cannot use VecSetValue() here since that usesCHKERRQ() which has a return in it */
164:   *VecSetValues(*v,1,i,va,*mode);
165: }

167: void PETSC_STDCALL vecview_(Vec *x,PetscViewer *vin,int *ierr)
168: {
169:   PetscViewer v;

171:   PetscPatchDefaultViewers_Fortran(vin,v);
172:   *VecView(*x,v);
173: }

175: void PETSC_STDCALL vecgettype_(Vec *vv,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
176: {
177:   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

188: }

190: void PETSC_STDCALL vecload_(PetscViewer *viewer,Vec *newvec,int *ierr)
191: {
192:   PetscViewer v;
193:   PetscPatchDefaultViewers_Fortran(viewer,v);
194:   *VecLoad(v,newvec);
195: }

197: /* Be to keep vec/examples/ex21.F and snes/examples/ex12.F up to date */
198: void PETSC_STDCALL vecrestorearray_(Vec *x,PetscScalar *fa,long *ia,int *ierr)
199: {
200:   int    m;
201:   PetscScalar *lx;

203:   *VecGetLocalSize(*x,&m);if (*ierr) return;
204:   *PetscScalarAddressFromFortran((PetscObject)*x,fa,*ia,m,&lx);if (*ierr) return;
205:   *VecRestoreArray(*x,&lx);if (*ierr) return;
206: }

208: void PETSC_STDCALL vecgetarray_(Vec *x,PetscScalar *fa,long *ia,int *ierr)
209: {
210:   PetscScalar *lx;
211:   int    m;

213:   *VecGetArray(*x,&lx); if (*ierr) return;
214:   *VecGetLocalSize(*x,&m);if (*ierr) return;
215:   *PetscScalarAddressToFortran((PetscObject)*x,fa,lx,m,ia);
216: }

218: void PETSC_STDCALL vecscatterdestroy_(VecScatter *ctx,int *ierr)
219: {
220:   *VecScatterDestroy(*ctx);
221: }

223: void PETSC_STDCALL vecdestroy_(Vec *v,int *ierr)
224: {
225:   *VecDestroy(*v);
226: }

228: void PETSC_STDCALL vecscattercreate_(Vec *xin,IS *ix,Vec *yin,IS *iy,VecScatter *newctx,int *ierr)
229: {
230:   CHKFORTRANNULLOBJECT(ix);
231:   CHKFORTRANNULLOBJECT(iy);
232:   *VecScatterCreate(*xin,*ix,*yin,*iy,newctx);
233: }

235: void PETSC_STDCALL vecscattercopy_(VecScatter *sctx,VecScatter *ctx,int *ierr)
236: {
237:   *VecScatterCopy(*sctx,ctx);
238: }

240: void PETSC_STDCALL mapcreatempi_(MPI_Comm *comm,int *n,int *N,PetscMap *vv,int *ierr)
241: {
242:   *PetscMapCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
243: }

245: void PETSC_STDCALL veccreatempi_(MPI_Comm *comm,int *n,int *N,Vec *vv,int *ierr)
246: {
247:   *VecCreateMPI((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
248: }

250: void PETSC_STDCALL veccreateshared_(MPI_Comm *comm,int *n,int *N,Vec *vv,int *ierr)
251: {
252:   *VecCreateShared((MPI_Comm)PetscToPointerComm(*comm),*n,*N,vv);
253: }

255: void PETSC_STDCALL veccreateseq_(MPI_Comm *comm,int *n,Vec *V,int *ierr)
256: {
257:   *VecCreateSeq((MPI_Comm)PetscToPointerComm(*comm),*n,V);
258: }

260: void PETSC_STDCALL veccreateseqwitharray_(MPI_Comm *comm,int *n,PetscScalar *s,Vec *V,int *ierr)
261: {
262:   CHKFORTRANNULLSCALAR(s);
263:   *VecCreateSeqWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,s,V);
264: }

266: void PETSC_STDCALL veccreatempiwitharray_(MPI_Comm *comm,int *n,int *N,PetscScalar *s,Vec *V,int *ierr)
267: {
268:   CHKFORTRANNULLSCALAR(s);
269:   *VecCreateMPIWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,*N,s,V);
270: }

272: void PETSC_STDCALL veccreate_(MPI_Comm *comm,Vec *V,int *ierr)
273: {
274:   *VecCreate((MPI_Comm)PetscToPointerComm(*comm),V);
275: }

277: void PETSC_STDCALL vecduplicate_(Vec *v,Vec *newv,int *ierr)
278: {
279:   *VecDuplicate(*v,newv);
280: }

282: /*
283:       vecduplicatevecs() and vecdestroyvecs() are slightly different from C since the 
284:     Fortran provides the array to hold the vector objects,while in C that 
285:     array is allocated by the VecDuplicateVecs()
286: */
287: void PETSC_STDCALL vecduplicatevecs_(Vec *v,int *m,Vec *newv,int *ierr)
288: {
289:   Vec *lV;
290:   int i;
291:   *VecDuplicateVecs(*v,*m,&lV);
292:   for (i=0; i<*m; i++) {
293:     newv[i] = lV[i];
294:   }
295:   PetscFree(lV);
296: }

298: void PETSC_STDCALL vecdestroyvecs_(Vec *vecs,int *m,int *ierr)
299: {
300:   int i;
301:   for (i=0; i<*m; i++) {
302:     *VecDestroy(vecs[i]);if (*ierr) return;
303:   }
304: }

306: void PETSC_STDCALL vecmtdot_(int *nv,Vec *x,Vec *y,PetscScalar *val,int *ierr)
307: {
308:   *VecMTDot(*nv,*x,y,val);
309: }

311: void PETSC_STDCALL vecmdot_(int *nv,Vec *x,Vec *y,PetscScalar *val,int *ierr)
312: {
313:   *VecMDot(*nv,*x,y,val);
314: }

316: void PETSC_STDCALL vecmaxpy_(int *nv,PetscScalar *alpha,Vec *x,Vec *y,int *ierr)
317: {
318:   *VecMAXPY(*nv,alpha,*x,y);
319: }

321: void PETSC_STDCALL vecstridenorm_(Vec *x,int *start,NormType *type,PetscReal *val,int *ierr)
322: {
323:   *VecStrideNorm(*x,*start,*type,val);
324: }

326: /* ----------------------------------------------------------------------------------------------*/
327: void PETSC_STDCALL veccreateghostblockwitharray_(MPI_Comm *comm,int *bs,int *n,int *N,int *nghost,int *ghosts,
328:                               PetscScalar *array,Vec *vv,int *ierr)
329: {
330:   CHKFORTRANNULLSCALAR(array);
331:   *VecCreateGhostBlockWithArray((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,
332:                                     ghosts,array,vv);
333: }

335: void PETSC_STDCALL veccreateghostblock_(MPI_Comm *comm,int *bs,int *n,int *N,int *nghost,int *ghosts,Vec *vv,
336:                           int *ierr)
337: {
338:   *VecCreateGhostBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,*N,*nghost,ghosts,vv);
339: }

341: void PETSC_STDCALL veccreateghostwitharray_(MPI_Comm *comm,int *n,int *N,int *nghost,int *ghosts,PetscScalar *array,
342:                               Vec *vv,int *ierr)
343: {
344:   CHKFORTRANNULLSCALAR(array);
345:   *VecCreateGhostWithArray((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,
346:                                     ghosts,array,vv);
347: }

349: void PETSC_STDCALL veccreateghost_(MPI_Comm *comm,int *n,int *N,int *nghost,int *ghosts,Vec *vv,int *ierr)
350: {
351:   *VecCreateGhost((MPI_Comm)PetscToPointerComm(*comm),*n,*N,*nghost,ghosts,vv);
352: }

354: void PETSC_STDCALL vecghostgetlocalform_(Vec *g,Vec *l,int *ierr)
355: {
356:   *VecGhostGetLocalForm(*g,l);
357: }

359: void PETSC_STDCALL vecghostrestorelocalform_(Vec *g,Vec *l,int *ierr)
360: {
361:   *VecGhostRestoreLocalForm(*g,l);
362: }

364: void PETSC_STDCALL vecmax_(Vec *x,int *p,PetscReal *val,int *ierr)
365: {
366:   CHKFORTRANNULLINTEGER(p);
367:   *VecMax(*x,p,val);
368: }

370: void PETSC_STDCALL vecconvertmpitoseqall_(Vec *v,Vec *newv,int *ierr)
371: {
372:   *VecConvertMPIToSeqAll(*v,newv);
373: }

375: void PETSC_STDCALL vecconvertmpitompizero_(Vec *v,Vec *newv,int *ierr)
376: {
377:   *VecConvertMPIToMPIZero(*v,newv);
378: }

380: void PETSC_STDCALL vecgetownershiprange_(Vec *x,int *low,int *high, int *ierr)
381: {
382:   CHKFORTRANNULLINTEGER(low);
383:   CHKFORTRANNULLINTEGER(high);
384:   *VecGetOwnershipRange(*x,low,high);
385: }

387: EXTERN_C_END