]>
Commit | Line | Data |
---|---|---|
0795afa3 | 1 | #include "isajet/pilot.h" |
2 | SUBROUTINE ISASRT(X,NCH,IMAP) | |
3 | C---------------------------------------------------------------------- | |
4 | C- | |
5 | C- Purpose and Methods : Sorts a floating point array X into ascending order. | |
6 | C- The array IMAP contains ordered list of pointers | |
7 | C- | |
8 | C- Inputs : X - Floating point array | |
9 | C- NCH - Number of elements in X | |
10 | C- Outputs : IMAP - pointer to ordered list in X | |
11 | C- Controls: None | |
12 | C- | |
13 | C- Created 3-OCT-1988 Rajendran Raja | |
14 | C- Based on the Algorithm of D.L.Shell, High speed sorting | |
15 | C- procedure , Communications of the ACM, Vol 2, July 1959, PP 30-32 | |
16 | C---------------------------------------------------------------------- | |
17 | #if defined(CERNLIB_IMPNONE) | |
18 | IMPLICIT NONE | |
19 | #endif | |
20 | REAL X(*) | |
21 | REAL TEMP | |
22 | INTEGER IMAP(*),NCH,M,I,J,K,IM,IT | |
23 | C---------------------------------------------------------------------- | |
24 | M=NCH | |
25 | 10 M=M/2 !binary chop | |
26 | IF(M.EQ.0)GO TO 999 | |
27 | K=NCH-M | |
28 | J=1 | |
29 | 20 I=J | |
30 | 30 IM=I+M | |
31 | IF(X(I).LE.X(IM))GO TO 40 | |
32 | TEMP = X(I) | |
33 | X(I) = X(IM) | |
34 | X(IM) = TEMP | |
35 | IT = IMAP(I) | |
36 | IMAP(I)=IMAP(IM) | |
37 | IMAP(IM)=IT | |
38 | I = I-M | |
39 | IF(I.GE.1)GO TO 30 | |
40 | 40 J=J+1 | |
41 | IF(J.GT.K)GO TO 10 | |
42 | GO TO 20 | |
43 | 999 RETURN | |
44 | END |