![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SSLECT 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * LOGICAL FUNCTION SSLECT( ZR, ZI ) 00012 * 00013 * .. Scalar Arguments .. 00014 * REAL ZI, ZR 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> SSLECT returns .TRUE. if the eigenvalue ZR+sqrt(-1)*ZI is to be 00024 *> selected, and otherwise it returns .FALSE. 00025 *> It is used by SCHK41 to test if SGEES succesfully sorts eigenvalues, 00026 *> and by SCHK43 to test if SGEESX succesfully sorts eigenvalues. 00027 *> 00028 *> The common block /SSLCT/ controls how eigenvalues are selected. 00029 *> If SELOPT = 0, then SSLECT return .TRUE. when ZR is less than zero, 00030 *> and .FALSE. otherwise. 00031 *> If SELOPT is at least 1, SSLECT returns SELVAL(SELOPT) and adds 1 00032 *> to SELOPT, cycling back to 1 at SELMAX. 00033 *> \endverbatim 00034 * 00035 * Arguments: 00036 * ========== 00037 * 00038 *> \param[in] ZR 00039 *> \verbatim 00040 *> ZR is REAL 00041 *> The real part of a complex eigenvalue ZR + i*ZI. 00042 *> \endverbatim 00043 *> 00044 *> \param[in] ZI 00045 *> \verbatim 00046 *> ZI is REAL 00047 *> The imaginary part of a complex eigenvalue ZR + i*ZI. 00048 *> \endverbatim 00049 * 00050 * Authors: 00051 * ======== 00052 * 00053 *> \author Univ. of Tennessee 00054 *> \author Univ. of California Berkeley 00055 *> \author Univ. of Colorado Denver 00056 *> \author NAG Ltd. 00057 * 00058 *> \date November 2011 00059 * 00060 *> \ingroup single_eig 00061 * 00062 * ===================================================================== 00063 LOGICAL FUNCTION SSLECT( ZR, ZI ) 00064 * 00065 * -- LAPACK test routine (version 3.4.0) -- 00066 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00067 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00068 * November 2011 00069 * 00070 * .. Scalar Arguments .. 00071 REAL ZI, ZR 00072 * .. 00073 * 00074 * ===================================================================== 00075 * 00076 * .. Arrays in Common .. 00077 LOGICAL SELVAL( 20 ) 00078 REAL SELWI( 20 ), SELWR( 20 ) 00079 * .. 00080 * .. Scalars in Common .. 00081 INTEGER SELDIM, SELOPT 00082 * .. 00083 * .. Common blocks .. 00084 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI 00085 * .. 00086 * .. Local Scalars .. 00087 INTEGER I 00088 REAL RMIN, X 00089 * .. 00090 * .. Parameters .. 00091 REAL ZERO 00092 PARAMETER ( ZERO = 0.0E0 ) 00093 * .. 00094 * .. External Functions .. 00095 REAL SLAPY2 00096 EXTERNAL SLAPY2 00097 * .. 00098 * .. Executable Statements .. 00099 * 00100 IF( SELOPT.EQ.0 ) THEN 00101 SSLECT = ( ZR.LT.ZERO ) 00102 ELSE 00103 RMIN = SLAPY2( ZR-SELWR( 1 ), ZI-SELWI( 1 ) ) 00104 SSLECT = SELVAL( 1 ) 00105 DO 10 I = 2, SELDIM 00106 X = SLAPY2( ZR-SELWR( I ), ZI-SELWI( I ) ) 00107 IF( X.LE.RMIN ) THEN 00108 RMIN = X 00109 SSLECT = SELVAL( I ) 00110 END IF 00111 10 CONTINUE 00112 END IF 00113 RETURN 00114 * 00115 * End of SSLECT 00116 * 00117 END