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