diff --git a/frame/collect_on_comm.c b/frame/collect_on_comm.c index c573f20e3a..c16517d5bc 100644 --- a/frame/collect_on_comm.c +++ b/frame/collect_on_comm.c @@ -69,7 +69,6 @@ col_on_comm ( int * Fcomm, int * typesize , int root_task ; MPI_Comm *comm, dummy_comm ; int ierr ; - int dtype = -1; comm = &dummy_comm ; *comm = MPI_Comm_f2c( *Fcomm ) ; @@ -91,18 +90,6 @@ col_on_comm ( int * Fcomm, int * typesize , for ( p = 1 , displace[0] = 0 , noutbuf_loc = recvcounts[0] ; p < ntasks ; p++ ) { displace[p] = displace[p-1]+recvcounts[p-1] ; noutbuf_loc = noutbuf_loc + recvcounts[p] ; - - /* check for overflow: displace is the partial sum of sendcounts, which can overflow for large problems. */ - /* it is sufficient to check displace[p] since it is greater than sendcounts[p] */ - if ( (displace[p] < 0) || (noutbuf_loc < 0) ) - { -#ifndef MS_SUA - fprintf(stderr,"%s %d buffer offset overflow!!\n",__FILE__,__LINE__) ; - fprintf(stderr," ---> p = %d,\n ---> displace[%d] = %d,\n ---> noutbuf_loc = %d,\n ---> typesize = %d\n", - p, p, displace[p], noutbuf_loc, *typesize); -#endif - MPI_Abort(MPI_COMM_WORLD,1) ; - } } if ( noutbuf_loc > * noutbuf ) @@ -114,23 +101,27 @@ col_on_comm ( int * Fcomm, int * typesize , #endif MPI_Abort(MPI_COMM_WORLD,1) ; } - } - /* handle different sized data types appropriately. */ - ierr = MPI_Type_match_size (MPI_TYPECLASS_REAL, *typesize, &dtype); - if (MPI_SUCCESS != ierr) { - ierr = MPI_Type_match_size (MPI_TYPECLASS_INTEGER, *typesize, &dtype); - } - if (MPI_SUCCESS != ierr) { + /* multiply everything by the size of the type */ + for ( p = 0 ; p < ntasks ; p++ ) { + displace[p] *= *typesize ; + recvcounts[p] *= *typesize ; + + /* check for overflow: displace is the partial sum of recvcounts, which can overflow for large problems. */ + if (displace[p] < 0) { #ifndef MS_SUA - fprintf(stderr,"%s %d FATAL ERROR: unhandled typesize = %d!!\n", __FILE__,__LINE__,*typesize) ; + fprintf(stderr,"%s %d buffer offset overflow!!\n",__FILE__,__LINE__) ; + fprintf(stderr," ---> p = %d,\n ---> displace[%d] = %d,\n ---> typesize = %d\n", + p, p, displace[p], *typesize); #endif - MPI_Abort(MPI_COMM_WORLD,1) ; + MPI_Abort(MPI_COMM_WORLD,1) ; + } + } } - ierr = MPI_Gatherv( inbuf, *ninbuf, dtype, - outbuf, recvcounts, displace, dtype, - root_task, *comm ) ; + ierr = MPI_Gatherv( inbuf , *ninbuf * *typesize , MPI_CHAR , + outbuf , recvcounts , displace, MPI_CHAR , + root_task , *comm ) ; #ifndef MS_SUA if ( ierr != 0 ) fprintf(stderr,"%s %d MPI_Gatherv returns %d\n",__FILE__,__LINE__,ierr ) ; #endif @@ -194,16 +185,14 @@ dst_on_comm ( int * Fcomm, int * typesize , noutbuf_loc = noutbuf_loc + sendcounts[p] ; /* check for overflow: displace is the partial sum of sendcounts, which can overflow for large problems. */ - /* it is sufficient to check displace[p] since it is greater than sendcounts[p] */ - if ( (displace[p] < 0) || (noutbuf_loc < 0) ) - { + if ( (displace[p] < 0) || (noutbuf_loc < 0) ) { #ifndef MS_SUA - fprintf(stderr,"%s %d buffer offset overflow!!\n",__FILE__,__LINE__) ; - fprintf(stderr," ---> p = %d,\n ---> displace[%d] = %d,\n ---> noutbuf_loc = %d,\n ---> typesize = %d\n", - p, p, displace[p], noutbuf_loc, *typesize); + fprintf(stderr,"%s %d buffer offset overflow!!\n",__FILE__,__LINE__) ; + fprintf(stderr," ---> p = %d,\n ---> displace[%d] = %d,\n ---> noutbuf_loc = %d,\n ---> typesize = %d\n", + p, p, displace[p], noutbuf_loc, *typesize); #endif - MPI_Abort(MPI_COMM_WORLD,1) ; - } + MPI_Abort(MPI_COMM_WORLD,1) ; + } } } @@ -211,12 +200,17 @@ dst_on_comm ( int * Fcomm, int * typesize , ierr = MPI_Type_match_size (MPI_TYPECLASS_REAL, *typesize, &dtype); if (MPI_SUCCESS != ierr) { ierr = MPI_Type_match_size (MPI_TYPECLASS_INTEGER, *typesize, &dtype); - } - if (MPI_SUCCESS != ierr) { + if (MPI_SUCCESS != ierr) { + if (1 == *typesize) { + dtype = MPI_CHAR; + } + else { #ifndef MS_SUA - fprintf(stderr,"%s %d FATAL ERROR: unhandled typesize = %d!!\n", __FILE__,__LINE__,*typesize) ; + fprintf(stderr,"%s %d FATAL ERROR: unhandled typesize = %d!!\n", __FILE__,__LINE__,*typesize) ; #endif - MPI_Abort(MPI_COMM_WORLD,1) ; + MPI_Abort(MPI_COMM_WORLD,1) ; + } + } } MPI_Scatterv( inbuf, sendcounts, displace, dtype,