1*> \brief \b CLARGE
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE CLARGE( N, A, LDA, ISEED, WORK, INFO )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            INFO, LDA, N
15*       ..
16*       .. Array Arguments ..
17*       INTEGER            ISEED( 4 )
18*       COMPLEX            A( LDA, * ), WORK( * )
19*       ..
20*
21*
22*> \par Purpose:
23*  =============
24*>
25*> \verbatim
26*>
27*> CLARGE pre- and post-multiplies a complex general n by n matrix A
28*> with a random unitary matrix: A = U*D*U'.
29*> \endverbatim
30*
31*  Arguments:
32*  ==========
33*
34*> \param[in] N
35*> \verbatim
36*>          N is INTEGER
37*>          The order of the matrix A.  N >= 0.
38*> \endverbatim
39*>
40*> \param[in,out] A
41*> \verbatim
42*>          A is COMPLEX array, dimension (LDA,N)
43*>          On entry, the original n by n matrix A.
44*>          On exit, A is overwritten by U*A*U' for some random
45*>          unitary matrix U.
46*> \endverbatim
47*>
48*> \param[in] LDA
49*> \verbatim
50*>          LDA is INTEGER
51*>          The leading dimension of the array A.  LDA >= N.
52*> \endverbatim
53*>
54*> \param[in,out] ISEED
55*> \verbatim
56*>          ISEED is INTEGER array, dimension (4)
57*>          On entry, the seed of the random number generator; the array
58*>          elements must be between 0 and 4095, and ISEED(4) must be
59*>          odd.
60*>          On exit, the seed is updated.
61*> \endverbatim
62*>
63*> \param[out] WORK
64*> \verbatim
65*>          WORK is COMPLEX array, dimension (2*N)
66*> \endverbatim
67*>
68*> \param[out] INFO
69*> \verbatim
70*>          INFO is INTEGER
71*>          = 0: successful exit
72*>          < 0: if INFO = -i, the i-th argument had an illegal value
73*> \endverbatim
74*
75*  Authors:
76*  ========
77*
78*> \author Univ. of Tennessee
79*> \author Univ. of California Berkeley
80*> \author Univ. of Colorado Denver
81*> \author NAG Ltd.
82*
83*> \ingroup complex_matgen
84*
85*  =====================================================================
86      SUBROUTINE CLARGE( N, A, LDA, ISEED, WORK, INFO )
87*
88*  -- LAPACK auxiliary routine --
89*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
90*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
91*
92*     .. Scalar Arguments ..
93      INTEGER            INFO, LDA, N
94*     ..
95*     .. Array Arguments ..
96      INTEGER            ISEED( 4 )
97      COMPLEX            A( LDA, * ), WORK( * )
98*     ..
99*
100*  =====================================================================
101*
102*     .. Parameters ..
103      COMPLEX            ZERO, ONE
104      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ),
105     $                   ONE = ( 1.0E+0, 0.0E+0 ) )
106*     ..
107*     .. Local Scalars ..
108      INTEGER            I
109      REAL               WN
110      COMPLEX            TAU, WA, WB
111*     ..
112*     .. External Subroutines ..
113      EXTERNAL           CGEMV, CGERC, CLARNV, CSCAL, XERBLA
114*     ..
115*     .. Intrinsic Functions ..
116      INTRINSIC          ABS, MAX, REAL
117*     ..
118*     .. External Functions ..
119      REAL               SCNRM2
120      EXTERNAL           SCNRM2
121*     ..
122*     .. Executable Statements ..
123*
124*     Test the input arguments
125*
126      INFO = 0
127      IF( N.LT.0 ) THEN
128         INFO = -1
129      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
130         INFO = -3
131      END IF
132      IF( INFO.LT.0 ) THEN
133         CALL XERBLA( 'CLARGE', -INFO )
134         RETURN
135      END IF
136*
137*     pre- and post-multiply A by random unitary matrix
138*
139      DO 10 I = N, 1, -1
140*
141*        generate random reflection
142*
143         CALL CLARNV( 3, ISEED, N-I+1, WORK )
144         WN = SCNRM2( N-I+1, WORK, 1 )
145         WA = ( WN / ABS( WORK( 1 ) ) )*WORK( 1 )
146         IF( WN.EQ.ZERO ) THEN
147            TAU = ZERO
148         ELSE
149            WB = WORK( 1 ) + WA
150            CALL CSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
151            WORK( 1 ) = ONE
152            TAU = REAL( WB / WA )
153         END IF
154*
155*        multiply A(i:n,1:n) by random reflection from the left
156*
157         CALL CGEMV( 'Conjugate transpose', N-I+1, N, ONE, A( I, 1 ),
158     $               LDA, WORK, 1, ZERO, WORK( N+1 ), 1 )
159         CALL CGERC( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ),
160     $               LDA )
161*
162*        multiply A(1:n,i:n) by random reflection from the right
163*
164         CALL CGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA,
165     $               WORK, 1, ZERO, WORK( N+1 ), 1 )
166         CALL CGERC( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ),
167     $               LDA )
168   10 CONTINUE
169      RETURN
170*
171*     End of CLARGE
172*
173      END
174