MPI 并行奇偶交换排序（Fortran）

奇偶交换排序

假设一组数有n个值，通过以下阶段可以将这组数排序：

• 第1阶段：将第1和第2个数、第3和第4个数、第5和第6个数…两两进行比较，每两个按大小排好；
• 第2阶段：不过是将第2和第3个数、第4和第5个数、第6和第7个数…两两进行比较，同样每两个按大小排好；
• 第3阶段：重复第1阶段；
• 第4阶段：重复第2阶段；
• …

最多需要n个阶段，就能把这组数排好序。

并行化

使用MPI，思路是把这组数分成几组，每个进程一组，内部先排好序，然后让进程和进程之间比较，小的进程取这两个进程最小的几个数，大的进程取最大的几个数，可以保证比较的两个进程的数是排好序的，重复奇偶交换步骤。以下使用fortran代码编写。

module my_module
    use mpi
    implicit none
    contains
        ! 排序
        subroutine sort(k)
            implicit none
            integer :: k(:), n, i, j, temp
            n = size(k)
            ! 冒泡排序
            do i=1, n
                do j=1, n-i
                    if (k(j) > k(j+1)) then
                        temp = k(j)
                        k(j) = k(j+1)
                        k(j+1) = temp
                    endif
                enddo
            enddo
        end subroutine sort
        ! 取两个有序数组合并后的前几位
        subroutine merge_low(local_k, recv_k)
            implicit none
            integer :: local_k(:), recv_k(:), n, l_i, r_i, t_i
            integer, allocatable :: temp_k(:)
            n = size(local_k)
            t_i = 1
            l_i = 1
            r_i = 1
            allocate(temp_k(n))
            do while(t_i <= n)
                if (local_k(l_i) < recv_k(r_i)) then
                    temp_k(t_i) = local_k(l_i)
                    l_i = l_i+1
                else
                    temp_k(t_i) = recv_k(r_i)
                    r_i = r_i+1
                endif
                t_i = t_i+1
            enddo
            local_k = temp_k
        end subroutine merge_low
        ! 取两个有序数组合并后的后几位
        subroutine merge_high(local_k, recv_k)
            implicit none
            integer :: local_k(:), recv_k(:), n, l_i, r_i, t_i
            integer, allocatable :: temp_k(:)
            n = size(local_k)
            allocate(temp_k(n))
            l_i=n
            r_i=n
            t_i=n
            do while(t_i >= 1)
                if (local_k(l_i) > recv_k(r_i)) then
                    temp_k(t_i) = local_k(l_i)
                    l_i = l_i-1
                else
                    temp_k(t_i) = recv_k(r_i)
                    r_i = r_i-1
                endif
                t_i = t_i-1
            enddo
            local_k = temp_k
        end subroutine merge_high
        ! 计算配对进程号
        integer function compute_partner(phase, rank, size)
            implicit none
            integer :: phase, rank, size
            
            if (mod(phase, 2) == mod(rank, 2)) then
                compute_partner = rank+1
            else
                compute_partner = rank-1
            endif
            ! 验证两头的匹配进程是否有效
            if (compute_partner < 0 .or. compute_partner > size-1) then
                compute_partner = MPI_PROC_NULL
            endif
        end function compute_partner
        ! 获取输入并初始化变量
        subroutine get_input(rank, size, stat, ierr, n, k, r, local_n, local_k, recv_k)
            use mpi
            implicit none
            integer :: rank, size, stat(MPI_STATUS_SIZE), ierr, n, local_n
            integer, allocatable :: k(:), r(:), local_k(:), recv_k(:)

            if (rank == 0) then
                print "('请输入排序的个数(', i2, '的倍数): ')", size
                read(*, *) n
            endif
            ! 把个数广播给各个进程，各个进程才能算出local_n，并初始化本地数组
            call MPI_BCAST(n, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
            local_n = n/size
            allocate(local_k(local_n))
            allocate(recv_k(local_n))

            if (rank == 0) then
                allocate(k(n))
                allocate(r(n))
                print "('请输入', i4, '个整数: ')", n
                read(*, *) k
            endif
            ! 把需要排序的数散射给各个进程
            call MPI_SCATTER(k, local_n, MPI_INTEGER, local_k, local_n, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
        end subroutine get_input
end module my_module

program main
    use mpi
    use my_module
    implicit none
    integer :: rank, size, ierr, stat(MPI_STATUS_SIZE)
    integer ::  phase, local_n, partner, n
    integer, allocatable :: k(:), r(:), local_k(:), recv_k(:)

    call MPI_INIT(ierr)
    call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
    call MPI_COMM_SIZE(MPI_COMM_WORLD, size, ierr)

    ! 初始化值
    call get_input(rank, size, stat, ierr, n, k, r, local_n, local_k, recv_k)
    ! 每个进程内部排序
    call sort(local_k)

    call MPI_BARRIER(MPI_COMM_WORLD, ierr)
    ! 进入并行奇偶交换排序
    do phase=0, size-1
        ! 计算与当前进程配对的进程号
        partner = compute_partner(phase, rank, size)
        if (partner .ne. MPI_PROC_NULL) then
            ! 能配对的进程才会互发消息，要防止死锁
            call MPI_SENDRECV(local_k, local_n, MPI_INTEGER, partner, 0, recv_k, local_n, MPI_INTEGER, partner, 0, MPI_COMM_WORLD, stat, ierr)
            
            ! 互发消息后要保留最小/最大的几个数
            if (rank < partner) then
                call merge_low(local_k, recv_k)
            else
                call merge_high(local_k, recv_k)
            endif
        endif
    enddo
    ! 把各个进程的数收集起来
    call MPI_GATHER(local_k, local_n, MPI_INTEGER, r, local_n, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)

    if (rank == 0) then
        print *, r
    endif
    ! 结束
    call MPI_FINALIZE(ierr)
end program main