d1/d95/cslect_8f_source.html

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