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