teshsuite/smpi/mpich3-test/datatype/large_type_sendrec.c

   1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
   2 /*
   3  *  (C) 2013 by Argonne National Laboratory.
   4  *      See COPYRIGHT in top-level directory.
   5  */
   6
   7 #include <stdio.h>
   8 #include <stdlib.h>
   9 #include <string.h>
  10
  11 /* Defines INT32_MAX, which is not appropriate for int types. */
  12 #include <stdint.h>
  13
  14 /* Defines INT_MAX */
  15 #include <limits.h>
  16
  17 #include <mpi.h>
  18
  19 #include <assert.h>
  20 static void verbose_abort(int errorcode)
  21 {
  22     /* We do not check error codes here
  23      * because if MPI is in a really sorry state,
  24      * all of them might fail. */
  25
  26     int rank;
  27     MPI_Comm_rank(MPI_COMM_WORLD, &rank);
  28
  29     char errorstring[MPI_MAX_ERROR_STRING];
  30     memset(errorstring, 0, MPI_MAX_ERROR_STRING); /* optional */
  31
  32     int errorclass;
  33     MPI_Error_class(errorcode, &errorclass);
  34
  35     int resultlen;
  36     MPI_Error_string(errorcode, errorstring, &resultlen);
  37
  38     fprintf(stderr, "%d: MPI failed (%d: %s) \n", rank, errorclass, errorstring);
  39     fflush(stderr); /* almost certainly redundant with the following... */
  40
  41     MPI_Abort(MPI_COMM_WORLD, errorclass);
  42
  43     return;
  44 }
  45 #define MPI_ASSERT(rc)  \
  46     do { if ((rc)!=MPI_SUCCESS) verbose_abort(rc); } while (0)
  47
  48 int Type_contiguous_x(MPI_Count count, MPI_Datatype oldtype,
  49         MPI_Datatype * newtype);
  50
  51 #define BIGMPI_MAX INT_MAX
  52
  53 /*
  54  * Synopsis
  55  *
  56  * int Type_contiguous_x(MPI_Count      count,
  57  *                            MPI_Datatype   oldtype,
  58  *                            MPI_Datatype * newtype)
  59  *
  60  *  Input Parameters
  61  *
  62  *   count             replication count (nonnegative integer)
  63  *   oldtype           old datatype (handle)
  64  *
  65  * Output Parameter
  66  *
  67  *   newtype           new datatype (handle)
  68  *
  69  */
  70 int Type_contiguous_x(MPI_Count count, MPI_Datatype oldtype, MPI_Datatype * newtype)
  71 {
  72     MPI_Count c = count/BIGMPI_MAX;
  73     MPI_Count r = count%BIGMPI_MAX;
  74
  75     MPI_Datatype chunk;
  76     MPI_ASSERT(MPI_Type_contiguous(BIGMPI_MAX, oldtype, &chunk));
  77
  78     MPI_Datatype chunks;
  79     MPI_ASSERT(MPI_Type_contiguous(c, chunk, &chunks));
  80
  81     MPI_Datatype remainder;
  82     MPI_ASSERT(MPI_Type_contiguous(r, oldtype, &remainder));
  83
  84     int typesize;
  85     MPI_ASSERT(MPI_Type_size(oldtype, &typesize));
  86
  87     MPI_Aint remdisp                   = (MPI_Aint)c*BIGMPI_MAX*typesize; /* must explicit-cast to avoid overflow */
  88     int array_of_blocklengths[2]       = {1,1};
  89     MPI_Aint array_of_displacements[2] = {0,remdisp};
  90     MPI_Datatype array_of_types[2]     = {chunks,remainder};
  91
  92     MPI_ASSERT(MPI_Type_create_struct(2, array_of_blocklengths, array_of_displacements, array_of_types, newtype));
  93     MPI_ASSERT(MPI_Type_commit(newtype));
  94
  95     MPI_ASSERT(MPI_Type_free(&chunk));
  96     MPI_ASSERT(MPI_Type_free(&chunks));
  97     MPI_ASSERT(MPI_Type_free(&remainder));
  98
  99     return MPI_SUCCESS;
 100 }
 101
 102
 103 int main(int argc, char * argv[])
 104 {
 105     int provided;
 106     size_t i;
 107     MPI_Count j;
 108     MPI_ASSERT(MPI_Init_thread(&argc, &argv, MPI_THREAD_SINGLE, &provided));
 109
 110     int rank, size;
 111     MPI_ASSERT(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
 112     MPI_ASSERT(MPI_Comm_size(MPI_COMM_WORLD, &size));
 113
 114     int logn = (argc>1) ? atoi(argv[1]) : 32;
 115     size_t count = (size_t)1<<logn; /* explicit cast required */
 116
 117     MPI_Datatype bigtype;
 118     MPI_ASSERT(Type_contiguous_x( (MPI_Count)count, MPI_CHAR, &bigtype));
 119     MPI_ASSERT(MPI_Type_commit(&bigtype));
 120
 121     MPI_Request requests[2];
 122     MPI_Status statuses[2];
 123
 124     char * rbuf = NULL;
 125     char * sbuf = NULL;
 126
 127     if (rank==(size-1)) {
 128         rbuf = malloc( count * sizeof(char)); assert(rbuf!=NULL);
 129         for (i=0; i<count; i++)
 130             rbuf[i] = 'a';
 131
 132         MPI_ASSERT(MPI_Irecv(rbuf, 1, bigtype, 0,      0, MPI_COMM_WORLD, &(requests[1]) ));
 133     }
 134     if (rank==0) {
 135         sbuf = malloc( count * sizeof(char)); assert(sbuf!=NULL);
 136         for (i=0; i<count; i++)
 137             sbuf[i] = 'z';
 138
 139         MPI_ASSERT(MPI_Isend(sbuf, 1, bigtype, size-1, 0, MPI_COMM_WORLD, &(requests[0]) ));
 140     }
 141
 142     MPI_Count ocount[2];
 143
 144     if (size==1) {
 145         MPI_ASSERT(MPI_Waitall(2, requests, statuses));
 146         MPI_ASSERT(MPI_Get_elements_x( &(statuses[1]), MPI_CHAR, &(ocount[1])));
 147     }
 148     else {
 149         if (rank==(size-1)) {
 150             MPI_ASSERT(MPI_Wait( &(requests[1]), &(statuses[1]) ));
 151             MPI_ASSERT(MPI_Get_elements_x( &(statuses[1]), MPI_CHAR, &(ocount[1]) ));
 152         } else if (rank==0) {
 153             MPI_ASSERT(MPI_Wait( &(requests[0]), &(statuses[0]) ));
 154             /* No valid fields in status from a send request (MPI-3 p53,
 155                line 1-5) */
 156         }
 157     }
 158
 159     /* correctness check */
 160     if (rank==(size-1)) {
 161         MPI_Count errors = 0;
 162         for (j=0; j<count; j++)
 163             errors += ( rbuf[j] != 'z' );
 164         if (errors == 0) {
 165             printf(" No Errors\n");
 166         } else {
 167             printf("errors = %lld \n", errors);
 168         }
 169     }
 170
 171     if (rbuf) free(rbuf);
 172     if (sbuf) free(sbuf);
 173
 174     MPI_ASSERT(MPI_Type_free(&bigtype));
 175
 176     MPI_ASSERT(MPI_Finalize());
 177
 178     return 0;
 179 }