da/d4f/dslect_8f_source.html

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