dlangt.c 5.3 KB

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