Date: 2013-07-02T14:40:37+00:00

Actual source code: sftype.c
petsc-3.4.2 2013-07-02

      1: #include <petsc-private/sfimpl.h>

      3: #if !defined(PETSC_HAVE_MPI_TYPE_GET_ENVELOPE)
      4: #define MPI_Type_get_envelope(datatype,num_ints,num_addrs,num_dtypes,combiner) (*(num_ints)=0,*(num_addrs)=0,*(num_dtypes)=0,*(combiner)=0,1);SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Need an MPI-2 implementation")
      5: #define MPI_Type_get_contents(datatype,num_ints,num_addrs,num_dtypes,ints,addrs,dtypes) (*(ints)=0,*(addrs)=0,*(dtypes)=0,1);SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP_SYS,"Need an MPI-2 implementation")
      6: #endif
      7: #if !defined(PETSC_HAVE_MPI_COMBINER_DUP)  /* We have no way to interpret output of MPI_Type_get_envelope without this. */
      8: #  define MPI_COMBINER_DUP   0
      9: #endif

     13: PetscErrorCode MPIPetsc_Type_unwrap(MPI_Datatype a,MPI_Datatype *atype)
     14: {
     15:   PetscMPIInt    nints,naddrs,ntypes,combiner;

     19:   MPI_Type_get_envelope(a,&nints,&naddrs,&ntypes,&combiner);
     20:   if (combiner == MPI_COMBINER_DUP) {
     21:     PetscMPIInt  ints[1];
     22:     MPI_Aint     addrs[1];
     23:     MPI_Datatype types[1];
     24:     if (nints != 0 || naddrs != 0 || ntypes != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Unexpected returns from MPI_Type_get_envelope()");
     25:     MPI_Type_get_contents(a,0,0,1,ints,addrs,types);
     26:     *atype = types[0];
     27:   } else *atype = a;
     28:   return(0);
     29: }

     33: PetscErrorCode MPIPetsc_Type_compare(MPI_Datatype a,MPI_Datatype b,PetscBool *match)
     34: {
     36:   MPI_Datatype   atype,btype;
     37:   PetscMPIInt    aintcount,aaddrcount,atypecount,acombiner;
     38:   PetscMPIInt    bintcount,baddrcount,btypecount,bcombiner;

     41:   MPIPetsc_Type_unwrap(a,&atype);
     42:   MPIPetsc_Type_unwrap(b,&btype);
     43:   *match = PETSC_FALSE;
     44:   if (atype == btype) {
     45:     *match = PETSC_TRUE;
     46:     return(0);
     47:   }
     48:   MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);
     49:   MPI_Type_get_envelope(btype,&bintcount,&baddrcount,&btypecount,&bcombiner);
     50:   if (acombiner == bcombiner && aintcount == bintcount && aaddrcount == baddrcount && atypecount == btypecount && (aintcount > 0 || aaddrcount > 0 || atypecount > 0)) {
     51:     PetscMPIInt  *aints,*bints;
     52:     MPI_Aint     *aaddrs,*baddrs;
     53:     MPI_Datatype *atypes,*btypes;
     54:     PetscBool    same;
     55:     PetscMalloc6(aintcount,PetscMPIInt,&aints,bintcount,PetscMPIInt,&bints,aaddrcount,MPI_Aint,&aaddrs,baddrcount,MPI_Aint,&baddrs,atypecount,MPI_Datatype,&atypes,btypecount,MPI_Datatype,&btypes);
     56:     MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);
     57:     MPI_Type_get_contents(btype,bintcount,baddrcount,btypecount,bints,baddrs,btypes);
     58:     PetscMemcmp(aints,bints,aintcount*sizeof(aints[0]),&same);
     59:     if (same) {
     60:       PetscMemcmp(aaddrs,baddrs,aaddrcount*sizeof(aaddrs[0]),&same);
     61:       if (same) {
     62:         /* This comparison should be recursive */
     63:         PetscMemcmp(atypes,btypes,atypecount*sizeof(atypes[0]),&same);
     64:       }
     65:     }
     66:     PetscFree6(aints,bints,aaddrs,baddrs,atypes,btypes);
     67:     if (same) *match = PETSC_TRUE;
     68:     return(0);
     69:   }
     70:   return(0);
     71: }