dlae2.c 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143
  1. /* dlae2.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. /* Subroutine */ int _starpu_dlae2_(doublereal *a, doublereal *b, doublereal *c__,
  14. doublereal *rt1, doublereal *rt2)
  15. {
  16. /* System generated locals */
  17. doublereal d__1;
  18. /* Builtin functions */
  19. double sqrt(doublereal);
  20. /* Local variables */
  21. doublereal ab, df, tb, sm, rt, adf, acmn, acmx;
  22. /* -- LAPACK auxiliary routine (version 3.2) -- */
  23. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  24. /* November 2006 */
  25. /* .. Scalar Arguments .. */
  26. /* .. */
  27. /* Purpose */
  28. /* ======= */
  29. /* DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix */
  30. /* [ A B ] */
  31. /* [ B C ]. */
  32. /* On return, RT1 is the eigenvalue of larger absolute value, and RT2 */
  33. /* is the eigenvalue of smaller absolute value. */
  34. /* Arguments */
  35. /* ========= */
  36. /* A (input) DOUBLE PRECISION */
  37. /* The (1,1) element of the 2-by-2 matrix. */
  38. /* B (input) DOUBLE PRECISION */
  39. /* The (1,2) and (2,1) elements of the 2-by-2 matrix. */
  40. /* C (input) DOUBLE PRECISION */
  41. /* The (2,2) element of the 2-by-2 matrix. */
  42. /* RT1 (output) DOUBLE PRECISION */
  43. /* The eigenvalue of larger absolute value. */
  44. /* RT2 (output) DOUBLE PRECISION */
  45. /* The eigenvalue of smaller absolute value. */
  46. /* Further Details */
  47. /* =============== */
  48. /* RT1 is accurate to a few ulps barring over/underflow. */
  49. /* RT2 may be inaccurate if there is massive cancellation in the */
  50. /* determinant A*C-B*B; higher precision or correctly rounded or */
  51. /* correctly truncated arithmetic would be needed to compute RT2 */
  52. /* accurately in all cases. */
  53. /* Overflow is possible only if RT1 is within a factor of 5 of overflow. */
  54. /* Underflow is harmless if the input data is 0 or exceeds */
  55. /* underflow_threshold / macheps. */
  56. /* ===================================================================== */
  57. /* .. Parameters .. */
  58. /* .. */
  59. /* .. Local Scalars .. */
  60. /* .. */
  61. /* .. Intrinsic Functions .. */
  62. /* .. */
  63. /* .. Executable Statements .. */
  64. /* Compute the eigenvalues */
  65. sm = *a + *c__;
  66. df = *a - *c__;
  67. adf = abs(df);
  68. tb = *b + *b;
  69. ab = abs(tb);
  70. if (abs(*a) > abs(*c__)) {
  71. acmx = *a;
  72. acmn = *c__;
  73. } else {
  74. acmx = *c__;
  75. acmn = *a;
  76. }
  77. if (adf > ab) {
  78. /* Computing 2nd power */
  79. d__1 = ab / adf;
  80. rt = adf * sqrt(d__1 * d__1 + 1.);
  81. } else if (adf < ab) {
  82. /* Computing 2nd power */
  83. d__1 = adf / ab;
  84. rt = ab * sqrt(d__1 * d__1 + 1.);
  85. } else {
  86. /* Includes case AB=ADF=0 */
  87. rt = ab * sqrt(2.);
  88. }
  89. if (sm < 0.) {
  90. *rt1 = (sm - rt) * .5;
  91. /* Order of execution important. */
  92. /* To get fully accurate smaller eigenvalue, */
  93. /* next line needs to be executed in higher precision. */
  94. *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
  95. } else if (sm > 0.) {
  96. *rt1 = (sm + rt) * .5;
  97. /* Order of execution important. */
  98. /* To get fully accurate smaller eigenvalue, */
  99. /* next line needs to be executed in higher precision. */
  100. *rt2 = acmx / *rt1 * acmn - *b / *rt1 * *b;
  101. } else {
  102. /* Includes case RT1 = RT2 = 0 */
  103. *rt1 = rt * .5;
  104. *rt2 = rt * -.5;
  105. }
  106. return 0;
  107. /* End of DLAE2 */
  108. } /* _starpu_dlae2_ */