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