Actual source code: zis.c

     2:  #include src/fortran/custom/zpetsc.h
     3:  #include petscis.h
      4: #ifdef PETSC_HAVE_FORTRAN_CAPS
      5: #define isduplicate_           ISDUPLICATE
      6: #define ispartitioningcount_   ISPARTITIONINGCOUNT
      7: #define isdestroy_             ISDESTROY
      8: #define iscreatestride_        ISCREATESTRIDE
      9: #define iscreategeneral_       ISCREATEGENERAL
     10: #define isgetindices_          ISGETINDICES
     11: #define isrestoreindices_      ISRESTOREINDICES
     12: #define isblockgetindices_     ISBLOCKGETINDICES
     13: #define isblockrestoreindices_ ISBLOCKRESTOREINDICES
     14: #define iscreateblock_         ISCREATEBLOCK
     15: #define isblock_               ISBLOCK
     16: #define isstride_              ISSTRIDE
     17: #define ispermutation_         ISPERMUTATION
     18: #define isidentity_            ISIDENTITY
     19: #define issorted_              ISSORTED
     20: #define isequal_               ISEQUAL
     21: #define isinvertpermutation_   ISINVERTPERMUTATION
     22: #define isview_                ISVIEW
     23: #define iscoloringcreate_      ISCOLORINGCREATE
     24: #define islocaltoglobalmappingcreate_ ISLOCALTOGLOBALMAPPINGCREATE
     25: #define islocaltoglobalmappingblock_ ISLOCALTOGLOBALMAPPINGBLOCK
     26: #define isallgather_                  ISALLGATHER
     27: #define iscoloringdestroy_            ISCOLORINGDESTROY
     28: #define iscoloringview_               ISCOLORINGVIEW
     29: #define ispartitioningtonumbering_    ISPARTITIONINGTONUMBERING
     30: #define islocaltoglobalmappingapply_  ISLOCALTOGLOBALMAPPINGAPPLY
     31: #define islocaltoglobalmappingview_  ISLOCALTOGLOBALMAPPINGVIEW
     32: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     33: #define isduplicate_           isduplicate
     34: #define islocaltoglobalmappingview_   islocaltoglobalmappingview
     35: #define islocaltoglobalmappingapply_  islocaltoglobalmappingapply
     36: #define iscoloringview_        iscoloringview
     37: #define iscoloringdestroy_     iscoloringdestroy
     38: #define isview_                isview
     39: #define isinvertpermutation_   isinvertpermutation
     40: #define isdestroy_             isdestroy
     41: #define iscreatestride_        iscreatestride
     42: #define iscreategeneral_       iscreategeneral
     43: #define isgetindices_          isgetindices
     44: #define isrestoreindices_      isrestoreindices
     45: #define isblockgetindices_     isblockgetindices
     46: #define isblockrestoreindices_ isblockrestoreindices
     47: #define iscreateblock_         iscreateblock
     48: #define isblock_               isblock
     49: #define isstride_              isstride
     50: #define ispermutation_         ispermutation
     51: #define isidentity_            isidentity
     52: #define issorted_              issorted
     53: #define isequal_               isequal
     54: #define iscoloringcreate_      iscoloringcreate
     55: #define islocaltoglobalmappingcreate_ islocaltoglobalmappingcreate
     56: #define islocaltoglobalmappingblock_ islocaltoglobalmappingblock
     57: #define isallgather_                  isallgather
     58: #define ispartitioningcount_          ispartitioningcount
     59: #define ispartitioningtonumbering_    ispartitioningtonumbering
     60: #endif

     64: void PETSC_STDCALL isduplicate_(IS *is,IS *newis,PetscErrorCode *ierr)
     65: {
     66:   *ISDuplicate(*is,newis);
     67: }

     69: void PETSC_STDCALL islocaltoglobalmappingview_(ISLocalToGlobalMapping *mapping,PetscViewer *viewer,PetscErrorCode *ierr)
     70: {
     71:   CHKFORTRANNULLOBJECTDEREFERENCE(viewer);
     72:   *ISLocalToGlobalMappingView(*mapping,*viewer);
     73: }

     75: /*
     76:    This is the same as the macro ISLocalToGlobalMappingApply() except it does not
     77:   return error codes.
     78: */
     79: void PETSC_STDCALL islocaltoglobalmappingapply_(ISLocalToGlobalMapping *mapping,PetscInt *N,PetscInt *in,PetscInt *out,PetscErrorCode *ierr)
     80: {
     81:   PetscInt i,*idx = (*mapping)->indices,Nmax = (*mapping)->n;
     82:   for (i=0; i<(*N); i++) {
     83:     if (in[i] < 0) {out[i] = in[i]; continue;}
     84:     if (in[i] >= Nmax) {
     85:       *PetscError(__LINE__,"ISLocalToGlobalMappingApply_Fortran",__FILE__,__SDIR__,1,1,"Index out of range");
     86:       return;
     87:     }
     88:     out[i] = idx[in[i]];
     89:   }
     90: }

     92: void PETSC_STDCALL ispartitioningtonumbering_(IS *is,IS *isout,PetscErrorCode *ierr)
     93: {
     94:   *ISPartitioningToNumbering(*is,isout);
     95: }

     97: void PETSC_STDCALL ispartitioningcount_(IS *is,PetscInt *count,PetscErrorCode *ierr)
     98: {
     99:   *ISPartitioningCount(*is,count);
    100: }

    102: void PETSC_STDCALL iscoloringdestroy_(ISColoring *iscoloring,PetscErrorCode *ierr)
    103: {
    104:   *ISColoringDestroy(*iscoloring);
    105: }

    107: void PETSC_STDCALL iscoloringview_(ISColoring *iscoloring,PetscViewer *viewer,PetscErrorCode *ierr)
    108: {
    109:   PetscViewer v;
    110:   PetscPatchDefaultViewers_Fortran(viewer,v);
    111:   *ISColoringView(*iscoloring,v);
    112: }

    114: void PETSC_STDCALL isview_(IS *is,PetscViewer *vin,PetscErrorCode *ierr)
    115: {
    116:   PetscViewer v;
    117:   PetscPatchDefaultViewers_Fortran(vin,v);
    118:   *ISView(*is,v);
    119: }

    121: void PETSC_STDCALL isequal_(IS *is1,IS *is2,PetscTruth *flg,PetscErrorCode *ierr)
    122: {
    123:   *ISEqual(*is1,*is2,flg);
    124: }

    126: void PETSC_STDCALL isidentity_(IS *is,PetscTruth *ident,PetscErrorCode *ierr)
    127: {
    128:   *ISIdentity(*is,ident);
    129: }

    131: void PETSC_STDCALL issorted_(IS *is,PetscTruth *flg,PetscErrorCode *ierr)
    132: {
    133:   *ISSorted(*is,flg);
    134: }

    136: void PETSC_STDCALL ispermutation_(IS *is,PetscTruth *perm,PetscErrorCode *ierr){
    137:   *ISPermutation(*is,perm);
    138: }

    140: void PETSC_STDCALL isstride_(IS *is,PetscTruth *flag,PetscErrorCode *ierr)
    141: {
    142:   *ISStride(*is,flag);
    143: }

    145: void PETSC_STDCALL isblockgetindices_(IS *x,PetscInt *fa,size_t *ia,PetscErrorCode *ierr)
    146: {
    147:   PetscInt   *lx;

    149:   *ISGetIndices(*x,&lx); if (*ierr) return;
    150:   *ia      = PetscIntAddressToFortran(fa,lx);
    151: }

    153: void PETSC_STDCALL isblockrestoreindices_(IS *x,PetscInt *fa,size_t *ia,PetscErrorCode *ierr)
    154: {
    155:   PetscInt *lx = PetscIntAddressFromFortran(fa,*ia);

    157:   *ISRestoreIndices(*x,&lx);
    158: }

    160: void PETSC_STDCALL isblock_(IS *is,PetscTruth *flag,PetscErrorCode *ierr)
    161: {
    162:   *ISBlock(*is,flag);
    163: }

    165: void PETSC_STDCALL isgetindices_(IS *x,PetscInt *fa,size_t *ia,PetscErrorCode *ierr)
    166: {
    167:   PetscInt   *lx;

    169:   *ISGetIndices(*x,&lx); if (*ierr) return;
    170:   *ia      = PetscIntAddressToFortran(fa,lx);
    171: }

    173: void PETSC_STDCALL isrestoreindices_(IS *x,PetscInt *fa,size_t *ia,PetscErrorCode *ierr)
    174: {
    175:   PetscInt *lx = PetscIntAddressFromFortran(fa,*ia);

    177:   *ISRestoreIndices(*x,&lx);
    178: }

    180: void PETSC_STDCALL iscreategeneral_(MPI_Comm *comm,PetscInt *n,PetscInt *idx,IS *is,PetscErrorCode *ierr)
    181: {
    182:   *ISCreateGeneral((MPI_Comm)PetscToPointerComm(*comm),*n,idx,is);
    183: }

    185: void PETSC_STDCALL isinvertpermutation_(IS *is,PetscInt *nlocal,IS *isout,PetscErrorCode *ierr)
    186: {
    187:   *ISInvertPermutation(*is,*nlocal,isout);
    188: }

    190: void PETSC_STDCALL iscreateblock_(MPI_Comm *comm,PetscInt *bs,PetscInt *n,PetscInt *idx,IS *is,PetscErrorCode *ierr)
    191: {
    192:   *ISCreateBlock((MPI_Comm)PetscToPointerComm(*comm),*bs,*n,idx,is);
    193: }

    195: void PETSC_STDCALL iscreatestride_(MPI_Comm *comm,PetscInt *n,PetscInt *first,PetscInt *step,
    196:                                IS *is,PetscErrorCode *ierr)
    197: {
    198:   *ISCreateStride((MPI_Comm)PetscToPointerComm(*comm),*n,*first,*step,is);
    199: }

    201: void PETSC_STDCALL isdestroy_(IS *is,PetscErrorCode *ierr)
    202: {
    203:   *ISDestroy(*is);
    204: }

    206: void PETSC_STDCALL iscoloringcreate_(MPI_Comm *comm,PetscInt *n,PetscInt *colors,ISColoring *iscoloring,PetscErrorCode *ierr)
    207: {
    208:   ISColoringValue *color;
    209:   PetscInt             i;

    211:   /* copies the colors[] array since that is kept by the ISColoring that is created */
    212:   *PetscMalloc((*n+1)*sizeof(ISColoringValue),&color);if (*ierr) return;
    213:   for (i=0; i<(*n); i++) {
    214:     if (colors[i] > IS_COLORING_MAX) {
    215:       *PetscError(__LINE__,"ISColoringCreate_Fortran",__FILE__,__SDIR__,1,1,"Color too large");
    216:       return;
    217:     }
    218:     if (colors[i] < 0) {
    219:       *PetscError(__LINE__,"ISColoringCreate_Fortran",__FILE__,__SDIR__,1,1,"Color cannot be negative");
    220:       return;
    221:     }
    222:     color[i] = (ISColoringValue)colors[i];
    223:   }
    224:   *ISColoringCreate((MPI_Comm)PetscToPointerComm(*comm),*n,color,iscoloring);
    225: }

    227: void PETSC_STDCALL islocaltoglobalmappingcreate_(MPI_Comm *comm,PetscInt *n,PetscInt *indices,ISLocalToGlobalMapping *mapping,PetscErrorCode *ierr)
    228: {
    229:   *ISLocalToGlobalMappingCreate((MPI_Comm)PetscToPointerComm(*comm),*n,indices,mapping);
    230: }

    232: void PETSC_STDCALL islocaltoglobalmappingblock_(ISLocalToGlobalMapping *inmap,PetscInt bs,ISLocalToGlobalMapping *outmap,PetscErrorCode *ierr)
    233: {
    234:   *ISLocalToGlobalMappingBlock(*inmap,bs,outmap);
    235: }

    237: void PETSC_STDCALL isallgather_(IS *is,IS *isout,PetscErrorCode *ierr)
    238: {
    239:   *ISAllGather(*is,isout);

    241: }