
C** XREF2 ** SUBROUTINE TO SORT AND PRINT XREF LISTING *****
C
C
	SUBROUTINE XREF2
C
	DIMENSION IRB(140),ILB(140),IORD(140)
	LOGICAL*1 COUNT(140),HEADER(106),NAME(6,140),DEBUG,IPRINT
	LOGICAL*1 JPRINT,LOST
	COMMON LINEN,MAXLIN,IPAGE,INC,IERROR,IBEGIN,ICOUNT,DEBUG,LOST,
	$ NUMBER(140,30),NAME,HEADER,COUNT,IPRINT,JPRINT
C
C	NOTE: ADJUST SIZE OF IRB,ILB,IORD,NAME,COUNT AND NUMBER TO 
C	CHANGE VARIABLE CAPACITY (NOW 140 NAMES).
C
	LINEN=4
	WRITE (6,2) HEADER,IPAGE
2	FORMAT (/106A1,I4,' **'/)
	IPAGE=IPAGE+1
4	IF (LOST) WRITE (6,8)
C
C--SORT THE ARRAY
C
	CALL SORTB (NAME,6,ICOUNT,IORD,ILB,IRB)
C
C--PRINT THE NAMES AND NUMBERS IN IORD ORDER
C
	DO 18 I=1,ICOUNT
	IF (LINEN .LT. MAXLIN) GO TO 10		!**ADJUST PAGE LENGTH HERE
	IF (I .EQ. ICOUNT)GO TO 14		!DON'T PAGE FOR 1 LINE
	LINEN=4
	WRITE (6,6) HEADER,IPAGE
6	FORMAT (1H1//106A1,I4/)
	IPAGE=IPAGE+1
	IF (LOST) WRITE (6,8)
8	FORMAT (20X,'***TOO MANY VARIABLES, SOME NOT XREFED***')
	IF (LOST) LINEN=LINEN+1
C
C--COMPENSATE FOR NASTY HABIT OF SORB TO REVERSE ORDER OF IDENTICAL
C	ITEMS IN LIST.
C
10	IF (I .EQ. ICOUNT) GO TO 14		!NOT ON LAST ITEM
	J=I+1
	DO 12 N=1,6			!DOES THIS ENTRY MATCH NEXT ONE?
	IF (NAME(N,IORD(I)) .NE. NAME(N,IORD(J))) GO TO 14		!NO
12	CONTINUE
	IF (NUMBER(IORD(I),1) .LE. NUMBER(IORD(J),1)) GO TO 14
	N=IORD(J)			!IF THE STATEMENT NUMBERS WITH THIS
	IORD(J)=IORD(I)			!ENTRY COME AFTER THOSE WITH NEXT
	IORD(I)=N		!ENTRY, SWITCH ORDER OF ENTRIES IN IORD.
C
14	J=COUNT(IORD(I))
	WRITE (6,16) (NAME(N,IORD(I)),N=1,6),(NUMBER(IORD(I),N),
	1N=1,J)
16	FORMAT (/2X,6A1,' --',15I4:/11X,15I4)		!FITS 72 COL
	IF (COUNT(IORD(I)) .GT. 15) LINEN=LINEN+1
	LINEN=LINEN+2
18	CONTINUE
C
	WRITE (6,20)			!CLEAR THE LV11 PRINTER A LITTLE
20	FORMAT (50(1H /))
	RETURN
	END
C** SORTB ** SUBROUTINE TO SORT  CHARACTER ARRAYS INTO ALPHABETIC ORDER
C                                  RT11/DOS
C
C
C--SORTS A1 CHAR ARRAYS INTO ALPHABETICAL ORDER. IT IS JUST LIKE 
C-----'SORTW' EXCEPT THAT THE ARRAY OF CHAR MUST BE LOGICAL*1 
C--ARRAY 'IN' CONTAINS THE CHARACTERS TO BE SORTED. 'IORD' IS RETURNED W
C---THE SUBSCRIPS OF 'IN' SORTED INTO ALPHABAETICAL ORDER. A TO Z TO
C----0 TO 9. ARRAYS 'ILB' AND 'IRB' ARE WORKING ARRAYS. ARRAY 'IN'
C-----CONTAINS 'M' RECORDS AND 'N' CHARACTERS EACH.
C---THE CONTENTS OF 'IN' ARE NOT CHANGED BY THIS SORT.
C---UPON COMPLETION, SEQUENTIAL ELEMENTS OF 'IORD' CONTAIN
C-----THE (SECOND) SUBSCRIPT OF 'IN' IN ALPABETICLY INCREASING
C-----ORDER.
C---THIS IS A "MONKEY PUZZLE TREE" SORT AND IS VERY FAST.
C
	SUBROUTINE SORTB (IN, N, M, IORD, IRB, ILB)
C
	DIMENSION ILB(M), IRB(M), IORD(M)
	LOGICAL*1 IN(N,M)
C
	ILB(1)=0
	IRB(1)=0
	DO 38 I=2,M
	ILB(I)=0
	IRB(I)=0
22	J=1
24	DO 26 L=1,N
	IF (IN(L,I) .NE. IN(L,J)) GO TO 28
26	CONTINUE
28	CONTINUE
	IF (IN(L,I) .GT. IN(L,J)) GO TO 34
30	IF (ILB(J) .EQ. 0) GO TO 32
	J=ILB(J)
	GO TO 24
32	IRB(I)=-J
	ILB(J)=I
	GO TO 38
34	IF (IRB(J) .LE. 0) GO TO 36
	J=IRB(J)
	GO TO 24
36	IRB(I)=IRB(J)
	IRB(J)=I
38	CONTINUE
C--NOW STRIP THE MONKY PUZZLE TREE
	L=1
40	J=1
	GO TO 44
42	J=ILB(J)
44	IF (ILB(J) .GT. 0) GO TO 42
46	IORD(L)=J
	L=L+1
48	IF (IRB(J)) 52, 54, 50
50	J=IRB(J)
	GO TO 44
52	J=-IRB(J)
	GO TO 46
54	RETURN
	END
