SUBROUTINE GPSRTI(KEY,II,JJ,NN,ISORT,IDIM2,INDEX)
C..       *** WRITTEN BY BOHDEN CMAYLO *** AUGUST 1972 *** REVISED JULY 1974 ***
C..      KEY = 1-256 MAJOR-MINOR, +=ASC, 0=NULL, -=DESC.
C..      II = FIRST ADDRESS
C..      JJ = LAST ADDRESS
C..      NN = DIMENSION
C..      ISORT = 2 DIMENSIONAL CHARACTER ARRAY
C..      NEXTJ = INVERSE OF KEY
C..      LSTN = LAST  ADDRESSES FOR EACH PARTITION
C..      MAXJ = MAX NUMBER OF KEYS TO BE SORTED
      INTEGER ISORT(NN,IDIM2)
      DIMENSION KEY(NN),INDEX(IDIM2)
      COMMON /XZXZXZ/ NEXTJ(256),LSTN(256)
          IF(II.GE.JJ) RETURN
      CALL INDEX1(II,JJ,INDEX)
      DO 1 I=1,NN
      NEXTJ(I)=0
1     LSTN(I)=0
C..      SET UP INVERSE OF KEYS AND DECENDING SORTS
      MAXJ=0
      DO 2 I=1,NN
      K=KEY(I)
      IF(K) 3,2,4
3      K=-K
      DO 5 J=II,JJ
5     ISORT(I,J)=-ISORT(I,J)
4     MAXJ=MAXJ+1
      NEXTJ(K)=I
2     CONTINUE
C..      SEE IF ALL KEYS OK
      DO 6 I=1,MAXJ
      IF(NEXTJ(I).LE.0) GO TO 13
6     CONTINUE
C..      SET UP FIRST PARTITION
      J=2
      NEXT=NEXTJ(1)
       NEXT1=NEXTJ(2)
      IST=II
      I=JJ
      LST=I-1
      LSTN(2)=JJ-1
      CALL SORTI(NEXT,IST,I,NN,ISORT,IDIM2,INDEX)
       IF(MAXJ.LE.1) GO TO 12
C..      LOCATE NEXT PARTITION
7     DO 9 I=IST,LST
      K1=INDEX(I)
      K2=INDEX(I+1)
      IF(ISORT(NEXT,K1).NE.ISORT(NEXT,K2)) GO TO 8
9     CONTINUE
      I=LST+1
C..      SORT NEXT PARTITION
8     IF(IST.EQ.I) GO TO 17
      CALL SORTI(NEXT1,IST,I,NN,ISORT,IDIM2,INDEX)
C..      CHECK IF FINISHED WITH PRESENT PARTITION
      IF(J.LT.MAXJ) GO TO 10
17    IST=I+1
      IF(IST.LE.LST) GO TO 7
C..      SEE IF FINISHED
16    J=J-1
      IF(IST.GE.JJ) GO TO 12
C..      GET NEXT PARTITION UP
      NEXT1=NEXT
      NEXT=NEXTJ(J-1)
      IST=LST+2
      LST =LSTN(J)
      IF(IST.GT.LST) GO TO 16
      GO TO 7
C..      PLACE NEXT PARTITION DOWN
10    J=J+1
      NEXT=NEXT1
      NEXT1=NEXTJ(J)
      LSTN(J)=I-1
      LST=I-1
      GO TO 7
C..      WRITE OUT ERROR MESSAGE
13    TYPE 15,II,JJ,NN,KEY
15    FORMAT(//' *** GPSORT ERROR *** FIRST =',I5,'   LAST =',I5,'   DIM
     1ENSION =',I5/'        KEY ='/(20I6/))
          TYPE 93
93        FORMAT(/'  ***  JOB ABORTED  ***'//)
          STOP
C..      RESET SORTED ARRAY FOR OUTPUT
12    DO 11 I=1,NN
      IF(KEY(I).GE.0) GO TO 11
      DO 14 J=II,JJ
14    ISORT(I,J)=-ISORT(I,J)
11    CONTINUE
      CALL INDEX2(II,JJ,ISORT,NN,INDEX)
      RETURN
      END
      SUBROUTINE INDEX2(IST,LST,IARRAY,NVAR,INDEX)
      DIMENSION INDEX(LST)
      INTEGER ITEMP,IARRAY(NVAR,LST)
      COMMON /XZXZXZ/ITEMP(256)
C..      ROUTINE FOR RESETTING ARRAY TO PROPER CONDITION
      DO 1 I=IST,LST
      J1=INDEX(I)
      IF(J1.LE.0.OR.J1.EQ.I) GO TO 1
C..      SAVE FIRST FILE FOR LATER USE
      DO 2 K=1,NVAR
2     ITEMP(K)=IARRAY(K,I)
      J2=I
C..      REPLACE CORRECT ARRAY ELEMENTS WITH THAT OF SORTED
3     DO 4 K=1,NVAR
4     IARRAY(K,J2)=IARRAY(K,J1)
      INDEX(J2)=0
      J2=J1
      J1=INDEX(J1)
      IF(J1.NE.I) GO TO 3
C..      RESET ARRAY WITH CORRECT FIRST LOCATION
      DO 5 K=1,NVAR
5     IARRAY(K,J2)=ITEMP(K)
      INDEX(J2)=0
1     CONTINUE
      RETURN
      END
      SUBROUTINE INDEX1(IST,LST,INDEX)
C..       ENTRY FOR SETTING  UP FIRST INDEX
      DIMENSION INDEX(LST)
C..      SET INDEX
      DO 10 I=IST,LST
10    INDEX(I)=I
      RETURN
      END
      SUBROUTINE SORTI(NI,II,JJ,NN,ISORT,IDIM2,INDEX)
C.......SORTS ONE OR TWO DIMENSION ARRAYS
C            1ST ARRAY DIMENSION HAS A LIMIT OF 256 WORDS.
C..  PROGRAM SORT -- WRITTEN BY BOHDEN CMAYLO -- MAY 1972
C..   NI = NUMBER OF THE ELEMENT IN ARRAY ISORT TO SORT ON.
C..   II = FIRST ARRAY NUMBER USED TO SORT.
C..   JJ = LAST  ARRAY NUMBER USED TO SORT.
C..   NN = THE NUMBER OF THE FIRST DIMENSION OF ISORT.
C..   ISORT = A ONE OR TWO DIMENSIONAL ARRAY WHICH CONTAINS ALL THE ELEMENTS.
C..   IDIM2 = LAST DIMENSION
      INTEGER ISORT(NN,IDIM2)
      DIMENSION INDEX(IDIM2)
      DIMENSION IU(20),IL(20)
      INTEGER T,TT
      IF(II.GT.JJ) GO TO 99
      IF(NI.GT.NN) GO TO 99
      M=1
      IF(II+1.EQ.JJ) GO TO 130
      I=II
      J=JJ
   5  IF(I.GE.J) GO TO 70
   10 K=I
      IJ=(J+I)/2
      KIJ=INDEX(IJ)
      T=ISORT(NI,KIJ)
      KI=INDEX(I)
      IF(ISORT(NI,KI).LE.T) GO TO 20
      INDEX(IJ)=KI
      INDEX(I)=KIJ
      KIJ=KI
      KI=INDEX(I)
      T=ISORT(NI,KIJ)
20    L=J
      KJ=INDEX(J)
      IF(ISORT(NI,KJ).GE.T) GO TO 40
      INDEX(IJ)=KJ
      INDEX(J)=KIJ
      KIJ=KJ
      KJ=INDEX(J)
      T=ISORT(NI,KIJ)
      IF(ISORT(NI,KI).LE.T) GO TO 40
      INDEX(IJ)=KI
      INDEX(I)=KIJ
      KIJ=KI
      KI=INDEX(I)
      T=ISORT(NI,KIJ)
      GO TO 40
30    KL=INDEX(L)
      INDEX(L)=INDEX(K)
      INDEX(K)=KL
40    L=L-1
      KL=INDEX(L)
      IF(ISORT(NI,KL).GT.T) GO TO 40
      TT=ISORT(NI,KL)
50    K=K+1
      KK=INDEX(K)
      IF(ISORT(NI,KK).LT.T) GO TO 50
      IF(K.LE.L) GO TO 30
      IF(L-I.LE.J-K) GO TO 60
      IL(M)=I
      IU(M)=L
      I=K
      M=M+1
      GO TO 80
   60 IL(M)=K
      IU(M)=J
      J=L
      M=M+1
      GO TO 80
   70 M=M-1
      IF(M.LE.0) RETURN
      I=IL(M)
      J=IU(M)
   80 IF(J-I.GE.II) GO TO 10
      IF(I.EQ.II) GO TO 5
      I=I-1
   90 I=I+1
      IF(I.EQ.J) GO TO 70
      KI1=INDEX(I+1)
      T=ISORT(NI,KI1)
      KI=INDEX(I)
      IF(ISORT(NI,KI).LE.T) GO TO 90
      K=I
100   INDEX(K+1)=INDEX(K)
      K=K-1
      KK=INDEX(K)
      IF(T.LT.ISORT(NI,KK)) GO TO 100
      INDEX(K+1)=KI1
      GO TO 90
130   KI=INDEX(II)
      KJ=INDEX(JJ)
      IF(ISORT(NI,KI).LE.ISORT(NI,KJ)) RETURN
      INDEX(II)=KJ
      INDEX(JJ)=KI
      RETURN
99    TYPE 98,NI,II,JJ,NN
98    FORMAT(//' *** SORT ERROR *** BAD PARAMETERS PASSED ARE'//
     1 20X,'NI=',I6,5X,'II=',I6,5X,'JJ=',I6,5X,'NN=',I6//
     2 '  ***  JOB ABORTED  ***'//)
      STOP
      END