1       SUBROUTINE CLATM6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
  2      $                   BETA, WX, WY, S, DIF )
  3 *
  4 *  -- LAPACK test routine (version 3.1) --
  5 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  6 *     June 2010
  7 *
  8 *     .. Scalar Arguments ..
  9       INTEGER            LDA, LDX, LDY, N, TYPE
 10       COMPLEX            ALPHA, BETA, WX, WY
 11 *     ..
 12 *     .. Array Arguments ..
 13       REAL               DIF( * ), S( * )
 14       COMPLEX            A( LDA, * ), B( LDA, * ), X( LDX, * ),
 15      $                   Y( LDY, * )
 16 *     ..
 17 *
 18 *  Purpose
 19 *  =======
 20 *
 21 *  CLATM6 generates test matrices for the generalized eigenvalue
 22 *  problem, their corresponding right and left eigenvector matrices,
 23 *  and also reciprocal condition numbers for all eigenvalues and
 24 *  the reciprocal condition numbers of eigenvectors corresponding to
 25 *  the 1th and 5th eigenvalues.
 26 *
 27 *  Test Matrices
 28 *  =============
 29 *
 30 *  Two kinds of test matrix pairs
 31 *           (A, B) = inverse(YH) * (Da, Db) * inverse(X)
 32 *  are used in the tests:
 33 *
 34 *  Type 1:
 35 *     Da = 1+a   0    0    0    0    Db = 1   0   0   0   0
 36 *           0   2+a   0    0    0         0   1   0   0   0
 37 *           0    0   3+a   0    0         0   0   1   0   0
 38 *           0    0    0   4+a   0         0   0   0   1   0
 39 *           0    0    0    0   5+a ,      0   0   0   0   1
 40 *  and Type 2:
 41 *     Da = 1+i   0    0       0       0    Db = 1   0   0   0   0
 42 *           0   1-i   0       0       0         0   1   0   0   0
 43 *           0    0    1       0       0         0   0   1   0   0
 44 *           0    0    0 (1+a)+(1+b)i  0         0   0   0   1   0
 45 *           0    0    0       0 (1+a)-(1+b)i,   0   0   0   0   1 .
 46 *
 47 *  In both cases the same inverse(YH) and inverse(X) are used to compute
 48 *  (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
 49 *
 50 *  YH:  =  1    0   -y    y   -y    X =  1   0  -x  -x   x
 51 *          0    1   -y    y   -y         0   1   x  -x  -x
 52 *          0    0    1    0    0         0   0   1   0   0
 53 *          0    0    0    1    0         0   0   0   1   0
 54 *          0    0    0    0    1,        0   0   0   0   1 , where
 55 *
 56 *  a, b, x and y will have all values independently of each other.
 57 *
 58 *  Arguments
 59 *  =========
 60 *
 61 *  TYPE    (input) INTEGER
 62 *          Specifies the problem type (see futher details).
 63 *
 64 *  N       (input) INTEGER
 65 *          Size of the matrices A and B.
 66 *
 67 *  A       (output) COMPLEX array, dimension (LDA, N).
 68 *          On exit A N-by-N is initialized according to TYPE.
 69 *
 70 *  LDA     (input) INTEGER
 71 *          The leading dimension of A and of B.
 72 *
 73 *  B       (output) COMPLEX array, dimension (LDA, N).
 74 *          On exit B N-by-N is initialized according to TYPE.
 75 *
 76 *  X       (output) COMPLEX array, dimension (LDX, N).
 77 *          On exit X is the N-by-N matrix of right eigenvectors.
 78 *
 79 *  LDX     (input) INTEGER
 80 *          The leading dimension of X.
 81 *
 82 *  Y       (output) COMPLEX array, dimension (LDY, N).
 83 *          On exit Y is the N-by-N matrix of left eigenvectors.
 84 *
 85 *  LDY     (input) INTEGER
 86 *          The leading dimension of Y.
 87 *
 88 *  ALPHA   (input) COMPLEX
 89 *
 90 *  BETA    (input) COMPLEX
 91 *          Weighting constants for matrix A.
 92 *
 93 *  WX      (input) COMPLEX
 94 *          Constant for right eigenvector matrix.
 95 *
 96 *  WY      (input) COMPLEX
 97 *          Constant for left eigenvector matrix.
 98 *
 99 *  S       (output) REAL array, dimension (N)
100 *          S(i) is the reciprocal condition number for eigenvalue i.
101 *
102 *  DIF     (output) REAL array, dimension (N)
103 *          DIF(i) is the reciprocal condition number for eigenvector i.
104 *
105 *  =====================================================================
106 *
107 *     .. Parameters ..
108       REAL               RONE, TWO, THREE
109       PARAMETER          ( RONE = 1.0E+0, TWO = 2.0E+0, THREE = 3.0E+0 )
110       COMPLEX            ZERO, ONE
111       PARAMETER          ( ZERO = ( 0.0E+00.0E+0 ),
112      $                   ONE = ( 1.0E+00.0E+0 ) )
113 *     ..
114 *     .. Local Scalars ..
115       INTEGER            I, INFO, J
116 *     ..
117 *     .. Local Arrays ..
118       REAL               RWORK( 50 )
119       COMPLEX            WORK( 26 ), Z( 88 )
120 *     ..
121 *     .. Intrinsic Functions ..
122       INTRINSIC          CABSCMPLXCONJG, REAL, SQRT
123 *     ..
124 *     .. External Subroutines ..
125       EXTERNAL           CGESVD, CLACPY, CLAKF2
126 *     ..
127 *     .. Executable Statements ..
128 *
129 *     Generate test problem ...
130 *     (Da, Db) ...
131 *
132       DO 20 I = 1, N
133          DO 10 J = 1, N
134 *
135             IF( I.EQ.J ) THEN
136                A( I, I ) = CMPLX( I ) + ALPHA
137                B( I, I ) = ONE
138             ELSE
139                A( I, J ) = ZERO
140                B( I, J ) = ZERO
141             END IF
142 *
143    10    CONTINUE
144    20 CONTINUE
145       IFTYPE.EQ.2 ) THEN
146          A( 11 ) = CMPLX( RONE, RONE )
147          A( 22 ) = CONJG( A( 11 ) )
148          A( 33 ) = ONE
149          A( 44 ) = CMPLXREAL( ONE+ALPHA ), REAL( ONE+BETA ) )
150          A( 55 ) = CONJG( A( 44 ) )
151       END IF
152 *
153 *     Form X and Y
154 *
155       CALL CLACPY( 'F', N, N, B, LDA, Y, LDY )
156       Y( 31 ) = -CONJG( WY )
157       Y( 41 ) = CONJG( WY )
158       Y( 51 ) = -CONJG( WY )
159       Y( 32 ) = -CONJG( WY )
160       Y( 42 ) = CONJG( WY )
161       Y( 52 ) = -CONJG( WY )
162 *
163       CALL CLACPY( 'F', N, N, B, LDA, X, LDX )
164       X( 13 ) = -WX
165       X( 14 ) = -WX
166       X( 15 ) = WX
167       X( 23 ) = WX
168       X( 24 ) = -WX
169       X( 25 ) = -WX
170 *
171 *     Form (A, B)
172 *
173       B( 13 ) = WX + WY
174       B( 23 ) = -WX + WY
175       B( 14 ) = WX - WY
176       B( 24 ) = WX - WY
177       B( 15 ) = -WX + WY
178       B( 25 ) = WX + WY
179       A( 13 ) = WX*A( 11 ) + WY*A( 33 )
180       A( 23 ) = -WX*A( 22 ) + WY*A( 33 )
181       A( 14 ) = WX*A( 11 ) - WY*A( 44 )
182       A( 24 ) = WX*A( 22 ) - WY*A( 44 )
183       A( 15 ) = -WX*A( 11 ) + WY*A( 55 )
184       A( 25 ) = WX*A( 22 ) + WY*A( 55 )
185 *
186 *     Compute condition numbers
187 *
188       S( 1 ) = RONE / SQRT( ( RONE+THREE*CABS( WY )*CABS( WY ) ) /
189      $         ( RONE+CABS( A( 11 ) )*CABS( A( 11 ) ) ) )
190       S( 2 ) = RONE / SQRT( ( RONE+THREE*CABS( WY )*CABS( WY ) ) /
191      $         ( RONE+CABS( A( 22 ) )*CABS( A( 22 ) ) ) )
192       S( 3 ) = RONE / SQRT( ( RONE+TWO*CABS( WX )*CABS( WX ) ) /
193      $         ( RONE+CABS( A( 33 ) )*CABS( A( 33 ) ) ) )
194       S( 4 ) = RONE / SQRT( ( RONE+TWO*CABS( WX )*CABS( WX ) ) /
195      $         ( RONE+CABS( A( 44 ) )*CABS( A( 44 ) ) ) )
196       S( 5 ) = RONE / SQRT( ( RONE+TWO*CABS( WX )*CABS( WX ) ) /
197      $         ( RONE+CABS( A( 55 ) )*CABS( A( 55 ) ) ) )
198 *
199       CALL CLAKF2( 14, A, LDA, A( 22 ), B, B( 22 ), Z, 8 )
200       CALL CGESVD( 'N''N'88, Z, 8, RWORK, WORK, 1, WORK( 2 ), 1,
201      $             WORK( 3 ), 24, RWORK( 9 ), INFO )
202       DIF( 1 ) = RWORK( 8 )
203 *
204       CALL CLAKF2( 41, A, LDA, A( 55 ), B, B( 55 ), Z, 8 )
205       CALL CGESVD( 'N''N'88, Z, 8, RWORK, WORK, 1, WORK( 2 ), 1,
206      $             WORK( 3 ), 24, RWORK( 9 ), INFO )
207       DIF( 5 ) = RWORK( 8 )
208 *
209       RETURN
210 *
211 *     End of CLATM6
212 *
213       END