| 1 | /* -*- Mode: C; c-basic-offset:4 ; -*- */ |
|---|
| 2 | /* |
|---|
| 3 | * |
|---|
| 4 | * (C) 2001 by Argonne National Laboratory. |
|---|
| 5 | * See COPYRIGHT in top-level directory. |
|---|
| 6 | */ |
|---|
| 7 | |
|---|
| 8 | #include "mpiimpl.h" |
|---|
| 9 | |
|---|
| 10 | /* MINLOC and MAXLOC structures */ |
|---|
| 11 | typedef struct MPIR_2int_loctype { |
|---|
| 12 | int value; |
|---|
| 13 | int loc; |
|---|
| 14 | } MPIR_2int_loctype; |
|---|
| 15 | |
|---|
| 16 | typedef struct MPIR_floatint_loctype { |
|---|
| 17 | float value; |
|---|
| 18 | int loc; |
|---|
| 19 | } MPIR_floatint_loctype; |
|---|
| 20 | |
|---|
| 21 | typedef struct MPIR_longint_loctype { |
|---|
| 22 | long value; |
|---|
| 23 | int loc; |
|---|
| 24 | } MPIR_longint_loctype; |
|---|
| 25 | |
|---|
| 26 | typedef struct MPIR_shortint_loctype { |
|---|
| 27 | short value; |
|---|
| 28 | int loc; |
|---|
| 29 | } MPIR_shortint_loctype; |
|---|
| 30 | |
|---|
| 31 | typedef struct MPIR_doubleint_loctype { |
|---|
| 32 | double value; |
|---|
| 33 | int loc; |
|---|
| 34 | } MPIR_doubleint_loctype; |
|---|
| 35 | |
|---|
| 36 | #if defined(HAVE_LONG_DOUBLE) |
|---|
| 37 | typedef struct MPIR_longdoubleint_loctype { |
|---|
| 38 | long double value; |
|---|
| 39 | int loc; |
|---|
| 40 | } MPIR_longdoubleint_loctype; |
|---|
| 41 | #endif |
|---|
| 42 | |
|---|
| 43 | /* Note a subtlety in these two macros which avoids compiler warnings. |
|---|
| 44 | The compiler complains about using == on floats, but the standard |
|---|
| 45 | requires that we set loc to min of the locs if the two values are |
|---|
| 46 | equal. So we do "if a<b {} else if a<=b Y" which is the same as |
|---|
| 47 | "if a<b X else if a==b Y" but avoids the warning. */ |
|---|
| 48 | #define MPIR_MAXLOC_C_CASE(c_type_) { \ |
|---|
| 49 | c_type_ *a = (c_type_ *)inoutvec; \ |
|---|
| 50 | c_type_ *b = (c_type_ *)invec; \ |
|---|
| 51 | for (i=0; i<len; i++) { \ |
|---|
| 52 | if (a[i].value < b[i].value) { \ |
|---|
| 53 | a[i].value = b[i].value; \ |
|---|
| 54 | a[i].loc = b[i].loc; \ |
|---|
| 55 | } else if (a[i].value <= b[i].value) \ |
|---|
| 56 | a[i].loc = MPIR_MIN(a[i].loc,b[i].loc); \ |
|---|
| 57 | } \ |
|---|
| 58 | } \ |
|---|
| 59 | break |
|---|
| 60 | |
|---|
| 61 | #define MPIR_MAXLOC_F_CASE(f_type_) { \ |
|---|
| 62 | f_type_ *a = (f_type_ *)inoutvec; \ |
|---|
| 63 | f_type_ *b = (f_type_ *)invec; \ |
|---|
| 64 | for ( i=0; i<flen; i+=2 ) { \ |
|---|
| 65 | if (a[i] < b[i]) { \ |
|---|
| 66 | a[i] = b[i]; \ |
|---|
| 67 | a[i+1] = b[i+1]; \ |
|---|
| 68 | } else if (a[i] <= b[i]) \ |
|---|
| 69 | a[i+1] = MPIR_MIN(a[i+1],b[i+1]); \ |
|---|
| 70 | } \ |
|---|
| 71 | } \ |
|---|
| 72 | break |
|---|
| 73 | |
|---|
| 74 | |
|---|
| 75 | #undef FUNCNAME |
|---|
| 76 | #define FUNCNAME MPIR_MAXLOC |
|---|
| 77 | #undef FCNAME |
|---|
| 78 | #define FCNAME MPIU_QUOTE(FUNCNAME) |
|---|
| 79 | void MPIR_MAXLOC( |
|---|
| 80 | void *invec, |
|---|
| 81 | void *inoutvec, |
|---|
| 82 | int *Len, |
|---|
| 83 | MPI_Datatype *type ) |
|---|
| 84 | { |
|---|
| 85 | int mpi_errno = MPI_SUCCESS; |
|---|
| 86 | int i, len = *Len, flen; |
|---|
| 87 | |
|---|
| 88 | flen = len * 2; /* used for Fortran types */ |
|---|
| 89 | |
|---|
| 90 | switch (*type) { |
|---|
| 91 | /* first the C types */ |
|---|
| 92 | case MPI_2INT: MPIR_MAXLOC_C_CASE(MPIR_2int_loctype); |
|---|
| 93 | case MPI_FLOAT_INT: MPIR_MAXLOC_C_CASE(MPIR_floatint_loctype); |
|---|
| 94 | case MPI_LONG_INT: MPIR_MAXLOC_C_CASE(MPIR_longint_loctype); |
|---|
| 95 | case MPI_SHORT_INT: MPIR_MAXLOC_C_CASE(MPIR_shortint_loctype); |
|---|
| 96 | case MPI_DOUBLE_INT: MPIR_MAXLOC_C_CASE(MPIR_doubleint_loctype); |
|---|
| 97 | #if defined(HAVE_LONG_DOUBLE) |
|---|
| 98 | case MPI_LONG_DOUBLE_INT: MPIR_MAXLOC_C_CASE(MPIR_longdoubleint_loctype); |
|---|
| 99 | #endif |
|---|
| 100 | |
|---|
| 101 | /* now the Fortran types */ |
|---|
| 102 | #ifdef HAVE_FORTRAN_BINDING |
|---|
| 103 | #ifndef HAVE_NO_FORTRAN_MPI_TYPES_IN_C |
|---|
| 104 | case MPI_2INTEGER: MPIR_MAXLOC_F_CASE(int); |
|---|
| 105 | case MPI_2REAL: MPIR_MAXLOC_F_CASE(float); |
|---|
| 106 | case MPI_2DOUBLE_PRECISION: MPIR_MAXLOC_F_CASE(double); |
|---|
| 107 | #endif |
|---|
| 108 | #endif |
|---|
| 109 | /* --BEGIN ERROR HANDLING-- */ |
|---|
| 110 | default: { |
|---|
| 111 | MPIU_THREADPRIV_DECL; |
|---|
| 112 | MPIU_THREADPRIV_GET; |
|---|
| 113 | MPIU_ERR_SET1(mpi_errno, MPI_ERR_OP, "**opundefined","**opundefined %s", "MPI_MAXLOC" ); |
|---|
| 114 | MPIU_THREADPRIV_FIELD(op_errno) = mpi_errno; |
|---|
| 115 | break; |
|---|
| 116 | } |
|---|
| 117 | /* --END ERROR HANDLING-- */ |
|---|
| 118 | } |
|---|
| 119 | |
|---|
| 120 | } |
|---|
| 121 | |
|---|
| 122 | |
|---|
| 123 | #undef FUNCNAME |
|---|
| 124 | #define FUNCNAME MPIR_MAXLOC_check_dtype |
|---|
| 125 | #undef FCNAME |
|---|
| 126 | #define FCNAME MPIU_QUOTE(FUNCNAME) |
|---|
| 127 | int MPIR_MAXLOC_check_dtype( MPI_Datatype type ) |
|---|
| 128 | { |
|---|
| 129 | int mpi_errno = MPI_SUCCESS; |
|---|
| 130 | |
|---|
| 131 | switch (type) { |
|---|
| 132 | /* first the C types */ |
|---|
| 133 | case MPI_2INT: |
|---|
| 134 | case MPI_FLOAT_INT: |
|---|
| 135 | case MPI_LONG_INT: |
|---|
| 136 | case MPI_SHORT_INT: |
|---|
| 137 | case MPI_DOUBLE_INT: |
|---|
| 138 | #if defined(HAVE_LONG_DOUBLE) |
|---|
| 139 | case MPI_LONG_DOUBLE_INT: |
|---|
| 140 | #endif |
|---|
| 141 | /* now the Fortran types */ |
|---|
| 142 | #ifdef HAVE_FORTRAN_BINDING |
|---|
| 143 | #ifndef HAVE_NO_FORTRAN_MPI_TYPES_IN_C |
|---|
| 144 | case MPI_2INTEGER: |
|---|
| 145 | case MPI_2REAL: |
|---|
| 146 | case MPI_2DOUBLE_PRECISION: |
|---|
| 147 | #endif |
|---|
| 148 | #endif |
|---|
| 149 | break; |
|---|
| 150 | |
|---|
| 151 | default: MPIU_ERR_SET1(mpi_errno, MPI_ERR_OP, "**opundefined", "**opundefined %s", "MPI_MAXLOC"); |
|---|
| 152 | } |
|---|
| 153 | |
|---|
| 154 | return mpi_errno; |
|---|
| 155 | } |
|---|