1 LOGICAL FUNCTION SSLECT( ZR, ZI )
2 *
3 * -- LAPACK test routine (version 3.1.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * February 2007
6 *
7 * .. Scalar Arguments ..
8 REAL ZI, ZR
9 * ..
10 *
11 * Purpose
12 * =======
13 *
14 * SSLECT returns .TRUE. if the eigenvalue ZR+sqrt(-1)*ZI is to be
15 * selected, and otherwise it returns .FALSE.
16 * It is used by SCHK41 to test if SGEES succesfully sorts eigenvalues,
17 * and by SCHK43 to test if SGEESX succesfully sorts eigenvalues.
18 *
19 * The common block /SSLCT/ controls how eigenvalues are selected.
20 * If SELOPT = 0, then SSLECT return .TRUE. when ZR is less than zero,
21 * and .FALSE. otherwise.
22 * If SELOPT is at least 1, SSLECT returns SELVAL(SELOPT) and adds 1
23 * to SELOPT, cycling back to 1 at SELMAX.
24 *
25 * Arguments
26 * =========
27 *
28 * ZR (input) REAL
29 * The real part of a complex eigenvalue ZR + i*ZI.
30 *
31 * ZI (input) REAL
32 * The imaginary part of a complex eigenvalue ZR + i*ZI.
33 *
34 * =====================================================================
35 *
36 * .. Arrays in Common ..
37 LOGICAL SELVAL( 20 )
38 REAL SELWI( 20 ), SELWR( 20 )
39 * ..
40 * .. Scalars in Common ..
41 INTEGER SELDIM, SELOPT
42 * ..
43 * .. Common blocks ..
44 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI
45 * ..
46 * .. Local Scalars ..
47 INTEGER I
48 REAL RMIN, X
49 * ..
50 * .. Parameters ..
51 REAL ZERO
52 PARAMETER ( ZERO = 0.0E0 )
53 * ..
54 * .. External Functions ..
55 REAL SLAPY2
56 EXTERNAL SLAPY2
57 * ..
58 * .. Executable Statements ..
59 *
60 IF( SELOPT.EQ.0 ) THEN
61 SSLECT = ( ZR.LT.ZERO )
62 ELSE
63 RMIN = SLAPY2( ZR-SELWR( 1 ), ZI-SELWI( 1 ) )
64 SSLECT = SELVAL( 1 )
65 DO 10 I = 2, SELDIM
66 X = SLAPY2( ZR-SELWR( I ), ZI-SELWI( I ) )
67 IF( X.LE.RMIN ) THEN
68 RMIN = X
69 SSLECT = SELVAL( I )
70 END IF
71 10 CONTINUE
72 END IF
73 RETURN
74 *
75 * End of SSLECT
76 *
77 END
2 *
3 * -- LAPACK test routine (version 3.1.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * February 2007
6 *
7 * .. Scalar Arguments ..
8 REAL ZI, ZR
9 * ..
10 *
11 * Purpose
12 * =======
13 *
14 * SSLECT returns .TRUE. if the eigenvalue ZR+sqrt(-1)*ZI is to be
15 * selected, and otherwise it returns .FALSE.
16 * It is used by SCHK41 to test if SGEES succesfully sorts eigenvalues,
17 * and by SCHK43 to test if SGEESX succesfully sorts eigenvalues.
18 *
19 * The common block /SSLCT/ controls how eigenvalues are selected.
20 * If SELOPT = 0, then SSLECT return .TRUE. when ZR is less than zero,
21 * and .FALSE. otherwise.
22 * If SELOPT is at least 1, SSLECT returns SELVAL(SELOPT) and adds 1
23 * to SELOPT, cycling back to 1 at SELMAX.
24 *
25 * Arguments
26 * =========
27 *
28 * ZR (input) REAL
29 * The real part of a complex eigenvalue ZR + i*ZI.
30 *
31 * ZI (input) REAL
32 * The imaginary part of a complex eigenvalue ZR + i*ZI.
33 *
34 * =====================================================================
35 *
36 * .. Arrays in Common ..
37 LOGICAL SELVAL( 20 )
38 REAL SELWI( 20 ), SELWR( 20 )
39 * ..
40 * .. Scalars in Common ..
41 INTEGER SELDIM, SELOPT
42 * ..
43 * .. Common blocks ..
44 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI
45 * ..
46 * .. Local Scalars ..
47 INTEGER I
48 REAL RMIN, X
49 * ..
50 * .. Parameters ..
51 REAL ZERO
52 PARAMETER ( ZERO = 0.0E0 )
53 * ..
54 * .. External Functions ..
55 REAL SLAPY2
56 EXTERNAL SLAPY2
57 * ..
58 * .. Executable Statements ..
59 *
60 IF( SELOPT.EQ.0 ) THEN
61 SSLECT = ( ZR.LT.ZERO )
62 ELSE
63 RMIN = SLAPY2( ZR-SELWR( 1 ), ZI-SELWI( 1 ) )
64 SSLECT = SELVAL( 1 )
65 DO 10 I = 2, SELDIM
66 X = SLAPY2( ZR-SELWR( I ), ZI-SELWI( I ) )
67 IF( X.LE.RMIN ) THEN
68 RMIN = X
69 SSLECT = SELVAL( I )
70 END IF
71 10 CONTINUE
72 END IF
73 RETURN
74 *
75 * End of SSLECT
76 *
77 END