今天在学 FORTRAN ，关于数组操作应用的大全,介绍了几种非常实用的排序方法，我将其改编了一下，几个程序将其放到了一块,在这共享一下。
 

程序运行结果：

 一、***************************************************************
source=>  6  2  8  4  0  9  3  5  1  7
sort=>  0  1  2  3  4  5  6  7  8  9
 二、***************************************************************
source=>  12  54  65   2   3  40  91   7 321  50
sort=>   2   3   7  12  40  50  54  65  91 321
 三、***************************************************************
source=> 23 54  8 25 61 77 13 10 66  9
sort=>  8  9 10 13 23 25 54 61 66 77
 四、***************************************************************
source=> 78 40 51 71  0 83 26  6 26 71
sort=>  0  6 26 26 40 51 71 71 78 83
 五、***************************************************************
source=>  6  2  8  4  0  9  3  5  1  7
 input key:
9
a( 6 )=  9
 六、***************************************************************
source=>  2  5  7  9 10 11 13 17 21 23
 input key:
13
a( 7 )= 13

 

 

 FORTRAN 源程序：

! 14.数组的应用    (重点掌握选择排序）

program ex06

    print*,'一、***************************************************************'
    call ex0801

    print*,'二、***************************************************************'
    call ex0802

    print*,'三、***************************************************************'
    call ex0803

    print*,'四、***************************************************************'
    call ex0804

    print*,'五、***************************************************************'
    call ex0805

    print*,'六、***************************************************************'
    call ex0806

 stop
 end

! *********************************************************************************

! 1 冒泡排序算法  (枚举、选择、冒泡、希尔）
! 冒泡排序法范例
! by perng 1997/8/29

subroutine ex0801
  implicit none
  integer, parameter :: n=10
  integer :: a(n)=(/6,2,8,4,0,9,3,5,1,7/) ! 待排序的数据
  write(*,"('source=>',10i3)") a
  call bubble_sort(a,n)  ! 调用排序的子程序
  write(*,"('sort=>',10i3)") a
  return
end

subroutine bubble_sort(a,n)
  implicit none
  integer :: n,a(n)
  integer i,j, temp
  do i=n-1,1,-1   ! 开始做n-1次的扫瞄  1,n=1
    do j=1,i      ! 一对一对的来比较，i之后的数字不用比较 1,n-i
    ! 如果a(j) > a(j+1) 就把这两个数值交换
      if ( a(j) > a(j+1) ) then
        temp=a(j)
        a(j)=a(j+1)
        a(j+1)=temp
      end if
    end do
  end do
  return
end subroutine

 

! *********************************************************************************
! 2 选择排序范例
! 选择排序法范例
! by perng 1997/8/29
subroutine ex0802
  implicit none
  integer, parameter :: n=10
  integer :: a(n)=(/12,54,65,2,3,40,91,7,321,50/) ! 排序的数据

  write(*,"('source=>',10i4)") a
  call selection_sort(a,n)      ! 调用排序的子程序
  write(*,"('sort=>',10i4)") a
 
  return
end
!
! 选择排序法的子程序
!
subroutine selection_sort(a,n)
  implicit none
  integer :: n,a(n)
  integer i,j  ! 循环计数器
  integer min  ! 找出每一轮中的最小值
  integer temp ! 交换数据时使用
!枚举排序
  do i=1,n-1
    min=a(i)     ! 暂时令a(i)是最小值
    do j=i+1,n
      if ( min > a(j) ) then   ! 发现a(i)不是最小
        temp=a(j)        ! 把a(i)\a(j)交换
        a(j)=a(i)
        a(i)=temp
        min=a(i)
      end if
 end do
  end do                             
  return
end subroutine               

! 选择排序
!   do i=1,n-1
!     k=i     ! 暂时令a(i)是最小值
!     do j=i+1,n
!       if (a(k) > a(j) ) k=j  ! 发现a(i)不是最小
!      end do
!    temp=a(k)        ! 把a(i)\a(j)交换
!         a(k)=a(i)
!         a(i)=temp
!     end do                             
!   return
! end subroutine             

 

! *********************************************************************************
! 3 shell排序法
! 选择排序法范例
! by perng 1997/8/29

subroutine ex0803
  implicit none
  integer, parameter :: n=10
  integer :: a(n)=(/23,54,8,25,61,77,13,10,66,9/) ! 排序的数据

  write(*,"('source=>',10i3)") a
  call shell_sort(a,n)
  write(*,"('sort=>',10i3)") a

  return
end

! 选择排序法的子程序

subroutine shell_sort(a,n)
  implicit none
  integer :: n,a(n) ! 传入的数据
  integer i,j       ! 循环计数器
  integer temp      ! 交换数值用
  integer k         ! k 值
  k=n/2             ! k 的初值
  do while( k>0 )
    do i=k+1,n
      j=i-k
      do while( j>0 )
      ! 如果a(j)>a(j+k),要交换它们的数值,并往回取出
      ! a(j-k)\a(j)为新的一组来比较。
        if ( a(j) .gt. a(j+k) ) then
          temp=a(j)
          a(j)=a(j+k)
          a(j+k)=temp
          j=j-k
        else
          exit ! a(j)<a(j+k)时可跳出循环
        end if
   end do
 end do
    k=k/2 ! 设定新的k值
  end do
  return
end subroutine

 

! *********************************************************************************
! 4 快速排序法
! 快速排序法范例
! by perng 1997/8/30

subroutine ex0804
implicit none
  integer, parameter :: n=10
  real :: b(n)
  integer :: a(n)
 
  ! 用随机数来产生数列
  call random_seed()
  call random_number(b)
  a = b*100
  write(*,"('source=>',10i3)") a

  ! 调用quick_sort时除了要传入类型的信息外,还要给定要排列类型元素
  ! 的上下限位置范围. 在此当然是要给 1,n ,表示要从头排到尾.
  call quick_sort(a,n,1,n)
  write(*,"('sort=>',10i3)") a
  return
end
!
! 快速排序法的子程序
!
recursive subroutine quick_sort(a,n,s,e)
implicit none
  integer :: n    ! 表示类型的大小
  integer :: a(n) ! 存放数据的类型
  integer :: s    ! 传入的参数, 这一组的类型起始位置
  integer :: e    ! 传入的参数, 这一组的类型结束位置
  integer :: l,r  ! 用来找a(l)>k及a(r)<k时用的
  integer :: k    ! 记录键值a(s)
  integer :: temp ! 交换两个数值时用的
  ! 首先要先给定l,r的初值. l要从头开始,e则要从尾开始
  l=s 
  r=e+1
  ! right值 > left值 时才有必要进行排序 
  if ( r<=l ) return

  k=a(s)  ! 设定键值
  do while(.true.)
    ! 找出a(l)<k的所在
    do while( .true. )
      l=l+1
      if ( (a(l) > k) .or. (l>=e) ) exit
    end do
    ! 找出a(r)>k的所在
    do while( .true. )
      r=r-1
      if ( (a(r) < k) .or. (r<=s) ) exit
    end do
    ! 如果right 跑到 left的左边时, 循环就该结束了
    if ( r <= l ) exit
    ! 交换a(l),a(r)的数值
    temp=a(l)
    a(l)=a(r)
    a(r)=temp
  end do
  ! 交换a(s),a(r)的数值
  temp=a(s)
  a(s)=a(r)
  a(r)=temp
  ! 把r之前的数据重新分组,再做排序
  call quick_sort(a,n,s,r-1)
  ! 把r之后的数据重新分组,再做排序
  call quick_sort(a,n,r+1,e)
  return
end subroutine quick_sort

 

! *********************************************************************************
! 5 查找算法  (顺序、折半）

! * 顺序查找法范例
! by perng 1997/8/31

subroutine ex0805
  implicit none
  integer, parameter :: n=10
  integer :: a(n)=(/6,2,8,4,0,9,3,5,1,7/) ! 存放数据组的类型
  integer key             ! 记录所要找的值
  integer loc
  integer, external :: sequential_search
  write(*,"('source=>',10i3)") a
  write(*,*) 'input key:'
  read (*,*) key                    ! 键入待寻数据
  ! 调用顺序查找的函数
  loc = sequential_search(a,n,key)
  if ( loc/=0 ) then
    write(*,"('a(',i2,' )='i3)") loc,key
  else
    write(*,*) "not found"
  end if
  return
end

! 顺序查找法的子程序
integer function sequential_search(a,n,key)
  implicit none
  integer n, a(n)
  integer key             ! 所要寻找的值
  integer i               ! 循环的计数器
  do i=1,n  ! 开始做扫瞄, 最多做n次.
    if ( key==a(i) ) then
      ! 找到了, 返回数字在类型中的位置
   sequential_search=i
   return
 end if
  end do
  ! 没找到时返回-1
  sequential_search=0
  return
end function

 

! *********************************************************************************
! * 折半查找法范例
! by perng 1997/8/31

subroutine ex0806
  implicit none
  integer, parameter :: n=10      ! 类型的大小
  integer :: a(n)=(/2,5,7,9,10,11,13,17,21,23/)
  integer key
  integer loc
  integer, external :: binary_search

  write(*,"('source=>',10i3)") a
  write(*,*) 'input key:'
  read (*,*) key
  ! 调用顺序查找的子程序
  loc=binary_search(a,n,key)
  if ( loc/=0 ) then
    write(*,"('a(',i2,' )='i3)") loc,key
  else
    write(*,*) "not found"
  end if
 
  return
end
!
! 折半查找法的子程序
!
integer function binary_search(a,n,key)
  implicit none
  integer n,a(n)
  integer key    ! 所要寻找的值
  integer l      ! 记录每一个小组的类型起始位置
  integer r      ! 记录每一个小组的类型结束位置
  integer m      ! 记录每一个小组的类型中间位置

  ! 一开始的小组范围就是整个类型
  l=1                    
  r=n
  m=(l+r)/2
  ! 如果key值超出范围, 铁定不存在类型中
  if ( (key < a(l)) .or. (key > a(r)) ) then
    binary_search = 0
    return
  end if

  do while( l <= r )
    if ( key > a(m) ) then
    ! 如果 key > 中间值，那数据就落在上半部
      l=m+1
      m=(l+r)/2
    else if ( key < a(m) ) then
    ! 如果 key < 中间值，那数据就落在下半部
      r=m-1
      m=(l+r)/2
    else if ( key .eq. a(m) ) then
   binary_search = m
   return
    end if
  end do

  binary_search = 0
  return
end function