冒泡排序改为快速排序

楚香饭

你好歹把代码输入到计算机里吧？

楚香饭

我没用过 PSCAD，以下代码需要你修改以后才能适应。

[Fortran] 纯文本查看 复制代码

! Recursive Fortran 95 quicksort routine
! sorts real numbers into ascending numerical order
! Author: Juli Rew, SCD Consulting juliana@ucar.edu), 9/03
! Based on algorithm from Cormen et al., Introduction to Algorithms,
! 1997 printing
! Made F conformant by Walt Brainerd
module qsort_c_module
  implicit none
  public :: QsortC
  private :: Partition

contains

  recursive subroutine QsortC(A,B)
    real, intent(in out), dimension(:) :: A , B
    integer :: iq
    if(size(A) > 1) then
      call Partition(A , B , iq)
      call QsortC(A(:iq-1),B(:iq-1))
      call QsortC(A(iq:),B(iq:))
    endif
  end subroutine QsortC

  subroutine Partition(A , B , marker)
    real, intent(in out), dimension(:) :: A , B
    integer, intent(out) :: marker
    integer :: i, j
    real :: temp
    real :: x      ! pivot point
    x = A(1)
    i= 0
    j= size(A) + 1
    do
      j = j-1
      do
        if (A(j) <= x) exit
        j = j-1
      end do
      i = i+1
      do
        if (A(i) >= x) exit
        i = i+1
      end do
      if (i < j) then
        ! exchange A(i) and A(j)
        temp = A(i)
        A(i) = A(j)
        A(j) = temp
        temp = B(i)
        B(i) = B(j)
        B(j) = temp
      elseif (i == j) then
        marker = i+1
        return
      else
        marker = i
        return
      endif
    end do
  end subroutine Partition

end module qsort_c_module

  use qsort_c_module
Implicit None 
Integer :: I,K,J !//我瞎写的
Real :: $CLK = 1.0 ,$IARM = 0.1,HLD1,FLAG1,$UNUM,HLD!//我瞎写的

Real Uk(20) , Ukk(40) , T1(20) , $Ts1(20) , $Us1(20)!//我瞎写的
Real M(20)!//我瞎写的
Real M1!//我瞎写的
Real N1!//我瞎写的
  call RANDOM_NUMBER( $us1)!//我瞎写的
  # LOCAL INTEGER T1(20)
  # LOCAL REAL M(20)
  # LOCAL REAL M1
  # LOCAL REAL N1
  IF ($CLK>0.9) THEN
    # LOCAL REAL Uk(20)
    DO I=1,20
      Uk(I)=$Us1(I)
    ENDDO
    # LOCAL REAL Ukk(40)
    DO K=1,20
      Ukk(K)=K
      Ukk(20+K)=Uk(K)
    ENDDO

    IF ($Iarm>0) THEN
      Hld1=1.0
      DO I=1,20
        IF ($Ts1(I)==1) THEN
          Ukk(20+I)=Ukk(20+I)*Hld1
        ENDIF
      ENDDO
      call QsortC( Ukk(21:) , Ukk(1:20) )!//排序
      DO I=1,20
        T1(I)=0
      ENDDO
      DO I=1,$Unum
        M(I)=Ukk(I)
        T1(M(I))=1
      ENDDO
    ENDIF
    IF ($Iarm<0) THEN
      Hld=1.0
      DO I=1,20
        IF ($Ts1(I)==1) THEN
          Ukk(20+I)=Ukk(20+I)*Hld
        ENDIF
      ENDDO
      call QsortC( Ukk(21:) , Ukk(1:20) )!//排序
      DO I=1,20
        T1(I)=0
      ENDDO
      DO I=1,$Unum
        M(I)=Ukk(21-I)
        T1(M(I))=1
      ENDDO
    ENDIF
    DO I=1,20
      $Ts1(I)=T1(I)
    ENDDO
  ENDIF
  
End