program hellompi implicit none include 'mpif.h' integer :: ierror integer :: commsize, rank integer :: nprocs, summ, rbuf call MPI_Init(ierror) call MPI_Comm_size(MPI_COMM_WORLD, commsize, ierror) call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) nprocs = commsize summ = rank do while ( (rank < nprocs) .and. (nprocs > 1) ) nprocs = nprocs / 2 if ( (rank + 1) > nprocs) then call MPI_Send(summ, 1, MPI_INTEGER, rank - nprocs, 0, MPI_COMM_WORLD, ierror) else call MPI_Recv(rbuf, 1, MPI_INTEGER, rank + nprocs, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierror) summ = summ + rbuf end if end do if (rank == 0) then write(*,*)'Total sum = ',summ, ' expected = ', commsize * (commsize - 1) / 2 end if call MPI_Finalize(ierror) end program hellompi