dlaswp.c 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159
  1. /* dlaswp.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 dlaswp_(integer *n, doublereal *a, integer *lda, integer
  14. *k1, integer *k2, integer *ipiv, integer *incx)
  15. {
  16. /* System generated locals */
  17. integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
  18. /* Local variables */
  19. integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
  20. doublereal temp;
  21. /* -- LAPACK auxiliary routine (version 3.2) -- */
  22. /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  23. /* November 2006 */
  24. /* .. Scalar Arguments .. */
  25. /* .. */
  26. /* .. Array Arguments .. */
  27. /* .. */
  28. /* Purpose */
  29. /* ======= */
  30. /* DLASWP performs a series of row interchanges on the matrix A. */
  31. /* One row interchange is initiated for each of rows K1 through K2 of A. */
  32. /* Arguments */
  33. /* ========= */
  34. /* N (input) INTEGER */
  35. /* The number of columns of the matrix A. */
  36. /* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
  37. /* On entry, the matrix of column dimension N to which the row */
  38. /* interchanges will be applied. */
  39. /* On exit, the permuted matrix. */
  40. /* LDA (input) INTEGER */
  41. /* The leading dimension of the array A. */
  42. /* K1 (input) INTEGER */
  43. /* The first element of IPIV for which a row interchange will */
  44. /* be done. */
  45. /* K2 (input) INTEGER */
  46. /* The last element of IPIV for which a row interchange will */
  47. /* be done. */
  48. /* IPIV (input) INTEGER array, dimension (K2*abs(INCX)) */
  49. /* The vector of pivot indices. Only the elements in positions */
  50. /* K1 through K2 of IPIV are accessed. */
  51. /* IPIV(K) = L implies rows K and L are to be interchanged. */
  52. /* INCX (input) INTEGER */
  53. /* The increment between successive values of IPIV. If IPIV */
  54. /* is negative, the pivots are applied in reverse order. */
  55. /* Further Details */
  56. /* =============== */
  57. /* Modified by */
  58. /* R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA */
  59. /* ===================================================================== */
  60. /* .. Local Scalars .. */
  61. /* .. */
  62. /* .. Executable Statements .. */
  63. /* Interchange row I with row IPIV(I) for each of rows K1 through K2. */
  64. /* Parameter adjustments */
  65. a_dim1 = *lda;
  66. a_offset = 1 + a_dim1;
  67. a -= a_offset;
  68. --ipiv;
  69. /* Function Body */
  70. if (*incx > 0) {
  71. ix0 = *k1;
  72. i1 = *k1;
  73. i2 = *k2;
  74. inc = 1;
  75. } else if (*incx < 0) {
  76. ix0 = (1 - *k2) * *incx + 1;
  77. i1 = *k2;
  78. i2 = *k1;
  79. inc = -1;
  80. } else {
  81. return 0;
  82. }
  83. n32 = *n / 32 << 5;
  84. if (n32 != 0) {
  85. i__1 = n32;
  86. for (j = 1; j <= i__1; j += 32) {
  87. ix = ix0;
  88. i__2 = i2;
  89. i__3 = inc;
  90. for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3)
  91. {
  92. ip = ipiv[ix];
  93. if (ip != i__) {
  94. i__4 = j + 31;
  95. for (k = j; k <= i__4; ++k) {
  96. temp = a[i__ + k * a_dim1];
  97. a[i__ + k * a_dim1] = a[ip + k * a_dim1];
  98. a[ip + k * a_dim1] = temp;
  99. /* L10: */
  100. }
  101. }
  102. ix += *incx;
  103. /* L20: */
  104. }
  105. /* L30: */
  106. }
  107. }
  108. if (n32 != *n) {
  109. ++n32;
  110. ix = ix0;
  111. i__1 = i2;
  112. i__3 = inc;
  113. for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
  114. ip = ipiv[ix];
  115. if (ip != i__) {
  116. i__2 = *n;
  117. for (k = n32; k <= i__2; ++k) {
  118. temp = a[i__ + k * a_dim1];
  119. a[i__ + k * a_dim1] = a[ip + k * a_dim1];
  120. a[ip + k * a_dim1] = temp;
  121. /* L40: */
  122. }
  123. }
  124. ix += *incx;
  125. /* L50: */
  126. }
  127. }
  128. return 0;
  129. /* End of DLASWP */
  130. } /* dlaswp_ */