Why does this code give me the incorrect answer? - fortran

Question

I'm attempting to write a program that uses an lcg as a function to calculate more random numbers using the box muller algorithm. I have gotten the lcg to work but the function that uses the box muller algorithm is giving out the wrong values.
Here's my code:
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
The key part is the muller function section. After checking the values I get with a calculator, I can see that the answers for y1 and y2 are different.
Any help would be appreciated.

Answer 1

I don't know what you're expecting as result from this program. However, read it it I can easily get the logic you followed. I notice two factual errors. Please, read through the code below to see my enhancement.
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
Additional suggestions
I find it often very useful to always close your block-of-code meaningfully like this (for example):
real function func_name(arg1, arg2, ....)
implicit none
....
end function func_name
subroutine sub_name(arg1, arg2, ...)
implicit none
...
end subroutine sub_name
Remark: The variable seed is unused in the function muller. Maybe it is not needed.

Answer 2

Given what I read here, it seems that it is better to replace function muller by a subroutine so that it can calculate simultaneously y1 and y2. In fact, the "block" *muller" purpose is to generate two other pseudo-random numbers based on two previously generated pseudo-random numbers x1 and x2 according to your program structure.
Then in the main program, instead of calling muller as a function, you should call it as subroutine by writing call muller at the corresponding position. However, the use of function rather than subroutine is still possible, but to return the two values y1 and y2, you can return a vector v, such that v(1) = y1; v(2) = y2.
The original program will become the following:
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
I'm convinced that the program above is far from doing what you want exactly. But it solves the issue you encountered.
Notes:
I supplied y1 and y2 to the subroutine muller because I imagine that you probably want to access the new generated pseudo-radom number. Also, I saw a lot of room where the variable array could be used. Finally, maybe it's advisable to check your algorithm and the calculation carried out in the last stage for lcgmean, lcgvar, lcgdev and lcgerr and see how you can incorporrate the use of array and whether this alternative is more efficient and faster