[交流] 初试OpenMP

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

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