C**********************************************************************
C
C
C
C	BIBTRANSF.FTN EST LE PROGRAMME QUI PERMET
C	DE TRANFERER LE FICHES VENANT DU 8/E
C	 LES FICHES SONT AUTOMATIQUEMENT REPARTIES EN
C	FICHES SIMPLES OU DOUBLES.
C
C***********************************************************************
	PROGRAM TRANSF
	DIMENSION MOT(512),T(72,4),TD(72,4),P(6,5),PD(6,5),A(18,5)
	DIMENSION AD(18,5),HUIT(500),FNAME(25),BOOK(36),CLE(1000,12)
	DIMENSION PAGE(10),VOL(4),DAY(9),MOC(12,10),TAP(10),RPL(72)
	DIMENSION MCLE(10)
	BYTE T,TD,P,PD,A,AD,BOOK,CLE,PAGE,VOL,DAY,MOC,TAP
	BYTE NSD,CR,HUIT,RPL
	COMMON HUIT
	CALL DATE(DAY)
	ICM=0
	MIN=32
	TYPE 950
950	FORMAT('$NOM DE  FILE A TRANSFERER:')
	ACCEPT 953,NCHAR,FNAME
953	FORMAT(Q,25A1)
	FNAME(NCHAR+1)=0
	OPEN (UNIT=2,NAME='DL1:[204,100]CODCLE.BIB',TYPE='OLD',
	2ACCESS='SEQUENTIAL',FORM='UNFORMATTED',SHARED)
	OPEN (UNIT=7,NAME='DL1:[204,100]MOTCLE.BIB',TYPE='OLD',
	2ACCESS='DIRECT',SHARED,FORM='UNFORMATTED',
	3RECORDSIZE=256,ASSOCIATEVARIABLE=J)
	OPEN (UNIT=3,NAME=FNAME,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(2)NMC,NF,CLE
	IF(NF)87,87,86
87	REWIND 4
86	TYPE 404
404	FORMAT(//,' POUR FINIR LES AUTEURS, LE TITRE OU LES MOTS CLE,
	2TAPER RETURN',/)
	NY=500
9560	NF=NF+1
	DO 406 I=1,4
	DO 406 I1=1,72
	T(I1,I)=' '
	TD(I1,I)=' '
406	CONTINUE
	DO 370 I=1,10
370	MCLE(I)=0
	TYPE 1,NF
1	FORMAT(//,' FICHE #',I6,//)
4	FORMAT(I4)
	MCF=1
956	NY=NY+1
	CALL TEST(NY)
	IF (HUIT(NY).EQ.'!') GO TO 600
	IF (HUIT(NY).NE.'*') GO TO 956
	DO 9563 I=1,4
	NY=NY+1
	CALL TEST(NY)
9563	CONTINUE
	DECODE(1,4,HUIT(NY)) NA
	IF (NA.EQ.0) NA=10
957	NY=NY+1
	CALL TEST(NY)
	IF (HUIT(NY).NE.'^') GO TO 957
	DO 958 I=1,5
	DO 958 K=1,18
	NY=NY+1
	CALL TEST(NY)
	A(K,I)=HUIT(NY)
958	CONTINUE
	IF (NA.LE.5) GO TO 959
967	NY=NY+1
	CALL TEST(NY)
	IF (HUIT(NY).NE.'^') GO TO 967
	DO 968 I=1,5
	DO 968 K=1,18
	NY=NY+1
	CALL TEST(NY)
	AD(K,I)=HUIT(NY)
968	CONTINUE
959	NY=NY+1
	CALL TEST(NY)
	IF (HUIT(NY).NE.'%') GO TO 959
	DO 978 I=1,5
	DO 978 K=1,6
	NY=NY+1
	CALL TEST(NY)
	P(K,I)=HUIT(NY)
978	CONTINUE
	IF (NA.LE.5) GO TO 9790
977	NY=NY+1
	CALL TEST(NY)
	IF (HUIT(NY).NE.'%') GO TO 977
	DO 998 I=1,5
	DO 998 K=1,6
	NY=NY+1
	CALL TEST(NY)
	PD(K,I)=HUIT(NY)
998	CONTINUE
9790	I=1
979	NY=NY+1
	CALL TEST(NY)
	IF (HUIT(NY).NE.'@') GO TO 979
	DO 911 K=1,72
	NY=NY+1
	CALL TEST(NY)
	T(K,I)=HUIT(NY)
	IF ((I.EQ.1).AND.(K.EQ.1)) GO TO 910
	IF (I.EQ.1) GO TO 991
	IF (K.NE.1) GO TO 991
	DO 992 JK=72,1,-1
	IF (T(JK,I-1).EQ.' ') GO TO 992
	IF (T(JK,I-1).EQ.'.') GO TO 910
	GO TO 994
992	CONTINUE
	GO TO 994
991	IF (T(K-1,I).EQ.'.') GO TO 910
994	IF ((T(K,I).GE.'A').AND.(T(K,I).LE.'Z')) T(K,I)=T(K,I)+MIN
910	CONTINUE
911	CONTINUE
	I=I+1
	IF (I.EQ.5) GO TO 920
	GO TO 979
920	I=1
930	NY=NY+1
	CALL TEST(NY)
	IF (HUIT(NY).EQ.'&') GO TO 925
	IF (HUIT(NY).NE.'@') GO TO 930
	DO 940 K=1,72
	NY=NY+1
	CALL TEST(NY)
	TD(K,I)=HUIT(NY)
	IF ((I.EQ.1).AND.(K.EQ.1)) GO TO 940
	IF (I.EQ.1) GO TO 1991
	IF (K.NE.1) GO TO 1991
	DO 1992 JK=72,1,-1
	IF (TD(JK,I-1).EQ.' ') GO TO 1992
	IF (TD(JK,I-1).EQ.'.') GO TO 940
	GO TO 1994
1992	CONTINUE
	GO TO 1994
1991	IF (TD(K-1,I).EQ.'.') GO TO 940
1994	IF ((TD(K,I).GE.'A').AND.(TD(K,I).LE.'Z')) TD(K,I)=TD(K,I)+MIN
940	CONTINUE
	I=I+1
	GO TO 930
925	NY=NY+1
	CALL TEST(NY)
	NSD=HUIT(NY)
	DO 9410 I=1,36
	NY=NY+1
	CALL TEST(NY)
	BOOK(I)=HUIT(NY)
9410	CONTINUE
	DO 942 I=1,4
	NY=NY+1
	CALL TEST(NY)
	VOL(I)=HUIT(NY)
942	CONTINUE
	DO 943 I=1,2
	NY=NY+1
	CALL TEST(NY)
943	CONTINUE
	DO 944 I=1,10
	NY=NY+1
	CALL TEST(NY)
	PAGE(I)=HUIT(NY)
944	CONTINUE
	DO 945 I=1,2
	NY=NY+1
	CALL TEST(NY)
945	CONTINUE
	DO 946 I=1,6
	NY=NY+1
	CALL TEST(NY)
	TAP(I)=HUIT(NY)
946	CONTINUE
	DECODE(4,4,TAP) NAN
	DO 947 I=1,10
	NY=NY+1
	CALL TEST(NY)
	TAP(I)=HUIT(NY)
947	CONTINUE
948	NY=NY+1
	CALL TEST(NY)
	IF (HUIT(NY).NE.'#') GO TO 948
	DO 949 I=1,5
	DO 949 K=1,12
	NY=NY+1
	CALL TEST(NY)
	MOC(K,I)=HUIT(NY)
949	CONTINUE
931	NY=NY+1
	CALL TEST(NY)
	IF(HUIT(NY).NE.'#') GO TO 931
	DO 932 I=6,10
	DO 932 K=1,12
	NY=NY+1
	CALL TEST(NY)
	MOC(K,I)=HUIT(NY)
932	CONTINUE
	DO 10 I=1,NA
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)
10	CONTINUE
	TYPE 7
7	FORMAT(//,' TITRE',/)
	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)
640	TYPE 505
505	FORMAT(/,'$CORRECTIONS?<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
2	FORMAT(/' AUTEUR #',I3)
	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)
31	FORMAT(18A1)
	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)
6	FORMAT(6A1)
	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,=OLD=NEW= POUR CHANGER
	2 OLD EN NEW,OU BIEN RETAPER 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
8	FORMAT(72A1)
	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
	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)
100	FORMAT(36A1)
	IF (RPL(1).EQ.' ') GO TO 1930
	DO 626 IZ=1,36
626	BOOK(IZ)=RPL(IZ)
1930	TYPE 1901,VOL
1901	FORMAT(/,' VOLUME:',4A1,/'$:')
	ACCEPT 6,(RPL(KZ),KZ=1,6)
	IF (RPL(1).EQ.' ') GO TO 1913
	DO 1914 K=1,4
1914	VOL(K)=RPL(K)
1913	TYPE 1902,PAGE
1902	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 1904,NAN
1904	FORMAT(/,' ANNEE:',I4/'$:')
	ACCEPT 4,NAW
	IF (NAW.NE.0) NAN=NAW
	TYPE 1905,TAP
1905	FORMAT(/,' T-A-P:',10A1,/'$:')
	ACCEPT 103,(RPL(KZ),KZ=1,10)
103	FORMAT(10A1)
	IF (RPL(1).EQ.' ') GO TO 640
	DO 645 IZ=1,10
645	TAP(IZ)=RPL(IZ)
	GO TO 640
506	CONTINUE
	MCF=1
120	IF (MCF-10) 121,121,130
106	FORMAT(12A1)
121	IF (MOC(1,MCF).EQ.' ') GO TO 130
	MCF=MCF+1
	GO TO 120
130	MCF=MCF-1
131	DO 200 I=1,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 60,REP
	IF (REP.NE.'N') GO TO 210
	TYPE 110,I
110	FORMAT(/,'$MOT CLE #',I3,' :')
	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.0) 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 60,REP
	IF (REP.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'$ON LE GARDE?<O OU N> OU ON EN CHANGE LE LIBELLE?<C>:')
	ACCEPT 60,REP
	IF (REP.EQ.'N') GO TO 200
	IF (REP.EQ.'C') 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	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	CONTINUE
	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	REWIND 2
	WRITE(2)NMC,NF,CLE
	GO TO 9560
600	CONTINUE
	CLOSE (UNIT=2)
	CLOSE (UNIT=3)
	CLOSE (UNIT=7)
	CLOSE (UNIT=4)
	CALL EXIT
	END
C
C
C
C	SUBROUTINE POUR TESTER LA FIN DU BUFFER
C	ET RELIRE LE SUIVANT EVENTUELLEMENT.
C
C
	SUBROUTINE TEST(NY)
	DIMENSION HUIT(500)
	BYTE HUIT
	COMMON HUIT
	IF (NY.LE.500) RETURN
	READ(3,END=999)HUIT
999	NY=1
	RETURN
	END