3

次のコードは、単純な 3 つの乱数を生成するだけです。

program testrand

integer, parameter :: nz = 160, nf = 160, nlt = 90

real :: tmpidx(3)
integer :: idxarr(3), idx1, idx2, idx3, seed_size, ticks
integer, allocatable :: seed(:)

call random_seed(size=seed_size)
allocate(seed(seed_size))

call system_clock(count=ticks)
seed = ticks+37*(/(i-1, i=1,seed_size)/)
call random_seed(put=seed)

deallocate(seed)

call random_number(tmpidx)
idxarr = tmpidx * (/nz, nf, nlt/)
idx1 = max(1,idxarr(1))
idx2 = max(1,idxarr(2))
idx3 = max(1,idxarr(3))
print *,idx1, idx2, idx3

end program

これを gfortran でコンパイルして数回実行すると、次のようになります。

> gfortran testrand.f90
> ./a.out
          74          98          86
> ./a.out
         113           3          10
> ./a.out
          44         104          27

かなりランダムに見えます。ここで、PGI Fortran でコンパイルし、数回実行します。

> pgf90 testrand.f90
> ./a.out
            1            1            1
> ./a.out
            1            1            1
> ./a.out
            1            1            1

もちろん、完全に確実な方法はありませんが、これはランダムではないと思います。:) ここで何が起こっているか知っている人はいますか？PGI Fortran で乱数を取得する正しい方法を知っている人はいますか?

4

1 に答える 1

4

どういうわけか、PGI はsystem_clockGNU コンパイラのように実装しません。理由はわかりませんが、最近、あなたと同じようなことをして見つけました。

私が話していることを確認するには、ticksを呼び出した後に印刷してくださいsystem_clock。0PGI では常に、GNU コンパイラではさまざまな数値が得られる可能性があります。問題を解決するために、以下のコードを適応させることができます。これは、 GNU fortran の Web サイトで入手できるコードを少し変更したバージョンです。

program testrand
use iso_fortran_env, only: int64

    integer, parameter :: nz = 160, nf = 160, nlt = 90
    real :: tmpidx(3)
    integer :: idxarr(3), idx1, idx2, idx3, seed_size, ticks
    integer, allocatable :: seed(:)

    call random_seed(size=seed_size)
    allocate(seed(seed_size))

    ! call system_clock(count=ticks)
    ! seed = ticks+37*(/(i-1, i=1,seed_size)/)
    ! call random_seed(put=seed)
    ! 
    ! deallocate(seed)

    call init_random_seed()

    call random_number(tmpidx)
    idxarr = tmpidx * (/nz, nf, nlt/)
    idx1 = max(1,idxarr(1))
    idx2 = max(1,idxarr(2))
    idx3 = max(1,idxarr(3))
    print *,idx1, idx2, idx3

contains
    !
    subroutine init_random_seed()
        implicit none
        integer, allocatable :: seed(:)
        integer :: i, n, istat, dt(8), pid
        integer(int64) :: t

        integer, parameter :: un=703

        call random_seed(size = n)
        allocate(seed(n))
        ! First try if the OS provides a random number generator
        open(unit=un, file="/dev/urandom", access="stream", &
            form="unformatted", action="read", status="old", iostat=istat)
        if (istat == 0) then
            read(un) seed
            close(un)
        else
            ! The PID is
            ! useful in case one launches multiple instances of the same
            ! program in parallel.
            call system_clock(t)
            if (t == 0) then
                call date_and_time(values=dt)
                t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 &
                + dt(2) * 31_int64 * 24 * 60 * 60 * 1000 &
                + dt(3) * 24_int64 * 60 * 60 * 1000 &
                + dt(5) * 60 * 60 * 1000 &
                + dt(6) * 60 * 1000 + dt(7) * 1000 &
                + dt(8)
            end if
            pid = getpid()
            t = ieor( t, int(pid, kind(t)) )
            do i = 1, n
                seed(i) = lcg(t)
            end do
        end if
        call random_seed(put=seed)
        !print*, "optimal seed = ", seed
    end subroutine init_random_seed
    !
    function lcg(s)
        integer :: lcg
        integer(int64), intent(in out) :: s
        if (s == 0) then
            s = 104729
        else
            s = mod(s, 4294967296_int64)
        end if
        s = mod(s * 279470273_int64, 4294967291_int64)
        lcg = int(mod(s, int(huge(0), 8)), kind(0))
    end function lcg
    !
    !this option is especially used for pgf90 to provide a getpid() function
    !> @brief Returns the process ID of the current process
    !! @todo write the actual code, for now returns a fixed value
    !<
    function getpid()result(pid)
        integer pid
        pid = 53 !just a prime number, no special meaning
    end function getpid
end program
于 2016-01-14T20:04:44.547 に答える