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