1*> \brief \b SLATM6
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 SLATM6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
12*                          BETA, WX, WY, S, DIF )
13*
14*       .. Scalar Arguments ..
15*       INTEGER            LDA, LDX, LDY, N, TYPE
16*       REAL               ALPHA, BETA, WX, WY
17*       ..
18*       .. Array Arguments ..
19*       REAL               A( LDA, * ), B( LDA, * ), DIF( * ), S( * ),
20*      $                   X( LDX, * ), Y( LDY, * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> SLATM6 generates test matrices for the generalized eigenvalue
30*> problem, their corresponding right and left eigenvector matrices,
31*> and also reciprocal condition numbers for all eigenvalues and
32*> the reciprocal condition numbers of eigenvectors corresponding to
33*> the 1th and 5th eigenvalues.
34*>
35*> Test Matrices
36*> =============
37*>
38*> Two kinds of test matrix pairs
39*>
40*>       (A, B) = inverse(YH) * (Da, Db) * inverse(X)
41*>
42*> are used in the tests:
43*>
44*> Type 1:
45*>    Da = 1+a   0    0    0    0    Db = 1   0   0   0   0
46*>          0   2+a   0    0    0         0   1   0   0   0
47*>          0    0   3+a   0    0         0   0   1   0   0
48*>          0    0    0   4+a   0         0   0   0   1   0
49*>          0    0    0    0   5+a ,      0   0   0   0   1 , and
50*>
51*> Type 2:
52*>    Da =  1   -1    0    0    0    Db = 1   0   0   0   0
53*>          1    1    0    0    0         0   1   0   0   0
54*>          0    0    1    0    0         0   0   1   0   0
55*>          0    0    0   1+a  1+b        0   0   0   1   0
56*>          0    0    0  -1-b  1+a ,      0   0   0   0   1 .
57*>
58*> In both cases the same inverse(YH) and inverse(X) are used to compute
59*> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
60*>
61*> YH:  =  1    0   -y    y   -y    X =  1   0  -x  -x   x
62*>         0    1   -y    y   -y         0   1   x  -x  -x
63*>         0    0    1    0    0         0   0   1   0   0
64*>         0    0    0    1    0         0   0   0   1   0
65*>         0    0    0    0    1,        0   0   0   0   1 ,
66*>
67*> where a, b, x and y will have all values independently of each other.
68*> \endverbatim
69*
70*  Arguments:
71*  ==========
72*
73*> \param[in] TYPE
74*> \verbatim
75*>          TYPE is INTEGER
76*>          Specifies the problem type (see further details).
77*> \endverbatim
78*>
79*> \param[in] N
80*> \verbatim
81*>          N is INTEGER
82*>          Size of the matrices A and B.
83*> \endverbatim
84*>
85*> \param[out] A
86*> \verbatim
87*>          A is REAL array, dimension (LDA, N).
88*>          On exit A N-by-N is initialized according to TYPE.
89*> \endverbatim
90*>
91*> \param[in] LDA
92*> \verbatim
93*>          LDA is INTEGER
94*>          The leading dimension of A and of B.
95*> \endverbatim
96*>
97*> \param[out] B
98*> \verbatim
99*>          B is REAL array, dimension (LDA, N).
100*>          On exit B N-by-N is initialized according to TYPE.
101*> \endverbatim
102*>
103*> \param[out] X
104*> \verbatim
105*>          X is REAL array, dimension (LDX, N).
106*>          On exit X is the N-by-N matrix of right eigenvectors.
107*> \endverbatim
108*>
109*> \param[in] LDX
110*> \verbatim
111*>          LDX is INTEGER
112*>          The leading dimension of X.
113*> \endverbatim
114*>
115*> \param[out] Y
116*> \verbatim
117*>          Y is REAL array, dimension (LDY, N).
118*>          On exit Y is the N-by-N matrix of left eigenvectors.
119*> \endverbatim
120*>
121*> \param[in] LDY
122*> \verbatim
123*>          LDY is INTEGER
124*>          The leading dimension of Y.
125*> \endverbatim
126*>
127*> \param[in] ALPHA
128*> \verbatim
129*>          ALPHA is REAL
130*> \endverbatim
131*>
132*> \param[in] BETA
133*> \verbatim
134*>          BETA is REAL
135*>
136*>          Weighting constants for matrix A.
137*> \endverbatim
138*>
139*> \param[in] WX
140*> \verbatim
141*>          WX is REAL
142*>          Constant for right eigenvector matrix.
143*> \endverbatim
144*>
145*> \param[in] WY
146*> \verbatim
147*>          WY is REAL
148*>          Constant for left eigenvector matrix.
149*> \endverbatim
150*>
151*> \param[out] S
152*> \verbatim
153*>          S is REAL array, dimension (N)
154*>          S(i) is the reciprocal condition number for eigenvalue i.
155*> \endverbatim
156*>
157*> \param[out] DIF
158*> \verbatim
159*>          DIF is REAL array, dimension (N)
160*>          DIF(i) is the reciprocal condition number for eigenvector i.
161*> \endverbatim
162*
163*  Authors:
164*  ========
165*
166*> \author Univ. of Tennessee
167*> \author Univ. of California Berkeley
168*> \author Univ. of Colorado Denver
169*> \author NAG Ltd.
170*
171*> \ingroup real_matgen
172*
173*  =====================================================================
174      SUBROUTINE SLATM6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
175     $                   BETA, WX, WY, S, DIF )
176*
177*  -- LAPACK computational routine --
178*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
179*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
180*
181*     .. Scalar Arguments ..
182      INTEGER            LDA, LDX, LDY, N, TYPE
183      REAL               ALPHA, BETA, WX, WY
184*     ..
185*     .. Array Arguments ..
186      REAL               A( LDA, * ), B( LDA, * ), DIF( * ), S( * ),
187     $                   X( LDX, * ), Y( LDY, * )
188*     ..
189*
190*  =====================================================================
191*
192*     .. Parameters ..
193      REAL               ZERO, ONE, TWO, THREE
194      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0,
195     $                   THREE = 3.0E+0 )
196*     ..
197*     .. Local Scalars ..
198      INTEGER            I, INFO, J
199*     ..
200*     .. Local Arrays ..
201      REAL               WORK( 100 ), Z( 12, 12 )
202*     ..
203*     .. Intrinsic Functions ..
204      INTRINSIC          REAL, SQRT
205*     ..
206*     .. External Subroutines ..
207      EXTERNAL           SGESVD, SLACPY, SLAKF2
208*     ..
209*     .. Executable Statements ..
210*
211*     Generate test problem ...
212*     (Da, Db) ...
213*
214      DO 20 I = 1, N
215         DO 10 J = 1, N
216*
217            IF( I.EQ.J ) THEN
218               A( I, I ) = REAL( I ) + ALPHA
219               B( I, I ) = ONE
220            ELSE
221               A( I, J ) = ZERO
222               B( I, J ) = ZERO
223            END IF
224*
225   10    CONTINUE
226   20 CONTINUE
227*
228*     Form X and Y
229*
230      CALL SLACPY( 'F', N, N, B, LDA, Y, LDY )
231      Y( 3, 1 ) = -WY
232      Y( 4, 1 ) = WY
233      Y( 5, 1 ) = -WY
234      Y( 3, 2 ) = -WY
235      Y( 4, 2 ) = WY
236      Y( 5, 2 ) = -WY
237*
238      CALL SLACPY( 'F', N, N, B, LDA, X, LDX )
239      X( 1, 3 ) = -WX
240      X( 1, 4 ) = -WX
241      X( 1, 5 ) = WX
242      X( 2, 3 ) = WX
243      X( 2, 4 ) = -WX
244      X( 2, 5 ) = -WX
245*
246*     Form (A, B)
247*
248      B( 1, 3 ) = WX + WY
249      B( 2, 3 ) = -WX + WY
250      B( 1, 4 ) = WX - WY
251      B( 2, 4 ) = WX - WY
252      B( 1, 5 ) = -WX + WY
253      B( 2, 5 ) = WX + WY
254      IF( TYPE.EQ.1 ) THEN
255         A( 1, 3 ) = WX*A( 1, 1 ) + WY*A( 3, 3 )
256         A( 2, 3 ) = -WX*A( 2, 2 ) + WY*A( 3, 3 )
257         A( 1, 4 ) = WX*A( 1, 1 ) - WY*A( 4, 4 )
258         A( 2, 4 ) = WX*A( 2, 2 ) - WY*A( 4, 4 )
259         A( 1, 5 ) = -WX*A( 1, 1 ) + WY*A( 5, 5 )
260         A( 2, 5 ) = WX*A( 2, 2 ) + WY*A( 5, 5 )
261      ELSE IF( TYPE.EQ.2 ) THEN
262         A( 1, 3 ) = TWO*WX + WY
263         A( 2, 3 ) = WY
264         A( 1, 4 ) = -WY*( TWO+ALPHA+BETA )
265         A( 2, 4 ) = TWO*WX - WY*( TWO+ALPHA+BETA )
266         A( 1, 5 ) = -TWO*WX + WY*( ALPHA-BETA )
267         A( 2, 5 ) = WY*( ALPHA-BETA )
268         A( 1, 1 ) = ONE
269         A( 1, 2 ) = -ONE
270         A( 2, 1 ) = ONE
271         A( 2, 2 ) = A( 1, 1 )
272         A( 3, 3 ) = ONE
273         A( 4, 4 ) = ONE + ALPHA
274         A( 4, 5 ) = ONE + BETA
275         A( 5, 4 ) = -A( 4, 5 )
276         A( 5, 5 ) = A( 4, 4 )
277      END IF
278*
279*     Compute condition numbers
280*
281      IF( TYPE.EQ.1 ) THEN
282*
283         S( 1 ) = ONE / SQRT( ( ONE+THREE*WY*WY ) /
284     $            ( ONE+A( 1, 1 )*A( 1, 1 ) ) )
285         S( 2 ) = ONE / SQRT( ( ONE+THREE*WY*WY ) /
286     $            ( ONE+A( 2, 2 )*A( 2, 2 ) ) )
287         S( 3 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
288     $            ( ONE+A( 3, 3 )*A( 3, 3 ) ) )
289         S( 4 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
290     $            ( ONE+A( 4, 4 )*A( 4, 4 ) ) )
291         S( 5 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
292     $            ( ONE+A( 5, 5 )*A( 5, 5 ) ) )
293*
294         CALL SLAKF2( 1, 4, A, LDA, A( 2, 2 ), B, B( 2, 2 ), Z, 12 )
295         CALL SGESVD( 'N', 'N', 8, 8, Z, 12, WORK, WORK( 9 ), 1,
296     $                WORK( 10 ), 1, WORK( 11 ), 40, INFO )
297         DIF( 1 ) = WORK( 8 )
298*
299         CALL SLAKF2( 4, 1, A, LDA, A( 5, 5 ), B, B( 5, 5 ), Z, 12 )
300         CALL SGESVD( 'N', 'N', 8, 8, Z, 12, WORK, WORK( 9 ), 1,
301     $                WORK( 10 ), 1, WORK( 11 ), 40, INFO )
302         DIF( 5 ) = WORK( 8 )
303*
304      ELSE IF( TYPE.EQ.2 ) THEN
305*
306         S( 1 ) = ONE / SQRT( ONE / THREE+WY*WY )
307         S( 2 ) = S( 1 )
308         S( 3 ) = ONE / SQRT( ONE / TWO+WX*WX )
309         S( 4 ) = ONE / SQRT( ( ONE+TWO*WX*WX ) /
310     $            ( ONE+( ONE+ALPHA )*( ONE+ALPHA )+( ONE+BETA )*( ONE+
311     $            BETA ) ) )
312         S( 5 ) = S( 4 )
313*
314         CALL SLAKF2( 2, 3, A, LDA, A( 3, 3 ), B, B( 3, 3 ), Z, 12 )
315         CALL SGESVD( 'N', 'N', 12, 12, Z, 12, WORK, WORK( 13 ), 1,
316     $                WORK( 14 ), 1, WORK( 15 ), 60, INFO )
317         DIF( 1 ) = WORK( 12 )
318*
319         CALL SLAKF2( 3, 2, A, LDA, A( 4, 4 ), B, B( 4, 4 ), Z, 12 )
320         CALL SGESVD( 'N', 'N', 12, 12, Z, 12, WORK, WORK( 13 ), 1,
321     $                WORK( 14 ), 1, WORK( 15 ), 60, INFO )
322         DIF( 5 ) = WORK( 12 )
323*
324      END IF
325*
326      RETURN
327*
328*     End of SLATM6
329*
330      END
331