d1/d02/dlctsx_8f_source.html

00001       LOGICAL          FUNCTION DLCTSX( AR, AI, BETA )
00002 *
00003 *  -- LAPACK test routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       DOUBLE PRECISION   AI, AR, BETA
00009 *     ..
00010 *
00011 *  Purpose
00012 *  =======
00013 *
00014 *  This function is used to determine what eigenvalues will be
00015 *  selected.  If this is part of the test driver DDRGSX, do not
00016 *  change the code UNLESS you are testing input examples and not
00017 *  using the built-in examples.
00018 *
00019 *  Arguments
00020 *  =========
00021 *
00022 *  AR      (input) DOUBLE PRECISION
00023 *          The numerator of the real part of a complex eigenvalue
00024 *          (AR/BETA) + i*(AI/BETA).
00025 *
00026 *  AI      (input) DOUBLE PRECISION
00027 *          The numerator of the imaginary part of a complex eigenvalue
00028 *          (AR/BETA) + i*(AI).
00029 *
00030 *  BETA    (input) DOUBLE PRECISION
00031 *          The denominator part of a complex eigenvalue
00032 *          (AR/BETA) + i*(AI/BETA).
00033 *
00034 *  =====================================================================
00035 *
00036 *     .. Scalars in Common ..
00037       LOGICAL            FS
00038       INTEGER            I, M, MPLUSN, N
00039 *     ..
00040 *     .. Common blocks ..
00041       COMMON             / MN / M, N, MPLUSN, I, FS
00042 *     ..
00043 *     .. Save statement ..
00044       SAVE
00045 *     ..
00046 *     .. Executable Statements ..
00047 *
00048       IF( FS ) THEN
00049          I = I + 1
00050          IF( I.LE.M ) THEN
00051             DLCTSX = .FALSE.
00052          ELSE
00053             DLCTSX = .TRUE.
00054          END IF
00055          IF( I.EQ.MPLUSN ) THEN
00056             FS = .FALSE.
00057             I = 0
00058          END IF
00059       ELSE
00060          I = I + 1
00061          IF( I.LE.N ) THEN
00062             DLCTSX = .TRUE.
00063          ELSE
00064             DLCTSX = .FALSE.
00065          END IF
00066          IF( I.EQ.MPLUSN ) THEN
00067             FS = .TRUE.
00068             I = 0
00069          END IF
00070       END IF
00071 *
00072 *       IF( AR/BETA.GT.0.0 )THEN
00073 *          DLCTSX = .TRUE.
00074 *       ELSE
00075 *          DLCTSX = .FALSE.
00076 *       END IF
00077 *
00078       RETURN
00079 *
00080 *     End of DLCTSX
00081 *
00082       END