Fortran 的堆排序（HeapSort）简单实现

Program www_fcode_cn
  Implicit None
  Real , External :: comp_f !// comp_f 用来对比两个数，以决定升序和降序排列
  Real :: a( 8 ) = (/3.,1.,7.,9.,5.,8.,3.,4./)
  Call HeapSort( a , comp_f )
  write(*,*)a
 
Contains !// HeapSort 函数Contains 在Program 下，可以避免传递数组大小参数。也可以包含在Module 中

  Subroutine HeapSort( stD , comp_f )
    Real , Intent( INOUT ) :: stD( : )
    Real , External :: comp_f
    Integer i,ir,j,l,n
    Real :: stTemp
    n = size( stD )
    If ( n < 2 ) Return
    l = n / 2 + 1
    ir = n
    Do while( .TRUE. )
      If( l > 1 ) then
        l = l - 1
        stTemp = stD( l )
      Else
        stTemp = stD( ir )
        stD( ir ) = stD( 1 )
        ir = ir - 1
        If( ir == 1 ) then
          stD( 1 ) = stTemp
          return
        End If
      End If
      i = l
      j = l + l
      Do while( j 0.0 ) then
            j = j+1
          End If
        EndIf
        If( comp_f( stTemp , stD(j) ) > 0.0 )then
          stD(i) = stD( j )
          i = j
          j = j + j
        Else
          j = ir + 1
        End If
      EndDo
      stD( i ) = stTemp
    End Do
  End Subroutine HeapSort

End Program www_fcode_cn

Real Function comp_f( st1 , st2 )
  Real , Parameter :: ORDER = 1.0 !// 降序，-1.0为升序
  Real , Intent( IN ) :: st1 , st2
  comp_f = ORDER*(st1 - st2)
End Function comp_f