1 LOGICAL FUNCTION DLCTSX( AR, AI, BETA )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 DOUBLE PRECISION AI, AR, BETA
9 * ..
10 *
11 * Purpose
12 * =======
13 *
14 * This function is used to determine what eigenvalues will be
15 * selected. If this is part of the test driver DDRGSX, do not
16 * change the code UNLESS you are testing input examples and not
17 * using the built-in examples.
18 *
19 * Arguments
20 * =========
21 *
22 * AR (input) DOUBLE PRECISION
23 * The numerator of the real part of a complex eigenvalue
24 * (AR/BETA) + i*(AI/BETA).
25 *
26 * AI (input) DOUBLE PRECISION
27 * The numerator of the imaginary part of a complex eigenvalue
28 * (AR/BETA) + i*(AI).
29 *
30 * BETA (input) DOUBLE PRECISION
31 * The denominator part of a complex eigenvalue
32 * (AR/BETA) + i*(AI/BETA).
33 *
34 * =====================================================================
35 *
36 * .. Scalars in Common ..
37 LOGICAL FS
38 INTEGER I, M, MPLUSN, N
39 * ..
40 * .. Common blocks ..
41 COMMON / MN / M, N, MPLUSN, I, FS
42 * ..
43 * .. Save statement ..
44 SAVE
45 * ..
46 * .. Executable Statements ..
47 *
48 IF( FS ) THEN
49 I = I + 1
50 IF( I.LE.M ) THEN
51 DLCTSX = .FALSE.
52 ELSE
53 DLCTSX = .TRUE.
54 END IF
55 IF( I.EQ.MPLUSN ) THEN
56 FS = .FALSE.
57 I = 0
58 END IF
59 ELSE
60 I = I + 1
61 IF( I.LE.N ) THEN
62 DLCTSX = .TRUE.
63 ELSE
64 DLCTSX = .FALSE.
65 END IF
66 IF( I.EQ.MPLUSN ) THEN
67 FS = .TRUE.
68 I = 0
69 END IF
70 END IF
71 *
72 * IF( AR/BETA.GT.0.0 )THEN
73 * DLCTSX = .TRUE.
74 * ELSE
75 * DLCTSX = .FALSE.
76 * END IF
77 *
78 RETURN
79 *
80 * End of DLCTSX
81 *
82 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 DOUBLE PRECISION AI, AR, BETA
9 * ..
10 *
11 * Purpose
12 * =======
13 *
14 * This function is used to determine what eigenvalues will be
15 * selected. If this is part of the test driver DDRGSX, do not
16 * change the code UNLESS you are testing input examples and not
17 * using the built-in examples.
18 *
19 * Arguments
20 * =========
21 *
22 * AR (input) DOUBLE PRECISION
23 * The numerator of the real part of a complex eigenvalue
24 * (AR/BETA) + i*(AI/BETA).
25 *
26 * AI (input) DOUBLE PRECISION
27 * The numerator of the imaginary part of a complex eigenvalue
28 * (AR/BETA) + i*(AI).
29 *
30 * BETA (input) DOUBLE PRECISION
31 * The denominator part of a complex eigenvalue
32 * (AR/BETA) + i*(AI/BETA).
33 *
34 * =====================================================================
35 *
36 * .. Scalars in Common ..
37 LOGICAL FS
38 INTEGER I, M, MPLUSN, N
39 * ..
40 * .. Common blocks ..
41 COMMON / MN / M, N, MPLUSN, I, FS
42 * ..
43 * .. Save statement ..
44 SAVE
45 * ..
46 * .. Executable Statements ..
47 *
48 IF( FS ) THEN
49 I = I + 1
50 IF( I.LE.M ) THEN
51 DLCTSX = .FALSE.
52 ELSE
53 DLCTSX = .TRUE.
54 END IF
55 IF( I.EQ.MPLUSN ) THEN
56 FS = .FALSE.
57 I = 0
58 END IF
59 ELSE
60 I = I + 1
61 IF( I.LE.N ) THEN
62 DLCTSX = .TRUE.
63 ELSE
64 DLCTSX = .FALSE.
65 END IF
66 IF( I.EQ.MPLUSN ) THEN
67 FS = .TRUE.
68 I = 0
69 END IF
70 END IF
71 *
72 * IF( AR/BETA.GT.0.0 )THEN
73 * DLCTSX = .TRUE.
74 * ELSE
75 * DLCTSX = .FALSE.
76 * END IF
77 *
78 RETURN
79 *
80 * End of DLCTSX
81 *
82 END