C**********************************************************************
C
C
C	BIBTAPREQ.FTN EST LA SOUROUTINE QUI CREE LA FILE
C	SY:LP.LST POUR ENVOYER DE DEMANDES DE TIRE-A-PART.
C
C**********************************************************************
	SUBROUTINE TAPRE(DAY)
	DIMENSION LA(512),NOMA(30)
	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)
	BYTE T,TD,P,PD,A,AD,BOOK,PAGE,VOL,DAY,NSD,NOMA
	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='SY:LP.LST',DISP='PRINT',TYPE='NEW')
	DO 71 I=1,512
	TYPE 72
72	FORMAT('$NUMERO DE LA FICHE A DEMANDER<fin=0>:')
	ACCEPT 73,LA(I)
73	FORMAT(I5)
	IF (LA(I).EQ.0) GO TO 74
71	CONTINUE
74	NBA=I-1
	TYPE 75
75	FORMAT(//'$NOM DU DEMANDEUR:')
	ACCEPT 76,NCHA,NOMA
76	FORMAT(Q,30A1)
	DO 77 KI=1,NBA
	NI=LA(KI)
	READ(4'NI)NSD,NF,NA,A,P,T,BOOK,VOL,PAGE,NAN
	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
86	CONTINUE
	PRINT 600
600	FORMAT(1H1,T35,'COUPER ICI')
	PRINT 601
601	FORMAT(T2,80(1H_),T90,'DEMANDE DE TIRE-A-PART')
	PRINT 605
605	FORMAT(T2,1H|,T80,1H|)
	PRINT 604,DAY,DAY,NI
604	FORMAT(T2,1H|,T50,'Gif-sur-Yvette ',9A1,T80,1H|,
	2T85,'LE ',9A1,' JE DEMANDE LA FICHE NUMER0 ',I5)
	PRINT 605
	PRINT 605
	PRINT 606,(A(KF,1),KF=1,18)
606	FORMAT(T2,1H|,T10,'Dear Dr ',18A1,T80,1H|)
	PRINT 605
	PRINT 607,(A(KF,1),KF=1,18)
607	FORMAT(T2,1H|,T10,'I would greatly appreciate a copy of your 
	2publication',T80,1H|,T85,18A1)
	PRINT 608
608	FORMAT(T2.1H|,T10,'entitled:',T80,1H|)
	PRINT 605
	I=1
18	PRINT 691,(T(K,I),K=1,72),(T(K,I),K=1,50)
	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 500
	I=1
19	PRINT 691,(TD(K,I),K=1,72),(T(K,I),K=1,50)
	IF (TD(1,I).EQ.' ') GO TO 500
	I=I+1
	IF (I-4) 19,19,500
691	FORMAT(T2,1H|,T5,72A1,T80,1H|,T82,50A1)
500	PRINT 609
609	FORMAT(T2,1H|,T10,'which appeared in:',T80,1H|)
	PRINT 605
	PRINT 610,BOOK,VOL,PAGE,NAN,BOOK
610	FORMAT(T2,1H|,T5,36A1,';',4A1,':',10A1,'(',I4,')',T80,1H|,
	2T85,36A1)
	PRINT 605
	PRINT 611,VOL,PAGE,NAN
611	FORMAT(T2,1H|,T80,1H|,T85,4A1,':',10A1,'(',I4,')')
	PRINT 612
612	FORMAT(T2,1H|,T20,'Yours sincerely,',T80,1H|)
	PRINT 605
	PRINT 605
	PRINT 613,NOMA,NOMA
613	FORMAT(T2,1H|,T40,30A1,T80,1H|,T85,30A1)
	PRINT 605
	PRINT 614
614	FORMAT(T2,35(1H-),'plier  ici',35(1H-))
	PRINT 605
	PRINT 615
615	FORMAT(T2,1H|,T5,'Expediteur (Mailing label)',T65,'TIMBRER',T80,
	21H|)
	PRINT 605
	PRINT 616,NOMA
616	FORMAT(T2,1H|,T5,30A1,T65,'  ICI'T80,1H|)
	PRINT 605
	PRINT 617
617	FORMAT(T2,1H|,T5,'CNRS-CESN-LA204',T80,1H|,/T2,1H|,T5,
	2'1 place de l''Eglise',T80,1H|,/T2,1H|,T5
	3,'F-91190    GIF/YVETTE',T80,1H|,/T2,1H|,
	4T20,'FRANCE',T80,1H|)
	PRINT 605
	PRINT 605
	PRINT 618,(P(KF,1),KF=1,6),(A(KF,1),KF=1,18)
618	FORMAT(T2,1H|,T30,'Dr ',6A1,18A1,T80,1H|)
	DO 620 KF=1,12
620	PRINT 605
77	CONTINUE
	CLOSE (UNIT=4)
	CLOSE (UNIT=6,DISP='PRINT')
	RETURN
	END