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.5 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151
  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. *> \date November 2011
  70. *
  71. *> \ingroup double_lin
  72. *
  73. * =====================================================================
  74. SUBROUTINE DLAORD( JOB, N, X, INCX )
  75. *
  76. * -- LAPACK test routine (version 3.4.0) --
  77. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  78. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  79. * November 2011
  80. *
  81. * .. Scalar Arguments ..
  82. CHARACTER JOB
  83. INTEGER INCX, N
  84. * ..
  85. * .. Array Arguments ..
  86. DOUBLE PRECISION X( * )
  87. * ..
  88. *
  89. * =====================================================================
  90. *
  91. * .. Local Scalars ..
  92. INTEGER I, INC, IX, IXNEXT
  93. DOUBLE PRECISION TEMP
  94. * ..
  95. * .. External Functions ..
  96. LOGICAL LSAME
  97. EXTERNAL LSAME
  98. * ..
  99. * .. Intrinsic Functions ..
  100. INTRINSIC ABS
  101. * ..
  102. * .. Executable Statements ..
  103. *
  104. INC = ABS( INCX )
  105. IF( LSAME( JOB, 'I' ) ) THEN
  106. *
  107. * Sort in increasing order
  108. *
  109. DO 20 I = 2, N
  110. IX = 1 + ( I-1 )*INC
  111. 10 CONTINUE
  112. IF( IX.EQ.1 )
  113. $ GO TO 20
  114. IXNEXT = IX - INC
  115. IF( X( IX ).GT.X( IXNEXT ) ) THEN
  116. GO TO 20
  117. ELSE
  118. TEMP = X( IX )
  119. X( IX ) = X( IXNEXT )
  120. X( IXNEXT ) = TEMP
  121. END IF
  122. IX = IXNEXT
  123. GO TO 10
  124. 20 CONTINUE
  125. *
  126. ELSE IF( LSAME( JOB, 'D' ) ) THEN
  127. *
  128. * Sort in decreasing order
  129. *
  130. DO 40 I = 2, N
  131. IX = 1 + ( I-1 )*INC
  132. 30 CONTINUE
  133. IF( IX.EQ.1 )
  134. $ GO TO 40
  135. IXNEXT = IX - INC
  136. IF( X( IX ).LT.X( IXNEXT ) ) THEN
  137. GO TO 40
  138. ELSE
  139. TEMP = X( IX )
  140. X( IX ) = X( IXNEXT )
  141. X( IXNEXT ) = TEMP
  142. END IF
  143. IX = IXNEXT
  144. GO TO 30
  145. 40 CONTINUE
  146. END IF
  147. RETURN
  148. *
  149. * End of DLAORD
  150. *
  151. END