我正在尝试编写一个程序，该程序使用lcg作为函数来使用box muller算法计算更多随机数。我已经让lcg工作但是使用box muller算法的函数给出了错误的值。
这是我的代码：
module rng
implicit none
integer, parameter :: dp = selected_real_kind(15,300)
real(kind=dp) :: A=100, B= 104001, M = 714025
contains
function lcg(seed)
integer, optional, intent(in) :: seed
real(kind=dp) :: x = 0, lcg
if(present(seed)) x = seed
x = mod(A * x + B, M)
lcg = x/714025
end function
function muller(seed)
integer, parameter :: dp = selected_real_kind(15,300)
integer, optional, intent(in) :: seed
real(kind = dp) :: y1, y2, mean = 0.49, sd = 0.5, muller1, muller2,
muller, x1, x2, pi = 4.0*ATAN(1.0)
integer :: N = 0
! I had to add the do while loop to ensure that this chunk of code would
only execute once
do while (N<1)
x1 = lcg()
x2 = lcg()
N = N + 1
y1 = sd * SQRT(-2.0*LOG(x1)) * COS(2*pi*(x2)) + mean
y2 = sd * SQRT(-2.0*LOG(x1)) * SIN(2*pi*(x2)) + mean
print *, y1, y2, x1, x2 ! Printing x1 and x2 to allow me to use a
calculator to check program is working correctly
end do
end function
end module
program lcgtest
use rng
implicit none
integer :: N
real(kind=dp) :: lcgmean, ttl = 0, sumof, lcgvar, dev1, muller1, muller2,
lcgerr, lcgdev
real, dimension(10000) :: array
do N = 1, 10000
ttl = ttl + lcg()
dev1 = lcg() - lcgmean
sumof = sumof + dev1
end do
muller1 = muller()
muller2 = muller()
lcgmean = ttl/10000
lcgvar = ((sumof)**2)/10000
lcgdev = SQRT((sumof)**2)/10000
lcgerr = lcgdev/100
print *, lcg(), "mean=", lcgmean, "variance=", lcgvar, lcgerr
end program
关键部分是muller功能部分。在检查了我用计算器得到的值后，我可以看到y1和y2的答案是不同的。
任何帮助都将不胜感激。
答案 0 :(得分：2)
我不知道你对此计划的期望是什么。但是，读它，我可以很容易地得到你遵循的逻辑。我注意到两个事实错误。请仔细阅读以下代码以查看我的增强功能。
module rng
implicit none
integer, parameter :: dp = selected_real_kind(15,300)
real(kind=dp) :: A=100, B= 104001, M = 714025
contains
function lcg(seed)
integer, optional, intent(in) :: seed
real(kind=dp) :: x = 0, lcg
if(present(seed)) x = seed
x = mod(A * x + B, M)
lcg = x/714025
end function lcg ! Note 'lcg' here @ the end
function muller(seed)
integer, parameter :: dp = selected_real_kind(15,300)
integer, optional, intent(in) :: seed
real(kind = dp) :: y1, y2, mean = 0.49, sd = 0.5, muller1, &
muller2, muller, x1, x2, pi = 4.0*ATAN(1.0)
integer :: N = 0
! I had to add the do while loop to ensure that this chunk
! of code would only execute once
do while (N<1)
x1 = lcg()
x2 = lcg()
N = N + 1
y1 = sd * SQRT(-2.0*LOG(x1)) * COS(2*pi*(x2)) + mean
y2 = sd * SQRT(-2.0*LOG(x1)) * SIN(2*pi*(x2)) + mean
! Printing x1 and x2 to allow me to use a
! calculator to check program is working correctly
print *, y1, y2, x1, x2
enddo
end function muller ! note the function name @ the end here
end module rng ! Note 'rng' here added.
program lcgtest
use rng
implicit none
integer :: N
real(kind=dp) :: lcgmean, ttl = 0, sumof, lcgvar, dev1, muller1, &
muller2, lcgerr, lcgdev
real, dimension(10000) :: array
! In the original code the variables 'lcgmean' and 'dev1' were
! *undefined* before they were used in the do-loop. This will cause the
! compiler to set them some random garbage values, and it will
! inevitably leads to unexpected result or error in most cases.
! In, order to avoid this by setting them.
! For example, lcgmean = 1.0 and dev1 = 0.1
! We'll then have the following:
lcgmean = 1.0
dev1 = 0.1
do N = 1, 10000
ttl = ttl + lcg()
dev1 = lcg() - lcgmean
sumof = sumof + dev1
end do
muller1 = muller()
muller2 = muller()
lcgmean = ttl/10000
lcgvar = ((sumof)**2)/10000
lcgdev = SQRT((sumof)**2)/10000
lcgerr = lcgdev/100
print *, lcg(), "mean=", lcgmean, "variance=", lcgvar, lcgerr
end program
其他建议
我发现始终关闭代码块通常非常有用（例如）：
real function func_name(arg1, arg2, ....)
implicit none
....
end function func_name
subroutine sub_name(arg1, arg2, ...)
implicit none
...
end subroutine sub_name
备注：函数seed中未使用变量muller。也许不需要它。
答案 1 :(得分：0)
根据我的阅读here，似乎最好用子程序替换函数muller ，以便它可以同时计算 y1 和 y2 。实际上，“块”*“muller”的目的是根据生成另外两个基于两个先前生成的伪随机数 x1 和 x2 的伪随机数。 >您的计划结构。
然后在主程序中，不要将 muller 作为函数调用，而应该通过在调用muller 中将其称为子例程。相应的位置。但是，仍然可以使用 function 而不是子例程，但要返回两个值 y1 和 y2 ，你可以返回一个向量v，这样v（1）= y1; v（2）= y2。
原始程序将成为以下内容：
module rng
implicit none
integer, parameter :: dp = selected_real_kind(15,300)
real(kind=dp) :: A=100, B= 104001, M = 714025
contains
function lcg(seed)
implicit none
integer, optional, intent(in) :: seed
real(kind=dp) :: x = 0, lcg
if(present(seed)) x = seed
x = mod(A * x + B, M)
lcg = x/714025
end function lcg ! Note 'lcg' here @ the end
!-------------------------------------------------------------------
! Subroutine muller.
! Here, we supply 4 arguments *y1, y2* and the optional
! argaument *seed* which apparently is not required since it is not
! used (but can be used in order to have a better pseudo number
! generator.
!-------------------------------------------------------------------
subroutine muller(y1, y2, seed)
implicit none
real(kind=dp), intent(out) :: y1, y2
integer, optional, intent(in) :: seed
! Local variables
real(kind=dp) :: x1, x2
real(kind=dp) :: mean = 0.49, sd = 0.5
real(kind=dp) :: pi = 4.0*ATAN(1.0)
integer :: N = 0
! The **do while** loop is not needed
! do while (N<1)
x1 = lcg()
x2 = lcg()
N = N + 1
y1 = sd * SQRT(-2.0*LOG(x1)) * COS(2*pi*(x2)) + mean
y2 = sd * SQRT(-2.0*LOG(x1)) * SIN(2*pi*(x2)) + mean
! display to the screen the values of x1, x2, y1, y2
print *, y1, y2, x1, x2
! enddo
end subroutine muller
end module rng
program lcgtest
use rng
implicit none
integer :: N
real(kind=dp) :: lcgmean, ttl = 0, sumof, lcgvar, dev1
real(kind=dp) :: lcgerr, lcgdev
! Because the variable **array** is not used, I will comment it out
!real, dimension(10000) :: array
real(kind=dp) :: out_lcg
! In the original code the variables 'lcgmean' and 'dev1' were
! *undefined* before they were used in the do-loop. This will cause the
! compiler to set them some random garbage values, and it will
! inevitably leads to unexpected result or error in most cases.
! In, order to avoid this by setting them.
! For example, lcgmean = 1.0 and dev1 = 0.1
! We'll then have the following:
lcgmean = 1.0
dev1 = 0.1
! The above is true for the variables **sumof**
sumof = 0.0
do N = 1, 10000
ttl = ttl + lcg()
dev1 = lcg() - lcgmean
sumof = sumof + dev1
enddo
call muller(y1, y2)
call muller(y1, y2)
lcgmean = ttl/10000
lcgvar = ((sumof)**2)/10000
lcgdev = SQRT((sumof)**2)/10000
lcgerr = lcgdev/100
out_lcg = lcg()
print *, out_lcg, "mean=", lcgmean, "variance=", lcgvar, lcgerr
end program
我确信上面的程序远远没有完全按照你的意愿行事。但它解决了你遇到的问题。
备注：
我将 y1 和 y2 提供给子例程muller ，因为我想你可能想要访问新生成的伪radom号码。另外，我看到了很多可以使用变量 array 的空间。最后，也许建议检查你的算法以及在 lcgmean，lcgvar，lcgdev 和 lcgerr 的最后阶段进行的计算，看看如何结合使用< strong>数组以及此备选方案是否更效率和更快