1*> \brief \b DLARGE 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 DLARGE( N, A, LDA, ISEED, WORK, INFO ) 12* 13* .. Scalar Arguments .. 14* INTEGER INFO, LDA, N 15* .. 16* .. Array Arguments .. 17* INTEGER ISEED( 4 ) 18* DOUBLE PRECISION A( LDA, * ), WORK( * ) 19* .. 20* 21* 22*> \par Purpose: 23* ============= 24*> 25*> \verbatim 26*> 27*> DLARGE pre- and post-multiplies a real general n by n matrix A 28*> with a random orthogonal 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 DOUBLE PRECISION 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*> orthogonal 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 DOUBLE PRECISION 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 double_matgen 84* 85* ===================================================================== 86 SUBROUTINE DLARGE( 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 DOUBLE PRECISION A( LDA, * ), WORK( * ) 98* .. 99* 100* ===================================================================== 101* 102* .. Parameters .. 103 DOUBLE PRECISION ZERO, ONE 104 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 105* .. 106* .. Local Scalars .. 107 INTEGER I 108 DOUBLE PRECISION TAU, WA, WB, WN 109* .. 110* .. External Subroutines .. 111 EXTERNAL DGEMV, DGER, DLARNV, DSCAL, XERBLA 112* .. 113* .. Intrinsic Functions .. 114 INTRINSIC MAX, SIGN 115* .. 116* .. External Functions .. 117 DOUBLE PRECISION DNRM2 118 EXTERNAL DNRM2 119* .. 120* .. Executable Statements .. 121* 122* Test the input arguments 123* 124 INFO = 0 125 IF( N.LT.0 ) THEN 126 INFO = -1 127 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 128 INFO = -3 129 END IF 130 IF( INFO.LT.0 ) THEN 131 CALL XERBLA( 'DLARGE', -INFO ) 132 RETURN 133 END IF 134* 135* pre- and post-multiply A by random orthogonal matrix 136* 137 DO 10 I = N, 1, -1 138* 139* generate random reflection 140* 141 CALL DLARNV( 3, ISEED, N-I+1, WORK ) 142 WN = DNRM2( N-I+1, WORK, 1 ) 143 WA = SIGN( WN, WORK( 1 ) ) 144 IF( WN.EQ.ZERO ) THEN 145 TAU = ZERO 146 ELSE 147 WB = WORK( 1 ) + WA 148 CALL DSCAL( N-I, ONE / WB, WORK( 2 ), 1 ) 149 WORK( 1 ) = ONE 150 TAU = WB / WA 151 END IF 152* 153* multiply A(i:n,1:n) by random reflection from the left 154* 155 CALL DGEMV( 'Transpose', N-I+1, N, ONE, A( I, 1 ), LDA, WORK, 156 $ 1, ZERO, WORK( N+1 ), 1 ) 157 CALL DGER( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ), 158 $ LDA ) 159* 160* multiply A(1:n,i:n) by random reflection from the right 161* 162 CALL DGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA, 163 $ WORK, 1, ZERO, WORK( N+1 ), 1 ) 164 CALL DGER( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ), 165 $ LDA ) 166 10 CONTINUE 167 RETURN 168* 169* End of DLARGE 170* 171 END 172