 LAPACK  3.10.1 LAPACK: Linear Algebra PACKage

## ◆ dlasrt()

 subroutine dlasrt ( character ID, integer N, double precision, dimension( * ) D, integer INFO )

DLASRT sorts numbers in increasing or decreasing order.

Purpose:
``` Sort the numbers in D in increasing order (if ID = 'I') or
in decreasing order (if ID = 'D' ).

Use Quick Sort, reverting to Insertion sort on arrays of
size <= 20. Dimension of STACK limits N to about 2**32.```
Parameters
 [in] ID ``` ID is CHARACTER*1 = 'I': sort D in increasing order; = 'D': sort D in decreasing order.``` [in] N ``` N is INTEGER The length of the array D.``` [in,out] D ``` D is DOUBLE PRECISION array, dimension (N) On entry, the array to be sorted. On exit, D has been sorted into increasing order (D(1) <= ... <= D(N) ) or into decreasing order (D(1) >= ... >= D(N) ), depending on ID.``` [out] INFO ``` INFO is INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value```

Definition at line 87 of file dlasrt.f.

88 *
89 * -- LAPACK computational routine --
90 * -- LAPACK is a software package provided by Univ. of Tennessee, --
91 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
92 *
93 * .. Scalar Arguments ..
94  CHARACTER ID
95  INTEGER INFO, N
96 * ..
97 * .. Array Arguments ..
98  DOUBLE PRECISION D( * )
99 * ..
100 *
101 * =====================================================================
102 *
103 * .. Parameters ..
104  INTEGER SELECT
105  parameter( SELECT = 20 )
106 * ..
107 * .. Local Scalars ..
108  INTEGER DIR, ENDD, I, J, START, STKPNT
109  DOUBLE PRECISION D1, D2, D3, DMNMX, TMP
110 * ..
111 * .. Local Arrays ..
112  INTEGER STACK( 2, 32 )
113 * ..
114 * .. External Functions ..
115  LOGICAL LSAME
116  EXTERNAL lsame
117 * ..
118 * .. External Subroutines ..
119  EXTERNAL xerbla
120 * ..
121 * .. Executable Statements ..
122 *
123 * Test the input parameters.
124 *
125  info = 0
126  dir = -1
127  IF( lsame( id, 'D' ) ) THEN
128  dir = 0
129  ELSE IF( lsame( id, 'I' ) ) THEN
130  dir = 1
131  END IF
132  IF( dir.EQ.-1 ) THEN
133  info = -1
134  ELSE IF( n.LT.0 ) THEN
135  info = -2
136  END IF
137  IF( info.NE.0 ) THEN
138  CALL xerbla( 'DLASRT', -info )
139  RETURN
140  END IF
141 *
142 * Quick return if possible
143 *
144  IF( n.LE.1 )
145  \$ RETURN
146 *
147  stkpnt = 1
148  stack( 1, 1 ) = 1
149  stack( 2, 1 ) = n
150  10 CONTINUE
151  start = stack( 1, stkpnt )
152  endd = stack( 2, stkpnt )
153  stkpnt = stkpnt - 1
154  IF( endd-start.LE.SELECT .AND. endd-start.GT.0 ) THEN
155 *
156 * Do Insertion sort on D( START:ENDD )
157 *
158  IF( dir.EQ.0 ) THEN
159 *
160 * Sort into decreasing order
161 *
162  DO 30 i = start + 1, endd
163  DO 20 j = i, start + 1, -1
164  IF( d( j ).GT.d( j-1 ) ) THEN
165  dmnmx = d( j )
166  d( j ) = d( j-1 )
167  d( j-1 ) = dmnmx
168  ELSE
169  GO TO 30
170  END IF
171  20 CONTINUE
172  30 CONTINUE
173 *
174  ELSE
175 *
176 * Sort into increasing order
177 *
178  DO 50 i = start + 1, endd
179  DO 40 j = i, start + 1, -1
180  IF( d( j ).LT.d( j-1 ) ) THEN
181  dmnmx = d( j )
182  d( j ) = d( j-1 )
183  d( j-1 ) = dmnmx
184  ELSE
185  GO TO 50
186  END IF
187  40 CONTINUE
188  50 CONTINUE
189 *
190  END IF
191 *
192  ELSE IF( endd-start.GT.SELECT ) THEN
193 *
194 * Partition D( START:ENDD ) and stack parts, largest one first
195 *
196 * Choose partition entry as median of 3
197 *
198  d1 = d( start )
199  d2 = d( endd )
200  i = ( start+endd ) / 2
201  d3 = d( i )
202  IF( d1.LT.d2 ) THEN
203  IF( d3.LT.d1 ) THEN
204  dmnmx = d1
205  ELSE IF( d3.LT.d2 ) THEN
206  dmnmx = d3
207  ELSE
208  dmnmx = d2
209  END IF
210  ELSE
211  IF( d3.LT.d2 ) THEN
212  dmnmx = d2
213  ELSE IF( d3.LT.d1 ) THEN
214  dmnmx = d3
215  ELSE
216  dmnmx = d1
217  END IF
218  END IF
219 *
220  IF( dir.EQ.0 ) THEN
221 *
222 * Sort into decreasing order
223 *
224  i = start - 1
225  j = endd + 1
226  60 CONTINUE
227  70 CONTINUE
228  j = j - 1
229  IF( d( j ).LT.dmnmx )
230  \$ GO TO 70
231  80 CONTINUE
232  i = i + 1
233  IF( d( i ).GT.dmnmx )
234  \$ GO TO 80
235  IF( i.LT.j ) THEN
236  tmp = d( i )
237  d( i ) = d( j )
238  d( j ) = tmp
239  GO TO 60
240  END IF
241  IF( j-start.GT.endd-j-1 ) THEN
242  stkpnt = stkpnt + 1
243  stack( 1, stkpnt ) = start
244  stack( 2, stkpnt ) = j
245  stkpnt = stkpnt + 1
246  stack( 1, stkpnt ) = j + 1
247  stack( 2, stkpnt ) = endd
248  ELSE
249  stkpnt = stkpnt + 1
250  stack( 1, stkpnt ) = j + 1
251  stack( 2, stkpnt ) = endd
252  stkpnt = stkpnt + 1
253  stack( 1, stkpnt ) = start
254  stack( 2, stkpnt ) = j
255  END IF
256  ELSE
257 *
258 * Sort into increasing order
259 *
260  i = start - 1
261  j = endd + 1
262  90 CONTINUE
263  100 CONTINUE
264  j = j - 1
265  IF( d( j ).GT.dmnmx )
266  \$ GO TO 100
267  110 CONTINUE
268  i = i + 1
269  IF( d( i ).LT.dmnmx )
270  \$ GO TO 110
271  IF( i.LT.j ) THEN
272  tmp = d( i )
273  d( i ) = d( j )
274  d( j ) = tmp
275  GO TO 90
276  END IF
277  IF( j-start.GT.endd-j-1 ) THEN
278  stkpnt = stkpnt + 1
279  stack( 1, stkpnt ) = start
280  stack( 2, stkpnt ) = j
281  stkpnt = stkpnt + 1
282  stack( 1, stkpnt ) = j + 1
283  stack( 2, stkpnt ) = endd
284  ELSE
285  stkpnt = stkpnt + 1
286  stack( 1, stkpnt ) = j + 1
287  stack( 2, stkpnt ) = endd
288  stkpnt = stkpnt + 1
289  stack( 1, stkpnt ) = start
290  stack( 2, stkpnt ) = j
291  END IF
292  END IF
293  END IF
294  IF( stkpnt.GT.0 )
295  \$ GO TO 10
296  RETURN
297 *
298 * End of DLASRT
299 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: