LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sslect.f
Go to the documentation of this file.
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
 All Files Functions