00001 /* slctes.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 /* Table of constant values */ 00017 00018 static real c_b2 = 1.f; 00019 00020 logical slctes_(real *zr, real *zi, real *d__) 00021 { 00022 /* System generated locals */ 00023 logical ret_val; 00024 00025 /* Builtin functions */ 00026 double r_sign(real *, real *); 00027 00028 00029 /* -- LAPACK test routine (version 3.1) -- */ 00030 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00031 /* November 2006 */ 00032 00033 /* .. Scalar Arguments .. */ 00034 /* .. */ 00035 00036 /* Purpose */ 00037 /* ======= */ 00038 00039 /* SLCTES returns .TRUE. if the eigenvalue (ZR/D) + sqrt(-1)*(ZI/D) */ 00040 /* is to be selected (specifically, in this subroutine, if the real */ 00041 /* part of the eigenvalue is negative), and otherwise it returns */ 00042 /* .FALSE.. */ 00043 00044 /* It is used by the test routine SDRGES to test whether the driver */ 00045 /* routine SGGES succesfully sorts eigenvalues. */ 00046 00047 /* Arguments */ 00048 /* ========= */ 00049 00050 /* ZR (input) REAL */ 00051 /* The numerator of the real part of a complex eigenvalue */ 00052 /* (ZR/D) + i*(ZI/D). */ 00053 00054 /* ZI (input) REAL */ 00055 /* The numerator of the imaginary part of a complex eigenvalue */ 00056 /* (ZR/D) + i*(ZI). */ 00057 00058 /* D (input) REAL */ 00059 /* The denominator part of a complex eigenvalue */ 00060 /* (ZR/D) + i*(ZI/D). */ 00061 00062 /* ===================================================================== */ 00063 00064 /* .. Parameters .. */ 00065 /* .. */ 00066 /* .. Intrinsic Functions .. */ 00067 /* .. */ 00068 /* .. Executable Statements .. */ 00069 00070 if (*d__ == 0.f) { 00071 ret_val = *zr < 0.f; 00072 } else { 00073 ret_val = r_sign(&c_b2, zr) != r_sign(&c_b2, d__); 00074 } 00075 00076 return ret_val; 00077 00078 /* End of SLCTES */ 00079 00080 } /* slctes_ */