dlanst.c 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167
  1. /* dlanst.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. /* Table of constant values */
  14. static integer c__1 = 1;
  15. doublereal _starpu_dlanst_(char *norm, integer *n, doublereal *d__, doublereal *e)
  16. {
  17. /* System generated locals */
  18. integer i__1;
  19. doublereal ret_val, d__1, d__2, d__3, d__4, d__5;
  20. /* Builtin functions */
  21. double sqrt(doublereal);
  22. /* Local variables */
  23. integer i__;
  24. doublereal sum, scale;
  25. extern logical _starpu_lsame_(char *, char *);
  26. doublereal anorm;
  27. extern /* Subroutine */ int _starpu_dlassq_(integer *, doublereal *, integer *,
  28. doublereal *, doublereal *);
  29. /* -- LAPACK auxiliary routine (version 3.2) -- */
  30. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  31. /* November 2006 */
  32. /* .. Scalar Arguments .. */
  33. /* .. */
  34. /* .. Array Arguments .. */
  35. /* .. */
  36. /* Purpose */
  37. /* ======= */
  38. /* DLANST returns the value of the one norm, or the Frobenius norm, or */
  39. /* the infinity norm, or the element of largest absolute value of a */
  40. /* real symmetric tridiagonal matrix A. */
  41. /* Description */
  42. /* =========== */
  43. /* DLANST returns the value */
  44. /* DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
  45. /* ( */
  46. /* ( norm1(A), NORM = '1', 'O' or 'o' */
  47. /* ( */
  48. /* ( normI(A), NORM = 'I' or 'i' */
  49. /* ( */
  50. /* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
  51. /* where norm1 denotes the one norm of a matrix (maximum column sum), */
  52. /* normI denotes the infinity norm of a matrix (maximum row sum) and */
  53. /* normF denotes the Frobenius norm of a matrix (square root of sum of */
  54. /* squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. */
  55. /* Arguments */
  56. /* ========= */
  57. /* NORM (input) CHARACTER*1 */
  58. /* Specifies the value to be returned in DLANST as described */
  59. /* above. */
  60. /* N (input) INTEGER */
  61. /* The order of the matrix A. N >= 0. When N = 0, DLANST is */
  62. /* set to zero. */
  63. /* D (input) DOUBLE PRECISION array, dimension (N) */
  64. /* The diagonal elements of A. */
  65. /* E (input) DOUBLE PRECISION array, dimension (N-1) */
  66. /* The (n-1) sub-diagonal or super-diagonal elements of A. */
  67. /* ===================================================================== */
  68. /* .. Parameters .. */
  69. /* .. */
  70. /* .. Local Scalars .. */
  71. /* .. */
  72. /* .. External Functions .. */
  73. /* .. */
  74. /* .. External Subroutines .. */
  75. /* .. */
  76. /* .. Intrinsic Functions .. */
  77. /* .. */
  78. /* .. Executable Statements .. */
  79. /* Parameter adjustments */
  80. --e;
  81. --d__;
  82. /* Function Body */
  83. if (*n <= 0) {
  84. anorm = 0.;
  85. } else if (_starpu_lsame_(norm, "M")) {
  86. /* Find max(abs(A(i,j))). */
  87. anorm = (d__1 = d__[*n], abs(d__1));
  88. i__1 = *n - 1;
  89. for (i__ = 1; i__ <= i__1; ++i__) {
  90. /* Computing MAX */
  91. d__2 = anorm, d__3 = (d__1 = d__[i__], abs(d__1));
  92. anorm = max(d__2,d__3);
  93. /* Computing MAX */
  94. d__2 = anorm, d__3 = (d__1 = e[i__], abs(d__1));
  95. anorm = max(d__2,d__3);
  96. /* L10: */
  97. }
  98. } else if (_starpu_lsame_(norm, "O") || *(unsigned char *)
  99. norm == '1' || _starpu_lsame_(norm, "I")) {
  100. /* Find norm1(A). */
  101. if (*n == 1) {
  102. anorm = abs(d__[1]);
  103. } else {
  104. /* Computing MAX */
  105. d__3 = abs(d__[1]) + abs(e[1]), d__4 = (d__1 = e[*n - 1], abs(
  106. d__1)) + (d__2 = d__[*n], abs(d__2));
  107. anorm = max(d__3,d__4);
  108. i__1 = *n - 1;
  109. for (i__ = 2; i__ <= i__1; ++i__) {
  110. /* Computing MAX */
  111. d__4 = anorm, d__5 = (d__1 = d__[i__], abs(d__1)) + (d__2 = e[
  112. i__], abs(d__2)) + (d__3 = e[i__ - 1], abs(d__3));
  113. anorm = max(d__4,d__5);
  114. /* L20: */
  115. }
  116. }
  117. } else if (_starpu_lsame_(norm, "F") || _starpu_lsame_(norm, "E")) {
  118. /* Find normF(A). */
  119. scale = 0.;
  120. sum = 1.;
  121. if (*n > 1) {
  122. i__1 = *n - 1;
  123. _starpu_dlassq_(&i__1, &e[1], &c__1, &scale, &sum);
  124. sum *= 2;
  125. }
  126. _starpu_dlassq_(n, &d__[1], &c__1, &scale, &sum);
  127. anorm = scale * sqrt(sum);
  128. }
  129. ret_val = anorm;
  130. return ret_val;
  131. /* End of DLANST */
  132. } /* _starpu_dlanst_ */