aboutsummaryrefslogtreecommitdiff
path: root/math/slalib/random.F__vms
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.F__vms
downloadiraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'math/slalib/random.F__vms')
-rw-r--r--math/slalib/random.F__vms69
1 files changed, 69 insertions, 0 deletions
diff --git a/math/slalib/random.F__vms b/math/slalib/random.F__vms
new file mode 100644
index 00000000..b57b5fc9
--- /dev/null
+++ b/math/slalib/random.F__vms
@@ -0,0 +1,69 @@
+ REAL FUNCTION sla_RANDOM (SEED)
+*+
+* - - - - - - -
+* R A N D O M
+* - - - - - - -
+*
+* Generate pseudo-random real number in the range 0 <= X < 1.
+* (single precision)
+*
+* !!! Version for VAX/VMS and DECstation !!!
+*
+* 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 (a REAL function from the DEC Fortran Library)
+*
+* 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
+
+ REAL RAN
+
+ 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.
+ END IF
+
+* Next pseudo-random number
+ sla_RANDOM=RAN(ISEED)
+
+ END