PROGRAM REFER

      INTEGER I, IN, MAX, N, NUM, OUT, XMAX
      PARAMETER (MAX = 200)

      INTEGER INDX(MAX)

      DOUBLE PRECISION  G(MAX),  H(MAX),  S(MAX), CP(MAX),  V(MAX)
      DOUBLE PRECISION A1(MAX), A2(MAX), A3(MAX), A4(MAX), C1(MAX)
      DOUBLE PRECISION C2(MAX),  RX(MAX), W(MAX), Z(MAX)

      DOUBLE PRECISION XG(MAX), XH(MAX), XS(MAX), XCP(MAX), XV(MAX)
      DOUBLE PRECISION XA1(MAX), XA2(MAX), XA3(MAX), XA4(MAX), XC1(MAX)
      DOUBLE PRECISION XC2(MAX), XRX(MAX), XW(MAX), XZ(MAX)

      CHARACTER *  8 BLANK, ION(MAX), XION(MAX)
      CHARACTER * 80 STUFF(2)

      IN = 10
      OUT = 12
      BLANK = '       '

      OPEN (IN,  FILE = 'ION.DAT', STATUS = 'OLD')
      OPEN (OUT, FILE = 'OUT.DAT', STATUS = 'UNKNOWN')

      DO 10 I = 1, MAX
        ION(I)  = BLANK
        Z(I)    = 0.0
        G(I)    = 0.0
        H(I)    = 0.0
        S(I)    = 0.0
        CP(I)   = 0.0
        V(I)    = 0.0
        A1(I)   = 0.0
        RX(I)   = 0.0
        A2(I)   = 0.0
        A3(I)   = 0.0
        A4(I)   = 0.0
        C1(I)   = 0.0
        C2(I)   = 0.0
        W(I)    = 0.0
        INDX(I) = 0
        XION(I) = BLANK
        XZ(I)   = 0.0
        XG(I)   = 0.0
        XH(I)   = 0.0
        XS(I)   = 0.0
        XCP(I)  = 0.0
        XV(I)   = 0.0
        XA1(I)  = 0.0
        XRX(I)  = 0.0
        XA2(I)  = 0.0
        XA3(I)  = 0.0
        XA4(I)  = 0.0
        XC1(I)  = 0.0
        XC2(I)  = 0.0
        XW(I)   = 0.0
   10 CONTINUE

      PRINT *, 'INITIALIZED'

      READ (IN, '(A80)') STUFF(1)
      READ (IN, '(A80)') STUFF(2)
      READ (IN, '(I5)' ) NUM

      DO 20 I = 1, NUM
        READ (IN, 500) ION(I), Z(I), G(I), H(I), S(I), CP(I), 
     &                 V(I), A1(I)
        READ (IN, 510) INDX(I), RX(I), A2(I), A3(I), A4(I), 
     &                 C1(I), C2(I), W(I)
   20 CONTINUE

      PRINT *, 'READ'

  500 FORMAT (A8, F3.0, 2E10.4, 3X, 4E10.4)
  510 FORMAT (I5, 4X, F4.2, 1X, 6E10.4)

      DO 30 I = 1, NUM
        A1(I) = A1(I) * 1.0D-01
        A2(I) = A2(I) * 1.0D+02
        A4(I) = A4(I) * 1.0D+04
        C2(I) = C2(I) * 1.0D+04
        W (I) = W (I) * 1.0D+05
   30 CONTINUE

      PRINT *, 'DIVIDED'

      N = NUM

      CALL SORT3 (N, ION, INDX, Z, G, H, S, CP, V, A1, RX, A2, A3, A4, 
     &            C1, C2, W)

      PRINT *, 'SORTED'

      WRITE (OUT, '(A80)') STUFF(1)
      WRITE (OUT, '(A80)') STUFF(2)

      DO 60 I = 1, NUM
        IF (ION(I) .NE. BLANK) THEN
          WRITE (OUT, 520) ION(I), Z(I), G(I), H(I), S(I), 
     &                     CP(I), V(I), A1(I)
          WRITE (OUT, 530) RX(I), A2(I), A3(I), A4(I), C1(I), 
     &                     C2(I), W(I)
        END IF
   60 CONTINUE

      PRINT *, 'WRITEN AND DONE'

  520 FORMAT (A8, F4.0, 1P, 6E11.4)
  530 FORMAT (8X, F4.2, 1P, 6E11.4)

      END


      SUBROUTINE SORT3 (N, R, RI, R1, R2, R3, R4, R5, R6, R7, R8, R9, 
     &                  R10, R11, R12, R13, R14)

      INTEGER MAX
      PARAMETER (MAX = 200)

      INTEGER IWKSP(MAX), J, N, RI(MAX), WKSPI(MAX)

      CHARACTER * 8 R(MAX), WKSPA(MAX)

      DOUBLE PRECISION R1(MAX), R2(MAX), R3(MAX), R4(MAX), R5(MAX)
      DOUBLE PRECISION R6(MAX), R7(MAX), R8(MAX), R9(MAX), R10(MAX)
      DOUBLE PRECISION R11(MAX), R12(MAX), R13(MAX), R14(MAX)
      DOUBLE PRECISION WKSPB(MAX)

      CALL INDEXX (N, R, IWKSP)

      PRINT *, 'INDEXED'

      DO 10 J = 1, N
        WKSPA(J) = R(J)
   10 CONTINUE
      DO 20 J = 1, N
        R(J) = WKSPA(IWKSP(J))
   20 CONTINUE
      PRINT *, 'R'

      DO 30 J = 1, N
        WKSPI(J) = RI(J)
   30 CONTINUE
      DO 40 J = 1, N
        RI(J) = WKSPI(IWKSP(J))
   40 CONTINUE
      PRINT *, 'RI'

      DO 50 J = 1, N
        WKSPB(J) = R1(J)
   50 CONTINUE
      DO 60 J = 1, N
        R1(J) = WKSPB(IWKSP(J))
   60 CONTINUE
      PRINT *, 'R1'

      DO 70 J = 1, N
        WKSPB(J) = R2(J)
   70 CONTINUE
      DO 80 J = 1, N
        R2(J) = WKSPB(IWKSP(J))
   80 CONTINUE
      PRINT *, 'R2'

      DO 90 J = 1, N
        WKSPB(J) = R3(J)
   90 CONTINUE
      DO 100 J = 1, N
        R3(J) = WKSPB(IWKSP(J))
  100 CONTINUE
      PRINT *, 'R3'

      DO 110 J = 1, N
        WKSPB(J) = R4(J)
  110 CONTINUE
      DO 120 J = 1, N
        R4(J) = WKSPB(IWKSP(J))
  120 CONTINUE
      PRINT *, 'R4'

      DO 130 J = 1, N
        WKSPB(J) = R5(J)
  130 CONTINUE
      DO 140 J = 1, N
        R5(J) = WKSPB(IWKSP(J))
  140 CONTINUE
      PRINT *, 'R5'

      DO 150 J = 1, N
        WKSPB(J) = R6(J)
  150 CONTINUE
      DO 160 J = 1, N
        R6(J) = WKSPB(IWKSP(J))
  160 CONTINUE
      PRINT *, 'R6'

      DO 170 J = 1, N
        WKSPB(J) = R7(J)
  170 CONTINUE
      DO 180 J = 1, N
        R7(J) = WKSPB(IWKSP(J))
  180 CONTINUE
      PRINT *, 'R7'

      DO 190 J = 1, N
        WKSPB(J) = R8(J)
  190 CONTINUE
      DO 200 J = 1, N
        R8(J) = WKSPB(IWKSP(J))
  200 CONTINUE
      PRINT *, 'R8'

      DO 210 J = 1, N
        WKSPB(J) = R9(J)
  210 CONTINUE
      DO 220 J = 1, N
        R9(J) = WKSPB(IWKSP(J))
  220 CONTINUE
      PRINT *, 'R9'

      DO 230 J = 1, N
        WKSPB(J) = R10(J)
  230 CONTINUE
      DO 240 J = 1, N
        R10(J) = WKSPB(IWKSP(J))
  240 CONTINUE
      PRINT *, 'R10'

      DO 250 J = 1, N
        WKSPB(J) = R11(J)
  250 CONTINUE
      DO 260 J = 1, N
        R11(J) = WKSPB(IWKSP(J))
  260 CONTINUE
      PRINT *, 'R11'

      DO 270 J = 1, N
        WKSPB(J) = R12(J)
  270 CONTINUE
      DO 280 J = 1, N
        R12(J) = WKSPB(IWKSP(J))
  280 CONTINUE
      PRINT *, 'R12'

      DO 290 J = 1, N
        WKSPB(J) = R13(J)
  290 CONTINUE
      DO 300 J = 1, N
        R13(J) = WKSPB(IWKSP(J))
  300 CONTINUE
      PRINT *, 'R13'

      DO 310 J = 1, N
        WKSPB(J) = R14(J)
  310 CONTINUE
      DO 320 J = 1, N
        R14(J) = WKSPB(IWKSP(J))
  320 CONTINUE
      PRINT *, 'R14'

      RETURN
      END


      SUBROUTINE INDEXX (N, ARRIN, INDX)

      INTEGER MAX
      PARAMETER (MAX = 200)


      INTEGER I, INDX(MAX), INDXT, IR, J, L, N

      CHARACTER * 8 ARRIN(MAX), Q

      DO 10 J = 1, MAX
        INDX(J) = J
   10 CONTINUE

      L = N/2 + 1
      IR = N

  100 CONTINUE
      IF (L .GT. 1) THEN 
        L = L - 1 
        INDXT = INDX(L)
        Q = ARRIN(INDXT)
      ELSE
        INDXT = INDX(IR)
        Q = ARRIN(INDXT)
        INDX(IR) = INDX(1)
        IR = IR - 1
        IF (IR .EQ. 1) THEN 
          INDX(1)  = INDXT
          RETURN
        END IF 
      END IF
      I = L
      J = L + L

  200 CONTINUE
      IF (J .LE. IR) THEN
        IF (J .LT. IR) THEN 
          IF (ARRIN(INDX(J)) .LT. ARRIN(INDX(J+1))) J = J + 1
        END IF
        IF (Q .LT. ARRIN(INDX(J))) THEN
          INDX(I) = INDX(J)
          I = J
          J = J + J
        ELSE
          J = IR + 1
        END IF 
        GO TO 200
      END IF
      INDX(I) = INDXT
      GO TO 100
      END