LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slctsx.f
Go to the documentation of this file.
1 *> \brief \b SLCTSX
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * LOGICAL FUNCTION SLCTSX( AR, AI, BETA )
12 *
13 * .. Scalar Arguments ..
14 * REAL AI, AR, BETA
15 * ..
16 *
17 *
18 *> \par Purpose:
19 * =============
20 *>
21 *> \verbatim
22 *>
23 *> This function is used to determine what eigenvalues will be
24 *> selected. If this is part of the test driver SDRGSX, do not
25 *> change the code UNLESS you are testing input examples and not
26 *> using the built-in examples.
27 *> \endverbatim
28 *
29 * Arguments:
30 * ==========
31 *
32 *> \param[in] AR
33 *> \verbatim
34 *> AR is REAL
35 *> The numerator of the real part of a complex eigenvalue
36 *> (AR/BETA) + i*(AI/BETA).
37 *> \endverbatim
38 *>
39 *> \param[in] AI
40 *> \verbatim
41 *> AI is REAL
42 *> The numerator of the imaginary part of a complex eigenvalue
43 *> (AR/BETA) + i*(AI).
44 *> \endverbatim
45 *>
46 *> \param[in] BETA
47 *> \verbatim
48 *> BETA is REAL
49 *> The denominator part of a complex eigenvalue
50 *> (AR/BETA) + i*(AI/BETA).
51 *> \endverbatim
52 *
53 * Authors:
54 * ========
55 *
56 *> \author Univ. of Tennessee
57 *> \author Univ. of California Berkeley
58 *> \author Univ. of Colorado Denver
59 *> \author NAG Ltd.
60 *
61 *> \date November 2011
62 *
63 *> \ingroup single_eig
64 *
65 * =====================================================================
66  LOGICAL FUNCTION slctsx( AR, AI, BETA )
67 *
68 * -- LAPACK test routine (version 3.4.0) --
69 * -- LAPACK is a software package provided by Univ. of Tennessee, --
70 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
71 * November 2011
72 *
73 * .. Scalar Arguments ..
74  REAL ai, ar, beta
75 * ..
76 *
77 * =====================================================================
78 *
79 * .. Scalars in Common ..
80  LOGICAL fs
81  INTEGER i, m, mplusn, n
82 * ..
83 * .. Common blocks ..
84  common / mn / m, n, mplusn, i, fs
85 * ..
86 * .. Save statement ..
87  SAVE
88 * ..
89 * .. Executable Statements ..
90 *
91  IF( fs ) THEN
92  i = i + 1
93  IF( i.LE.m ) THEN
94  slctsx = .false.
95  ELSE
96  slctsx = .true.
97  END IF
98  IF( i.EQ.mplusn ) THEN
99  fs = .false.
100  i = 0
101  END IF
102  ELSE
103  i = i + 1
104  IF( i.LE.n ) THEN
105  slctsx = .true.
106  ELSE
107  slctsx = .false.
108  END IF
109  IF( i.EQ.mplusn ) THEN
110  fs = .true.
111  i = 0
112  END IF
113  END IF
114 *
115 * IF( AR/BETA.GT.0.0 )THEN
116 * SLCTSX = .TRUE.
117 * ELSE
118 * SLCTSX = .FALSE.
119 * END IF
120 *
121  return
122 *
123 * End of SLCTSX
124 *
125  END