CTITL  SORTNUM.FTN - SORT BASS MAGS INTO ASCENDING FID ORDER
C INPUT DATA   LU 2
C OUTPUT DATA  LU 8
      INTEGER*4 INDEX(285000)
      INTEGER*4 X(285000)
      CHARACTER*72 TLINE
      LOGICAL UP,IER
C
      OPEN(UNIT=2,FILE='basszone55.dat',READONLY)
C OPEN THE INPUT FILE
      OPEN(UNIT=8,FILE='sort.dat')
C OPEN THE OUTPUT FILE
C
      OPEN(UNIT=4,ACCESS='DIRECT',RECL=72,STATUS='SCRATCH',
     .  FORM='FORMATTED')
C OPEN FILE FOR RANDOM ACCESS
      REWIND 2
      DO 8 N=1,285001
      READ(2,101,END=9) TLINE
  101 FORMAT(A72)
      WRITE(4,101,REC=N) TLINE
    8 CONTINUE
      STOP 'TOO MANY STATIONS'
C STOP IF TOO LARGE FOR ARRAY BOUNDS
    9 N=N-1
C TAKE OF THE EOF READ
      DO 10 I=1,N
      READ(4,100,REC=I) X(I)
  100 FORMAT(16X,I8)
      INDEX(I)=I
C FILL SORT INDEX ARRAY
   10 CONTINUE
C BACK ROUND
C
C NOW SORT INTO ASCENDING X VALUES
      CALL BUBSTD(INDEX,X,1,N)
C PERFORM THE SORT
      DO 23 K=1,N
C FIND THE RECORD IN THE ORIGINAL FILE TO COPY THE COMPLETE
C RECORD TO THE OUTPUT FILE
      READ(4,102,REC=INDEX(K)) TLINE
      WRITE(8,102) TLINE
  102 FORMAT(A72)
C COPY HERE
   23 CONTINUE
      CLOSE(UNIT=8,STATUS='KEEP')
      END
      SUBROUTINE BUBSTD(IR,A,IBASE,N)
      INTEGER*4 A(N)
      INTEGER*4 IR(N)
      LOGICAL NSWAP
      IF (N .LE. 1) RETURN
C NOTHING TO SORT
      NM1=N-1
      DO 30 J=IBASE,NM1
      NSWAP=.TRUE.
      IRI=IR(1)
      DO 40 I=IBASE,NM1
      IP1=I+1
      IRIP1=IR(IP1)
      IF (A(IRI) .LE. A(IRIP1)) GOTO 40
      NSWAP=.FALSE.
      IR(I)=IRIP1
      IR(IP1)=IRI
      IRIP1=IRI
   40 IRI=IRIP1
      IF (NSWAP) RETURN
   30 CONTINUE
      RETURN
      END