dla_gbrpvgrw.c 4.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137
  1. /* _starpu_dla_gbrpvgrw.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. doublereal _starpu_dla_gbrpvgrw__(integer *n, integer *kl, integer *ku, integer *
  14. ncols, doublereal *ab, integer *ldab, doublereal *afb, integer *ldafb)
  15. {
  16. /* System generated locals */
  17. integer ab_dim1, ab_offset, afb_dim1, afb_offset, i__1, i__2, i__3, i__4;
  18. doublereal ret_val, d__1, d__2;
  19. /* Local variables */
  20. integer i__, j, kd;
  21. doublereal amax, umax, rpvgrw;
  22. /* -- LAPACK routine (version 3.2.1) -- */
  23. /* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and -- */
  24. /* -- Jason Riedy of Univ. of California Berkeley. -- */
  25. /* -- April 2009 -- */
  26. /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
  27. /* -- Univ. of California Berkeley and NAG Ltd. -- */
  28. /* .. */
  29. /* .. Scalar Arguments .. */
  30. /* .. */
  31. /* .. Array Arguments .. */
  32. /* .. */
  33. /* Purpose */
  34. /* ======= */
  35. /* DLA_GBRPVGRW computes the reciprocal pivot growth factor */
  36. /* norm(A)/norm(U). The "max absolute element" norm is used. If this is */
  37. /* much less than 1, the stability of the LU factorization of the */
  38. /* (equilibrated) matrix A could be poor. This also means that the */
  39. /* solution X, estimated condition numbers, and error bounds could be */
  40. /* unreliable. */
  41. /* Arguments */
  42. /* ========= */
  43. /* N (input) INTEGER */
  44. /* The number of linear equations, i.e., the order of the */
  45. /* matrix A. N >= 0. */
  46. /* KL (input) INTEGER */
  47. /* The number of subdiagonals within the band of A. KL >= 0. */
  48. /* KU (input) INTEGER */
  49. /* The number of superdiagonals within the band of A. KU >= 0. */
  50. /* NCOLS (input) INTEGER */
  51. /* The number of columns of the matrix A. NCOLS >= 0. */
  52. /* AB (input) DOUBLE PRECISION array, dimension (LDAB,N) */
  53. /* On entry, the matrix A in band storage, in rows 1 to KL+KU+1. */
  54. /* The j-th column of A is stored in the j-th column of the */
  55. /* array AB as follows: */
  56. /* AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl) */
  57. /* LDAB (input) INTEGER */
  58. /* The leading dimension of the array AB. LDAB >= KL+KU+1. */
  59. /* AFB (input) DOUBLE PRECISION array, dimension (LDAFB,N) */
  60. /* Details of the LU factorization of the band matrix A, as */
  61. /* computed by DGBTRF. U is stored as an upper triangular */
  62. /* band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, */
  63. /* and the multipliers used during the factorization are stored */
  64. /* in rows KL+KU+2 to 2*KL+KU+1. */
  65. /* LDAFB (input) INTEGER */
  66. /* The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1. */
  67. /* ===================================================================== */
  68. /* .. Local Scalars .. */
  69. /* .. */
  70. /* .. Intrinsic Functions .. */
  71. /* .. */
  72. /* .. Executable Statements .. */
  73. /* Parameter adjustments */
  74. ab_dim1 = *ldab;
  75. ab_offset = 1 + ab_dim1;
  76. ab -= ab_offset;
  77. afb_dim1 = *ldafb;
  78. afb_offset = 1 + afb_dim1;
  79. afb -= afb_offset;
  80. /* Function Body */
  81. rpvgrw = 1.;
  82. kd = *ku + 1;
  83. i__1 = *ncols;
  84. for (j = 1; j <= i__1; ++j) {
  85. amax = 0.;
  86. umax = 0.;
  87. /* Computing MAX */
  88. i__2 = j - *ku;
  89. /* Computing MIN */
  90. i__4 = j + *kl;
  91. i__3 = min(i__4,*n);
  92. for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
  93. /* Computing MAX */
  94. d__2 = (d__1 = ab[kd + i__ - j + j * ab_dim1], abs(d__1));
  95. amax = max(d__2,amax);
  96. }
  97. /* Computing MAX */
  98. i__3 = j - *ku;
  99. i__2 = j;
  100. for (i__ = max(i__3,1); i__ <= i__2; ++i__) {
  101. /* Computing MAX */
  102. d__2 = (d__1 = afb[kd + i__ - j + j * afb_dim1], abs(d__1));
  103. umax = max(d__2,umax);
  104. }
  105. if (umax != 0.) {
  106. /* Computing MIN */
  107. d__1 = amax / umax;
  108. rpvgrw = min(d__1,rpvgrw);
  109. }
  110. }
  111. ret_val = rpvgrw;
  112. return ret_val;
  113. } /* _starpu_dla_gbrpvgrw__ */