dpoequ.c 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175
  1. /* dpoequ.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_dpoequ_(integer *n, doublereal *a, integer *lda,
  14. doublereal *s, doublereal *scond, doublereal *amax, integer *info)
  15. {
  16. /* System generated locals */
  17. integer a_dim1, a_offset, i__1;
  18. doublereal d__1, d__2;
  19. /* Builtin functions */
  20. double sqrt(doublereal);
  21. /* Local variables */
  22. integer i__;
  23. doublereal smin;
  24. extern /* Subroutine */ int _starpu_xerbla_(char *, integer *);
  25. /* -- LAPACK routine (version 3.2) -- */
  26. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  27. /* November 2006 */
  28. /* .. Scalar Arguments .. */
  29. /* .. */
  30. /* .. Array Arguments .. */
  31. /* .. */
  32. /* Purpose */
  33. /* ======= */
  34. /* DPOEQU computes row and column scalings intended to equilibrate a */
  35. /* symmetric positive definite matrix A and reduce its condition number */
  36. /* (with respect to the two-norm). S contains the scale factors, */
  37. /* S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with */
  38. /* elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This */
  39. /* choice of S puts the condition number of B within a factor N of the */
  40. /* smallest possible condition number over all possible diagonal */
  41. /* scalings. */
  42. /* Arguments */
  43. /* ========= */
  44. /* N (input) INTEGER */
  45. /* The order of the matrix A. N >= 0. */
  46. /* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
  47. /* The N-by-N symmetric positive definite matrix whose scaling */
  48. /* factors are to be computed. Only the diagonal elements of A */
  49. /* are referenced. */
  50. /* LDA (input) INTEGER */
  51. /* The leading dimension of the array A. LDA >= max(1,N). */
  52. /* S (output) DOUBLE PRECISION array, dimension (N) */
  53. /* If INFO = 0, S contains the scale factors for A. */
  54. /* SCOND (output) DOUBLE PRECISION */
  55. /* If INFO = 0, S contains the ratio of the smallest S(i) to */
  56. /* the largest S(i). If SCOND >= 0.1 and AMAX is neither too */
  57. /* large nor too small, it is not worth scaling by S. */
  58. /* AMAX (output) DOUBLE PRECISION */
  59. /* Absolute value of largest matrix element. If AMAX is very */
  60. /* close to overflow or very close to underflow, the matrix */
  61. /* should be scaled. */
  62. /* INFO (output) INTEGER */
  63. /* = 0: successful exit */
  64. /* < 0: if INFO = -i, the i-th argument had an illegal value */
  65. /* > 0: if INFO = i, the i-th diagonal element is nonpositive. */
  66. /* ===================================================================== */
  67. /* .. Parameters .. */
  68. /* .. */
  69. /* .. Local Scalars .. */
  70. /* .. */
  71. /* .. External Subroutines .. */
  72. /* .. */
  73. /* .. Intrinsic Functions .. */
  74. /* .. */
  75. /* .. Executable Statements .. */
  76. /* Test the input parameters. */
  77. /* Parameter adjustments */
  78. a_dim1 = *lda;
  79. a_offset = 1 + a_dim1;
  80. a -= a_offset;
  81. --s;
  82. /* Function Body */
  83. *info = 0;
  84. if (*n < 0) {
  85. *info = -1;
  86. } else if (*lda < max(1,*n)) {
  87. *info = -3;
  88. }
  89. if (*info != 0) {
  90. i__1 = -(*info);
  91. _starpu_xerbla_("DPOEQU", &i__1);
  92. return 0;
  93. }
  94. /* Quick return if possible */
  95. if (*n == 0) {
  96. *scond = 1.;
  97. *amax = 0.;
  98. return 0;
  99. }
  100. /* Find the minimum and maximum diagonal elements. */
  101. s[1] = a[a_dim1 + 1];
  102. smin = s[1];
  103. *amax = s[1];
  104. i__1 = *n;
  105. for (i__ = 2; i__ <= i__1; ++i__) {
  106. s[i__] = a[i__ + i__ * a_dim1];
  107. /* Computing MIN */
  108. d__1 = smin, d__2 = s[i__];
  109. smin = min(d__1,d__2);
  110. /* Computing MAX */
  111. d__1 = *amax, d__2 = s[i__];
  112. *amax = max(d__1,d__2);
  113. /* L10: */
  114. }
  115. if (smin <= 0.) {
  116. /* Find the first non-positive diagonal element and return. */
  117. i__1 = *n;
  118. for (i__ = 1; i__ <= i__1; ++i__) {
  119. if (s[i__] <= 0.) {
  120. *info = i__;
  121. return 0;
  122. }
  123. /* L20: */
  124. }
  125. } else {
  126. /* Set the scale factors to the reciprocals */
  127. /* of the diagonal elements. */
  128. i__1 = *n;
  129. for (i__ = 1; i__ <= i__1; ++i__) {
  130. s[i__] = 1. / sqrt(s[i__]);
  131. /* L30: */
  132. }
  133. /* Compute SCOND = min(S(I)) / max(S(I)) */
  134. *scond = sqrt(smin) / sqrt(*amax);
  135. }
  136. return 0;
  137. /* End of DPOEQU */
  138. } /* _starpu_dpoequ_ */