MPI/src/DenseMtx_gather.c

/*  DenseMtx_gather.c  */

#include "../spoolesMPI.h"

/*--------------------------------------------------------------------*/
typedef struct _Msg Msg ;
struct _Msg {
   int           id    ;
   int           size  ;
   double        *base ;
   MPI_Request   req   ;
   Msg           *next ;
} ;
/*--------------------------------------------------------------------*/
/*
   --------------------------------------------------------------------
   purpose -- to gather entries from a distributed X into Y .
      what rows of X to be sent to other processors are
      found in sendIVL. what rows of Y to be received
      from other processors are found in recvIVL.

   Y  -- on return, contains the rows specified by recvIVL.
      row indices of Y will be in ascending order.
   X  -- this processor's part of the distributed partitioned
      DenseMtx object. row indices of X are assumed to be
      in ascending order.
   sendIVL -- list jproc contains the global ids of rows in X
      that need to be sent to processor jproc. note, lists are
      assumed to be in ascending order and are local with respect to X.
   recvIVL -- list jproc contains the global ids of rows in jproc's
      part of X that will to be sent to this processor. note,
      lists are assumed to be in ascending order and are local
      with respect to Y.

   created -- 98jul31, cca
   --------------------------------------------------------------------
*/
void
DenseMtx_MPI_gatherRows (
   DenseMtx   *Y,
   DenseMtx   *X,
   IVL        *sendIVL,
   IVL        *recvIVL,
   int        stats[],
   int        msglvl,
   FILE       *msgFile,
   int        firsttag,
   MPI_Comm   comm
) {
double       *recvvec, *sendvec ;
int          flag, iirow, irow, jproc, jrow, lasttag, myid, ncolX,
             ncolY, nproc, nrecv, nrowX, nrowY, nsend, nword, tag,
             tagbound ;
int          *colindX, *colindY, *recvrowids,
             *rowindX, *rowindY, *sendrowids ;
Msg          *msg, *nextmsg, *recvhead, *sendhead ;
MPI_Status   status ;
/*
   ---------------
   check the input
   ---------------
*/
if ( Y == NULL || X == NULL || sendIVL == NULL || recvIVL == NULL
     || (msglvl > 0 && msgFile == NULL) ) {
   fprintf(stderr, "\n fatal error in DenseMtx_MPI_gatherRows()"
           "\n bad input\n") ;
   fprintf(stderr, "\n Y %p, X %p, sendIVL %p, recvIVL %p",
           Y, X, sendIVL, recvIVL) ;
   exit(-1) ;
}
MPI_Comm_rank(comm, &myid) ;
MPI_Comm_size(comm, &nproc) ;
lasttag = firsttag + nproc*nproc ;
if ( lasttag > (tagbound = maxTagMPI(comm)) ) {
   fprintf(stderr, "\n fatal error in DenseMtx_MPI_gatherRows()"
          "\n lasttag = %d, tag_bound = %d", lasttag, tagbound) ;
   exit(-1) ;
}
if ( DENSEMTX_IS_REAL(X) ) {
   nword = 1 ;
} else if ( DENSEMTX_IS_COMPLEX(X) ) {
   nword = 2 ;
} else {
   fprintf(stderr, "\n fatal error in DenseMtx_MPI_gatherRows()"
           "\n X->type = %d\n", X->type) ;
   exit(-1) ;
}
DenseMtx_columnIndices(Y, &ncolY,  &colindY) ;
DenseMtx_rowIndices(Y, &nrowY, &rowindY) ;
DenseMtx_columnIndices(X, &ncolX,  &colindX) ;
DenseMtx_rowIndices(X, &nrowX, &rowindX) ;
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n sendIVL ") ;
   IVL_writeForHumanEye(sendIVL, msgFile) ;
   fprintf(msgFile, "\n\n recvIVL ") ;
   IVL_writeForHumanEye(recvIVL, msgFile) ;
   fflush(msgFile) ;
}
/*
   ----------------------
   load the internal rows
   ----------------------
*/
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n loading internal rows") ;
   fflush(msgFile) ;
}
IVL_listAndSize(sendIVL, myid, &nsend, &sendrowids) ;
IVL_listAndSize(recvIVL, myid, &nrecv, &recvrowids) ;
for ( iirow = 0 ; iirow < nsend ; iirow++ ) {
   irow = sendrowids[iirow] ;
   jrow = recvrowids[iirow] ;
   if ( msglvl > 2 ) {
      fprintf(msgFile, "\n irow %d, jrow %d", irow, jrow) ;
      fflush(msgFile) ;
   }
/*
   DenseMtx_copyRow(Y, jrow, X, irow) ;
*/
   DenseMtx_copyRowAndIndex(Y, jrow, X, irow) ;
}
if ( msglvl > 2 ) {
   fprintf(msgFile, "\n\n after loading internal rows") ;
   DenseMtx_writeForHumanEye(Y, msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------------------
   post the sends and the receives
   -------------------------------
*/
recvhead = sendhead = NULL ;
for ( jproc = 0 ; jproc < nproc ; jproc++ ) {
   if ( jproc != myid ) {
      IVL_listAndSize(sendIVL, jproc, &nsend, &sendrowids) ;
      IVL_listAndSize(recvIVL, jproc, &nrecv, &recvrowids) ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n\n jproc %d, nsend %d, nrecv %d",
                 jproc, nsend, nrecv) ;
         fflush(msgFile) ;
      }
      if ( nsend > 0 ) {
/*
         -------------------------
         create the message object
         -------------------------
*/
         ALLOCATE(msg, struct _Msg, 1) ;
         msg->id   = jproc ;
         msg->size = nword * nsend * ncolY ;
         msg->base = sendvec = DVinit(msg->size, 0.0) ;
         msg->next = sendhead, sendhead = msg ;
         tag       = firsttag + myid*nproc + jproc ;
/*
         -----------------------------------
         fill the buffer with matrix entries
         -----------------------------------
*/
         for ( iirow = 0 ; iirow < nsend ; iirow++ ) {
            irow = sendrowids[iirow] ;
            DenseMtx_copyRowIntoVector(X, irow, sendvec) ;
            sendvec += nword*ncolY ;
         }
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n sendvec") ;
            DVfprintf(msgFile, msg->size, msg->base) ;
            fflush(msgFile) ;
         }
/*
         -------------
         post the send
         -------------
*/
         stats[0]++ ;
         stats[2] += msg->size * sizeof(double) ;
         if ( msglvl > 2 ) {
            fprintf(msgFile,
                    "\n posting Isend to %d, size %d, tag %d",
                    jproc, msg->size, tag) ;
            fflush(msgFile) ;
         }
         MPI_Isend(msg->base, msg->size, MPI_DOUBLE,
                   jproc, tag, comm, &msg->req) ;

      }
      if ( nrecv > 0 ) {
/*
         -------------------------
         create the message object
         -------------------------
*/
         ALLOCATE(msg, struct _Msg, 1) ;
         msg->id   = jproc ;
         msg->size = nword * nrecv * ncolY ;
         msg->base = (void *) DVinit(msg->size, 0.0) ;
         msg->next = recvhead, recvhead = msg ;
         tag       = firsttag + jproc*nproc + myid ;
/*
         ----------------
         post the receive
         ----------------
*/
         stats[1]++ ;
         stats[3] += msg->size * sizeof(double) ;
         if ( msglvl > 2 ) {
            fprintf(msgFile,
                    "\n posting Irecv from %d, size %d, tag %d",
                    jproc, msg->size, tag) ;
            fflush(msgFile) ;
         }
         MPI_Irecv(msg->base, msg->size, MPI_DOUBLE,
                   jproc, tag, comm, &msg->req) ;

      }
   }
}
/*
   -------------------------------------------
   loop while there are messages to receive or
   sent messages that have not been received
   -------------------------------------------
*/
while ( sendhead != NULL || recvhead != NULL ) {
   for ( msg = sendhead, sendhead = NULL ;
         msg != NULL ;
         msg = nextmsg ) {
      nextmsg = msg->next ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n msg %p to %d", msg, msg->id) ;
         fflush(msgFile) ;
      }
      MPI_Test(&msg->req, &flag, &status) ;
      if ( flag == 1 ) {
         if ( msglvl > 2 ) {
            fprintf(msgFile, ", received") ;
            fflush(msgFile) ;
         }
         DVfree((double *) msg->base) ;
         FREE(msg) ;
      } else {
         msg->next = sendhead, sendhead = msg ;
      }
   }
   for ( msg = recvhead, recvhead = NULL ;
         msg != NULL ;
         msg = nextmsg ) {
      nextmsg = msg->next ;
      if ( msglvl > 2 ) {
         fprintf(msgFile, "\n msg %p from %d", msg, msg->id) ;
         fflush(msgFile) ;
      }
      MPI_Test(&msg->req, &flag, &status) ;
      if ( flag == 1 ) {
         jproc = msg->id ;
         if ( msglvl > 2 ) {
            fprintf(msgFile, ", received") ;
            fflush(msgFile) ;
         }
         IVL_listAndSize(recvIVL, jproc, &nrecv, &recvrowids) ;
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n recvrowids") ;
            IVfprintf(msgFile, nrecv, recvrowids) ;
            fflush(msgFile) ;
         }
         recvvec = msg->base ;
         if ( msglvl > 2 ) {
            fprintf(msgFile, "\n recvvec") ;
            DVfprintf(msgFile, nword*nrecv*ncolY, recvvec) ;
            fflush(msgFile) ;
         }
         for ( iirow = 0 ; iirow < nrecv ; iirow++ ) {
            irow = recvrowids[iirow] ;
            DenseMtx_copyVectorIntoRow(Y, irow, recvvec) ;
            recvvec += nword*ncolY ;
         }
         DVfree((double *) msg->base) ;
         FREE(msg) ;
      } else {
         msg->next = recvhead, recvhead = msg ;
      }
   }
}
return ; }

/*--------------------------------------------------------------------*/