C**********************************************************************
C
C
C	BIBSORTIE.FTN EST LA SOUSROUTINE QUI CREE LA FILE
C	SY:*.LST OU * EST LE MEME NOM QUE CELUI DE LA FILE
C	DES REFERENCES.
C
C**********************************************************************
	SUBROUTINE SORTI(NBA,LA,NOMA,O,COM)
	DIMENSION LA(512),NOMA(30),O(25),COM(132),AUT(36)
	DIMENSION T(72,4),TD(72,4),P(6,5),PD(6,5),A(18,5)
	DIMENSION AD(18,5),BOOK(36)
	DIMENSION PAGE(10),VOL(4),DAY(9),TAP(10)
	DIMENSION MCLE(10),PRE(8)
	BYTE T,TD,P,PD,A,AD,BOOK,PAGE,VOL,DAY,TAP,NSD,COM,NOMA,AUT,PRE
	COMMON /ASVAR/L
	CALL ASSIGN(4,'DL1:[204,100]FICHES.BIB')
	CALL FDBSET(4,'OLD')
	DEFINE FILE 4(8000,256,U,L)
	OPEN (UNIT=6,NAME=NOMA,DISP='PRINT',TYPE='NEW')
	L=1
	SP=' '
	SUBL='-'
96	LIN=0
	KP=1
	PRINT 80,(COM(KI),KI=1,62),KP
80	FORMAT(1H1,//1X,62A1,T64,'PAGE ',I3)
	LIN=LIN+3
	KIZER=0
	DO 1000 KI=1,NBA
	IF (LA(KI).EQ.0) GO TO 1000
	KIZER=KIZER+1
45	IF (LIN) 43,43,44
43	KP=KP+1
	PRINT 46,KP
46	FORMAT(1H1//,T64,'PAGE 'I6)
	LIN=LIN+3
44	IF (LIN.LE.53) GO TO 70
	DO 71 ILN=LIN,60
	PRINT 40
71	CONTINUE
	PRINT 82
82	FORMAT(T65,'.../...',/)
	LIN=0
	GO TO 45
70	PRINT 42
	LIN=LIN+2
42	FORMAT(1X,/)
	NI=LA(KI)
	READ(4'NI)NSD,NF,NA,A,P,T,BOOK,VOL,PAGE,NAN,TAP,ICB,DAY,MCLE
	IF (NSD.EQ.'S') GO TO 86
	READ(4'NI)NSD,NF,NA,A,AD,T
	NFB=NI+1
	READ(4'NFB)NSD,NF,P,PD,TD,BOOK,VOL,PAGE,NAN,TAP,ICB,DAY,MCLE
86	CONTINUE
	DO 500 KO=1,25
	IF (O(KO).EQ.'N') GO TO 510
	IF (O(KO).EQ.'A1') GO TO 515
	IF (((O(KO-1).EQ.'A1').AND.(O(KO+1).EQ.'P1')).OR.
	2((O(KO-1).EQ.'P1').AND.(O(KO+1).EQ.'A1'))) GO TO 516
	IF (((O(KO-1).EQ.'AF').AND.(O(KO+1).EQ.'PF')).OR.
	2((O(KO-1).EQ.'PF').AND.(O(KO+1).EQ.'AF'))) GO TO 516
	IF ((O(KO+1).EQ.'AP').OR.(O(KO+1).EQ.'PA')) GO TO 518
	IF ((O(KO-1).EQ.'AP').OR.(O(KO-1).EQ.'PA')) GO TO 519
	IF (O(KO).EQ.'P1') GO TO 520
	IF (O(KO).EQ.'AP') GO TO 525
	IF (O(KO).EQ.'PA') GO TO 530
	IF (O(KO).EQ.'AF') GO TO 531
	IF (O(KO).EQ.'PF') GO TO 533
	IF (((O(KO-1).EQ.'AF').OR.(O(KO-1).EQ.'PF')).AND.
	2((O(KO+1).NE.'AF').OR.(O(KO+1).NE.'PF'))) GO TO 516
	IF (O(KO).EQ.'J') GO TO 535
	IF (O(KO).EQ.'V') GO TO 540
	IF (O(KO).EQ.'P') GO TO 545
	IF (O(KO).EQ.'AN') GO TO 550
	IF (O(KO).EQ.'T') GO TO 555
	IF (O(KO).EQ.'SJ') GO TO 560
	IF (O(KO).EQ.SP) GO TO 1000
	GO TO 500
510	SEP=O(KO+1)
	KO=KO+1
	PRINT 1010,KIZER,SEP
	GO TO 500
516	SEPA=O(KO)
521	PRINT 30,SEPA
	GO TO 500
518	IF (NA.NE.1) GO TO 501
	KO=KO+5
	GO TO 500
501	IF (NA.NE.2) GO TO 502
	KO=KO+2
	SEPC=O(KO)
	PRINT 31,SEPC
	GO TO 500
502	SEPB=O(KO)
	PRINT 30,SEPB
	GO TO 500
519	IF (NA.EQ.1) GO TO 500
	IF ((NA.EQ.4).OR.(NA.EQ.7).OR.(NA.EQ.10)) GO TO 503
504	SEPC=O(KO)
	PRINT 31,SEPC
	GO TO 500
503	PRINT 40
	LIN=LIN+1
	GO TO 504
515	AUT(19)=' '
	AUT(20)=' '
	DO 1 J=1,18
1	AUT(J)=A(J,1)
	CALL WAT(AUT)
	GO TO 500
30	FORMAT(1H+,1X,A1,1X$)
31	FORMAT(1H+,1X,A3,1X$)
520	AUT(7)=' '
	AUT(8)=' '
	DO 3 J=1,6
3	AUT(J)=P(J,1)
	CALL WAT(AUT)
	GO TO 500
525	IF (NA.LE.2) GO TO 500
	NAM=NA-1
	DO 1500 IA=2,NAM
	AUT(19)=' '
	AUT(20)=' '
	DO 4 J=1,18
	IF (IA.LE.5) AUT(J)=A(J,IA)
	IF (IA.GT.5) AUT(J)=AD(J,IA-5)
4	CONTINUE
	PRE(7)=' '
	PRE(8)=' '
	DO 5 J=1,6
	IF (IA.LE.5) PRE(J)=P(J,IA)
	IF (IA.GT.5) PRE(J)=PD(J,IA-5)
5	CONTINUE
	IF ((IA.EQ.4).OR.(IA.EQ.7)) GO TO 20
	CALL WAT(AUT)
	GO TO 1501
20	PRINT 40
	LIN=LIN+1
	CALL WAT(AUT)
1501	CONTINUE
	IF (IA.EQ.(NA-2)) GO TO 526
	PRINT 30,SEPA
	CALL WAT(PRE)
	PRINT 30,SEPB
	GO TO 1500
526	PRINT 30,SEPA
	CALL WAT(PRE)
1500	CONTINUE
	GO TO 500
530	IF (NA.LE.2) GO TO 500
	NAM=NA-1
	DO 1510 IA=2,NAM
	AUT(19)=' '
	AUT(20)=' '
	DO 14 J=1,18
	IF (IA.LE.5) AUT(J)=A(J,IA)
	IF (IA.GT.5) AUT(J)=AD(J,IA-5)
14	CONTINUE
	PRE(7)=' '
	PRE(8)=' '
	DO 15 J=1,6
	IF (IA.LE.5) PRE(J)=P(J,IA)
	IF (IA.GT.5) PRE(J)=PD(J,IA-5)
15	CONTINUE
	IF ((IA.EQ.4).OR.(IA.EQ.7)) GO TO 50
40	FORMAT(1X)
	CALL WAT(PRE)
	GO TO 51
50	PRINT 40
	LIN=LIN+1
	CALL WAT(PRE)
51	PRINT 30,SEPA
	CALL WAT(AUT)
	IF (IA.EQ.(NA-1)) GO TO 500
	PRINT 30,SEPB
1510	CONTINUE
	GO TO 500
531	IF (NA.EQ.1) GO TO 500
	AUT(19)=' '
	AUT(20)=' '
	DO 6 J=1,18
	IF (NA.LE.5) AUT(J)=A(J,NA)
	IF (NA.GT.5) AUT(J)=AD(J,NA-5)
6	CONTINUE
	CALL WAT(AUT)
	GO TO 500
533	IF (NA.EQ.1) GO TO 500
	PRE(7)=' '
	PRE(8)=' '
	DO 7 J=1,6
	IF(NA.LE.5) PRE(J)=P(J,NA)
	IF (NA.GT.5) PRE(J)=PD(J,NA-5)
7	CONTINUE
	CALL WAT(PRE)
	GO TO 500
555	DO 18 I=1,4
	IF (T(1,I).EQ.' ') GO TO 17
	PRINT 691,(T(K,I),K=1,72)
	LIN=LIN+1
18	CONTINUE
17	IF (NSD.EQ.'S') PRINT 40
	IF (NSD.EQ.'S') LIN=LIN+1
	IF (NSD.EQ.'S') GO TO 500
	DO 19 I=1,4
	IF (TD(1,I).EQ.' ') GO TO 171
	PRINT 691,(TD(K,I),K=1,72)
	LIN=LIN+1
19	CONTINUE
171	PRINT 40
	LIN=LIN+1
	GO TO 500
691	FORMAT(1X,72A1)
535	IF (BOOK(1).EQ.' ') GO TO 500
	CALL WAT(BOOK)
537	SEPA=O(KO+1)
	GO TO 521
1010	FORMAT(1H+,I3,A2$)
540	IF (VOL(1).EQ.' ') GO TO 500
	AUT(1)=VOL(1)
	AUT(2)=VOL(2)
	AUT(3)=VOL(3)
	AUT(4)=VOL(4)
	AUT(5)=' '
	AUT(6)=' '
	CALL WAT(AUT)
	GO TO 537
545	DO 8 J=1,10
8	AUT(J)=PAGE(J)
	AUT(11)=' '
	AUT(12)=' '
	CALL WAT(AUT)
	GO TO 537
550	PRINT 9,NAN
9	FORMAT(1H+,I4$)
	GO TO 537
560	NS=0
	IF (BOOK(1).EQ.' ') GO TO 500
	DO 900 KS=1,35
	IF ((BOOK(KS).EQ.' ').AND.(BOOK(KS+1).EQ.' ')) GO TO 910
	NS=NS+1
900	CONTINUE
910	PRINT 1020,(SUBL,KLS=1,NS)
	LIN=LIN+1
1020	FORMAT(1X,/,1H+,36A1)
500	CONTINUE
1000	CONTINUE
	DO 77 ILN=LIN,60
	PRINT 40
77	CONTINUE
	PRINT 84
84	FORMAT(T65,'FIN/END',/)
	CLOSE (UNIT=4)
	CLOSE (UNIT=6,DISP='PRINT')
	RETURN
	END
C
C
C
C
C
	SUBROUTINE WAT(STRING)
C
C
C	SUBROUTINE WAT POUR ECRIRE EN SUPRIMANT LES BLANCS.
C
C
C
	DIMENSION STRING(36)
	BYTE STRING
	DO 100 I=1,35
	IF ((STRING(I).EQ.' ').AND.(STRING(I+1).EQ.' ')) GO TO 110
	PRINT 120,STRING(I)
100	CONTINUE
120	FORMAT(1H+,A1,$)
110	RETURN
	END