应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 初试OpenMP
21/1返回列表
查看: 682  |  回复: 1
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看

holmescn

金虫 (正式写手)

[交流] 初试OpenMP

先上代码
CODE:
Program euler41
    Implicit None
    Integer, Parameter :: N = 9
    Integer, Dimension(N) :: Digits
    Integer :: I, R, X

    ! Digits
    Digits = (/(I, I=N,1,-1)/)

    !$OMP PARALLEL SHARED(Digits) Private(R,I,X)
    !$OMP DO
    Do R = 9, 1, -1
        Do I = 1, Arrangement(N, R)
            X = Permutations(R, I)
            If(IsPrime(X)) Then
                Print *, X
            EndIf
        EndDo
    EndDo
    !$OMP END DO
    !$OMP END PARALLEL

Contains

    Function Arrangement(N, M) Result(R)
        Implicit None
        Integer, intent(in) :: N, M
        Integer :: R
        Integer :: I
        R = 1
        Do I = (N-M+1), N
            R = R * I
        End DO
    EndFunction

    Function IsPrime(N) Result(R)
        Implicit None
        Integer :: N, I
        Logical :: R
        R = .True.
        !$OMP PARALLEL SHARED(N, R) PRIVATE(I)
        !$OMP DO
        DO I = 2, Floor(Sqrt(N*1.0))
            If(Mod(N, I) == 0) Then
                R = .False.
            EndIf
        EndDo
        !$OMP END DO
        !$OMP END PARALLEL
        Return
    EndFunction

    Function Permutations(R, nth) Result(V)
        Implicit None
        Integer, Dimension(N) :: Indices
        Integer, Intent(In) :: R, nth
        Integer :: V
        Integer :: M
        Integer :: Factorial
        Integer :: I, J, K

        Indices = 1
        M = nth - 1
        V = 0
        Factorial = Arrangement(N-1, N-1)

        Do I = 1, R
            J = M / Factorial + 1
            M = Mod(M, Factorial)
            If(N.ne.I) Factorial = Factorial / (N-I)

            ! Find the index
            K = 1
            Do
                If(Indices(K) > 0) J = J - 1
                If(J .eq. 0) Exit
                K = K + 1
            End Do
            Indices(K) = 0

            ! Gen the Number
            V = V*10 + Digits(K)
        EndDo
    EndFunction
End Program euler41

题目是Euler工程的第四十一题. 这个题显然是可以并行的. 因为生成一个排列数, 和判断这个数是不是质数是并行的.同时, 判断一个数是不是质数也是可以并行的, 因为判断某个数是不是给定数的因数这个操作是independent的.

这样, 就有了上面的代码. 但不知道是什么地方写的不对, 用gfortran 编译的时候, 使用-openmp选项, 好像没有起什么作用. 运行速度还是和没有openmp的一样. 使用top查看,也没看出多线程来. 使用ifort编译,运行结果出错. 真是有些郁闷.

具体情况还在研究中. 大家一起讨论讨论吧.
回复此楼

» 猜你喜欢
1楼 2011-07-14 15:14:06
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

holmescn

金虫 (正式写手)
★
jjdg(金币+1): 欢迎在本版开题讨论 2011-07-14 20:12:32
1. 调整了一下程序. 减少了一些重复运算.
2. 同时, 把OpenMP的directive写得简单了.
3. gfotran 的openmp 是使用 -fopenmp, 而intel的是-openmp

结果, gfortran -fopenmp -O3 这样编译, 还是需要43s才能运行完. 而ifort -openmp -O3只需要0.6s了.
CODE:
Program euler41
    Implicit None
    Integer, Parameter :: N = 9
    Integer, Dimension(N) :: Digits
    Integer :: I, R, X
    Integer :: Fac

    ! Digits
    Digits = (/(I, I=N,1,-1)/)
    Fac = Arrangement(N-1, N-1)

    Do R = 9, 1, -1
    !$OMP PARALLEL DO
        Do I = 1, Arrangement(N, R)
            X = Permutations(R, I, Fac)
            If(IsPrime(X) .and. X > 97000000) Then
                Print *, X
                Stop
            EndIf
        EndDo
    !$OMP END PARALLEL DO
    EndDo
Contains

    Function Arrangement(N, M) Result(R)
        Implicit None
        Integer, intent(in) :: N, M
        Integer :: R
        Integer :: I
        R = 1
        Do I = (N-M+1), N
            R = R * I
        End DO
    EndFunction

    Function IsPrime(N) Result(R)
        Implicit None
        Integer :: N, I
        Logical :: R
        R = .True.
        !$OMP PARALLEL DO
        DO I = 2, Floor(Sqrt(N*1.0))
            If(Mod(N, I) == 0) Then
                R = .False.
            EndIf
        EndDo
        !$OMP END PARALLEL DO
        Return
    EndFunction

    Function Permutations(R, nth, Fac) Result(V)
        Implicit None
        Integer, Dimension(N) :: Indices
        Integer, Intent(In) :: R, nth
        Integer, Intent(In) :: Fac
        Integer :: Factorial
        Integer :: V
        Integer :: M
        Integer :: I, J, K

        Indices = 1
        M = nth - 1
        V = 0
        Factorial = Fac

        Do I = 1, R
            J = M / Factorial + 1
            M = Mod(M, Factorial)
            If(N.ne.I) Factorial = Factorial / (N-I)

            ! Find the index
            K = 1
            Do
                If(Indices(K) > 0) J = J - 1
                If(J .eq. 0) Exit
                K = K + 1
            End Do
            Indices(K) = 0

            ! Gen the Number
            V = V*10 + Digits(K)
        EndDo
    EndFunction
End Program euler41
赞一下(1人) 回复此楼
2楼2011-07-14 16:29:24
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 holmescn 的主题更新
21/1返回列表
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 304求调剂 +3 曼殊2266 2026-03-18 3/150 2026-03-19 14:42 by peike
[考研] 332求调剂 +3 ydfyh 2026-03-17 3/150 2026-03-19 10:14 by 功夫疯狂
[考研] 本科郑州大学物理学院，一志愿华科070200学硕，346求调剂 +4 我不是一根葱 2026-03-18 4/200 2026-03-19 09:11 by 浮云166
[考研] 304求调剂 +6 司空. 2026-03-18 6/300 2026-03-18 23:03 by 星空星月
[考研] 【同济软件】软件（085405）考研求调剂 +3 2026eternal 2026-03-18 3/150 2026-03-18 19:09 by 搏击518
[考研] 295求调剂 +3 一志愿京区211 2026-03-18 5/250 2026-03-18 17:03 by zhaoqian0518
[考研] 331求调剂（0703有机化学 +7 ZY-05 2026-03-13 8/400 2026-03-18 14:13 by 007_lilei
[考研] 0703化学求调剂 总分331 +3 ZY-05 2026-03-13 3/150 2026-03-18 10:58 by macy2011
[考研] 268求调剂 +6 简单点0 2026-03-17 6/300 2026-03-18 09:04 by 无际的草原
[考研] 293求调剂 +11 zjl的号 2026-03-16 16/800 2026-03-18 08:10 by zhukairuo
[考研] 梁成伟老师课题组欢迎你的加入 +8 一鸭鸭哟 2026-03-14 10/500 2026-03-17 15:07 by 一鸭鸭哟
[考研] 一志愿苏州大学材料工程（085601）专硕有科研经历三项国奖两个实用型专利一项省级立项 +6 大火山小火山 2026-03-16 8/400 2026-03-17 15:05 by 无懈可击111
[考研] 一志愿，福州大学材料专硕339分求调剂 +3 木子momo青争 2026-03-15 3/150 2026-03-17 07:52 by laoshidan
[考研] [导师推荐]西南科技大学国防/材料导师推荐 +3 尖角小荷 2026-03-16 6/300 2026-03-16 23:21 by 尖角小荷
[考研] 中科院材料273求调剂 +4 yzydy 2026-03-15 4/200 2026-03-16 15:59 by Gaodh_82
[考研] 085600调剂 +5 漾漾123sun 2026-03-12 6/300 2026-03-16 15:58 by 漾漾123sun
[考研] 0703化学调剂 290分有科研经历，论文在投 +7 腻腻gk 2026-03-14 7/350 2026-03-16 10:12 by houyaoxu
[考研] 求老师收留调剂 +4 jiang姜66 2026-03-14 5/250 2026-03-15 20:11 by Winj1e
[考研] 材料与化工 323 英一+数二+物化，一志愿：哈工大 本人本科双一流 +4 自由的_飞翔 2026-03-13 5/250 2026-03-14 19:39 by hmn_wj
[考研] 295求调剂 +3 小匕仔汁 2026-03-12 3/150 2026-03-13 15:17 by vgtyfty
信息提示
关闭
请填处理意见
关闭