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_ */