| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1.1.1 1996/02/15 17:49:50 mclareni |
| 6 | * Kernlib |
| 7 | * |
| 8 | * |
| 9 | #include "kerngen/pilot.h" |
| 10 | #if !defined(CERNLIB_TCGEN) |
| 11 | SUBROUTINE SORTX(MX,NC,NR,NCS,NK) |
| 12 | C |
| 13 | C CERN PROGLIB# M106 SORTX .VERSION KERNFOR 1.0 661115 |
| 14 | C ORIG. 15/11/66 CL |
| 15 | C |
| 16 | DIMENSION MX(2),NK(2,2) |
| 17 | COMMON/SLATE/I,I1,I2,I3,IC,IR,ICMX,N1,N2,N3,N4,N5,NKI,NKI1,NKI2, |
| 18 | 1 NCSORT,NRM1,INK,JNK,NHELP,NKIP1,XQX(19) |
| 19 | C |
| 20 | NCSORT=IABS(NCS) |
| 21 | IF(NR.LE.1.OR.NCSORT.GT.NC.OR.NCSORT.LE.0) GO TO 1000 |
| 22 | NK(1,1)=NCSORT |
| 23 | DO 1 I=2,NR |
| 24 | 1 NK(1,I)=NK(1,I-1)+NC |
| 25 | I3=0 |
| 26 | NRM1=NR-1 |
| 27 | INK=1 |
| 28 | C |
| 29 | C-- MAIN PROGRAM (PASSES N1,N2, AND N3 TO MERGE) |
| 30 | C |
| 31 | 100 JNK=3-INK |
| 32 | N3=0 |
| 33 | C |
| 34 | 101 N1=N3+1 |
| 35 | IF(N1.GT.NRM1) GO TO 113 |
| 36 | DO 103 I=N1,NRM1 |
| 37 | NKI=NK(INK,I) |
| 38 | NKIP1=NK(INK,I+1) |
| 39 | IF (MX(NKIP1).LT.MX(NKI)) GO TO 104 |
| 40 | 103 CONTINUE |
| 41 | 113 N3=NR |
| 42 | N4=N1 |
| 43 | N5=NR |
| 44 | GO TO 206 |
| 45 | C |
| 46 | 104 N2=I+1 |
| 47 | IF (N2.GT.NRM1) GO TO 116 |
| 48 | DO 106 I=N2,NRM1 |
| 49 | NKI=NK(INK,I) |
| 50 | NKIP1=NK(INK,I+1) |
| 51 | IF(MX(NKIP1).LT.MX(NKI)) GO TO 107 |
| 52 | 106 CONTINUE |
| 53 | 116 I=NR |
| 54 | C |
| 55 | 107 N3=I |
| 56 | C |
| 57 | C-- MERGE SEQUENCE (STRINGS N1-(N2-1), N2-N3) |
| 58 | C |
| 59 | I1=N1 |
| 60 | I2=N2 |
| 61 | DO 203 I3=N1,N3 |
| 62 | NKI1=NK(INK,I1) |
| 63 | NKI2=NK(INK,I2) |
| 64 | IF(MX(NKI2).LT.MX(NKI1)) GO TO 202 |
| 65 | NK(JNK,I3)=NKI1 |
| 66 | I1=I1+1 |
| 67 | IF(N2-I1) 204,204,203 |
| 68 | 202 NK(JNK,I3)=NKI2 |
| 69 | I2=I2+1 |
| 70 | IF ((N3+1).LE.I2) GO TO 205 |
| 71 | 203 CONTINUE |
| 72 | GO TO 208 |
| 73 | C |
| 74 | 204 N4=I2 |
| 75 | N5=N3 |
| 76 | GO TO 206 |
| 77 | C |
| 78 | 205 N4=I1 |
| 79 | N5=N2-1 |
| 80 | 206 DO 207 I=N4,N5 |
| 81 | I3=I3+1 |
| 82 | 207 NK(JNK,I3)=NK(INK,I) |
| 83 | IF(NR.GT.N3) GO TO 101 |
| 84 | 208 INK=JNK |
| 85 | IF (N1.NE.1) GO TO 100 |
| 86 | C |
| 87 | C-- FINAL PERMUTATION PROGRAM |
| 88 | C |
| 89 | JNK=3-INK |
| 90 | DO 302 IC=1,NC |
| 91 | DO 301 IR=1,NR |
| 92 | ICMX=NK(INK,IR)+IC-NCSORT |
| 93 | 301 NK(JNK,IR)=MX(ICMX) |
| 94 | ICMX=IC |
| 95 | DO 302 IR=1,NR |
| 96 | IF (NCS.GE.0) GO TO 303 |
| 97 | NHELP=NR-IR+1 |
| 98 | MX(ICMX)=NK(JNK,NHELP) |
| 99 | GO TO 302 |
| 100 | 303 MX(ICMX)=NK(JNK,IR) |
| 101 | 302 ICMX=ICMX+NC |
| 102 | 1000 RETURN |
| 103 | END |
| 104 | #endif |
git://git.uio.no / u / mrichter / AliRoot.git / blame