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