TotalView MPI Exercise 2

Assignment

Your assignment is to use TotalView to locate an error in the following program. This is a 4-processor MPI example. It uses gather for process 1 ( root = 1) to collect the results from the individual process. It does not produce correct results.

The correct output is:
0 0 204 204 408 408 612 612

      PROGRAM GATHER
      IMPLICIT NONE
      include 'mpif.h'
      INTEGER a(2,8), b(8), cpart(2), ctotal(8)
      INTEGER rank, size, i, k, root, ierr, scount, rcount
      call MPI_Init(ierr)
      call MPI_Comm_rank( MPI_COMM_WORLD, rank ,ierr)
      call MPI_Comm_size( MPI_COMM_WORLD, size ,ierr)
      root = 1
      if (size .NE. 4) then
         print *,'Error!:# of processors must be equal to 4'
         print *,'Programm aborting....'
         call MPI_Abort(MPI_COMM_WORLD, 1)
      endif
      DO 10 i=1,2
        DO 10 k=1,8
          a(i,k)=rank*(k+1)
10    CONTINUE
      scount = 2
      rcount = 8      
C     for (i=0;i<2;i++){
C        for (k=0;k<8;k++) {
C           if(k<7) printf("%d ",a[i][k])
C           if(k==7) printf("%d\n",a[i][k])
C        }
C      }
      do 15 k=1,8
        b(k) = k+1
15    CONTINUE

      do 20 i=1,2
        cpart(i) = 0
        do 20 k=1,8
        cpart(i) = cpart(i) + a(i,k) * b(k)
20    CONTINUE
      call MPI_Gather(cpart,scount,MPI_INTEGER,ctotal,rcount,MPI_INTEGER,
     &   root, MPI_COMM_WORLD, ierr)

      if (rank.EQ.root) THEN
        do 25 k=1,8
        if(k.LT.8) print *, ctotal(k)
        if(k.EQ.8) print *, ctotal(k)
25      continue
      endif
      CALL MPI_Finalize(ierr);
      STOP
      END

Details

cut and paste the code into the file gather.c

icc -g -lmpi -o gather gather.c

mpirun -np 4 ./gather

Tips

Launch Totalview with:
totalview mpirun -a -np 4 ./gather

A solution

It has been a common mistake that in the use of MPI_gather function one sets the receive account is n times of the send count, where n is the number of processes (n=4 in this example) when no derived datatype is used. For the simple datatype used in this example, rcound should be equal to scount.

    
      PROGRAM GATHER
      IMPLICIT NONE
      include 'mpif.h'
      INTEGER a(2,8), b(8), cpart(2), ctotal(8)
      INTEGER rank, size, i, k, root, ierr, scount, rcount
      call MPI_Init(ierr)
      call MPI_Comm_rank( MPI_COMM_WORLD, rank ,ierr)
      call MPI_Comm_size( MPI_COMM_WORLD, size ,ierr)
      root = 1
      if (size .NE. 4) then
         print *,'Error!:# of processors must be equal to 4'
         print *,'Programm aborting....'
         call MPI_Abort(MPI_COMM_WORLD, 1)
      endif
      DO 10 i=1,2
        DO 10 k=1,8
          a(i,k)=rank*(k+1)
10    CONTINUE
      scount = 2 
      do 15 k=1,8
        b(k) = k+1
15    CONTINUE
      rcount = 2
      do 20 i=1,2
        cpart(i) = 0
        do 20 k=1,8
        cpart(i) = cpart(i) + a(i,k) * b(k)
20    CONTINUE
      call MPI_Gather(cpart, scount,MPI_INTEGER,ctotal,rcount,MPI_INTEGER,
     &   root, MPI_COMM_WORLD, ierr)

      if (rank.EQ.root) THEN
        do 25 k=1,8
        if(k.LT.8) print *, ctotal(k)
        if(k.EQ.8) print *, ctotal(k)
25      continue
      endif
      CALL MPI_Finalize(ierr);
      STOP
      END