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
1.7.2