! scat.F  check scatter and gather  

program scat

  include 'mpif.h'

  integer :: proc, numprocs
  integer :: myid           ! myid runs 0 to numprocs-1 
  integer :: count = 1
  integer :: master = 0 
  double precision :: esec
  integer :: ierr ! for fortran, same as "C" return value
  integer, dimension(1000) :: bufout ! built by master for distribution 
  integer, dimension(1000) :: bufin  ! slaves and master receive here 
  integer, dimension(1000) :: gath   ! only master receives here from Gather
                                     ! subscripts start with zero 
  integer :: i

  call MPI_Init(ierr) 
  if(ierr .ne. MPI_SUCCESS) then
    print *, 'MPI_Init failed'
  end if
  call MPI_Comm_rank(MPI_COMM_WORLD, myid, ierr) 
  call MPI_Comm_size(MPI_COMM_WORLD, numprocs, ierr) 

  if(myid == master) then
    print *, 'scat.F  numprocs=', numprocs
    print *, 'Scatter is blocking and must be executed by all.' 
    print *, 'Scatter automatically indexes through bufout.'
    print *, 'all, including master, receive from scatter.' 
    print *, 'Gather is blocking and must be executed by all.' 
    print *, 'Gather automatically indexes through gath.'
    print *, 'only master receives from Gather.'
    print *, 'no order guaranteed for print output.'
    do i=1,numprocs ! subscripts start at 1, rank at zero
      bufout(i) = 100+i 
      bufin(i) = 0 
      gath(i) = 0 
    end do
  end if
  ! all 
  count = 1
  call MPI_Scatter(bufout, count, MPI_INTEGER,        &
                   bufin,  count, MPI_INTEGER,        &
                   master, MPI_COMM_WORLD, ierr) 
  ! if(ierr .ne. MPI_SUCCESS) then
  !   print *, 'MPI_Scatter failed , myid=', myid
  ! else
  !   print *, 'MPI_Scatter OK at myid=', myid
  ! end if

  esec = MPI_Wtime() 
  print *, 'recvd scat ', bufin(1), ' for proc=', myid, &
           ' at', esec,'  sec'

  bufin(1) = bufin(1)+10*myid 
  call MPI_Gather(bufin, count, MPI_INTEGER,           &
                  gath,  count, MPI_INTEGER,           &
                  master, MPI_COMM_WORLD, ierr) 
  esec = MPI_Wtime() 
  print *, 'recvd gath', gath(1), ',', gath(2), ' for proc=', &
            myid, '  at', esec, ' sec'

  if(myid == master) then
    print *, 'master gath vector ' 
    do i=1,numprocs
      print *, 'gath(', i, ')=', gath(i) 
    end do
  end if
  call MPI_Finalize(ierr)  
end ! scat.F