LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ clatm6()

subroutine clatm6 ( integer type,
integer n,
complex, dimension( lda, * ) a,
integer lda,
complex, dimension( lda, * ) b,
complex, dimension( ldx, * ) x,
integer ldx,
complex, dimension( ldy, * ) y,
integer ldy,
complex alpha,
complex beta,
complex wx,
complex wy,
real, dimension( * ) s,
real, dimension( * ) dif )

CLATM6

Purpose:
!>
!> CLATM6 generates test matrices for the generalized eigenvalue
!> problem, their corresponding right and left eigenvector matrices,
!> and also reciprocal condition numbers for all eigenvalues and
!> the reciprocal condition numbers of eigenvectors corresponding to
!> the 1th and 5th eigenvalues.
!>
!> Test Matrices
!> =============
!>
!> Two kinds of test matrix pairs
!>          (A, B) = inverse(YH) * (Da, Db) * inverse(X)
!> are used in the tests:
!>
!> Type 1:
!>    Da = 1+a   0    0    0    0    Db = 1   0   0   0   0
!>          0   2+a   0    0    0         0   1   0   0   0
!>          0    0   3+a   0    0         0   0   1   0   0
!>          0    0    0   4+a   0         0   0   0   1   0
!>          0    0    0    0   5+a ,      0   0   0   0   1
!> and Type 2:
!>    Da = 1+i   0    0       0       0    Db = 1   0   0   0   0
!>          0   1-i   0       0       0         0   1   0   0   0
!>          0    0    1       0       0         0   0   1   0   0
!>          0    0    0 (1+a)+(1+b)i  0         0   0   0   1   0
!>          0    0    0       0 (1+a)-(1+b)i,   0   0   0   0   1 .
!>
!> In both cases the same inverse(YH) and inverse(X) are used to compute
!> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
!>
!> YH:  =  1    0   -y    y   -y    X =  1   0  -x  -x   x
!>         0    1   -y    y   -y         0   1   x  -x  -x
!>         0    0    1    0    0         0   0   1   0   0
!>         0    0    0    1    0         0   0   0   1   0
!>         0    0    0    0    1,        0   0   0   0   1 , where
!>
!> a, b, x and y will have all values independently of each other.
!>
Parameters
[in]TYPE
!>          TYPE is INTEGER
!>          Specifies the problem type (see further details).
!>
[in]N
!>          N is INTEGER
!>          Size of the matrices A and B.
!>
[out]A
!>          A is COMPLEX array, dimension (LDA, N).
!>          On exit A N-by-N is initialized according to TYPE.
!>
[in]LDA
!>          LDA is INTEGER
!>          The leading dimension of A and of B.
!>
[out]B
!>          B is COMPLEX array, dimension (LDA, N).
!>          On exit B N-by-N is initialized according to TYPE.
!>
[out]X
!>          X is COMPLEX array, dimension (LDX, N).
!>          On exit X is the N-by-N matrix of right eigenvectors.
!>
[in]LDX
!>          LDX is INTEGER
!>          The leading dimension of X.
!>
[out]Y
!>          Y is COMPLEX array, dimension (LDY, N).
!>          On exit Y is the N-by-N matrix of left eigenvectors.
!>
[in]LDY
!>          LDY is INTEGER
!>          The leading dimension of Y.
!>
[in]ALPHA
!>          ALPHA is COMPLEX
!>
[in]BETA
!>          BETA is COMPLEX
!>
!>          Weighting constants for matrix A.
!>
[in]WX
!>          WX is COMPLEX
!>          Constant for right eigenvector matrix.
!>
[in]WY
!>          WY is COMPLEX
!>          Constant for left eigenvector matrix.
!>
[out]S
!>          S is REAL array, dimension (N)
!>          S(i) is the reciprocal condition number for eigenvalue i.
!>
[out]DIF
!>          DIF is REAL array, dimension (N)
!>          DIF(i) is the reciprocal condition number for eigenvector i.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 172 of file clatm6.f.

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*
clakf2
subroutine clakf2(m, n, a, lda, b, d, e, z, ldz)
CLAKF2
Definition clakf2.f:105
cgesvd
subroutine cgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, info)
CGESVD computes the singular value decomposition (SVD) for GE matrices
Definition cgesvd.f:213
clacpy
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
Definition clacpy.f:101
Here is the call graph for this function:
Here is the caller graph for this function: