Fortran Coder

查看: 11222|回复: 7
打印 上一主题 下一主题

[求助] random_numer( )不随机问题

[复制链接]

22

帖子

6

主题

0

精华

入门

StarkLee

F 币
96 元
贡献
52 点
跳转到指定楼层
楼主
发表于 2014-12-5 13:57:42 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
[Fortran] 纯文本查看 复制代码
  program main
  implicit none
   interface
	subroutine random_arr(a)
	implicit none
	integer(4),intent(out),allocatable ::a(:)
	end
   end interface
   integer , allocatable :: A(:)
   integer , allocatable :: B(:)
   integer len
call random_arr(A)
call random_arr(B)
print *,A
print *,B

  end program



subroutine random_arr(a)
implicit none
real(4) temp,temp2
integer(4) siz,i
integer(4),intent(out),allocatable ::a(:)
call random_seed()
call random_number(temp)
print *,temp
siz=int(temp*20)
print *," ",siz," "
allocate (a(siz))
a(:)=0
loop:do i=1,siz
30 call random_number(temp2)
 a(i) = int(temp2*20)
if(i/=1)then
if(all( a(1:(i-1))/=a(i)) )then
cycle loop
else 
goto 30
end if
end if
End do loop
end subroutine


temp每次都是0.9几是为什么啊==
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

798

帖子

2

主题

0

精华

大宗师

F 币
3793 元
贡献
2268 点
沙发
发表于 2014-12-5 15:31:18 | 只看该作者
call random_seed()
只需要执行一次就好,也就是说,不能写在子程序中,写在主程序。

22

帖子

6

主题

0

精华

入门

StarkLee

F 币
96 元
贡献
52 点
板凳
 楼主| 发表于 2014-12-5 18:02:49 来自移动端 | 只看该作者
li913 发表于 2014-12-5 15:31
call random_seed()
只需要执行一次就好,也就是说,不能写在子程序中,写在主程序。 ...

嗯,改了,还是不合适诶…-_-#

798

帖子

2

主题

0

精华

大宗师

F 币
3793 元
贡献
2268 点
地板
发表于 2014-12-5 20:07:49 | 只看该作者
如果你是想生成互不相同的随机数组,代码米问题。

954

帖子

0

主题

0

精华

大师

F 币
184 元
贡献
75 点

规矩勋章元老勋章新人勋章水王勋章热心勋章

QQ
5#
发表于 2014-12-5 21:38:16 | 只看该作者
不知道你用的什么编译器?

如果是 gfortran 的话,你需要自己根据系统时间生成种子。Linux 下还可以访问 /dev/urandom 获取种子

[Fortran] 纯文本查看 复制代码
  program main
  implicit none
   interface
	subroutine random_arr(a)
	implicit none
	integer(4),intent(out),allocatable ::a(:)
	end
   end interface
   integer , allocatable :: A(:)
   integer , allocatable :: B(:)
   integer len
call init_random_seed()
call random_arr(A)
call random_arr(B)
print *,A
print *,B

  end program
  
subroutine random_arr(a)
implicit none
real(4) temp,temp2
integer(4) siz,i
integer(4),intent(out),allocatable ::a(:)

call random_number(temp)
print *,temp
siz=int(temp*20)
print *," ",siz," "
allocate (a(siz))
a(:)=0
loop:do i=1,siz
30 call random_number(temp2)
 a(i) = int(temp2*20)
if(i/=1)then
if(all( a(1:(i-1))/=a(i)) )then
cycle loop
else 
goto 30
end if
end if
End do loop
end subroutine

subroutine init_random_seed()
  use iso_fortran_env, only: int64
  implicit none
  integer, allocatable :: seed(:)
  integer :: i, n, un, istat, dt(8), pid , lcg
  integer(int64) :: t

  call random_seed(size = n)
  allocate(seed(n))
  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
  call random_seed(put=seed)
end subroutine init_random_seed

function lcg(s)
  use iso_fortran_env, only: int64    
  integer :: lcg
  integer(int64) :: 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), int64)), kind(0))
end function lcg

22

帖子

6

主题

0

精华

入门

StarkLee

F 币
96 元
贡献
52 点
6#
 楼主| 发表于 2014-12-6 00:02:56 | 只看该作者
vvt 发表于 2014-12-5 21:38
不知道你用的什么编译器?

如果是 gfortran 的话,你需要自己根据系统时间生成种子。Linux 下还可以访问 / ...

哇!!用的gfortran,合适了。
感觉后面这段程序好高端!!
感谢大神~

22

帖子

6

主题

0

精华

入门

StarkLee

F 币
96 元
贡献
52 点
7#
 楼主| 发表于 2014-12-6 00:29:17 来自移动端 | 只看该作者
vvt 发表于 2014-12-5 21:38
不知道你用的什么编译器?

如果是 gfortran 的话,你需要自己根据系统时间生成种子。Linux 下还可以访问 / ...

用的gfortran
可以了呢!感谢大神,感觉这段代码好高端!~

100

帖子

0

主题

0

精华

专家

F 币
550 元
贡献
291 点

规矩勋章元老勋章

QQ
8#
发表于 2014-12-6 16:14:41 | 只看该作者
种子是关键,呵呵...
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

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

GMT+8, 2024-5-6 11:02

Powered by Tencent X3.4

© 2013-2024 Tencent

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