slae2.c
Go to the documentation of this file.
00001 /* slae2.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 /* Subroutine */ int slae2_(real *a, real *b, real *c__, real *rt1, real *rt2)
00017 {
00018     /* System generated locals */
00019     real r__1;
00020 
00021     /* Builtin functions */
00022     double sqrt(doublereal);
00023 
00024     /* Local variables */
00025     real ab, df, tb, sm, rt, adf, acmn, acmx;
00026 
00027 
00028 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00029 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00030 /*     November 2006 */
00031 
00032 /*     .. Scalar Arguments .. */
00033 /*     .. */
00034 
00035 /*  Purpose */
00036 /*  ======= */
00037 
00038 /*  SLAE2  computes the eigenvalues of a 2-by-2 symmetric matrix */
00039 /*     [  A   B  ] */
00040 /*     [  B   C  ]. */
00041 /*  On return, RT1 is the eigenvalue of larger absolute value, and RT2 */
00042 /*  is the eigenvalue of smaller absolute value. */
00043 
00044 /*  Arguments */
00045 /*  ========= */
00046 
00047 /*  A       (input) REAL */
00048 /*          The (1,1) element of the 2-by-2 matrix. */
00049 
00050 /*  B       (input) REAL */
00051 /*          The (1,2) and (2,1) elements of the 2-by-2 matrix. */
00052 
00053 /*  C       (input) REAL */
00054 /*          The (2,2) element of the 2-by-2 matrix. */
00055 
00056 /*  RT1     (output) REAL */
00057 /*          The eigenvalue of larger absolute value. */
00058 
00059 /*  RT2     (output) REAL */
00060 /*          The eigenvalue of smaller absolute value. */
00061 
00062 /*  Further Details */
00063 /*  =============== */
00064 
00065 /*  RT1 is accurate to a few ulps barring over/underflow. */
00066 
00067 /*  RT2 may be inaccurate if there is massive cancellation in the */
00068 /*  determinant A*C-B*B; higher precision or correctly rounded or */
00069 /*  correctly truncated arithmetic would be needed to compute RT2 */
00070 /*  accurately in all cases. */
00071 
00072 /*  Overflow is possible only if RT1 is within a factor of 5 of overflow. */
00073 /*  Underflow is harmless if the input data is 0 or exceeds */
00074 /*     underflow_threshold / macheps. */
00075 
00076 /* ===================================================================== */
00077 
00078 /*     .. Parameters .. */
00079 /*     .. */
00080 /*     .. Local Scalars .. */
00081 /*     .. */
00082 /*     .. Intrinsic Functions .. */
00083 /*     .. */
00084 /*     .. Executable Statements .. */
00085 
00086 /*     Compute the eigenvalues */
00087 
00088     sm = *a + *c__;
00089     df = *a - *c__;
00090     adf = dabs(df);
00091     tb = *b + *b;
00092     ab = dabs(tb);
00093     if (dabs(*a) > dabs(*c__)) {
00094         acmx = *a;
00095         acmn = *c__;
00096     } else {
00097         acmx = *c__;
00098         acmn = *a;
00099     }
00100     if (adf > ab) {
00101 /* Computing 2nd power */
00102         r__1 = ab / adf;
00103         rt = adf * sqrt(r__1 * r__1 + 1.f);
00104     } else if (adf < ab) {
00105 /* Computing 2nd power */
00106         r__1 = adf / ab;
00107         rt = ab * sqrt(r__1 * r__1 + 1.f);
00108     } else {
00109 
00110 /*        Includes case AB=ADF=0 */
00111 
00112         rt = ab * sqrt(2.f);
00113     }
00114     if (sm < 0.f) {
00115         *rt1 = (sm - rt) * .5f;
00116 
00117 /*        Order of execution important. */
00118 /*        To get fully accurate smaller eigenvalue, */
00119 /*        next line needs to be executed in higher precision. */
00120 
00121         *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
00122     } else if (sm > 0.f) {
00123         *rt1 = (sm + rt) * .5f;
00124 
00125 /*        Order of execution important. */
00126 /*        To get fully accurate smaller eigenvalue, */
00127 /*        next line needs to be executed in higher precision. */
00128 
00129         *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
00130     } else {
00131 
00132 /*        Includes case RT1 = RT2 = 0 */
00133 
00134         *rt1 = rt * .5f;
00135         *rt2 = rt * -.5f;
00136     }
00137     return 0;
00138 
00139 /*     End of SLAE2 */
00140 
00141 } /* slae2_ */


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