Fortran Coder

查看: 3339|回复: 1
打印 上一主题 下一主题

[通用算法] PSCAD排序

[复制链接]

834

帖子

2

主题

0

精华

大宗师

F 币
3922 元
贡献
2332 点
楼主
发表于 2021-11-11 21:21:46 | 显示全部楼层
[Fortran] 纯文本查看 复制代码
!代码仅为讲解原理所用,未经过验证
!  未经过验证
!  未经过验证
!------------------------------
module sortMod
  type UDT
    real x, y
    character str*40
  end type
  !升序排列
contains
  !单元素排序
  subroutine sortScale(a)
    implicit none
    real a(:), b
    integer i, j
    do i = 1, size(a)-1
      do j = i+1, size(a)
        if(a(i)>a(j)) then
          b=a(i)
          a(i)=a(j)
          a(j)=b
        end if
      end do
    end do
  end subroutine
  !按第一列对整行排序
  subroutine sortArray(a)
    implicit none
    real a(:,:), b(size(a,1))
    integer i, j
    do i = 1, size(a,2)-1
      do j = i+1, size(a,2)
        if(a(1,i)>a(1,j)) then
          b=a(:,i)
          a(:,i)=a(:,j)
          a(:,j)=b
        end if
      end do
    end do
  end subroutine 
  !按前两列对整行排序
  subroutine sortArray2(a)
    implicit none
    real a(:,:), b(size(a,1))
    integer i, j
    do i = 1, size(a,2)-1
      do j = i+1, size(a,2)
        if(a(1,i)==a(1,j)) then
          if(a(2,i)>a(2,j)) then
            b=a(:,i)
            a(:,i)=a(:,j)
            a(:,j)=b
          end if
        else if(a(1,i)>a(1,j)) then
          b=a(:,i)
          a(:,i)=a(:,j)
          a(:,j)=b   
        end if
      end do
    end do
  end subroutine 
  !按前两列对整行排序,效果同sortArray2, 但更简洁
  !适用于按照前n列排序
  subroutine sortArray3(a)
    implicit none
    real a(:,:), b(size(a,1)), hugeval
    integer i, j
    hugeval = maxval(abs(a(2,:)))*1.1 !大于第二列最大绝对值
    do i = 1, size(a,2)-1
      do j = i+1, size(a,2)
        if(a(1,i)*hugeval+a(2,i)>hugeval*a(1,j)+a(2,j)) then
          b=a(:,i)
          a(:,i)=a(:,j)
          a(:,j)=b   
        end if
      end do
    end do
  end subroutine 
  !自定义数据排序
  subroutine sortUDT(a)
    implicit none
    type(UDT) a(:), b
    integer i, j
    do i = 1, size(a)-1
      do j = i+1, size(a)
        if(a(i)%x>a(j)%x) then
          b=a(i)
          a(i)=a(j)
          a(j)=b
        end if
      end do
    end do
  end subroutine
end module 
  
    

评分

参与人数 1F 币 +3 贡献 +3 收起 理由
fcode + 3 + 3

查看全部评分

您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-11-1 07:12

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表