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