aboutsummaryrefslogtreecommitdiff
path: root/src/slalib/gresid.f_mips
diff options
context:
space:
mode:
Diffstat (limited to 'src/slalib/gresid.f_mips')
-rw-r--r--src/slalib/gresid.f_mips74
1 files changed, 74 insertions, 0 deletions
diff --git a/src/slalib/gresid.f_mips b/src/slalib/gresid.f_mips
new file mode 100644
index 0000000..7f353f9
--- /dev/null
+++ b/src/slalib/gresid.f_mips
@@ -0,0 +1,74 @@
+ REAL FUNCTION sla_GRESID (S)
+*+
+* - - - - - - -
+* G R E S I D
+* - - - - - - -
+*
+* Generate pseudo-random normal deviate ( = 'Gaussian residual')
+* (single precision)
+*
+* !!! Version for VAX/VMS and DECstation !!!
+*
+* Given:
+* S real standard deviation
+*
+* The results of many calls to this routine will be
+* normally distributed with mean zero and standard deviation S.
+*
+* The Box-Muller algorithm is used. This is described in
+* Numerical Recipes, section 7.2.
+*
+* P.T.Wallace Starlink 14 October 1991
+*
+* Copyright (C) 1995 Rutherford Appleton Laboratory
+*-
+
+ IMPLICIT NONE
+
+ REAL S
+
+ REAL X,Y,R,W,GNEXT,G
+ INTEGER ISEED
+ LOGICAL FIRST
+
+ REAL RAN
+
+ SAVE GNEXT,ISEED,FIRST
+ DATA ISEED / 123456789 /
+ DATA FIRST / .TRUE. /
+
+
+
+* Second normal deviate of the pair available?
+ IF (FIRST) THEN
+
+* No - generate two random numbers inside unit circle
+ R = 2.0
+ DO WHILE (R.GE.1.0)
+
+* Generate two random numbers in range +/- 1
+ X = 2.0*RAN(ISEED)-1.0
+ Y = 2.0*RAN(ISEED)-1.0
+
+* Try again if not in unit circle
+ R = X*X+Y*Y
+ END DO
+
+* Box-Muller transformation, generating two deviates
+ W = SQRT(-2.0*LOG(R)/MAX(R,1E-20))
+ GNEXT = X*W
+ G = Y*W
+
+* Set flag to indicate availability of next deviate
+ FIRST = .FALSE.
+ ELSE
+
+* Return second deviate of the pair & reset flag
+ G = GNEXT
+ FIRST = .TRUE.
+ END IF
+
+* Scale the deviate by the required standard deviation
+ sla_GRESID = G*S
+
+ END