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