001:       SUBROUTINE CLARNV( IDIST, ISEED, N, X )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       INTEGER            IDIST, N
009: *     ..
010: *     .. Array Arguments ..
011:       INTEGER            ISEED( 4 )
012:       COMPLEX            X( * )
013: *     ..
014: *
015: *  Purpose
016: *  =======
017: *
018: *  CLARNV returns a vector of n random complex numbers from a uniform or
019: *  normal distribution.
020: *
021: *  Arguments
022: *  =========
023: *
024: *  IDIST   (input) INTEGER
025: *          Specifies the distribution of the random numbers:
026: *          = 1:  real and imaginary parts each uniform (0,1)
027: *          = 2:  real and imaginary parts each uniform (-1,1)
028: *          = 3:  real and imaginary parts each normal (0,1)
029: *          = 4:  uniformly distributed on the disc abs(z) < 1
030: *          = 5:  uniformly distributed on the circle abs(z) = 1
031: *
032: *  ISEED   (input/output) INTEGER array, dimension (4)
033: *          On entry, the seed of the random number generator; the array
034: *          elements must be between 0 and 4095, and ISEED(4) must be
035: *          odd.
036: *          On exit, the seed is updated.
037: *
038: *  N       (input) INTEGER
039: *          The number of random numbers to be generated.
040: *
041: *  X       (output) COMPLEX array, dimension (N)
042: *          The generated random numbers.
043: *
044: *  Further Details
045: *  ===============
046: *
047: *  This routine calls the auxiliary routine SLARUV to generate random
048: *  real numbers from a uniform (0,1) distribution, in batches of up to
049: *  128 using vectorisable code. The Box-Muller method is used to
050: *  transform numbers from a uniform to a normal distribution.
051: *
052: *  =====================================================================
053: *
054: *     .. Parameters ..
055:       REAL               ZERO, ONE, TWO
056:       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
057:       INTEGER            LV
058:       PARAMETER          ( LV = 128 )
059:       REAL               TWOPI
060:       PARAMETER          ( TWOPI = 6.2831853071795864769252867663E+0 )
061: *     ..
062: *     .. Local Scalars ..
063:       INTEGER            I, IL, IV
064: *     ..
065: *     .. Local Arrays ..
066:       REAL               U( LV )
067: *     ..
068: *     .. Intrinsic Functions ..
069:       INTRINSIC          CMPLX, EXP, LOG, MIN, SQRT
070: *     ..
071: *     .. External Subroutines ..
072:       EXTERNAL           SLARUV
073: *     ..
074: *     .. Executable Statements ..
075: *
076:       DO 60 IV = 1, N, LV / 2
077:          IL = MIN( LV / 2, N-IV+1 )
078: *
079: *        Call SLARUV to generate 2*IL real numbers from a uniform (0,1)
080: *        distribution (2*IL <= LV)
081: *
082:          CALL SLARUV( ISEED, 2*IL, U )
083: *
084:          IF( IDIST.EQ.1 ) THEN
085: *
086: *           Copy generated numbers
087: *
088:             DO 10 I = 1, IL
089:                X( IV+I-1 ) = CMPLX( U( 2*I-1 ), U( 2*I ) )
090:    10       CONTINUE
091:          ELSE IF( IDIST.EQ.2 ) THEN
092: *
093: *           Convert generated numbers to uniform (-1,1) distribution
094: *
095:             DO 20 I = 1, IL
096:                X( IV+I-1 ) = CMPLX( TWO*U( 2*I-1 )-ONE,
097:      $                       TWO*U( 2*I )-ONE )
098:    20       CONTINUE
099:          ELSE IF( IDIST.EQ.3 ) THEN
100: *
101: *           Convert generated numbers to normal (0,1) distribution
102: *
103:             DO 30 I = 1, IL
104:                X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
105:      $                       EXP( CMPLX( ZERO, TWOPI*U( 2*I ) ) )
106:    30       CONTINUE
107:          ELSE IF( IDIST.EQ.4 ) THEN
108: *
109: *           Convert generated numbers to complex numbers uniformly
110: *           distributed on the unit disk
111: *
112:             DO 40 I = 1, IL
113:                X( IV+I-1 ) = SQRT( U( 2*I-1 ) )*
114:      $                       EXP( CMPLX( ZERO, TWOPI*U( 2*I ) ) )
115:    40       CONTINUE
116:          ELSE IF( IDIST.EQ.5 ) THEN
117: *
118: *           Convert generated numbers to complex numbers uniformly
119: *           distributed on the unit circle
120: *
121:             DO 50 I = 1, IL
122:                X( IV+I-1 ) = EXP( CMPLX( ZERO, TWOPI*U( 2*I ) ) )
123:    50       CONTINUE
124:          END IF
125:    60 CONTINUE
126:       RETURN
127: *
128: *     End of CLARNV
129: *
130:       END
131: