C**********************************************************************
C
C
C	BIBCORREC.FTN EST LA SOUSROUTINE QUI PERMET
C	DE CORRIGER ET REINDEXER APRES SAUVETAGE LES FICHES
C	BIBLIOGRAPHIQUES.
C
C***********************************************************************
	SUBROUTINE CORRE(ICM,DAY)
	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,10),TAP(10),RPL(72)
	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
	COMMON /CHANG/NMC,CLE,MCLE,MOC,MOT
	OPEN (UNIT=1,NAME='DL1:[204,100]ABBAUT.BIB',TYPE='OLD',
	2ACCESS='SEQUENTIAL',FORM='UNFORMATTED',SHARED)
	READ(1)NABB,ABB,NEGO,EGO
	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 fiche voulez vous corriger? <son numero>:')
	ACCEPT 1903,NF
1903	FORMAT(I5)
	TYPE 404
404	FORMAT(//,' Lors des corrections,taper RETURN si
	2 ce qui est ecrit est correct.',/)
400	CONTINUE
	TYPE 1,NF
1	FORMAT(//,' FICHE #',I6,//)
4	FORMAT(I4)
	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 10 I=1,NA
2	FORMAT(/,' AUTEUR #',I3)
3	FORMAT(/,' AUTEUR #',I3,1X,18A1,1X,6A1)
	IF (I.LE.5) TYPE 3,I,(A(K,I),K=1,18),(P(K,I),K=1,6)
	IF (I.GT.5) TYPE 3,I,(AD(K,I-5),K=1,18),(PD(K,I-5),K=1,6)
31	FORMAT(18A1)
6	FORMAT(6A1)
10	CONTINUE
	TYPE 7
7	FORMAT(//,' TITRE',/)
8	FORMAT(72A1)
	I=1
18	TYPE 691,(T(K,I),K=1,72)
	IF (T(1,I).EQ.' ') GO TO 17
	I=I+1
	IF (I-4) 18,18,17
17	CONTINUE
	IF (NSD.EQ.'S') GO TO 701
	I=1
19	TYPE 691,(TD(K,I),K=1,72)
	IF (TD(1,I).EQ.' ') GO TO 701
	I=I+1
	IF (I-4) 19,19,701
701	TYPE 9,BOOK,VOL,PAGE,NAN
9	FORMAT(/,' ',36A1,';',4A1,':',10A1,'(',I4,')')
	TYPE 105,TAP
105	FORMAT(/,' T-A-P:',10A1)
	TYPE 700,DAYB,ICB
700	FORMAT(/,' FICHE ENTREE OU MODIFIEE LE ',9A1,
	2' SOUS L''UIC NUMERO [ 204,',O3,' ]')
100	FORMAT(36A1)
103	FORMAT(10A1)
640	TYPE 505
505	FORMAT(/,'$Y a t-il des corrections a faire?<O ou [N]>:')
	ACCEPT 507,CR
	IF (CR.NE.'O') GO TO 506
500	TYPE 502
502	FORMAT(//,' **** CORRECTIONS ****',//)
508	TYPE 503
503	FORMAT(' A pour les auteurs'/' T pour le titre'/' R pour 
	2 les references'/'$RETURN pour verifier le tout:')
	READ(5,507,ERR=508)CR
507	FORMAT(A1)
	IF (CR.EQ.' ') GO TO 1500
	IF (CR.NE.'A') GO TO 255
1500	TYPE 91,NF,NA
91	FORMAT(//,' FICHE #',I6,//,' NOMBRE D''AUTEURS:',I5/'$:')
	ACCEPT 4,NAW
	IF (NAW.NE.0) NA=NAW
	DO 941 I=1,NA
	TYPE 2,I
	IF (I.LE.5) TYPE 93,(A(K,I),K=1,18)
	IF (I.GT.5) TYPE 93,(AD(K,I-5),K=1,18)
93	FORMAT(//,' NOM:',18A1,/'$:')
	ACCEPT 31,(RPL(KZ),KZ=1,18)
	IF (RPL(1).EQ.' ') GO TO 610
	DO 611 IZ=1,18
	IF (I.LE.5) A(IZ,I)=RPL(IZ)
	IF (I.GT.5) AD(IZ,I-5)=RPL(IZ)
611	CONTINUE
610	IF (I.LE.5) TYPE 95,(P(K,I),K=1,6)
	IF (I.GT.5) TYPE 95,(PD(K,I-5),K=1,6)
95	FORMAT(/,' PRENOMS:',6A1,/'$:')
	ACCEPT 6,(RPL(KZ),KZ=1,6)
	IF (RPL(1).EQ.' ') GO TO 941
	DO 612 K=1,6
	IF (I.LE.5) P(K,I)=RPL(K)
	IF (I.GT.5) PD(K,I-5)=RPL(K)
612	CONTINUE
941	CONTINUE
255	IF (CR.EQ.' ') GO TO 1501
	IF (CR.NE.'T') GO TO 256
1501	TYPE *,'TITRE:RETURN pour valider'
	TYPE *,'=Old=New= pour changer Old en New ,
	2ou bien retaper toute la ligne'
	TYPE *,'ou encore ! pour effacer toute la ligne.'
691	FORMAT(1X,72A1)
	I=1
918	IF (I.LE.4) TYPE 691,(T(K,I),K=1,72)
	IF (I.GT.4) TYPE 691,(TD(K,I-4),K=1,72)
	ACCEPT 8,RPL
	IF (RPL(1).NE.'=') GO TO 1110
	IF (RPL(1).NE.'!') GO TO 8010
	DO 8011 KJ=1,72
8011	RPL(KJ)=' '
	GO TO 8012
8010	DO 1300 KJ=2,36
	IF (RPL(KJ).EQ.'=') GO TO 1320
1300	CONTINUE
1320	LO=KJ-2
	KJ=KJ+1
	DO 1330 KL=KJ,36
	IF (RPL(KL).EQ.'=') GO TO 1340
1330	CONTINUE
1340	LN=KL-KJ
	LON=71-LO
	LOL=LO-1
	LNK=LN-1
	LNL=LO+3
	DO 1115 K=1,LON
	IF (I-4) 1120,1120,1125
1120	DO 1121 KI=0,LOL
1121	RPL(37+KI)=T(K+KI,I)
	GO TO 1127
1125	DO 1126 KI=0,LOL
1126	RPL(37+KI)=TD(K+KI,I-4)
1127	DO 1116 KI=1,LO
	IF (RPL(KI+1).NE.RPL(36+KI)) GO TO 1115
1116	CONTINUE
	GO TO 1130
1115	CONTINUE
	GO TO 918
1130	LNN=LN-LO
	KJ=K+LO
	IF (LNN) 1400,1600,1700
1400	DO 1450 KI=KJ,72
	KL=KI+LNN
	IF (KL.GT.72) GO TO 1455
	IF (I.LE.4) T(KL,I)=T(KI,I)
	IF (I.GT.4) TD(KL,I-4)=TD(KI,I-4)
1450	CONTINUE
1455	GO TO 1600
1700	DO 1460 KI=72,KJ,-1
	KL=KI+LNN
	IF (KL.GT.72) GO TO 1460
	IF (I.LE.4) T(KL,I)=T(KI,I)
	IF (I.GT.4) TD(KL,I-4)=TD(KI,I-4)
1460	CONTINUE
1600	IF (I-4) 1135,1135,1137
1135	DO 1136 KI=0,LNK
1136	T(K+KI,I)=RPL(LNL+KI)
	GO TO 918
1137	DO 1138 KI=0,LNK
1138	TD(K+KI,I-4)=RPL(LNL+KI)
	GO TO 918
1110	IF (I.LE.4) GO TO 1000
	IF ((RPL(1).EQ.' ').AND.(TD(1,I-4).EQ.' ')) GO TO 917
	GO TO 1100
1000	IF ((RPL(1).EQ.' ').AND.(T(1,I).EQ.' ')) GO TO 917
1100	IF (RPL(1).EQ.' ') GO TO 620
8012	DO 615 IZ=1,72
	IF (I.LE.4) T(IZ,I)=RPL(IZ)
	IF (I.GT.4) TD(IZ,I-4)=RPL(IZ)
615	CONTINUE
620	I=I+1
	IF (I-8)918,918,917
917	CONTINUE
256	IF (CR.EQ.' ') GO TO 1502
	IF (CR.NE.'R') GO TO 640
1502	TYPE 99,BOOK
99	FORMAT(/,' JOURNAL:',36A1,/'$:')
	ACCEPT 100,(RPL(KZ),KZ=1,36)
	IF (RPL(1).EQ.' ') GO TO 930
	DO 626 IZ=1,36
626	BOOK(IZ)=RPL(IZ)
	DO 900 I=1,NABB
	DO 911 K=1,6
	IF (BOOK(K).NE.ABB(I,K)) GO TO 900
911	CONTINUE
	GO TO 910
900	CONTINUE
	GO TO 930
910	DO 920 K=1,36
920	BOOK(K)=ABB(I,K+6)
930	TYPE 901,VOL
901	FORMAT(/,' VOLUME:',4A1,/'$:')
	ACCEPT 6,(RPL(KZ),KZ=1,6)
	IF (RPL(1).EQ.' ') GO TO 913
	DO 914 K=1,4
914	VOL(K)=RPL(K)
913	TYPE 902,PAGE
902	FORMAT(/,' PAGES:',10A1,/'$:')
	ACCEPT 103,(RPL(KZ),KZ=1,10)
	IF (RPL(1).EQ.' ') GO TO 630
	DO 631 K=1,10
631	PAGE(K)=RPL(K)
630	TYPE 904,NAN
904	FORMAT(/,' ANNEE:',I4/'$:')
	ACCEPT 4,NAW
	IF (NAW.NE.0) NAN=NAW
	TYPE 905,TAP
905	FORMAT(/,' T-A-P:',10A1,/'$:')
	ACCEPT 103,(RPL(KZ),KZ=1,10)
	IF (RPL(1).EQ.' ') GO TO 640
	DO 645 IZ=1,10
645	TAP(IZ)=RPL(IZ)
	GO TO 640
506	CONTINUE
	MCF=0
	DO 6100 NCL=1,10
6100	NCLE(NCL)=0
	DO 6110 NCL=1,10
	IF (MCLE(NCL).EQ.0) GO TO 6110
	MCF=MCF+1
	NCLE(MCF)=MCLE(NCL)
6110	CONTINUE
	DO 6120 NCL=1,10
6120	MCLE(NCL)=NCLE(NCL)
360	IF (MCF.EQ.0) GO TO 363
	TYPE 355
355	FORMAT(//,' MOTS CLE DEJA RENTRES:')
	DO 357 NCL=1,MCF
	TYPE 358,NCL,(CLE(MCLE(NCL),K),K=1,12)
358	FORMAT(1X,I3,1X,12A1)
357	CONTINUE
363	TYPE 362
362	FORMAT(/,' Desirez vous ajouter des mots cles<A>,en supprimer
	2<S>,en remplacer<R>,'/'$ou bien laisser en l''etat<[L]>?:')
	ACCEPT 507,CR
	IF (CR.EQ.'A') CALL AJOUT(MCF,NF)
	IF ((CR.EQ.'S').OR.(CR.EQ.'R')) CALL SUPPR(MCF,NF)
	IF (CR.EQ.'R') CALL AJOUT(MCF,NF)
	IF ((CR.EQ.'A').OR.(CR.EQ.'R').OR.(CR.EQ.'S')) GO TO 363
60	FORMAT(A3)
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 951
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
951	REWIND 2
	WRITE(2)NMC,NFZ,CLE
	TYPE 8020
8020	FORMAT(/,'$Desirez vous corriger une autre fiches<O ou [N]>?:')
	ACCEPT 507,CR
	IF (CR.EQ.'O') GO TO 8100
600	CLOSE (UNIT=1)
	CLOSE (UNIT=2)
	CLOSE (UNIT=7)
	CLOSE (UNIT=4)
	RETURN
	END