d8/de9/clctsx_8f_source.html

00001       LOGICAL          FUNCTION CLCTSX( ALPHA, 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       COMPLEX            ALPHA, 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 CDRGSX, 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 *  ALPHA   (input) COMPLEX
00023 *  BETA    (input) COMPLEX
00024 *          parameters to decide whether the pair (ALPHA, BETA) is
00025 *          selected.
00026 *
00027 *  =====================================================================
00028 *
00029 *     .. Parameters ..
00030 *     REAL               ZERO
00031 *     PARAMETER          ( ZERO = 0.0E+0 )
00032 *     COMPLEX            CZERO
00033 *     PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
00034 *     ..
00035 *     .. Scalars in Common ..
00036       LOGICAL            FS
00037       INTEGER            I, M, MPLUSN, N
00038 *     ..
00039 *     .. Common blocks ..
00040       COMMON             / MN / M, N, MPLUSN, I, FS
00041 *     ..
00042 *     .. Save statement ..
00043       SAVE
00044 *     ..
00045 *     .. Executable Statements ..
00046 *
00047       IF( FS ) THEN
00048          I = I + 1
00049          IF( I.LE.M ) THEN
00050             CLCTSX = .FALSE.
00051          ELSE
00052             CLCTSX = .TRUE.
00053          END IF
00054          IF( I.EQ.MPLUSN ) THEN
00055             FS = .FALSE.
00056             I = 0
00057          END IF
00058       ELSE
00059          I = I + 1
00060          IF( I.LE.N ) THEN
00061             CLCTSX = .TRUE.
00062          ELSE
00063             CLCTSX = .FALSE.
00064          END IF
00065          IF( I.EQ.MPLUSN ) THEN
00066             FS = .TRUE.
00067             I = 0
00068          END IF
00069       END IF
00070 *
00071 *      IF( BETA.EQ.CZERO ) THEN
00072 *         CLCTSX = ( REAL( ALPHA ).GT.ZERO )
00073 *      ELSE
00074 *         CLCTSX = ( REAL( ALPHA/BETA ).GT.ZERO )
00075 *      END IF
00076 *
00077       RETURN
00078 *
00079 *     End of CLCTSX
00080 *
00081       END