comms_reduce_real Subroutine

  subroutine comms_reduce_real(array, size, op)
    !! Reduce real data to root node

    implicit none

    real(kind=dp), intent(inout) :: array
    integer, intent(in)    :: size
    character(len=*), intent(in) :: op

#ifdef MPI
    integer :: error, ierr

    real(kind=dp), allocatable :: array_red(:)

    allocate (array_red(size), stat=ierr)
    if (ierr /= 0) then
      call io_error('failure to allocate array_red in comms_reduce_real')
    end if

    select case (op)

    case ('SUM')
      call MPI_reduce(array, array_red, size, MPI_double_precision, MPI_sum, root_id, mpi_comm_world, error)
    case ('PRD')
      call MPI_reduce(array, array_red, size, MPI_double_precision, MPI_prod, root_id, mpi_comm_world, error)
    case ('MIN')
      call MPI_reduce(array, array_red, size, MPI_double_precision, MPI_MIN, root_id, mpi_comm_world, error)
    case ('MAX')
      call MPI_reduce(array, array_red, size, MPI_double_precision, MPI_max, root_id, mpi_comm_world, error)
    case default
      call io_error('Unknown operation in comms_reduce_real')

    end select

    call dcopy(size, array_red, 1, array, 1)

    if (error .ne. MPI_success) then
      call io_error('Error in comms_reduce_real')
    end if

    if (allocated(array_red)) deallocate (array_red)
#endif

    return

  end subroutine comms_reduce_real