00001 LOGICAL FUNCTION CSLECT( Z ) 00002 * 00003 * -- LAPACK test routine (version 3.1.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * February 2007 00006 * 00007 * .. Scalar Arguments .. 00008 COMPLEX Z 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * CSLECT returns .TRUE. if the eigenvalue Z is to be selected, 00015 * otherwise it returns .FALSE. 00016 * It is used by CCHK41 to test if CGEES succesfully sorts eigenvalues, 00017 * and by CCHK43 to test if CGEESX succesfully sorts eigenvalues. 00018 * 00019 * The common block /SSLCT/ controls how eigenvalues are selected. 00020 * If SELOPT = 0, then CSLECT return .TRUE. when real(Z) is less than 00021 * zero, and .FALSE. otherwise. 00022 * If SELOPT is at least 1, CSLECT returns SELVAL(SELOPT) and adds 1 00023 * to SELOPT, cycling back to 1 at SELMAX. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * Z (input) COMPLEX 00029 * The eigenvalue Z. 00030 * 00031 * ===================================================================== 00032 * 00033 * .. Parameters .. 00034 REAL ZERO 00035 PARAMETER ( ZERO = 0.0E0 ) 00036 * .. 00037 * .. Local Scalars .. 00038 INTEGER I 00039 REAL RMIN, X 00040 * .. 00041 * .. Scalars in Common .. 00042 INTEGER SELDIM, SELOPT 00043 * .. 00044 * .. Arrays in Common .. 00045 LOGICAL SELVAL( 20 ) 00046 REAL SELWI( 20 ), SELWR( 20 ) 00047 * .. 00048 * .. Common blocks .. 00049 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI 00050 * .. 00051 * .. Intrinsic Functions .. 00052 INTRINSIC ABS, CMPLX, REAL 00053 * .. 00054 * .. Executable Statements .. 00055 * 00056 IF( SELOPT.EQ.0 ) THEN 00057 CSLECT = ( REAL( Z ).LT.ZERO ) 00058 ELSE 00059 RMIN = ABS( Z-CMPLX( SELWR( 1 ), SELWI( 1 ) ) ) 00060 CSLECT = SELVAL( 1 ) 00061 DO 10 I = 2, SELDIM 00062 X = ABS( Z-CMPLX( SELWR( I ), SELWI( I ) ) ) 00063 IF( X.LE.RMIN ) THEN 00064 RMIN = X 00065 CSLECT = SELVAL( I ) 00066 END IF 00067 10 CONTINUE 00068 END IF 00069 RETURN 00070 * 00071 * End of CSLECT 00072 * 00073 END
1.7.2