00001 /* zlctsx.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Common Block Declarations */ 00017 00018 struct { 00019 integer m, n, mplusn, i__; 00020 logical fs; 00021 } mn_; 00022 00023 #define mn_1 mn_ 00024 00025 logical zlctsx_(doublecomplex *alpha, doublecomplex *beta) 00026 { 00027 /* System generated locals */ 00028 logical ret_val; 00029 00030 00031 /* -- LAPACK test routine (version 3.1) -- */ 00032 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00033 /* November 2006 */ 00034 00035 /* .. Scalar Arguments .. */ 00036 /* .. */ 00037 00038 /* Purpose */ 00039 /* ======= */ 00040 00041 /* This function is used to determine what eigenvalues will be */ 00042 /* selected. If this is part of the test driver ZDRGSX, do not */ 00043 /* change the code UNLESS you are testing input examples and not */ 00044 /* using the built-in examples. */ 00045 00046 /* Arguments */ 00047 /* ========= */ 00048 00049 /* ALPHA (input) COMPLEX*16 */ 00050 /* BETA (input) COMPLEX*16 */ 00051 /* parameters to decide whether the pair (ALPHA, BETA) is */ 00052 /* selected. */ 00053 00054 /* ===================================================================== */ 00055 00056 /* .. Parameters .. */ 00057 /* DOUBLE PRECISION ZERO */ 00058 /* PARAMETER ( ZERO = 0.0E+0 ) */ 00059 /* COMPLEX*16 CZERO */ 00060 /* PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) ) */ 00061 /* .. */ 00062 /* .. Scalars in Common .. */ 00063 /* .. */ 00064 /* .. Common blocks .. */ 00065 /* .. */ 00066 /* .. Save statement .. */ 00067 /* .. */ 00068 /* .. Executable Statements .. */ 00069 00070 if (mn_1.fs) { 00071 ++mn_1.i__; 00072 if (mn_1.i__ <= mn_1.m) { 00073 ret_val = FALSE_; 00074 } else { 00075 ret_val = TRUE_; 00076 } 00077 if (mn_1.i__ == mn_1.mplusn) { 00078 mn_1.fs = FALSE_; 00079 mn_1.i__ = 0; 00080 } 00081 } else { 00082 ++mn_1.i__; 00083 if (mn_1.i__ <= mn_1.n) { 00084 ret_val = TRUE_; 00085 } else { 00086 ret_val = FALSE_; 00087 } 00088 if (mn_1.i__ == mn_1.mplusn) { 00089 mn_1.fs = TRUE_; 00090 mn_1.i__ = 0; 00091 } 00092 } 00093 00094 /* IF( BETA.EQ.CZERO ) THEN */ 00095 /* ZLCTSX = ( DBLE( ALPHA ).GT.ZERO ) */ 00096 /* ELSE */ 00097 /* ZLCTSX = ( DBLE( ALPHA/BETA ).GT.ZERO ) */ 00098 /* END IF */ 00099 00100 return ret_val; 00101 00102 /* End of ZLCTSX */ 00103 00104 } /* zlctsx_ */