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