LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SLARNV( IDIST, ISEED, N, X ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 INTEGER IDIST, N 00010 * .. 00011 * .. Array Arguments .. 00012 INTEGER ISEED( 4 ) 00013 REAL X( * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * SLARNV returns a vector of n random real numbers from a uniform or 00020 * normal distribution. 00021 * 00022 * Arguments 00023 * ========= 00024 * 00025 * IDIST (input) INTEGER 00026 * Specifies the distribution of the random numbers: 00027 * = 1: uniform (0,1) 00028 * = 2: uniform (-1,1) 00029 * = 3: normal (0,1) 00030 * 00031 * ISEED (input/output) INTEGER array, dimension (4) 00032 * On entry, the seed of the random number generator; the array 00033 * elements must be between 0 and 4095, and ISEED(4) must be 00034 * odd. 00035 * On exit, the seed is updated. 00036 * 00037 * N (input) INTEGER 00038 * The number of random numbers to be generated. 00039 * 00040 * X (output) REAL array, dimension (N) 00041 * The generated random numbers. 00042 * 00043 * Further Details 00044 * =============== 00045 * 00046 * This routine calls the auxiliary routine SLARUV to generate random 00047 * real numbers from a uniform (0,1) distribution, in batches of up to 00048 * 128 using vectorisable code. The Box-Muller method is used to 00049 * transform numbers from a uniform to a normal distribution. 00050 * 00051 * ===================================================================== 00052 * 00053 * .. Parameters .. 00054 REAL ONE, TWO 00055 PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0 ) 00056 INTEGER LV 00057 PARAMETER ( LV = 128 ) 00058 REAL TWOPI 00059 PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 ) 00060 * .. 00061 * .. Local Scalars .. 00062 INTEGER I, IL, IL2, IV 00063 * .. 00064 * .. Local Arrays .. 00065 REAL U( LV ) 00066 * .. 00067 * .. Intrinsic Functions .. 00068 INTRINSIC COS, LOG, MIN, SQRT 00069 * .. 00070 * .. External Subroutines .. 00071 EXTERNAL SLARUV 00072 * .. 00073 * .. Executable Statements .. 00074 * 00075 DO 40 IV = 1, N, LV / 2 00076 IL = MIN( LV / 2, N-IV+1 ) 00077 IF( IDIST.EQ.3 ) THEN 00078 IL2 = 2*IL 00079 ELSE 00080 IL2 = IL 00081 END IF 00082 * 00083 * Call SLARUV to generate IL2 numbers from a uniform (0,1) 00084 * distribution (IL2 <= LV) 00085 * 00086 CALL SLARUV( ISEED, IL2, U ) 00087 * 00088 IF( IDIST.EQ.1 ) THEN 00089 * 00090 * Copy generated numbers 00091 * 00092 DO 10 I = 1, IL 00093 X( IV+I-1 ) = U( I ) 00094 10 CONTINUE 00095 ELSE IF( IDIST.EQ.2 ) THEN 00096 * 00097 * Convert generated numbers to uniform (-1,1) distribution 00098 * 00099 DO 20 I = 1, IL 00100 X( IV+I-1 ) = TWO*U( I ) - ONE 00101 20 CONTINUE 00102 ELSE IF( IDIST.EQ.3 ) THEN 00103 * 00104 * Convert generated numbers to normal (0,1) distribution 00105 * 00106 DO 30 I = 1, IL 00107 X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )* 00108 $ COS( TWOPI*U( 2*I ) ) 00109 30 CONTINUE 00110 END IF 00111 40 CONTINUE 00112 RETURN 00113 * 00114 * End of SLARNV 00115 * 00116 END