]>
Commit | Line | Data |
---|---|---|
0795afa3 | 1 | #include "isajet/pilot.h" |
2 | SUBROUTINE ORDECR(IA,IB,N) | |
3 | C---------------------------------------------------------------------- | |
4 | C- | |
5 | C- Purpose and Methods : | |
6 | C- return an ordered array (by size of absolute values) | |
7 | C- Warning: input array is destroyed | |
8 | C- | |
9 | C- Inputs : | |
10 | C- IA(N) = input array | |
11 | C- Outputs : | |
12 | C- IB(N) = output ordered array | |
13 | C- | |
14 | C- Created 9-MAY-1988 Serban D. Protopopescu | |
15 | C- | |
16 | C---------------------------------------------------------------------- | |
17 | #if defined(CERNLIB_IMPNONE) | |
18 | IMPLICIT NONE | |
19 | #endif | |
20 | INTEGER IA(*),IB(*),N,I,J,JSEL | |
21 | C---------------------------------------------------------------------- | |
22 | DO 2 I=1,N | |
23 | JSEL=0 | |
24 | IB(I)=0 | |
25 | DO 1 J=1,N | |
26 | IF(IABS(IA(J)).GT.IABS(IB(I))) THEN | |
27 | IB(I)=IA(J) | |
28 | JSEL=J | |
29 | ENDIF | |
30 | 1 CONTINUE | |
31 | IF(JSEL.GT.0) IA(JSEL)=0 | |
32 | 2 CONTINUE | |
33 | 999 RETURN | |
34 | END |