You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

dlaord.f 3.4 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148
  1. *> \brief \b DLAORD
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * SUBROUTINE DLAORD( JOB, N, X, INCX )
  12. *
  13. * .. Scalar Arguments ..
  14. * CHARACTER JOB
  15. * INTEGER INCX, N
  16. * ..
  17. * .. Array Arguments ..
  18. * DOUBLE PRECISION X( * )
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> DLAORD sorts the elements of a vector x in increasing or decreasing
  28. *> order.
  29. *> \endverbatim
  30. *
  31. * Arguments:
  32. * ==========
  33. *
  34. *> \param[in] JOB
  35. *> \verbatim
  36. *> JOB is CHARACTER
  37. *> = 'I': Sort in increasing order
  38. *> = 'D': Sort in decreasing order
  39. *> \endverbatim
  40. *>
  41. *> \param[in] N
  42. *> \verbatim
  43. *> N is INTEGER
  44. *> The length of the vector X.
  45. *> \endverbatim
  46. *>
  47. *> \param[in,out] X
  48. *> \verbatim
  49. *> X is DOUBLE PRECISION array, dimension
  50. *> (1+(N-1)*INCX)
  51. *> On entry, the vector of length n to be sorted.
  52. *> On exit, the vector x is sorted in the prescribed order.
  53. *> \endverbatim
  54. *>
  55. *> \param[in] INCX
  56. *> \verbatim
  57. *> INCX is INTEGER
  58. *> The spacing between successive elements of X. INCX >= 0.
  59. *> \endverbatim
  60. *
  61. * Authors:
  62. * ========
  63. *
  64. *> \author Univ. of Tennessee
  65. *> \author Univ. of California Berkeley
  66. *> \author Univ. of Colorado Denver
  67. *> \author NAG Ltd.
  68. *
  69. *> \ingroup double_lin
  70. *
  71. * =====================================================================
  72. SUBROUTINE DLAORD( JOB, N, X, INCX )
  73. *
  74. * -- LAPACK test routine --
  75. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  76. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  77. *
  78. * .. Scalar Arguments ..
  79. CHARACTER JOB
  80. INTEGER INCX, N
  81. * ..
  82. * .. Array Arguments ..
  83. DOUBLE PRECISION X( * )
  84. * ..
  85. *
  86. * =====================================================================
  87. *
  88. * .. Local Scalars ..
  89. INTEGER I, INC, IX, IXNEXT
  90. DOUBLE PRECISION TEMP
  91. * ..
  92. * .. External Functions ..
  93. LOGICAL LSAME
  94. EXTERNAL LSAME
  95. * ..
  96. * .. Intrinsic Functions ..
  97. INTRINSIC ABS
  98. * ..
  99. * .. Executable Statements ..
  100. *
  101. INC = ABS( INCX )
  102. IF( LSAME( JOB, 'I' ) ) THEN
  103. *
  104. * Sort in increasing order
  105. *
  106. DO 20 I = 2, N
  107. IX = 1 + ( I-1 )*INC
  108. 10 CONTINUE
  109. IF( IX.EQ.1 )
  110. $ GO TO 20
  111. IXNEXT = IX - INC
  112. IF( X( IX ).GT.X( IXNEXT ) ) THEN
  113. GO TO 20
  114. ELSE
  115. TEMP = X( IX )
  116. X( IX ) = X( IXNEXT )
  117. X( IXNEXT ) = TEMP
  118. END IF
  119. IX = IXNEXT
  120. GO TO 10
  121. 20 CONTINUE
  122. *
  123. ELSE IF( LSAME( JOB, 'D' ) ) THEN
  124. *
  125. * Sort in decreasing order
  126. *
  127. DO 40 I = 2, N
  128. IX = 1 + ( I-1 )*INC
  129. 30 CONTINUE
  130. IF( IX.EQ.1 )
  131. $ GO TO 40
  132. IXNEXT = IX - INC
  133. IF( X( IX ).LT.X( IXNEXT ) ) THEN
  134. GO TO 40
  135. ELSE
  136. TEMP = X( IX )
  137. X( IX ) = X( IXNEXT )
  138. X( IXNEXT ) = TEMP
  139. END IF
  140. IX = IXNEXT
  141. GO TO 30
  142. 40 CONTINUE
  143. END IF
  144. RETURN
  145. *
  146. * End of DLAORD
  147. *
  148. END