![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLAORD 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SLAORD( JOB, N, X, INCX ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER JOB 00015 * INTEGER INCX, N 00016 * .. 00017 * .. Array Arguments .. 00018 * REAL X( * ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> SLAORD sorts the elements of a vector x in increasing or decreasing 00028 *> order. 00029 *> \endverbatim 00030 * 00031 * Arguments: 00032 * ========== 00033 * 00034 *> \param[in] JOB 00035 *> \verbatim 00036 *> JOB is CHARACTER 00037 *> = 'I': Sort in increasing order 00038 *> = 'D': Sort in decreasing order 00039 *> \endverbatim 00040 *> 00041 *> \param[in] N 00042 *> \verbatim 00043 *> N is INTEGER 00044 *> The length of the vector X. 00045 *> \endverbatim 00046 *> 00047 *> \param[in,out] X 00048 *> \verbatim 00049 *> X is REAL array, dimension 00050 *> (1+(N-1)*INCX) 00051 *> On entry, the vector of length n to be sorted. 00052 *> On exit, the vector x is sorted in the prescribed order. 00053 *> \endverbatim 00054 *> 00055 *> \param[in] INCX 00056 *> \verbatim 00057 *> INCX is INTEGER 00058 *> The spacing between successive elements of X. INCX >= 0. 00059 *> \endverbatim 00060 * 00061 * Authors: 00062 * ======== 00063 * 00064 *> \author Univ. of Tennessee 00065 *> \author Univ. of California Berkeley 00066 *> \author Univ. of Colorado Denver 00067 *> \author NAG Ltd. 00068 * 00069 *> \date November 2011 00070 * 00071 *> \ingroup single_lin 00072 * 00073 * ===================================================================== 00074 SUBROUTINE SLAORD( JOB, N, X, INCX ) 00075 * 00076 * -- LAPACK test routine (version 3.4.0) -- 00077 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00078 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00079 * November 2011 00080 * 00081 * .. Scalar Arguments .. 00082 CHARACTER JOB 00083 INTEGER INCX, N 00084 * .. 00085 * .. Array Arguments .. 00086 REAL X( * ) 00087 * .. 00088 * 00089 * ===================================================================== 00090 * 00091 * .. Local Scalars .. 00092 INTEGER I, INC, IX, IXNEXT 00093 REAL TEMP 00094 * .. 00095 * .. External Functions .. 00096 LOGICAL LSAME 00097 EXTERNAL LSAME 00098 * .. 00099 * .. Intrinsic Functions .. 00100 INTRINSIC ABS 00101 * .. 00102 * .. Executable Statements .. 00103 * 00104 INC = ABS( INCX ) 00105 IF( LSAME( JOB, 'I' ) ) THEN 00106 * 00107 * Sort in increasing order 00108 * 00109 DO 20 I = 2, N 00110 IX = 1 + ( I-1 )*INC 00111 10 CONTINUE 00112 IF( IX.EQ.1 ) 00113 $ GO TO 20 00114 IXNEXT = IX - INC 00115 IF( X( IX ).GT.X( IXNEXT ) ) THEN 00116 GO TO 20 00117 ELSE 00118 TEMP = X( IX ) 00119 X( IX ) = X( IXNEXT ) 00120 X( IXNEXT ) = TEMP 00121 END IF 00122 IX = IXNEXT 00123 GO TO 10 00124 20 CONTINUE 00125 * 00126 ELSE IF( LSAME( JOB, 'D' ) ) THEN 00127 * 00128 * Sort in decreasing order 00129 * 00130 DO 40 I = 2, N 00131 IX = 1 + ( I-1 )*INC 00132 30 CONTINUE 00133 IF( IX.EQ.1 ) 00134 $ GO TO 40 00135 IXNEXT = IX - INC 00136 IF( X( IX ).LT.X( IXNEXT ) ) THEN 00137 GO TO 40 00138 ELSE 00139 TEMP = X( IX ) 00140 X( IX ) = X( IXNEXT ) 00141 X( IXNEXT ) = TEMP 00142 END IF 00143 IX = IXNEXT 00144 GO TO 30 00145 40 CONTINUE 00146 END IF 00147 RETURN 00148 * 00149 * End of SLAORD 00150 * 00151 END