' Copyright © 1998-2001, 2012-2014, 2016, 2017, 2019 John S. Philo
' This file is part of the program SVEDBERG. SVEDBERG is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by the Free Software Foundation,
' either version 3 Of the License, or any later version. The author asks only that if you use any of
' this code in your own programs then please acknowledge that use and cite any appropriate publications.
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
' You should have received a copy of the GNU General Public License
' along with this program. If not, see
Option Strict Off
Option Explicit On
Module RANDOM
Function GaussNoise(ByRef idum As Short) As Single
Dim fac As Single
Dim v2 As Single
Dim V1 As Single
Dim R As Single
'returns normally distributed deviate with zero mean and variance of 1
Static iflag As Short
Static gset As Single
If iflag Then
' we have an extra deviate handy
iflag = False
GaussNoise = gset
Else
'we don't have an extra deviate handy, so pick
'two uniform numbers in the square from -1 to 1
Do
V1 = 2! * Ran0(idum) - 1!
v2 = 2! * Ran0(idum) - 1!
' see if they are in the unit circle
R = V1 * V1 + v2 * v2
Loop Until R > 0! And R <= 1!
fac = System.Math.Sqrt(-2! * System.Math.Log(R) / R)
gset = V1 * fac
iflag = True
GaussNoise = v2 * fac
End If
End Function
Function Ran0(ByRef idum As Integer) As Single
Dim dum As Single
Dim j As Integer
Dim seed As Single
' returns better random numbers distributed over 0 to 1
Static V(97) As Single
Static iflag As Boolean
Static y As Single
If idum < 0 Or iflag = 0 Then
iflag = True
seed = System.Math.Abs(idum)
idum = 1
Randomize()
For j = 1 To 97
dum = Rnd()
Next j
For j = 1 To 97
V(j) = Rnd()
Next j
y = Rnd()
End If
j = 1 + Int(97 * y)
y = V(j)
V(j) = Rnd()
Ran0 = y
End Function
Function RndSign() As Integer
'returns +1 or -1 randomly
Dim x As Single
x = 2.0! * Ran0(0)
If x < 1 Then
RndSign = -1
Else
RndSign = 1
End If
End Function
End Module