zslect.c
Go to the documentation of this file.
00001 /* zslect.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 selopt, seldim;
00020     logical selval[20];
00021     doublereal selwr[20], selwi[20];
00022 } sslct_;
00023 
00024 #define sslct_1 sslct_
00025 
00026 logical zslect_(doublecomplex *z__)
00027 {
00028     /* System generated locals */
00029     integer i__1, i__2, i__3;
00030     doublecomplex z__1, z__2;
00031     logical ret_val;
00032 
00033     /* Builtin functions */
00034     double z_abs(doublecomplex *);
00035 
00036     /* Local variables */
00037     integer i__;
00038     doublereal x, rmin;
00039 
00040 
00041 /*  -- LAPACK test routine (version 3.1.1) -- */
00042 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00043 /*     February 2007 */
00044 
00045 /*     .. Scalar Arguments .. */
00046 /*     .. */
00047 
00048 /*  Purpose */
00049 /*  ======= */
00050 
00051 /*  ZSLECT returns .TRUE. if the eigenvalue Z is to be selected, */
00052 /*  otherwise it returns .FALSE. */
00053 /*  It is used by ZCHK41 to test if ZGEES succesfully sorts eigenvalues, */
00054 /*  and by ZCHK43 to test if ZGEESX succesfully sorts eigenvalues. */
00055 
00056 /*  The common block /SSLCT/ controls how eigenvalues are selected. */
00057 /*  If SELOPT = 0, then ZSLECT return .TRUE. when real(Z) is less than */
00058 /*  zero, and .FALSE. otherwise. */
00059 /*  If SELOPT is at least 1, ZSLECT returns SELVAL(SELOPT) and adds 1 */
00060 /*  to SELOPT, cycling back to 1 at SELMAX. */
00061 
00062 /*  Arguments */
00063 /*  ========= */
00064 
00065 /*  Z       (input) COMPLEX*16 */
00066 /*          The eigenvalue Z. */
00067 
00068 /*  ===================================================================== */
00069 
00070 /*     .. Parameters .. */
00071 /*     .. */
00072 /*     .. Local Scalars .. */
00073 /*     .. */
00074 /*     .. Scalars in Common .. */
00075 /*     .. */
00076 /*     .. Arrays in Common .. */
00077 /*     .. */
00078 /*     .. Common blocks .. */
00079 /*     .. */
00080 /*     .. Intrinsic Functions .. */
00081 /*     .. */
00082 /*     .. Executable Statements .. */
00083 
00084     if (sslct_1.selopt == 0) {
00085         ret_val = z__->r < 0.;
00086     } else {
00087         z__2.r = sslct_1.selwr[0], z__2.i = sslct_1.selwi[0];
00088         z__1.r = z__->r - z__2.r, z__1.i = z__->i - z__2.i;
00089         rmin = z_abs(&z__1);
00090         ret_val = sslct_1.selval[0];
00091         i__1 = sslct_1.seldim;
00092         for (i__ = 2; i__ <= i__1; ++i__) {
00093             i__2 = i__ - 1;
00094             i__3 = i__ - 1;
00095             z__2.r = sslct_1.selwr[i__2], z__2.i = sslct_1.selwi[i__3];
00096             z__1.r = z__->r - z__2.r, z__1.i = z__->i - z__2.i;
00097             x = z_abs(&z__1);
00098             if (x <= rmin) {
00099                 rmin = x;
00100                 ret_val = sslct_1.selval[i__ - 1];
00101             }
00102 /* L10: */
00103         }
00104     }
00105     return ret_val;
00106 
00107 /*     End of ZSLECT */
00108 
00109 } /* zslect_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:43