LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ sget22()

subroutine sget22 ( character  TRANSA,
character  TRANSE,
character  TRANSW,
integer  N,
real, dimension( lda, * )  A,
integer  LDA,
real, dimension( lde, * )  E,
integer  LDE,
real, dimension( * )  WR,
real, dimension( * )  WI,
real, dimension( * )  WORK,
real, dimension( 2 )  RESULT 
)

SGET22

Purpose:
 SGET22 does an eigenvector check.

 The basic test is:

    RESULT(1) = | A E  -  E W | / ( |A| |E| ulp )

 using the 1-norm.  It also tests the normalization of E:

    RESULT(2) = max | m-norm(E(j)) - 1 | / ( n ulp )
                 j

 where E(j) is the j-th eigenvector, and m-norm is the max-norm of a
 vector.  If an eigenvector is complex, as determined from WI(j)
 nonzero, then the max-norm of the vector ( er + i*ei ) is the maximum
 of
    |er(1)| + |ei(1)|, ... , |er(n)| + |ei(n)|

 W is a block diagonal matrix, with a 1 by 1 block for each real
 eigenvalue and a 2 by 2 block for each complex conjugate pair.
 If eigenvalues j and j+1 are a complex conjugate pair, so that
 WR(j) = WR(j+1) = wr and WI(j) = - WI(j+1) = wi, then the 2 by 2
 block corresponding to the pair will be:

    (  wr  wi  )
    ( -wi  wr  )

 Such a block multiplying an n by 2 matrix ( ur ui ) on the right
 will be the same as multiplying  ur + i*ui  by  wr + i*wi.

 To handle various schemes for storage of left eigenvectors, there are
 options to use A-transpose instead of A, E-transpose instead of E,
 and/or W-transpose instead of W.
Parameters
[in]TRANSA
          TRANSA is CHARACTER*1
          Specifies whether or not A is transposed.
          = 'N':  No transpose
          = 'T':  Transpose
          = 'C':  Conjugate transpose (= Transpose)
[in]TRANSE
          TRANSE is CHARACTER*1
          Specifies whether or not E is transposed.
          = 'N':  No transpose, eigenvectors are in columns of E
          = 'T':  Transpose, eigenvectors are in rows of E
          = 'C':  Conjugate transpose (= Transpose)
[in]TRANSW
          TRANSW is CHARACTER*1
          Specifies whether or not W is transposed.
          = 'N':  No transpose
          = 'T':  Transpose, use -WI(j) instead of WI(j)
          = 'C':  Conjugate transpose, use -WI(j) instead of WI(j)
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in]A
          A is REAL array, dimension (LDA,N)
          The matrix whose eigenvectors are in E.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[in]E
          E is REAL array, dimension (LDE,N)
          The matrix of eigenvectors. If TRANSE = 'N', the eigenvectors
          are stored in the columns of E, if TRANSE = 'T' or 'C', the
          eigenvectors are stored in the rows of E.
[in]LDE
          LDE is INTEGER
          The leading dimension of the array E.  LDE >= max(1,N).
[in]WR
          WR is REAL array, dimension (N)
[in]WI
          WI is REAL array, dimension (N)

          The real and imaginary parts of the eigenvalues of A.
          Purely real eigenvalues are indicated by WI(j) = 0.
          Complex conjugate pairs are indicated by WR(j)=WR(j+1) and
          WI(j) = - WI(j+1) non-zero; the real part is assumed to be
          stored in the j-th row/column and the imaginary part in
          the (j+1)-th row/column.
[out]WORK
          WORK is REAL array, dimension (N*(N+1))
[out]RESULT
          RESULT is REAL array, dimension (2)
          RESULT(1) = | A E  -  E W | / ( |A| |E| ulp )
          RESULT(2) = max | m-norm(E(j)) - 1 | / ( n ulp )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 165 of file sget22.f.

167 *
168 * -- LAPACK test routine --
169 * -- LAPACK is a software package provided by Univ. of Tennessee, --
170 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
171 *
172 * .. Scalar Arguments ..
173  CHARACTER TRANSA, TRANSE, TRANSW
174  INTEGER LDA, LDE, N
175 * ..
176 * .. Array Arguments ..
177  REAL A( LDA, * ), E( LDE, * ), RESULT( 2 ), WI( * ),
178  $ WORK( * ), WR( * )
179 * ..
180 *
181 * =====================================================================
182 *
183 * .. Parameters ..
184  REAL ZERO, ONE
185  parameter( zero = 0.0, one = 1.0 )
186 * ..
187 * .. Local Scalars ..
188  CHARACTER NORMA, NORME
189  INTEGER IECOL, IEROW, INCE, IPAIR, ITRNSE, J, JCOL,
190  $ JVEC
191  REAL ANORM, ENORM, ENRMAX, ENRMIN, ERRNRM, TEMP1,
192  $ ULP, UNFL
193 * ..
194 * .. Local Arrays ..
195  REAL WMAT( 2, 2 )
196 * ..
197 * .. External Functions ..
198  LOGICAL LSAME
199  REAL SLAMCH, SLANGE
200  EXTERNAL lsame, slamch, slange
201 * ..
202 * .. External Subroutines ..
203  EXTERNAL saxpy, sgemm, slaset
204 * ..
205 * .. Intrinsic Functions ..
206  INTRINSIC abs, max, min, real
207 * ..
208 * .. Executable Statements ..
209 *
210 * Initialize RESULT (in case N=0)
211 *
212  result( 1 ) = zero
213  result( 2 ) = zero
214  IF( n.LE.0 )
215  $ RETURN
216 *
217  unfl = slamch( 'Safe minimum' )
218  ulp = slamch( 'Precision' )
219 *
220  itrnse = 0
221  ince = 1
222  norma = 'O'
223  norme = 'O'
224 *
225  IF( lsame( transa, 'T' ) .OR. lsame( transa, 'C' ) ) THEN
226  norma = 'I'
227  END IF
228  IF( lsame( transe, 'T' ) .OR. lsame( transe, 'C' ) ) THEN
229  norme = 'I'
230  itrnse = 1
231  ince = lde
232  END IF
233 *
234 * Check normalization of E
235 *
236  enrmin = one / ulp
237  enrmax = zero
238  IF( itrnse.EQ.0 ) THEN
239 *
240 * Eigenvectors are column vectors.
241 *
242  ipair = 0
243  DO 30 jvec = 1, n
244  temp1 = zero
245  IF( ipair.EQ.0 .AND. jvec.LT.n .AND. wi( jvec ).NE.zero )
246  $ ipair = 1
247  IF( ipair.EQ.1 ) THEN
248 *
249 * Complex eigenvector
250 *
251  DO 10 j = 1, n
252  temp1 = max( temp1, abs( e( j, jvec ) )+
253  $ abs( e( j, jvec+1 ) ) )
254  10 CONTINUE
255  enrmin = min( enrmin, temp1 )
256  enrmax = max( enrmax, temp1 )
257  ipair = 2
258  ELSE IF( ipair.EQ.2 ) THEN
259  ipair = 0
260  ELSE
261 *
262 * Real eigenvector
263 *
264  DO 20 j = 1, n
265  temp1 = max( temp1, abs( e( j, jvec ) ) )
266  20 CONTINUE
267  enrmin = min( enrmin, temp1 )
268  enrmax = max( enrmax, temp1 )
269  ipair = 0
270  END IF
271  30 CONTINUE
272 *
273  ELSE
274 *
275 * Eigenvectors are row vectors.
276 *
277  DO 40 jvec = 1, n
278  work( jvec ) = zero
279  40 CONTINUE
280 *
281  DO 60 j = 1, n
282  ipair = 0
283  DO 50 jvec = 1, n
284  IF( ipair.EQ.0 .AND. jvec.LT.n .AND. wi( jvec ).NE.zero )
285  $ ipair = 1
286  IF( ipair.EQ.1 ) THEN
287  work( jvec ) = max( work( jvec ),
288  $ abs( e( j, jvec ) )+abs( e( j,
289  $ jvec+1 ) ) )
290  work( jvec+1 ) = work( jvec )
291  ELSE IF( ipair.EQ.2 ) THEN
292  ipair = 0
293  ELSE
294  work( jvec ) = max( work( jvec ),
295  $ abs( e( j, jvec ) ) )
296  ipair = 0
297  END IF
298  50 CONTINUE
299  60 CONTINUE
300 *
301  DO 70 jvec = 1, n
302  enrmin = min( enrmin, work( jvec ) )
303  enrmax = max( enrmax, work( jvec ) )
304  70 CONTINUE
305  END IF
306 *
307 * Norm of A:
308 *
309  anorm = max( slange( norma, n, n, a, lda, work ), unfl )
310 *
311 * Norm of E:
312 *
313  enorm = max( slange( norme, n, n, e, lde, work ), ulp )
314 *
315 * Norm of error:
316 *
317 * Error = AE - EW
318 *
319  CALL slaset( 'Full', n, n, zero, zero, work, n )
320 *
321  ipair = 0
322  ierow = 1
323  iecol = 1
324 *
325  DO 80 jcol = 1, n
326  IF( itrnse.EQ.1 ) THEN
327  ierow = jcol
328  ELSE
329  iecol = jcol
330  END IF
331 *
332  IF( ipair.EQ.0 .AND. wi( jcol ).NE.zero )
333  $ ipair = 1
334 *
335  IF( ipair.EQ.1 ) THEN
336  wmat( 1, 1 ) = wr( jcol )
337  wmat( 2, 1 ) = -wi( jcol )
338  wmat( 1, 2 ) = wi( jcol )
339  wmat( 2, 2 ) = wr( jcol )
340  CALL sgemm( transe, transw, n, 2, 2, one, e( ierow, iecol ),
341  $ lde, wmat, 2, zero, work( n*( jcol-1 )+1 ), n )
342  ipair = 2
343  ELSE IF( ipair.EQ.2 ) THEN
344  ipair = 0
345 *
346  ELSE
347 *
348  CALL saxpy( n, wr( jcol ), e( ierow, iecol ), ince,
349  $ work( n*( jcol-1 )+1 ), 1 )
350  ipair = 0
351  END IF
352 *
353  80 CONTINUE
354 *
355  CALL sgemm( transa, transe, n, n, n, one, a, lda, e, lde, -one,
356  $ work, n )
357 *
358  errnrm = slange( 'One', n, n, work, n, work( n*n+1 ) ) / enorm
359 *
360 * Compute RESULT(1) (avoiding under/overflow)
361 *
362  IF( anorm.GT.errnrm ) THEN
363  result( 1 ) = ( errnrm / anorm ) / ulp
364  ELSE
365  IF( anorm.LT.one ) THEN
366  result( 1 ) = ( min( errnrm, anorm ) / anorm ) / ulp
367  ELSE
368  result( 1 ) = min( errnrm / anorm, one ) / ulp
369  END IF
370  END IF
371 *
372 * Compute RESULT(2) : the normalization error in E.
373 *
374  result( 2 ) = max( abs( enrmax-one ), abs( enrmin-one ) ) /
375  $ ( real( n )*ulp )
376 *
377  RETURN
378 *
379 * End of SGET22
380 *
lde
logical function lde(RI, RJ, LR)
Definition: dblat2.f:2942
slaset
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: slaset.f:110
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
slange
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:114
saxpy
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
Definition: saxpy.f:89
sgemm
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
Definition: sgemm.f:187
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: