aboutsummaryrefslogtreecommitdiff
path: root/math/slalib/random.Fdefault
diff options
context:
space:
mode:
authorJoe Hunkeler <jhunkeler@gmail.com>2015-08-11 16:51:37 -0400
committerJoe Hunkeler <jhunkeler@gmail.com>2015-08-11 16:51:37 -0400
commit40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch)
tree4464880c571602d54f6ae114729bf62a89518057 /math/slalib/random.Fdefault
downloadiraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'math/slalib/random.Fdefault')
-rw-r--r--math/slalib/random.Fdefault87
1 files changed, 87 insertions, 0 deletions
diff --git a/math/slalib/random.Fdefault b/math/slalib/random.Fdefault
new file mode 100644
index 00000000..9a79cb6c
--- /dev/null
+++ b/math/slalib/random.Fdefault
@@ -0,0 +1,87 @@
+#include "config.h"
+ REAL FUNCTION sla_RANDOM (SEED)
+*+
+* - - - - - - -
+* R A N D O M
+* - - - - - - -
+*
+* Generate pseudo-random real number in the range 0 <= X < 1.
+* (single precision)
+*
+*
+* Given:
+* SEED real an arbitrary real number
+*
+* Notes:
+*
+* 1) The result is a pseudo-random REAL number in the range
+* 0 <= sla_RANDOM < 1.
+*
+* 2) SEED is used first time through only.
+*
+* Called: RAN or RAND (a REAL function returning a random variate --
+* the precise function which is called depends on which functions
+* are available when the library is built). If neither of these
+* is available, we use the local substitute RANDOM defined
+* in rtl_random.c
+*
+* P.T.Wallace Starlink 14 October 1991
+*
+* License:
+* This program 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 2 of the License, or
+* (at your option) any later version.
+*
+* 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 (see SLA_CONDITIONS); if not, write to the
+* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+* Boston, MA 02110-1301 USA
+*-
+
+ IMPLICIT NONE
+
+ REAL SEED
+
+#if HAVE_RAND
+ REAL RAND
+#elif HAVE_RANDOM
+ REAL RANDOM
+#else
+ error "Can't find random-number function"
+#endif
+
+ REAL AS
+ INTEGER ISEED
+ LOGICAL FIRST
+ SAVE FIRST
+ DATA FIRST /.TRUE./
+
+
+
+* If first time, turn SEED into a large, odd integer
+ IF (FIRST) THEN
+ AS=ABS(SEED)+1.0
+ ISEED=NINT(AS/10.0**(NINT(ALOG10(AS))-6))
+ IF (MOD(ISEED,2).EQ.0) ISEED=ISEED+1
+ FIRST=.FALSE.
+#if HAVE_RAND
+ AS = RAND(ISEED)
+#endif
+ ELSE
+ ISEED=0
+ END IF
+
+* Next pseudo-random number
+#if HAVE_RAND
+ sla_RANDOM=RAND(0)
+#elif HAVE_RANDOM
+ sla_RANDOM=RANDOM(ISEED)
+#endif
+
+ END