C..  INDEXSORT.FTN     BOHDEN K. CMAYLO  MARCH 1982
C..     PROGRAM SORTS INDEX DOCUMENT FOR ACCOUNT
	BYTE IN(132),FORFIL(8),DEV(4),UIC(9),LITN
	BYTE INSORT(136,210)
	DIMENSION ISORT(68,210),KEY(68),INDEX(210)
	DOUBLE PRECISION TYPE(3),XFORFL
	EQUIVALENCE (INSORT,ISORT),(FORFIL,XFORFL)
	DATA LITN,XFORFL/'n','SY:1.SY '/
	DATA TYPE/'DESCEND','ASCEND','NAMES'/
	DATA INUNIT/1/
	DATA MXB,MXB1,MXW,MXREC/132,133,68,210/
	DATA INCR,IPR,IERR,KEY/5,5,0,1,2,66*0/
C..
C..	GET COMMAND LINE + SORT SPEC, IF ANY: DEF:BY DOC, DESENDING
C..
	IQ=ISTXQT(IN)
	IF(IQ.LE.0) GO TO 4
4	IF(IQ.LE.0) WRITE(IPR,1)
1	FORMAT('$INDEXSORT>')
	IF(IQ.LE.0) READ(INCR,2,END=99)IQ,(IN(I),I=1,IQ)
	IF(IQ.LE.0) GO TO 99
	IQ=IQ+1
	IN(IQ)=' '
	IF(IN(1).EQ.'H'.AND.IN(2).EQ.'E') GO TO 88
	IF(IN(1).EQ.'/'.AND.IN(2).EQ.'H') GO TO 88
C..
C..	CHECK FOR DEVICE
C..
	IDEV=0
	IF(IN(3).EQ.':') IDEV=2
	IF(IN(4).EQ.':') IDEV=3
	IF(IN(5).EQ.':') IDEV=4
	IF(IDEV.EQ.0) GO TO 6
	CALL DOBYTE(DEV,DEV(4),' ')
	CALL BYTEDO(DEV,DEV(IDEV),IN)
	IB=IDEV+2
	GO TO 7
6	CALL BYTEDO(DEV,DEV(4),'SY00')
C..
C..	DECODE UIC
C..
	IB=1
7	IF(IN(IB).EQ.'[') IB=IB+1
	IPASS=0
5	IPASS=IPASS+1
	IC=IB+1
	IF(IN(IC).EQ.','.OR.IN(IC).EQ.']'.OR.IN(IC).EQ.' ') GO TO 10
	IC=IC+1
	IF(IN(IC).EQ.','.OR.IN(IC).EQ.']'.OR.IN(IC).EQ.' ') GO TO 10
	IC=IC+1
	IF(IN(IC).EQ.','.OR.IN(IC).EQ.']'.OR.IN(IC).EQ.' ') GO TO 10
C..
C..	IN FORMAT ERROR
C..
9	WRITE(IPR,8)(IN(I),I=1,IQ)
8	FORMAT('0*** ERROR IN PARAMETER=',132A1)
	GO TO 99
C..
C..	DECODE GROUP #
C..
10	IF(IC.GT.IQ) GO TO 9
	IENC=IC-IB
	DECODE(IENC,15,IN(IB),ERR=9)NUM
15	FORMAT(O3)
	IF(IPASS.EQ.1) IGRP=NUM
	IB=IC+1
	IF(IPASS.EQ.1) GO TO 5
	IMEM=NUM
C..
C..	GET SORT PARAM (0=-#, 1=+#, 2 OR N=BY NAME)
C..
	IOP=0
	IF(IC.GE.IQ) GO TO 20
	IF(IN(IQ-1).EQ.'A') IOP=1
	IF(IN(IQ-1).EQ.'N') IOP=2
20	IF(IOP.EQ.0) KEY(1)=-1
	IF(IOP.EQ.0) KEY(2)=-2
C..
C..	CREATE FILE NAME OF DOC001.W11
C..
	IENC=25
	ENCODE(IENC,21,IN)DEV,IGRP,IMEM
21	FORMAT(4A1,':[',O3,',',O3,']DOC001.W11 ')
	CALL RIDBLK(IN,IENC)
C..
C..	GET FILE CONVERTED AND READ IN
C..
	CALL INDOC(INUNIT,IN,FORFIL)
C..
C..	READ DATA INTO SORT FILE
C..
	IR=0
	IFRST=4
	IF(IOP.EQ.2) IFRST=0
30	IR=IR+1
31	READ(INUNIT,2,END=32)IQ,(INSORT(I+IFRST,IR),I=1,IQ)
2	FORMAT(Q,132A1)
C..
C..   TURN INTO CAPS
C..
	IF(IQ.GT.3) CALL CAPS(INSORT(4+IFRST,IR),IQ-3)
C.
C..   CHECK FOR ERROR
C..
	IF(IQ.GT.MXB.OR.IR.GT.MXREC-1) GO TO 33
C..
C..	SEARCH FOR <> IN MIDDLE OF LINE (BAD INDEX)
C..
221	DO 222 I=2,IQ
	N=I+IFRST
	IF(INSORT(N-1,IR).EQ.'<'.AND.INSORT(N,IR).EQ.'>') GO TO 223
222	CONTINUE
C..
C..	NO <>, BAD, READ NEXT RECORD
C..
	GO TO 31
C..
C..	CHECK IF TWO RECORDS
C..
223	IRIQ=I
C..
C..	MOVE INDEX DOC NUMBER TO FRONT
C..
	IF(IFRST.EQ.0) GO TO 135
	CALL BYTEDO(INSORT(1,IR),INSORT(IFRST,IR),INSORT(IRIQ,IR))
C..
C..	CLEAN UP DOC #
C..
	DO 35 I=1,4
	IF(INSORT(I,IR).EQ.'#'.OR.INSORT(I,IR).EQ.'>') INSORT(I,IR)=' '
35	CONTINUE
C..
C..	COPY NEXT PART OVER TO NEXT RECORD AND BLANK OUT OLD RECORD
C..
135	IQ=IQ-IRIQ
	IF(IQ.LE.5) GO TO 30
	IR=IR+1
	CALL BYTEDO
     1 (INSORT(IFRST+1,IR),INSORT(IQ+IFRST,IR),INSORT(N+1,IR-1))
	CALL DOBYTE(INSORT(N+1,IR-1),INSORT(MXB,IR-1),' ')
C..
C..	CHANGE <N> TO <n>
C..
	IF(INSORT(IFRST+2,IR).EQ.'N') INSORT(IFRST+2,IR)=LITN
	GO TO 221
C..
C..	READ ERROR
C..
33	WRITE(IPR,333)IR,MXREC,IQ,MXB
333	FORMAT('0*** ERROR RECORD ',I3,'>',I3,' or  BUFFER',I4,'>',I3)
	IERR=IERR+1
	GO TO 32
C..
C..	FINISH READING + GET SORT KEY
C..
32	IR=IR-1
	IF(IOP.NE.2) GO TO 37
	DO 36 I=1,MXW
	KEY(I)=I
36	CONTINUE
C..
C..	SORT IF NO ERRORS
C..
37	CONTINUE
	IF(IERR.GT.0) GO TO 99
      CALL GPSRTI(KEY,1,IR,MXW,ISORT,MXREC,INDEX)
C..
C..	WRITE OUT RESULTS
C..
	REWIND INUNIT
	DO 40 I=1,IR
C..
C..	GET LAST >
C..
	DO 41 IQ=1,MXB
	IF(INSORT(MXB1-IQ,I).EQ.'>') GO TO 42
41	CONTINUE
	IQ=MXB
42	IQ=MXB1-IQ-IFRST
	WRITE(INUNIT,43)(INSORT(II+IFRST,I),II=1,IQ)
43	FORMAT(132A1)
40	CONTINUE
	CALL CLOSE(INUNIT)
C..
C..	COPY OVER TO DOC001.W11
C..
	IENC=57
	ENCODE(IENC,50,IN)DEV,IGRP,IMEM,FORFIL
50	FORMAT('DXF ',4A1,':[',O3,',',O3,']DOC001.W11/TYPE:DOC=',
     1 8A1,'/TYPE:PM!  ')
	CALL XSPAWN(IN)
	IENC=21
	ENCODE(IENC,59,IN)FORFIL
59	FORMAT('PIP ',8A1,';*/DE/NM!')
	CALL XSPAWN(IN)
	WRITE(IPR,60)IR,TYPE(IOP+1)
60	FORMAT('* END OF INDEXSORT *',I4,' RECORDS SORTED BY ',A8)
99	CALL EXIT
C..
C..	HELP SECTION
C..
88	WRITE(IPR,888)
888	FORMAT(/' *** INDEXSORT HELP ***'//
     1 ' DOCUMENTS ARE ASSUMED TO BE ON SY: DISKS.'//
     2 ' THREE OPTIONS ARE AVAILABLE:'/
     3 '              1) SORT BY DECENDING DOC NUMBER (DEFAULT)'/
     4 '              2) SORT BY ASCENDING DOC NUMBER (OPTION=A)'/
     5 '              3) SORT BY DOCUMENT NAME (OPTION=N)'/
     6 '0     TO RUN, DO FOLLOWING:'//
     7 '  >INDEXSORT DDUU:UIC OPTION'//
     8 '    DDUU: = DISK,  UIC =[ggg,mmm],  OPTION = A, N, NULL'//)
	GO TO 99
	END
