teshsuite/smpi/mpich3-test/coll/opprod.c

   1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
   2 /*
   3  *
   4  *  (C) 2003 by Argonne National Laboratory.
   5  *      See COPYRIGHT in top-level directory.
   6  */
   7 #include "mpi.h"
   8 #include "mpitestconf.h"
   9 #include <stdio.h>
  10 #include "mpitest.h"
  11
  12 /*
  13 static char MTEST_Descrip[] = "Test MPI_PROD operations on optional datatypes dupported by MPICH";
  14 */
  15
  16 typedef struct { double r, i; } d_complex;
  17 #ifdef HAVE_LONG_DOUBLE
  18 typedef struct { long double r, i; } ld_complex;
  19 #endif
  20
  21 /*
  22  * This test looks at the handling of logical and for types that are not
  23  * integers or are not required integers (e.g., long long).  MPICH allows
  24  * these as well.  A strict MPI test should not include this test.
  25  */
  26 int main( int argc, char *argv[] )
  27 {
  28     int errs = 0;
  29     int rank, size, maxsize, result[6] = { 1, 1, 2, 6, 24, 120 };
  30     MPI_Comm      comm;
  31     char cinbuf[3], coutbuf[3];
  32     signed char scinbuf[3], scoutbuf[3];
  33     unsigned char ucinbuf[3], ucoutbuf[3];
  34     d_complex dinbuf[3], doutbuf[3];
  35
  36     MTest_Init( &argc, &argv );
  37
  38     comm = MPI_COMM_WORLD;
  39
  40     MPI_Comm_rank( comm, &rank );
  41     MPI_Comm_size( comm, &size );
  42     if (size > 5) maxsize = 5;
  43     else          maxsize = size;
  44
  45     /* General forumula: If we multiple the values from 1 to n, the
  46        product is n!.  This grows very fast, so we'll only use the first
  47        five (1! = 1, 2! = 2, 3! = 6, 4! = 24, 5! = 120), with n!
  48        stored in the array result[n] */
  49
  50 #ifndef USE_STRICT_MPI
  51     /* char */
  52     MTestPrintfMsg( 10, "Reduce of MPI_CHAR\n" );
  53     cinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
  54     cinbuf[1] = 0;
  55     cinbuf[2] = (rank > 1);
  56
  57     coutbuf[0] = 0;
  58     coutbuf[1] = 1;
  59     coutbuf[2] = 1;
  60     MPI_Reduce( cinbuf, coutbuf, 3, MPI_CHAR, MPI_PROD, 0, comm );
  61     if (rank == 0) {
  62         if (coutbuf[0] != (char)result[maxsize-1]) {
  63             errs++;
  64             fprintf( stderr, "char PROD(rank) test failed (%d!=%d)\n",
  65                      (int)coutbuf[0], (int)result[maxsize]);
  66         }
  67         if (coutbuf[1]) {
  68             errs++;
  69             fprintf( stderr, "char PROD(0) test failed\n" );
  70         }
  71         if (size > 1 && coutbuf[2]) {
  72             errs++;
  73             fprintf( stderr, "char PROD(>) test failed\n" );
  74         }
  75     }
  76 #endif /* USE_STRICT_MPI */
  77
  78     /* signed char */
  79     MTestPrintfMsg( 10, "Reduce of MPI_SIGNED_CHAR\n" );
  80     scinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
  81     scinbuf[1] = 0;
  82     scinbuf[2] = (rank > 1);
  83
  84     scoutbuf[0] = 0;
  85     scoutbuf[1] = 1;
  86     scoutbuf[2] = 1;
  87     MPI_Reduce( scinbuf, scoutbuf, 3, MPI_SIGNED_CHAR, MPI_PROD, 0, comm );
  88     if (rank == 0) {
  89         if (scoutbuf[0] != (signed char)result[maxsize-1]) {
  90             errs++;
  91             fprintf( stderr, "signed char PROD(rank) test failed (%d!=%d)\n",
  92                      (int)scoutbuf[0], (int)result[maxsize]);
  93         }
  94         if (scoutbuf[1]) {
  95             errs++;
  96             fprintf( stderr, "signed char PROD(0) test failed\n" );
  97         }
  98         if (size > 1 && scoutbuf[2]) {
  99             errs++;
 100             fprintf( stderr, "signed char PROD(>) test failed\n" );
 101         }
 102     }
 103
 104     /* unsigned char */
 105     MTestPrintfMsg( 10, "Reduce of MPI_UNSIGNED_CHAR\n" );
 106     ucinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
 107     ucinbuf[1] = 0;
 108     ucinbuf[2] = (rank > 0);
 109
 110     ucoutbuf[0] = 0;
 111     ucoutbuf[1] = 1;
 112     ucoutbuf[2] = 1;
 113     MPI_Reduce( ucinbuf, ucoutbuf, 3, MPI_UNSIGNED_CHAR, MPI_PROD, 0, comm );
 114     if (rank == 0) {
 115         if (ucoutbuf[0] != (unsigned char)result[maxsize-1]) {
 116             errs++;
 117             fprintf( stderr, "unsigned char PROD(rank) test failed\n" );
 118         }
 119         if (ucoutbuf[1]) {
 120             errs++;
 121             fprintf( stderr, "unsigned char PROD(0) test failed\n" );
 122         }
 123         if (size > 1 && ucoutbuf[2]) {
 124             errs++;
 125             fprintf( stderr, "unsigned char PROD(>) test failed\n" );
 126         }
 127     }
 128
 129 #ifndef USE_STRICT_MPI
 130     /* For some reason, complex is not allowed for sum and prod */
 131     if (MPI_DOUBLE_COMPLEX != MPI_DATATYPE_NULL) {
 132         int dc;
 133 #ifdef HAVE_LONG_DOUBLE
 134         ld_complex ldinbuf[3], ldoutbuf[3];
 135 #endif
 136         /* Must determine which C type matches this Fortran type */
 137         MPI_Type_size( MPI_DOUBLE_COMPLEX, &dc );
 138         if (dc == sizeof(d_complex)) {
 139             /* double complex; may be null if we do not have Fortran support */
 140             dinbuf[0].r = (rank < maxsize && rank > 0) ? rank : 1;
 141             dinbuf[1].r = 0;
 142             dinbuf[2].r = (rank > 0);
 143             dinbuf[0].i = 0;
 144             dinbuf[1].i = 1;
 145             dinbuf[2].i = -(rank > 0);
 146
 147             doutbuf[0].r = 0;
 148             doutbuf[1].r = 1;
 149             doutbuf[2].r = 1;
 150             doutbuf[0].i = 0;
 151             doutbuf[1].i = 1;
 152             doutbuf[2].i = 1;
 153             MPI_Reduce( dinbuf, doutbuf, 3, MPI_DOUBLE_COMPLEX, MPI_PROD, 0, comm );
 154             if (rank == 0) {
 155                 double imag, real;
 156                 if (doutbuf[0].r != (double)result[maxsize-1] || doutbuf[0].i != 0) {
 157                     errs++;
 158                     fprintf( stderr, "double complex PROD(rank) test failed\n" );
 159                 }
 160                 /* Multiplying the imaginary part depends on size mod 4 */
 161                 imag = 1.0; real = 0.0; /* Make compiler happy */
 162                 switch (size % 4) {
 163                 case 1: imag = 1.0; real = 0.0; break;
 164                 case 2: imag = 0.0; real = -1.0; break;
 165                 case 3: imag =-1.0; real = 0.0; break;
 166                 case 0: imag = 0.0; real = 1.0; break;
 167                 }
 168                 if (doutbuf[1].r != real || doutbuf[1].i != imag) {
 169                     errs++;
 170                     fprintf( stderr, "double complex PROD(i) test failed (%f,%f)!=(%f,%f)\n",
 171                          doutbuf[1].r,doutbuf[1].i,real,imag);
 172                 }
 173                 if (doutbuf[2].r != 0 || doutbuf[2].i != 0) {
 174                     errs++;
 175                     fprintf( stderr, "double complex PROD(>) test failed\n" );
 176                 }
 177             }
 178         }
 179 #ifdef HAVE_LONG_DOUBLE
 180         else if (dc == sizeof(ld_complex)) {
 181             /* double complex; may be null if we do not have Fortran support */
 182             ldinbuf[0].r = (rank < maxsize && rank > 0) ? rank : 1;
 183             ldinbuf[1].r = 0;
 184             ldinbuf[2].r = (rank > 0);
 185             ldinbuf[0].i = 0;
 186             ldinbuf[1].i = 1;
 187             ldinbuf[2].i = -(rank > 0);
 188
 189             ldoutbuf[0].r = 0;
 190             ldoutbuf[1].r = 1;
 191             ldoutbuf[2].r = 1;
 192             ldoutbuf[0].i = 0;
 193             ldoutbuf[1].i = 1;
 194             ldoutbuf[2].i = 1;
 195             MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_DOUBLE_COMPLEX, MPI_PROD, 0, comm );
 196             if (rank == 0) {
 197                 long double imag, real;
 198                 if (ldoutbuf[0].r != (double)result[maxsize-1] || ldoutbuf[0].i != 0) {
 199                     errs++;
 200                     fprintf( stderr, "double complex PROD(rank) test failed\n" );
 201                 }
 202                 /* Multiplying the imaginary part depends on size mod 4 */
 203                 imag = 1.0; real = 0.0; /* Make compiler happy */
 204                 switch (size % 4) {
 205                 case 1: imag = 1.0; real = 0.0; break;
 206                 case 2: imag = 0.0; real = -1.0; break;
 207                 case 3: imag =-1.0; real = 0.0; break;
 208                 case 0: imag = 0.0; real = 1.0; break;
 209                 }
 210                 if (ldoutbuf[1].r != real || ldoutbuf[1].i != imag) {
 211                     errs++;
 212                     fprintf( stderr, "double complex PROD(i) test failed (%Lf,%Lf)!=(%Lf,%Lf)\n",
 213                          ldoutbuf[1].r,ldoutbuf[1].i,real,imag);
 214                 }
 215                 if (ldoutbuf[2].r != 0 || ldoutbuf[2].i != 0) {
 216                     errs++;
 217                     fprintf( stderr, "double complex PROD(>) test failed\n" );
 218                 }
 219             }
 220         }
 221 #endif /* HAVE_LONG_DOUBLE */
 222     }
 223 #endif /* USE_STRICT_MPI */
 224
 225 #ifdef HAVE_LONG_DOUBLE
 226     { long double ldinbuf[3], ldoutbuf[3];
 227     /* long double */
 228     ldinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
 229     ldinbuf[1] = 0;
 230     ldinbuf[2] = (rank > 0);
 231
 232     ldoutbuf[0] = 0;
 233     ldoutbuf[1] = 1;
 234     ldoutbuf[2] = 1;
 235     if (MPI_LONG_DOUBLE != MPI_DATATYPE_NULL) {
 236         MPI_Reduce( ldinbuf, ldoutbuf, 3, MPI_LONG_DOUBLE, MPI_PROD, 0, comm );
 237         if (rank == 0) {
 238             if (ldoutbuf[0] != (long double)result[maxsize-1]) {
 239                 errs++;
 240                 fprintf( stderr, "long double PROD(rank) test failed\n" );
 241             }
 242             if (ldoutbuf[1]) {
 243                 errs++;
 244                 fprintf( stderr, "long double PROD(0) test failed\n" );
 245             }
 246             if (size > 1 && ldoutbuf[2] != 0) {
 247                 errs++;
 248                 fprintf( stderr, "long double PROD(>) test failed\n" );
 249             }
 250         }
 251     }
 252     }
 253 #endif /* HAVE_LONG_DOUBLE */
 254
 255 #ifdef HAVE_LONG_LONG
 256     {
 257         long long llinbuf[3], lloutbuf[3];
 258     /* long long */
 259     llinbuf[0] = (rank < maxsize && rank > 0) ? rank : 1;
 260     llinbuf[1] = 0;
 261     llinbuf[2] = (rank > 0);
 262
 263     lloutbuf[0] = 0;
 264     lloutbuf[1] = 1;
 265     lloutbuf[2] = 1;
 266     if (MPI_LONG_LONG != MPI_DATATYPE_NULL) {
 267         MPI_Reduce( llinbuf, lloutbuf, 3, MPI_LONG_LONG, MPI_PROD, 0, comm );
 268         if (rank == 0) {
 269             if (lloutbuf[0] != (long long)result[maxsize-1]) {
 270                 errs++;
 271                 fprintf( stderr, "long long PROD(rank) test failed\n" );
 272             }
 273             if (lloutbuf[1]) {
 274                 errs++;
 275                 fprintf( stderr, "long long PROD(0) test failed\n" );
 276             }
 277             if (size > 1 && lloutbuf[2]) {
 278                 errs++;
 279                 fprintf( stderr, "long long PROD(>) test failed\n" );
 280             }
 281         }
 282     }
 283     }
 284 #endif /* HAVE_LONG_LONG */
 285
 286     MTest_Finalize( errs );
 287     MPI_Finalize();
 288     return 0;
 289 }