00001 LOGICAL FUNCTION SSLECT( ZR, ZI ) 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 REAL ZI, ZR 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * SSLECT returns .TRUE. if the eigenvalue ZR+sqrt(-1)*ZI is to be 00015 * selected, and otherwise it returns .FALSE. 00016 * It is used by SCHK41 to test if SGEES succesfully sorts eigenvalues, 00017 * and by SCHK43 to test if SGEESX succesfully sorts eigenvalues. 00018 * 00019 * The common block /SSLCT/ controls how eigenvalues are selected. 00020 * If SELOPT = 0, then SSLECT return .TRUE. when ZR is less than zero, 00021 * and .FALSE. otherwise. 00022 * If SELOPT is at least 1, SSLECT returns SELVAL(SELOPT) and adds 1 00023 * to SELOPT, cycling back to 1 at SELMAX. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * ZR (input) REAL 00029 * The real part of a complex eigenvalue ZR + i*ZI. 00030 * 00031 * ZI (input) REAL 00032 * The imaginary part of a complex eigenvalue ZR + i*ZI. 00033 * 00034 * ===================================================================== 00035 * 00036 * .. Arrays in Common .. 00037 LOGICAL SELVAL( 20 ) 00038 REAL SELWI( 20 ), SELWR( 20 ) 00039 * .. 00040 * .. Scalars in Common .. 00041 INTEGER SELDIM, SELOPT 00042 * .. 00043 * .. Common blocks .. 00044 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI 00045 * .. 00046 * .. Local Scalars .. 00047 INTEGER I 00048 REAL RMIN, X 00049 * .. 00050 * .. Parameters .. 00051 REAL ZERO 00052 PARAMETER ( ZERO = 0.0E0 ) 00053 * .. 00054 * .. External Functions .. 00055 REAL SLAPY2 00056 EXTERNAL SLAPY2 00057 * .. 00058 * .. Executable Statements .. 00059 * 00060 IF( SELOPT.EQ.0 ) THEN 00061 SSLECT = ( ZR.LT.ZERO ) 00062 ELSE 00063 RMIN = SLAPY2( ZR-SELWR( 1 ), ZI-SELWI( 1 ) ) 00064 SSLECT = SELVAL( 1 ) 00065 DO 10 I = 2, SELDIM 00066 X = SLAPY2( ZR-SELWR( I ), ZI-SELWI( I ) ) 00067 IF( X.LE.RMIN ) THEN 00068 RMIN = X 00069 SSLECT = SELVAL( I ) 00070 END IF 00071 10 CONTINUE 00072 END IF 00073 RETURN 00074 * 00075 * End of SSLECT 00076 * 00077 END
1.7.2