1 SUBROUTINE SLARGE( N, A, LDA, ISEED, WORK, INFO )
2 *
3 * -- LAPACK auxiliary test routine (version 3.1)
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER INFO, LDA, N
9 * ..
10 * .. Array Arguments ..
11 INTEGER ISEED( 4 )
12 REAL A( LDA, * ), WORK( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SLARGE pre- and post-multiplies a real general n by n matrix A
19 * with a random orthogonal matrix: A = U*D*U'.
20 *
21 * Arguments
22 * =========
23 *
24 * N (input) INTEGER
25 * The order of the matrix A. N >= 0.
26 *
27 * A (input/output) REAL array, dimension (LDA,N)
28 * On entry, the original n by n matrix A.
29 * On exit, A is overwritten by U*A*U' for some random
30 * orthogonal matrix U.
31 *
32 * LDA (input) INTEGER
33 * The leading dimension of the array A. LDA >= N.
34 *
35 * ISEED (input/output) INTEGER array, dimension (4)
36 * On entry, the seed of the random number generator; the array
37 * elements must be between 0 and 4095, and ISEED(4) must be
38 * odd.
39 * On exit, the seed is updated.
40 *
41 * WORK (workspace) REAL array, dimension (2*N)
42 *
43 * INFO (output) INTEGER
44 * = 0: successful exit
45 * < 0: if INFO = -i, the i-th argument had an illegal value
46 *
47 * =====================================================================
48 *
49 * .. Parameters ..
50 REAL ZERO, ONE
51 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
52 * ..
53 * .. Local Scalars ..
54 INTEGER I
55 REAL TAU, WA, WB, WN
56 * ..
57 * .. External Subroutines ..
58 EXTERNAL SGEMV, SGER, SLARNV, SSCAL, XERBLA
59 * ..
60 * .. Intrinsic Functions ..
61 INTRINSIC MAX, SIGN
62 * ..
63 * .. External Functions ..
64 REAL SNRM2
65 EXTERNAL SNRM2
66 * ..
67 * .. Executable Statements ..
68 *
69 * Test the input arguments
70 *
71 INFO = 0
72 IF( N.LT.0 ) THEN
73 INFO = -1
74 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
75 INFO = -3
76 END IF
77 IF( INFO.LT.0 ) THEN
78 CALL XERBLA( 'SLARGE', -INFO )
79 RETURN
80 END IF
81 *
82 * pre- and post-multiply A by random orthogonal matrix
83 *
84 DO 10 I = N, 1, -1
85 *
86 * generate random reflection
87 *
88 CALL SLARNV( 3, ISEED, N-I+1, WORK )
89 WN = SNRM2( N-I+1, WORK, 1 )
90 WA = SIGN( WN, WORK( 1 ) )
91 IF( WN.EQ.ZERO ) THEN
92 TAU = ZERO
93 ELSE
94 WB = WORK( 1 ) + WA
95 CALL SSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
96 WORK( 1 ) = ONE
97 TAU = WB / WA
98 END IF
99 *
100 * multiply A(i:n,1:n) by random reflection from the left
101 *
102 CALL SGEMV( 'Transpose', N-I+1, N, ONE, A( I, 1 ), LDA, WORK,
103 $ 1, ZERO, WORK( N+1 ), 1 )
104 CALL SGER( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ),
105 $ LDA )
106 *
107 * multiply A(1:n,i:n) by random reflection from the right
108 *
109 CALL SGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA,
110 $ WORK, 1, ZERO, WORK( N+1 ), 1 )
111 CALL SGER( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ),
112 $ LDA )
113 10 CONTINUE
114 RETURN
115 *
116 * End of SLARGE
117 *
118 END
2 *
3 * -- LAPACK auxiliary test routine (version 3.1)
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER INFO, LDA, N
9 * ..
10 * .. Array Arguments ..
11 INTEGER ISEED( 4 )
12 REAL A( LDA, * ), WORK( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SLARGE pre- and post-multiplies a real general n by n matrix A
19 * with a random orthogonal matrix: A = U*D*U'.
20 *
21 * Arguments
22 * =========
23 *
24 * N (input) INTEGER
25 * The order of the matrix A. N >= 0.
26 *
27 * A (input/output) REAL array, dimension (LDA,N)
28 * On entry, the original n by n matrix A.
29 * On exit, A is overwritten by U*A*U' for some random
30 * orthogonal matrix U.
31 *
32 * LDA (input) INTEGER
33 * The leading dimension of the array A. LDA >= N.
34 *
35 * ISEED (input/output) INTEGER array, dimension (4)
36 * On entry, the seed of the random number generator; the array
37 * elements must be between 0 and 4095, and ISEED(4) must be
38 * odd.
39 * On exit, the seed is updated.
40 *
41 * WORK (workspace) REAL array, dimension (2*N)
42 *
43 * INFO (output) INTEGER
44 * = 0: successful exit
45 * < 0: if INFO = -i, the i-th argument had an illegal value
46 *
47 * =====================================================================
48 *
49 * .. Parameters ..
50 REAL ZERO, ONE
51 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
52 * ..
53 * .. Local Scalars ..
54 INTEGER I
55 REAL TAU, WA, WB, WN
56 * ..
57 * .. External Subroutines ..
58 EXTERNAL SGEMV, SGER, SLARNV, SSCAL, XERBLA
59 * ..
60 * .. Intrinsic Functions ..
61 INTRINSIC MAX, SIGN
62 * ..
63 * .. External Functions ..
64 REAL SNRM2
65 EXTERNAL SNRM2
66 * ..
67 * .. Executable Statements ..
68 *
69 * Test the input arguments
70 *
71 INFO = 0
72 IF( N.LT.0 ) THEN
73 INFO = -1
74 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
75 INFO = -3
76 END IF
77 IF( INFO.LT.0 ) THEN
78 CALL XERBLA( 'SLARGE', -INFO )
79 RETURN
80 END IF
81 *
82 * pre- and post-multiply A by random orthogonal matrix
83 *
84 DO 10 I = N, 1, -1
85 *
86 * generate random reflection
87 *
88 CALL SLARNV( 3, ISEED, N-I+1, WORK )
89 WN = SNRM2( N-I+1, WORK, 1 )
90 WA = SIGN( WN, WORK( 1 ) )
91 IF( WN.EQ.ZERO ) THEN
92 TAU = ZERO
93 ELSE
94 WB = WORK( 1 ) + WA
95 CALL SSCAL( N-I, ONE / WB, WORK( 2 ), 1 )
96 WORK( 1 ) = ONE
97 TAU = WB / WA
98 END IF
99 *
100 * multiply A(i:n,1:n) by random reflection from the left
101 *
102 CALL SGEMV( 'Transpose', N-I+1, N, ONE, A( I, 1 ), LDA, WORK,
103 $ 1, ZERO, WORK( N+1 ), 1 )
104 CALL SGER( N-I+1, N, -TAU, WORK, 1, WORK( N+1 ), 1, A( I, 1 ),
105 $ LDA )
106 *
107 * multiply A(1:n,i:n) by random reflection from the right
108 *
109 CALL SGEMV( 'No transpose', N, N-I+1, ONE, A( 1, I ), LDA,
110 $ WORK, 1, ZERO, WORK( N+1 ), 1 )
111 CALL SGER( N, N-I+1, -TAU, WORK( N+1 ), 1, WORK, 1, A( 1, I ),
112 $ LDA )
113 10 CONTINUE
114 RETURN
115 *
116 * End of SLARGE
117 *
118 END