![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CSLECT 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 CSLECT( Z ) 00012 * 00013 * .. Scalar Arguments .. 00014 * COMPLEX Z 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> CSLECT returns .TRUE. if the eigenvalue Z is to be selected, 00024 *> otherwise it returns .FALSE. 00025 *> It is used by CCHK41 to test if CGEES succesfully sorts eigenvalues, 00026 *> and by CCHK43 to test if CGEESX succesfully sorts eigenvalues. 00027 *> 00028 *> The common block /SSLCT/ controls how eigenvalues are selected. 00029 *> If SELOPT = 0, then CSLECT return .TRUE. when real(Z) is less than 00030 *> zero, and .FALSE. otherwise. 00031 *> If SELOPT is at least 1, CSLECT 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] Z 00039 *> \verbatim 00040 *> Z is COMPLEX 00041 *> The eigenvalue Z. 00042 *> \endverbatim 00043 * 00044 * Authors: 00045 * ======== 00046 * 00047 *> \author Univ. of Tennessee 00048 *> \author Univ. of California Berkeley 00049 *> \author Univ. of Colorado Denver 00050 *> \author NAG Ltd. 00051 * 00052 *> \date November 2011 00053 * 00054 *> \ingroup complex_eig 00055 * 00056 * ===================================================================== 00057 LOGICAL FUNCTION CSLECT( Z ) 00058 * 00059 * -- LAPACK test routine (version 3.4.0) -- 00060 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00061 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00062 * November 2011 00063 * 00064 * .. Scalar Arguments .. 00065 COMPLEX Z 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 REAL ZERO 00072 PARAMETER ( ZERO = 0.0E0 ) 00073 * .. 00074 * .. Local Scalars .. 00075 INTEGER I 00076 REAL RMIN, X 00077 * .. 00078 * .. Scalars in Common .. 00079 INTEGER SELDIM, SELOPT 00080 * .. 00081 * .. Arrays in Common .. 00082 LOGICAL SELVAL( 20 ) 00083 REAL SELWI( 20 ), SELWR( 20 ) 00084 * .. 00085 * .. Common blocks .. 00086 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI 00087 * .. 00088 * .. Intrinsic Functions .. 00089 INTRINSIC ABS, CMPLX, REAL 00090 * .. 00091 * .. Executable Statements .. 00092 * 00093 IF( SELOPT.EQ.0 ) THEN 00094 CSLECT = ( REAL( Z ).LT.ZERO ) 00095 ELSE 00096 RMIN = ABS( Z-CMPLX( SELWR( 1 ), SELWI( 1 ) ) ) 00097 CSLECT = SELVAL( 1 ) 00098 DO 10 I = 2, SELDIM 00099 X = ABS( Z-CMPLX( SELWR( I ), SELWI( I ) ) ) 00100 IF( X.LE.RMIN ) THEN 00101 RMIN = X 00102 CSLECT = SELVAL( I ) 00103 END IF 00104 10 CONTINUE 00105 END IF 00106 RETURN 00107 * 00108 * End of CSLECT 00109 * 00110 END