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 * * 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 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