1 LOGICAL FUNCTION CSLECT( Z )
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 COMPLEX Z
9 * ..
10 *
11 * Purpose
12 * =======
13 *
14 * CSLECT returns .TRUE. if the eigenvalue Z is to be selected,
15 * otherwise it returns .FALSE.
16 * It is used by CCHK41 to test if CGEES succesfully sorts eigenvalues,
17 * and by CCHK43 to test if CGEESX succesfully sorts eigenvalues.
18 *
19 * The common block /SSLCT/ controls how eigenvalues are selected.
20 * If SELOPT = 0, then CSLECT return .TRUE. when real(Z) is less than
21 * zero, and .FALSE. otherwise.
22 * If SELOPT is at least 1, CSLECT returns SELVAL(SELOPT) and adds 1
23 * to SELOPT, cycling back to 1 at SELMAX.
24 *
25 * Arguments
26 * =========
27 *
28 * Z (input) COMPLEX
29 * The eigenvalue Z.
30 *
31 * =====================================================================
32 *
33 * .. Parameters ..
34 REAL ZERO
35 PARAMETER ( ZERO = 0.0E0 )
36 * ..
37 * .. Local Scalars ..
38 INTEGER I
39 REAL RMIN, X
40 * ..
41 * .. Scalars in Common ..
42 INTEGER SELDIM, SELOPT
43 * ..
44 * .. Arrays in Common ..
45 LOGICAL SELVAL( 20 )
46 REAL SELWI( 20 ), SELWR( 20 )
47 * ..
48 * .. Common blocks ..
49 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI
50 * ..
51 * .. Intrinsic Functions ..
52 INTRINSIC ABS, CMPLX, REAL
53 * ..
54 * .. Executable Statements ..
55 *
56 IF( SELOPT.EQ.0 ) THEN
57 CSLECT = ( REAL( Z ).LT.ZERO )
58 ELSE
59 RMIN = ABS( Z-CMPLX( SELWR( 1 ), SELWI( 1 ) ) )
60 CSLECT = SELVAL( 1 )
61 DO 10 I = 2, SELDIM
62 X = ABS( Z-CMPLX( SELWR( I ), SELWI( I ) ) )
63 IF( X.LE.RMIN ) THEN
64 RMIN = X
65 CSLECT = SELVAL( I )
66 END IF
67 10 CONTINUE
68 END IF
69 RETURN
70 *
71 * End of CSLECT
72 *
73 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 COMPLEX Z
9 * ..
10 *
11 * Purpose
12 * =======
13 *
14 * CSLECT returns .TRUE. if the eigenvalue Z is to be selected,
15 * otherwise it returns .FALSE.
16 * It is used by CCHK41 to test if CGEES succesfully sorts eigenvalues,
17 * and by CCHK43 to test if CGEESX succesfully sorts eigenvalues.
18 *
19 * The common block /SSLCT/ controls how eigenvalues are selected.
20 * If SELOPT = 0, then CSLECT return .TRUE. when real(Z) is less than
21 * zero, and .FALSE. otherwise.
22 * If SELOPT is at least 1, CSLECT returns SELVAL(SELOPT) and adds 1
23 * to SELOPT, cycling back to 1 at SELMAX.
24 *
25 * Arguments
26 * =========
27 *
28 * Z (input) COMPLEX
29 * The eigenvalue Z.
30 *
31 * =====================================================================
32 *
33 * .. Parameters ..
34 REAL ZERO
35 PARAMETER ( ZERO = 0.0E0 )
36 * ..
37 * .. Local Scalars ..
38 INTEGER I
39 REAL RMIN, X
40 * ..
41 * .. Scalars in Common ..
42 INTEGER SELDIM, SELOPT
43 * ..
44 * .. Arrays in Common ..
45 LOGICAL SELVAL( 20 )
46 REAL SELWI( 20 ), SELWR( 20 )
47 * ..
48 * .. Common blocks ..
49 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI
50 * ..
51 * .. Intrinsic Functions ..
52 INTRINSIC ABS, CMPLX, REAL
53 * ..
54 * .. Executable Statements ..
55 *
56 IF( SELOPT.EQ.0 ) THEN
57 CSLECT = ( REAL( Z ).LT.ZERO )
58 ELSE
59 RMIN = ABS( Z-CMPLX( SELWR( 1 ), SELWI( 1 ) ) )
60 CSLECT = SELVAL( 1 )
61 DO 10 I = 2, SELDIM
62 X = ABS( Z-CMPLX( SELWR( I ), SELWI( I ) ) )
63 IF( X.LE.RMIN ) THEN
64 RMIN = X
65 CSLECT = SELVAL( I )
66 END IF
67 10 CONTINUE
68 END IF
69 RETURN
70 *
71 * End of CSLECT
72 *
73 END