LAPACK 3.3.0
|
00001 LOGICAL FUNCTION ZLCTSX( 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*16 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 ZDRGSX, 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*16 00023 * BETA (input) COMPLEX*16 00024 * parameters to decide whether the pair (ALPHA, BETA) is 00025 * selected. 00026 * 00027 * ===================================================================== 00028 * 00029 * .. Parameters .. 00030 * DOUBLE PRECISION ZERO 00031 * PARAMETER ( ZERO = 0.0E+0 ) 00032 * COMPLEX*16 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 ZLCTSX = .FALSE. 00051 ELSE 00052 ZLCTSX = .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 ZLCTSX = .TRUE. 00062 ELSE 00063 ZLCTSX = .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 * ZLCTSX = ( DBLE( ALPHA ).GT.ZERO ) 00073 * ELSE 00074 * ZLCTSX = ( DBLE( ALPHA/BETA ).GT.ZERO ) 00075 * END IF 00076 * 00077 RETURN 00078 * 00079 * End of ZLCTSX 00080 * 00081 END