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
1.7.2