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

24小时热门版块排行榜    

Znn3bq.jpeg
小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 初试OpenMP
北京石油化工学院2026年研究生招生接收调剂公告
21/1返回列表
查看: 694  |  回复: 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返回列表
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 327求调剂 +12 Xxjc1107. 2026-04-06 12/600 2026-04-08 16:46 by luoyongfeng
[考研] 一志愿电子科技大学085600材料与化工 329分求调剂 +11 Naiko 2026-04-04 11/550 2026-04-08 14:00 by wutongshun
[考研] 生物学328分求调剂 +7 闪电kkl 2026-04-08 7/350 2026-04-08 13:54 by 蔡苏阳
[考研] 285求调剂 +7 AZMK 2026-04-07 7/350 2026-04-08 11:10 by 逆水乘风
[考研] 287求调剂 +6 Fnhc 2026-04-07 6/300 2026-04-08 10:05 by xingguangj
[考研] 求调剂 +28 111623 2026-04-04 33/1650 2026-04-08 09:24 by 泽润东方
[考研] 283分求调剂 +14 试试看呗 2026-04-04 14/700 2026-04-08 07:03 by lijunpoly
[考研] 一志愿华南师范大学0702物理学305调剂 +3 念常安 2026-04-07 5/250 2026-04-08 06:45 by lijunpoly
[考研] 326分，一志愿沪9，求生物学调剂 +4 刘墨墨 2026-04-05 4/200 2026-04-08 06:22 by lijunpoly
[考研] 11408 325分 +3 jgtxuxgkx 2026-04-07 3/150 2026-04-07 23:10 by lbsjt
[考研] 生物学363调剂求助 +7 fanzhang6666 2026-04-06 9/450 2026-04-07 17:37 by lijunpoly
[考研] 307求调剂 +3 所念及所望 2026-04-06 3/150 2026-04-06 17:30 by 土木硕士招生
[考研] 材料调剂 +9 革微桂 2026-04-04 9/450 2026-04-05 08:27 by 544594351
[考研] 283求调剂 +4 mcbbc 2026-04-03 5/250 2026-04-04 20:51 by imissbao
[考研] 265求调剂 +17 林深温澜 2026-04-01 20/1000 2026-04-04 01:09 by userper
[考研] 调剂0855-288 +5 x熊二a 2026-04-03 5/250 2026-04-04 00:19 by 猪会飞
[考研] 考研求调剂 +3 木心想继续深造 2026-04-03 3/150 2026-04-03 21:56 by 啵啵啵0119
[考研] 求调剂 +4 15064154688 2026-04-03 5/250 2026-04-03 15:07 by zrongyan
[考研] 309求调剂 +14 呆菇不是戴夫 2026-04-02 14/700 2026-04-03 09:42 by 蓝云思雨
[考研] 085600，320分求调剂 +6 大馋小子 2026-04-02 6/300 2026-04-02 21:54 by dongzh2009
信息提示
关闭
请填处理意见
关闭