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