MINICERN/packlib/kernlib/kerngen/tcgen/sortx.F

   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