Fortran Coder

查看: 8853|回复: 5
打印 上一主题 下一主题

[Module] 程序调用完module后不再执行hou

[复制链接]

8

帖子

2

主题

0

精华

入门

F 币
59 元
贡献
29 点
跳转到指定楼层
楼主
发表于 2020-10-2 16:56:42 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
module inversionModule
    implicit none

contains
    ! 求交点
    subroutine get_points(x_max, y_max, x_interval, y_interval, x1, y1, x2, y2, x_point, y_point)
        implicit none
        real y, x
        integer x_max, y_max, x_interval, y_interval, x1, y1, x2, y2, i, j
        real, intent(inout), dimension(:), allocatable :: x_point, y_point
        if (y1 == y2) then
            allocate (x_point(x_max/x_interval + 1)); allocate (y_point(y_max/y_interval + 1))
            y_point(:) = y1
            do i = 0, x_max, x_interval
                x_point(i/x_interval + 1) = i
            enddo
        else
            j = 0
            do i = 0, x_max, x_interval
                y = (y2 - y1)*(i - x1)/(x2 - x1 + 0.0) + y1
                if (y >= 0 .and. y <= y_max) then
                    j = j + 1
                endif
            enddo

            do i = 0, y_max, y_interval
                x = (x2 - x1)*(i - y1)/(y2 - y1 + 0.0) + x1
                if (x >= 0 .and. x <= x_max) then
                    j = j + 1
                endif
            enddo

            allocate (x_point(j)); allocate (y_point(j))
            x_point(:) = 0; y_point(:) = 0

            j = 0
            do i = 0, x_max, x_interval
                y = (y2 - y1)*(i - x1)/(x2 - x1 + 0.0) + y1
                if (y >= 0 .and. y <= y_max) then
                    j = j + 1
                    x_point(j) = i
                    y_point(j) = y
                    ! print*,i,y
                endif
            enddo
            do i = 0, y_max, y_interval
                x = (x2 - x1)*(i - y1)/(y2 - y1 + 0.0) + x1
                if (x >= 0 .and. x <= x_max) then
                    j = j + 1
                    x_point(j) = x
                    y_point(j) = i
                    ! print*,x,i
                endif
            enddo
        endif

    end subroutine

    ! 冒泡排序
    subroutine bubble_sort(x_point, y_point, y1, y2, x_point_sort, y_point_sort)
        implicit none
        integer :: i, j, y1, y2
        real :: t
        real, dimension(:), allocatable :: tmp
        real, intent(in), dimension(:), allocatable :: x_point, y_point
        real, dimension(:), allocatable :: x_point_sort, y_point_sort
        allocate (x_point_sort(size(x_point))); allocate (y_point_sort(size(y_point)))
        x_point_sort(:) = x_point(:); y_point_sort(:) = y_point(:)

        do i = 0, size(x_point) - 1
            do j = 0, size(x_point) - 1
                if (x_point_sort(j) > x_point_sort(j + 1)) then
                    t = x_point_sort(j)
                    x_point_sort(j) = x_point_sort(j + 1)
                    x_point_sort(J + 1) = t
                endif
            enddo
        enddo
        do i = 0, size(x_point) - 1
            do j = 0, size(x_point) - 1
                if (y_point_sort(j) > y_point_sort(j + 1)) then
                    t = y_point_sort(j)
                    y_point_sort(j) = y_point_sort(j + 1)
                    y_point_sort(J + 1) = t
                endif
            enddo
        enddo
        if (y1 > y2) then
            allocate (tmp(size(y_point)))
            tmp(:) = y_point_sort(:)
            j = 0
            do i = size(tmp), 1, -1
                j = j + 1
                y_point_sort(j) = tmp(i)
            enddo
        endif
    end subroutine bubble_sort

    ! 去重
    subroutine duplicate_removal(x_point, y_point, x_point_deled, y_point_deled)
        implicit none
        integer i, len, j
        real, intent(out), dimension(:), allocatable :: x_point_deled, y_point_deled
        real, intent(in), dimension(:), allocatable :: x_point, y_point
        len = size(x_point)
        do i = 1, size(x_point) - 1
            if (abs(x_point(i) - x_point(i + 1)) < 0.00001) then
                len = len - 1
            endif
        enddo

        allocate (x_point_deled(len)); allocate (y_point_deled(len))
        x_point_deled(:) = 0; y_point_deled(:) = 0
        i = 1; j = 1
        do while (i <= size(x_point))
            if (abs(x_point(i) - x_point(i + 1)) < 0.00001) then
                x_point_deled(j) = x_point(i)
                y_point_deled(j) = y_point(i)
                i = i + 2
            else
                x_point_deled(j) = x_point(i)
                y_point_deled(j) = y_point(i)
                i = i + 1
            endif
            j = j + 1
        enddo

    end subroutine duplicate_removal

    ! 求距离
    subroutine get_distance(x_point_deled, y_point_deled, x_interval, len_x, distance, number)
        integer i, points_len, xi, yi, len_x, x_interval
        real, intent(in), dimension(:), allocatable :: x_point_deled, y_point_deled
        real, intent(out), dimension(:), allocatable :: distance
        integer, intent(out), dimension(:), allocatable :: number
        points_len = size(x_point_deled)
        allocate (distance(points_len - 1)); allocate (number(points_len - 1))
        do i = 1, points_len - 1
            xi = (x_point_deled(i) + x_point_deled(i + 1))/(x_interval*2)
            yi = (y_point_deled(i) + y_point_deled(i + 1))/(x_interval*2)
            number(i) = len_x*yi + xi + 1
            distance(i) = sqrt((x_point_deled(i) - x_point_deled(i + 1))**2 + ((y_point_deled(i) - y_point_deled(i + 1)))**2)
        enddo
    end subroutine get_distance

    subroutine get_result(x_max, y_max, x_interval, y_interval, x1, y1, x2, y2, distance, number)
        implicit none
        real, dimension(:), allocatable :: x_point_deled, y_point_deled
        real, dimension(:), allocatable :: x_point, y_point, x_point_sort, y_point_sort
        integer, intent(in) :: x_max, y_max, x_interval, y_interval, x1, y1, x2, y2
        real, intent(out), dimension(:), allocatable :: distance
        integer, intent(out), dimension(:), allocatable :: number

        call get_points(x_max, y_max, x_interval, y_interval, x1, y1, x2, y2, x_point, y_point)
        call bubble_sort(x_point, y_point, y1, y2, x_point_sort, y_point_sort)
        call duplicate_removal(x_point_sort, y_point_sort, x_point_deled, y_point_deled)
        call get_distance(x_point_deled, y_point_deled, x_interval, x_max/x_interval, distance, number)
    end subroutine get_result

end module inversionModule

program main
    use inversionModule
    implicit none
    integer x_max, y_max, x_interval, y_interval, x1, y1, x2, y2
    real, dimension(:), allocatable :: distance
    integer, dimension(:), allocatable :: number

    x_max = 70; y_max = 80; x_interval = 10; y_interval = 10; x1 = 0; y1 = 50; x2 = 70; y2 = 10

    call get_result(x_max, y_max, x_interval, y_interval, x1, y1, x2, y2, distance, number)
    print *, "point_result"
    print *, number
    print *, distance

    print *, x_max, y_max, x_interval, y_interval, x1, y1, x2, y2, distance, number
end program main

这是我写的程序代码,执行完call get_result后,程序不再运行
经过测试,是get_result中的call bubble_sort原因,注释call bubble_sort后,程序不再停止,就是可以执行call get_result之后的代码
我实在找不出原因,特来求助


QQ截图20201002165626.jpg (8.83 KB, 下载次数: 272)

QQ截图20201002165626.jpg
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

159

帖子

2

主题

1

精华

大师

Vim

F 币
961 元
贡献
469 点

规矩勋章

来自 4#
发表于 2020-10-3 09:33:15 | 只看该作者
本帖最后由 Transpose 于 2020-10-3 09:35 编辑

编译选项加上 -Wall -fcheck=all 会发现第72行出现数组越界。Fortran数组下标是默认从1开始的,你的循环时从0开始的

8

帖子

2

主题

0

精华

入门

F 币
59 元
贡献
29 点
沙发
 楼主| 发表于 2020-10-2 17:14:41 | 只看该作者
经过测试,同样代码在ubuntu下使用gfortran运行成功,但是在windows 10 下用mingw64 的gfortran运行没有结果,不知道是不是bug

213

帖子

2

主题

0

精华

宗师

F 币
2126 元
贡献
875 点

规矩勋章

板凳
发表于 2020-10-3 01:52:23 | 只看该作者
Vintingb 发表于 2020-10-2 17:14
经过测试,同样代码在ubuntu下使用gfortran运行成功,但是在windows 10 下用mingw64 的gfortran运行没有结果, ...

ubuntu是32还是64?

8

帖子

2

主题

0

精华

入门

F 币
59 元
贡献
29 点
5#
 楼主| 发表于 2020-10-3 12:28:00 | 只看该作者

ubuntu是64位

8

帖子

2

主题

0

精华

入门

F 币
59 元
贡献
29 点
6#
 楼主| 发表于 2020-10-3 12:57:31 | 只看该作者
本帖最后由 Vintingb 于 2020-10-3 16:47 编辑
Transpose 发表于 2020-10-3 09:33
编译选项加上 -Wall -fcheck=all 会发现第72行出现数组越界。Fortran数组下标是默认从1开始的,你的循环时 ...

修改后,运行成功了,感谢
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

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

GMT+8, 2024-4-25 19:24

Powered by Tencent X3.4

© 2013-2024 Tencent

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