Commit cdaa9fc4 by Steven G. Kargl Committed by Tobias Schlüter

random.c: Fix several spelling and formatting mistakes in comments.

* random.c: Fix several spelling and formatting mistakes in
comments.
(random_r8): Fix loop to make random numbers range in [0,1(.

Co-Authored-By: Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>

From-SVN: r83063
parent 9d409075
2004-06-13 Steven G. Kargl <kargls@comcast.net> 2004-06-13 Steven G. Kargl <kargls@comcast.net>
Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* random.c: Fix several spelling and formatting mistakes in
comments.
(random_r8): Fix loop to make random numbers range in [0,1(.
2004-06-13 Steven G. Kargl <kargls@comcast.net>
* random.c (random_r4): Burn a random number. * random.c (random_r4): Burn a random number.
(random_r8): fix infinite loop. (random_r8): fix infinite loop.
......
...@@ -416,7 +416,7 @@ arandom_r8 (gfc_array_r8 * harv) ...@@ -416,7 +416,7 @@ arandom_r8 (gfc_array_r8 * harv)
wish to acknowledge the source, as a courtesy. wish to acknowledge the source, as a courtesy.
"There is no copyright on the code below." included the original "There is no copyright on the code below." included the original
KISS algorithm. */ KISS algorithm. */
#include "config.h" #include "config.h"
#include "libgfortran.h" #include "libgfortran.h"
...@@ -449,7 +449,7 @@ kiss_random_kernel(void) ...@@ -449,7 +449,7 @@ kiss_random_kernel(void)
} }
/* This function produces a REAL(4) value in the uniform distribution /* This function produces a REAL(4) value from the uniform distribution
with range [0,1). */ with range [0,1). */
void void
...@@ -485,7 +485,7 @@ prefix(random_r8) (GFC_REAL_8 *x) ...@@ -485,7 +485,7 @@ prefix(random_r8) (GFC_REAL_8 *x)
+ kiss_random_kernel (); + kiss_random_kernel ();
*x = (GFC_REAL_8)kiss / (GFC_REAL_8)(~(GFC_UINTEGER_8) 0); *x = (GFC_REAL_8)kiss / (GFC_REAL_8)(~(GFC_UINTEGER_8) 0);
} }
while (*x == 0); while (*x == 1.0);
} }
...@@ -554,7 +554,7 @@ prefix(arandom_r4) (gfc_array_r4 *x) ...@@ -554,7 +554,7 @@ prefix(arandom_r4) (gfc_array_r4 *x)
} }
} }
/* This function fills a REAL(8) array with valuse from the uniform /* This function fills a REAL(8) array with values from the uniform
distribution with range [0,1). */ distribution with range [0,1). */
void void
...@@ -620,7 +620,7 @@ prefix(arandom_r8) (gfc_array_r8 *x) ...@@ -620,7 +620,7 @@ prefix(arandom_r8) (gfc_array_r8 *x)
} }
/* prefix(random_seed) is used to seed the PRNG with either a default /* prefix(random_seed) is used to seed the PRNG with either a default
set of seeds or user specified set of seed. prefix(random_seed) set of seeds or user specified set of seeds. prefix(random_seed)
must be called with no argument or exactly one argument. */ must be called with no argument or exactly one argument. */
void void
...@@ -633,7 +633,7 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 * put, ...@@ -633,7 +633,7 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 * put,
if (size == NULL && put == NULL && get == NULL) if (size == NULL && put == NULL && get == NULL)
{ {
/* From the standard: "If no argument is present, the processor assigns /* From the standard: "If no argument is present, the processor assigns
a processor-dependent value to the seed." */ a processor-dependent value to the seed." */
kiss_seed[0] = kiss_default_seed[0]; kiss_seed[0] = kiss_default_seed[0];
kiss_seed[1] = kiss_default_seed[1]; kiss_seed[1] = kiss_default_seed[1];
kiss_seed[2] = kiss_default_seed[2]; kiss_seed[2] = kiss_default_seed[2];
...@@ -645,37 +645,37 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 * put, ...@@ -645,37 +645,37 @@ random_seed (GFC_INTEGER_4 *size, gfc_array_i4 * put,
if (put != NULL) if (put != NULL)
{ {
/* If the rank of the array is not 1, abort */ /* If the rank of the array is not 1, abort. */
if (GFC_DESCRIPTOR_RANK (put) != 1) if (GFC_DESCRIPTOR_RANK (put) != 1)
runtime_error ("Array rank of PUT is not 1."); runtime_error ("Array rank of PUT is not 1.");
/* If the array is too small, abort */ /* If the array is too small, abort. */
if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size) if (((put->dim[0].ubound + 1 - put->dim[0].lbound)) < kiss_size)
runtime_error ("Array size of PUT is too small."); runtime_error ("Array size of PUT is too small.");
if (put->dim[0].stride == 0) if (put->dim[0].stride == 0)
put->dim[0].stride = 1; put->dim[0].stride = 1;
/* This code now should do correct strides. */ /* This code now should do correct strides. */
for (i = 0; i < kiss_size; i++) for (i = 0; i < kiss_size; i++)
kiss_seed[i] =(GFC_UINTEGER_4) put->data[i * put->dim[0].stride]; kiss_seed[i] =(GFC_UINTEGER_4) put->data[i * put->dim[0].stride];
} }
/* Return the seed to GET data */ /* Return the seed to GET data. */
if (get != NULL) if (get != NULL)
{ {
/* If the rank of the array is not 1, abort. */ /* If the rank of the array is not 1, abort. */
if (GFC_DESCRIPTOR_RANK (get) != 1) if (GFC_DESCRIPTOR_RANK (get) != 1)
runtime_error ("Array rank of GET is not 1."); runtime_error ("Array rank of GET is not 1.");
/* If the array is too small, abort. */ /* If the array is too small, abort. */
if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size) if (((get->dim[0].ubound + 1 - get->dim[0].lbound)) < kiss_size)
runtime_error ("Array size of GET is too small."); runtime_error ("Array size of GET is too small.");
if (get->dim[0].stride == 0) if (get->dim[0].stride == 0)
get->dim[0].stride = 1; get->dim[0].stride = 1;
/* This code now should do correct strides. */ /* This code now should do correct strides. */
for (i = 0; i < kiss_size; i++) for (i = 0; i < kiss_size; i++)
get->data[i * get->dim[0].stride] = (GFC_INTEGER_4) kiss_seed[i]; get->data[i * get->dim[0].stride] = (GFC_INTEGER_4) kiss_seed[i];
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment