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