C**********************************************************************
C
C
C	BIBFICHES.FTN EST LA SOUSROUTINE QUI PERMET
C	DE RENTRER ET CORRIGER  AVANT SAUVETAGE LES FICHES
C	BIBLIOGRAPHIQUES.
C	 LES FICHES SONT AUTOMATIQUEMENT REPARTIES EN
C	FICHES SIMPLES OU DOUBLES.
C
C***********************************************************************
	SUBROUTINE FICHE(ICM,DAY,NFDA,NFDB)
	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),NDX(255),IFRPL(50),IFK(50)
	BYTE T,TD,P,PD,A,AD,EGO,ABB,BOOK,CLE,PAGE,VOL,DAY,MOC,TAP
	BYTE RPL,NSD,CR
	COMMON /ASVAR/L,J
	COMMON /RP/NRPL,IFRPL
	OPEN (UNIT=1,NAME='DL1:[204,100]ABBAUT.BIB',TYPE='OLD',
	2ACCESS='SEQUENTIAL',FORM='UNFORMATTED',SHARED)
	OPEN (UNIT=2,NAME='DL1:[204,100]CODCLE.BIB',TYPE='OLD',
	2ACCESS='SEQUENTIAL',FORM='UNFORMATTED',SHARED)
	OPEN (UNIT=6,NAME='DL1:[204,100]FICHKILL.BIB',TYPE='OLD',
	2ACCESS='SEQUENTIAL',FORM='UNFORMATTED',SHARED)
	READ(6)NFK,IFK
	OPEN (UNIT=7,NAME='DL1:[204,100]MOTCLE.BIB',TYPE='OLD',
	2ACCESS='DIRECT',SHARED,FORM='UNFORMATTED',
	3RECORDSIZE=256,ASSOCIATEVARIABLE=J)
	OPEN (UNIT=3,NAME='DL1:[204,100]NONINDX.BIB',TYPE='OLD',
	2SHARED,FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
	CALL ASSIGN(4,'DL1:[204,100]FICHES.BIB')
	CALL FDBSET(4,'OLD')
	DEFINE FILE 4(8000,256,U,L)
	READ(1)NABB,ABB,NEGO,EGO
	READ(2)NMC,NF,CLE
	READ(3)NX,NDX
	IF(NF)87,87,86
87	REWIND 4
86	TYPE 404
404	FORMAT(//,' Lorsque vous n''avez plus rien a entrer,
	2taper RETURN',/)
	NFDA=NF+1
400	NF=NF+1
	DO 406 I=1,10
	DO 406 I1=1,12
	MOC(I1,I)=' '
406	CONTINUE
	DO 370 I=1,10
370	MCLE(I)=0
	TYPE 1,NF
1	FORMAT(//,' FICHE #',I6,//)
4	FORMAT(I4)
	NA=1
	NSD='S'
	DO 402 K=1,5
	DO 403 I=1,6
	P(I,K)=' '
403	PD(I,K)=' '
	DO 402 I=1,18
	A(I,K)=' '
	AD(I,K)=' '
402	CONTINUE
	MCF=1
	NA=1
15	I=NA
	TYPE 2,I
2	FORMAT(/,' AUTEUR #',I3)
	TYPE 3
3	FORMAT(//,'$NOM:')
	IF (NA.LE.5) ACCEPT 31,(A(K,I),K=1,18)
	IF (NA.GT.5) ACCEPT 31,(AD(K,I-5),K=1,18)
	IF (NA.LE.5) RPL(1)=A(1,I)
	IF (NA.GT.5) RPL(1)=AD(1,I-5)
	IF (RPL(1).EQ.' ') GO TO 10
31	FORMAT(18A1)
	DO 800 K=1,NEGO
	DO 801 K1=1,12
	IF(NA.LE.5) GO TO 70
	IF(AD(K1,I-5).NE.EGO(K,K1)) GO TO 800
	GO TO 801
70	IF (A(K1,I).NE.EGO(K,K1)) GO TO 800
801	CONTINUE
	GO TO 810
800	CONTINUE
	GO TO 830
810	DO 811 K=1,12
	IF (NA.LE.5) MOC(K,MCF)=A(K,I)
	IF (NA.GT.5) MOC(K,MCF)=AD(K,I-5)
811	CONTINUE
	MCF=MCF+1
830	TYPE 5
5	FORMAT(/,'$PRENOMS:')
	IF (NA.LE.5) ACCEPT 6,(P(K,I),K=1,6)
6	FORMAT(6A1)
	IF (NA.GT.5) ACCEPT 6,(PD(K,I-5),K=1,6)
	NA=NA+1
	GO TO 15
10	CONTINUE
	NA=NA-1
	IF(NA.GT.5) NSD='D'
	DO 92 I=1,4
	DO 92 K=1,72
	T(K,I)=' '
92	TD(K,I)=' '
	TYPE 7
7	FORMAT(//,' TITRE en 4 lignes'/' Si plus de 4 lignes repondre
	2 * a la question JOURNAL:',/)
8	FORMAT(72A1)
	I=1
18	ACCEPT 8,(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
	TYPE 9
9	FORMAT(/,'$JOURNAL:')
	ACCEPT 100,BOOK
100	FORMAT(36A1)
	IF(BOOK(1).NE.'*') GO TO 701
	NSD='D'
	I=1
19	ACCEPT 8,(TD(K,I),K=1,72)
	IF (TD(1,I).EQ.' ') GO TO 17
	I=I+1
	IF (I-4) 19,19,17
701	DO 700  I=1,NABB
	DO 711 K=1,6
	IF(BOOK(K).NE.ABB(I,K)) GO TO 700
711	CONTINUE
	GO TO 710
700	CONTINUE
	GO TO 730
710	DO 720 K=1,36
720	BOOK(K)=ABB(I,K+6)
730	TYPE 101
101	FORMAT(/,'$VOLUME:')
	ACCEPT 32,VOL
32	FORMAT(4A1)
	TYPE 102
102	FORMAT(/,'$PAGES:')
	ACCEPT 103,PAGE
103	FORMAT(10A1)
	TYPE 104
104	FORMAT(/,'$ANNEE:')
	ACCEPT 4,NAN
	TYPE 105
105	FORMAT(/,'$T-A-P:')
	ACCEPT 103,TAP
	NFTM=0
	IF ((NSD.EQ.'D').OR.(NFK.EQ.0)) GO TO 640
	NFTM=NF-1
	NF=IFK(NFK)
	IFK(NFK)=0
	NFK=NFK-1
	NRPL=NRPL+1
	IFRPL(NRPL)=NF
	TYPE 8030,NF
8030	FORMAT(/,' ATTENTION,cette fiche remplace la fiche #',I5,
	2' qui avait ete supprimee!',//)
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 8010
	DO 8011 KJ=1,72
8011	RPL(KJ)=' '
	GO TO 8013
8010	IF (RPL(1).NE.'=') GO TO 1110
	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
8013	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
	NCL=0
	INIMCF=1
120	IF (MCF-10) 121,121,130
121	TYPE 110,MCF
110	FORMAT(/,'$MOT CLE #',I3,' :')
	ACCEPT 106,(MOC(K,MCF),K=1,12)
106	FORMAT(12A1)
	IF (MOC(1,MCF).EQ.' ') GO TO 130
	MCF=MCF+1
	NCL=NCL+1
	GO TO 120
130	MCF=MCF-1
	IF (NCL.NE.0) GO TO 131
	NX=NX+1
	NDX(NX)=NF
	IF (MCF)214,214,131
131	DO 200 I=INIMCF,MCF
205	IF (MOC(1,I).GE.'A') GO TO 207
	KIZ=0
	DO 208 KI=1,12
	IF (MOC(KI,I).EQ.' ') GO TO 209
	KIZ=KIZ+1
	RPL(KI)=MOC(KI,I)
208	CONTINUE
209	DECODE(KIZ,206,RPL) K
206	FORMAT(I12)
	TYPE 217,(CLE(K,KI),KI=1,12)
	ACCEPT 507,CR
	IF (CR.NE.'N') GO TO 210
	TYPE 110,I
	ACCEPT 106,(MOC(KI,I),KI=1,12)
	GO TO 205
207	CONTINUE
	IF (NMC) 202,202,204
204	K=0
201	K=K+1
	NON=0
	DO 211 KI=1,12
	IF(MOC(KI,I).NE.CLE(K,KI)) NON=NON+1
211	CONTINUE
	IF (NON.GT.2) GO TO 213
	IF (NON.EQ.0) GO TO 210
	TYPE 217,(CLE(K,KI),KI=1,12)
217	FORMAT(//'$Vous voulez dire ',12A1,' ? <[O] ou N>:')
	ACCEPT 507,CR
	IF (CR.EQ.'N') GO TO 201
	DO 218 KI=1,12
218	MOC(KI,I)=CLE(K,KI)
	GO TO 210
213	IF (K-NMC) 201,202,202
202	TYPE 203,(MOC(KI,I),KI=1,12)
203	FORMAT(//,1H$,12A1,' est un nouveau mot cle !',//
	2'$le garde-t-on? <[O] ou N>:')
	ACCEPT 507,CR
	IF (CR.EQ.'N') GO TO 220
60	FORMAT(A3)
	NMC=NMC+1
	DO 65 KI=1,12
65	CLE(NMC,KI)=MOC(KI,I)
	MOT(1)=1
	MOT(2)=NF
	WRITE(7'NMC)MOT
	MCLE(I)=NMC
	GO TO 230
220	TYPE 110,I
	ACCEPT 106,(MOC(KI,I),KI=1,12)
	GO TO 204
210	READ(7'K)MOT
	MOT(1)=MOT(1)+1
	IN=MOT(1)+1
	MOT(IN)=NF
	WRITE(7'K) MOT
	MCLE(I)=K
230	CONTINUE
200	CONTINUE
214	TYPE 6001
6001	FORMAT('$Voulez vous ajouter encore des mots cles <O ou [N]>:')
	ACCEPT 507,CR
	IF (CR.NE.'O') GO TO 6002
	MCF=MCF+1
	INIMCF=MCF
	GO TO 120
6002	IF(NSD.EQ.'D') GO TO 90
	WRITE(4'NF)NSD,NF,NA,A,P,T,BOOK,VOL,PAGE,NAN,TAP,ICM,DAY,MCLE
	NFDB=NF
	GO TO 951
90	WRITE(4'NF)NSD,NF,NA,A,AD,T
	NFDB=NF
	NFDC=NF+1
	WRITE(4'NFDC)NSD,NF,P,PD,TD,BOOK,VOL,PAGE,NAN,TAP,ICM,DAY,MCLE
	NF=NF+1
951	IF (NFTM.GT.0) NF=NFTM
	REWIND 2
	WRITE(2)NMC,NF,CLE
	REWIND 3
	WRITE(3)NX,NDX
	REWIND 6
	WRITE(6)NFK,IFK
	TYPE 6077,NF
6077	FORMAT(' La fiche # ',I5,' est sauvee.'/)
	TYPE 300
300	FORMAT(//,'$Continue-t-on?<[O] ou N>:')
	ACCEPT 507,CR
	IF (CR.NE.'N') GO TO 400
600	CLOSE (UNIT=1)
	CLOSE (UNIT=2)
	CLOSE (UNIT=3)
	CLOSE (UNIT=7)
	CLOSE (UNIT=6)
	CLOSE (UNIT=4)
	RETURN
	END