LAPACK: TESTING/LIN/slaord.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SLAORD( JOB, N, X, INCX )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       CHARACTER          JOB
00009       INTEGER            INCX, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       REAL               X( * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  SLAORD sorts the elements of a vector x in increasing or decreasing
00019 *  order.
00020 *
00021 *  Arguments
00022 *  =========
00023 *
00024 *  JOB     (input) CHARACTER
00025 *          = 'I':  Sort in increasing order
00026 *          = 'D':  Sort in decreasing order
00027 *
00028 *  N       (input) INTEGER
00029 *          The length of the vector X.
00030 *
00031 *  X       (input/output) REAL array, dimension
00032 *                         (1+(N-1)*INCX)
00033 *          On entry, the vector of length n to be sorted.
00034 *          On exit, the vector x is sorted in the prescribed order.
00035 *
00036 *  INCX    (input) INTEGER
00037 *          The spacing between successive elements of X.  INCX >= 0.
00038 *
00039 *  =====================================================================
00040 *
00041 *     .. Local Scalars ..
00042       INTEGER            I, INC, IX, IXNEXT
00043       REAL               TEMP
00044 *     ..
00045 *     .. External Functions ..
00046       LOGICAL            LSAME
00047       EXTERNAL           LSAME
00048 *     ..
00049 *     .. Intrinsic Functions ..
00050       INTRINSIC          ABS
00051 *     ..
00052 *     .. Executable Statements ..
00053 *
00054       INC = ABS( INCX )
00055       IF( LSAME( JOB, 'I' ) ) THEN
00056 *
00057 *        Sort in increasing order
00058 *
00059          DO 20 I = 2, N
00060             IX = 1 + ( I-1 )*INC
00061    10       CONTINUE
00062             IF( IX.EQ.1 )
00063      $         GO TO 20
00064             IXNEXT = IX - INC
00065             IF( X( IX ).GT.X( IXNEXT ) ) THEN
00066                GO TO 20
00067             ELSE
00068                TEMP = X( IX )
00069                X( IX ) = X( IXNEXT )
00070                X( IXNEXT ) = TEMP
00071             END IF
00072             IX = IXNEXT
00073             GO TO 10
00074    20    CONTINUE
00075 *
00076       ELSE IF( LSAME( JOB, 'D' ) ) THEN
00077 *
00078 *        Sort in decreasing order
00079 *
00080          DO 40 I = 2, N
00081             IX = 1 + ( I-1 )*INC
00082    30       CONTINUE
00083             IF( IX.EQ.1 )
00084      $         GO TO 40
00085             IXNEXT = IX - INC
00086             IF( X( IX ).LT.X( IXNEXT ) ) THEN
00087                GO TO 40
00088             ELSE
00089                TEMP = X( IX )
00090                X( IX ) = X( IXNEXT )
00091                X( IXNEXT ) = TEMP
00092             END IF
00093             IX = IXNEXT
00094             GO TO 30
00095    40    CONTINUE
00096       END IF
00097       RETURN
00098 *
00099 *     End of SLAORD
00100 *
00101       END