C**********************************************************************
C
C
C	BIBCHANGE.FTN EST LE PROGRAMME QUI PERMET
C	DE MODIFIER EN REGROUPANT LES MOTS CLE SUR LES FICHES
C	BIBLIOGRAPHIQUES.
C
C***********************************************************************
	PROGRAM BIBCHA
	DIMENSION MOT(512),T(72,4),TD(72,4),P(6,5),PD(6,5),A(18,5)
	DIMENSION AD(18,5),EGO(30,12),ABB(40,42),BOOK(36),CLE(1000,12)
	DIMENSION PAGE(10),VOL(4),DAY(9),MOC(12),TAP(10),NMOT(512)
	DIMENSION MCLE(10),NCLE(10),DAYB(9)
	BYTE T,TD,P,PD,A,AD,EGO,ABB,BOOK,CLE,PAGE,VOL,DAY,MOC,TAP
	BYTE RPL,NSD,CR,DAYB
	COMMON /ASVAR/L,J
	OPEN (UNIT=2,NAME='DL1:[204,100]CODCLE.BIB',TYPE='OLD',
	2ACCESS='SEQUENTIAL',FORM='UNFORMATTED',SHARED)
	READ(2)NMC,NFZ,CLE
	OPEN (UNIT=7,NAME='DL1:[204,100]MOTCLE.BIB',TYPE='OLD',
	2ACCESS='DIRECT',SHARED,FORM='UNFORMATTED',
	3RECORDSIZE=256,ASSOCIATEVARIABLE=J)
	CALL ASSIGN(4,'DL1:[204,100]FICHES.BIB')
	CALL FDBSET(4,'OLD')
	DEFINE FILE 4(8000,256,U,L)
8100	TYPE 1902
1902	FORMAT('$Quelle MOT CLE supprime-t-on? <son numero>:')
	ACCEPT 1903,NMCSUP
1903	FORMAT(I5)
	TYPE 11902
11902	FORMAT('$Dans quel MOT CLE le reverse-t-on? <son numero>:')
	ACCEPT 1903,NMCREV
	READ(7'NMCSUP)MOT
	READ(7'NMCREV)NMOT
	TYPE 12000,(CLE(NMCSUP,I),I=1,12),MOT(1),(CLE(NMCREV,I),I=1,12),
     X	NMOT(1)
12000	FORMAT(' On reverse ',12A1,' (',I4,' fiches) dans ',12A1,
     x	' (',I4,' fiches).'//'$OK? <O ou [N]>:')
	ACCEPT 507,CR
507	FORMAT(A1)
	IF (CR.NE.'O') GO TO 8100
	IF (NMOT(1)+MOT(1).LE.511) GO TO 12030
	TYPE 12040
12040	FORMAT(' TROP de fiches, regroupement impossible...')
	GO TO 8100
12030	TYPE 12050,(CLE(NMCSUP,I),I=1,12)
12050	FORMAT('$Mot cle de remplacement pour ',12A1,' : ')
	ACCEPT 12060,(MOC(I),I=1,12)
12060	FORMAT(12A1)
	IN=MOT(1)
	DO 12002 I=1,IN
	NF=MOT(I+1)
	READ(4'NF)NSD,NF,NA,A,P,T,BOOK,VOL,PAGE,NAN,TAP,ICB,DAYB,MCLE
	IF (NSD.EQ.'S') GO TO 86
	READ(4'NF)NSD,NF,NA,A,AD,T
	NFB=NF+1
	READ(4'NFB)NSD,NF,P,PD,TD,BOOK,VOL,PAGE,NAN,TAP,ICB,DAYB,MCLE
86	DO 6110 NCL=1,10
	IF (MCLE(NCL).NE.NMCSUP) GO TO 6110
	MCLE(NCL)=NMCREV
6110	CONTINUE
214	IF(NSD.EQ.'D') GO TO 90
	WRITE(4'NF)NSD,NF,NA,A,P,T,BOOK,VOL,PAGE,NAN,TAP,ICM,DAY,MCLE
	GO TO 12002
90	WRITE(4'NF)NSD,NF,NA,A,AD,T
	WRITE(4'NFB)NSD,NF,P,PD,TD,BOOK,VOL,PAGE,NAN,TAP,ICM,DAY,MCLE
12002	CONTINUE
	JA=NMOT(1)+2
	JB=NMOT(1)+MOT(1)+1
	JC=2
	NMOT(1)=NMOT(1)+MOT(1)
	DO 12010 J=JA,JB
	NMOT(J)=MOT(JC)
	JC=JC+1
12010	CONTINUE
	DO 12020 J=1,512
	MOT(J)=0
12020	CONTINUE	
	WRITE(7'NMCSUP)MOT
	WRITE(7'NMCREV)NMOT
	DO 12070 I=1,12
	CLE(NMCSUP,I)=MOC(I)
12070	CONTINUE	
	REWIND 2
	WRITE(2)NMC,NFZ,CLE
	TYPE 8020,7,7,7
8020	FORMAT(/,3A1,'$Desirez vous d''autres changements <O ou [N]>?:')
	ACCEPT 507,CR
	IF (CR.EQ.'O') GO TO 8100
600	CLOSE (UNIT=2)
	CLOSE (UNIT=7)
	CLOSE (UNIT=4)
	STOP
	END