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