C***************************************************************
C
C
C	BIBAUTASK.FTN PERMET DE RETROUVER LES FICHES DONT
C	LES AUTEURS SONT DEMANDES AU CLAVIER.
C
C	IL UTILISE LE FICHIER AUTALPH.BIB SAUVE PAR BIBAUTALP.FTN
C	CE PROGRAMME EST STAND-ALONE RELATIVEMENT A BIBLIO.
C
C******************************************************************
	PROGRAM AUTASK
	DIMENSION A(18,5),AD(18,5),AUT(2559),P(6,5),PD(6,5),MCLE(10)
	DIMENSION T(72,4),TD(72,4),BOOK(36),PAGE(10),VOL(4),DAY(9),TAP(10)
	DIMENSION ASK(18),PA(6)
	BYTE NSD,A,AD,T,TD,P,PD,BOOK,PAGE,VOL,DAY,TAP,ASK,PA,BELL
	INTEGER AUT
	LOGICAL*1 FAN,FPA,FMC
	OPEN (UNIT=1,NAME='DL1:[204,100]AUTALPH.BIB',TYPE='OLD'
	2,ACCESS='DIRECT',SHARED,FORM='UNFORMATTED',RECORDSIZE=1280
	3,ASSOCIATEVARIABLE=JAK,MAXREC=26)
	CALL ASSIGN(4,'DL1:[204,100]FICHES.BIB')
	CALL FDBSET(4,'OLD')
	DEFINE FILE 4(8000,256,U,L)
	TYPE 6
6	FORMAT(/,' Si vous desirez la sortie sur l''imprimante,tapez "6"'
	2,/'$Si vous la desirez ici,tapez "RETURN":')
	ACCEPT 7,IOUT
7	FORMAT(I5)
	IF (IOUT.EQ.0) IOUT=5
	IF (IOUT.EQ.6) OPEN (UNIT=6,NAME='SY:AUTASK.LST',
	2DISP='PRINT',TYPE='NEW')
1500	KAN1=0
	KAN2=0
	FAN=.FALSE.
	FPA=.FALSE.
	FMC=.FALSE.
	TYPE 1
1	FORMAT(/,'$Nom de l''Auteur a trouver <Fin = RETURN>:')
	ACCEPT 2,ASK
2	FORMAT(18A1)
	IF (ASK(1).EQ.' ') GO TO 1600
	TYPE 3
3	FORMAT(/,'$Prenom <si inconnu taper "RETURN">:')
	ACCEPT 4,PA
5	FORMAT(1X,3A1)
	IF (PA(1).EQ.' ') FPA=.TRUE.
	TYPE 20
20	FORMAT(/,'$Annee de parution ou 1ere fourchette
	1<si inconnue taper RETURN>:')
	ACCEPT 21,KAN1
21	FORMAT(I4)
	IF (KAN1.EQ.0) GO TO 35
	TYPE 23
23	FORMAT(/'$Annee 2de fourchette <Si identique taper RETURN>')
	ACCEPT 21,KAN2
	IF (KAN2.EQ.0) KAN2=KAN1
	IF (KAN2.GE.KAN1) GO TO 36
	KAN=KAN1
	KAN1=KAN2
	KAN2=KAN
	GO TO 36
35	CONTINUE
	FAN=.TRUE.
36	TYPE 22
22	FORMAT(/'$Numero d''un mot cle<sinon RETURN>:')
	ACCEPT 21,KMTCL
	IF (KMTCL.EQ.0) FMC=.TRUE.
	TYPE *,'PATIENCE...,je commence a chercher!!'
	IF (IOUT.EQ.6) TYPE 12
12	FORMAT(//' Si toutefois vous desirez travailler a autre
	2 chose,',/' vous pouvez reobtenir le prompt en faisant 
	3"CTRL C" "RETURN".'/' Je vous previendrai ici lorsque 
	4j''aurai termine.Merci'/)
4	FORMAT(6A1)
	BELL=7
	WRITE(IOUT,14)PA,ASK,KAN1,KAN2,KMTCL
14	FORMAT(/,' FICHES AYANT ',6A1,1X,18A1,' COMME AUTEUR, DE ',I4,
	1' A ',I4,/' MOT CLE:',I4/)
	IL=ASK(1)-64
	IB=0
	READ(1'IL)NFC,AUT
	IF (NFC.EQ.0) GO TO 1500
	DO 1000 NFD=1,NFC
	NFK=AUT(NFD)
	READ(4'NFK)NSD,NF,NA,A,P,T,BOOK,VOL,PAGE,NAN,TAP,ICM,DAY,MCLE
	IF(NSD.EQ.'S') GO TO 86
	IF (NSD.EQ.'K') GO TO 1000
	READ(4'NFK)NSD,NF,NA,A,AD,T
	NFB=NFK+1
	READ(4'NFB)NSD,NF,P,PD,TD,BOOK,VOL,PAGE,NAN,TAP,ICM,DAY,MCLE
86	IF (FAN) GO TO 30
	IF (NAN.LT.KAN1.OR.NAN.GT.KAN2) GO TO 1000
30	DO 100 IA=1,NA
	IF (IA.GT.5) GO TO 110
	DO 200 IK=1,18
	IF (A(IK,IA).EQ.ASK(IK)) GO TO 200
	GO TO 100
200	CONTINUE
	IF (FPA) GO TO 300
	DO 210 IK=1,6
	IF (P(IK,IA).EQ.PA(IK)) GO TO 210
	GO TO 100
210	CONTINUE
	GO TO 300
110	DO 220 IK=1,18
	IF (AD(IK,IA-5).EQ.ASK(IK)) GO TO 220
	GO TO 100
220	CONTINUE
	IF (PA(1).EQ.' ') GO TO 300
	DO 230 IK=1,6
	IF (PD(IK,IA-5).EQ.PA(IK)) GO TO 230
	GO TO 100
230	CONTINUE
	GO TO 300
100	CONTINUE
	GO TO 1000
300	CONTINUE
	IF (FMC) GO TO 32
	DO 34 IMC=1,10
D	TYPE *,NF,MCLE(IMC)
	IF (MCLE(IMC).EQ.KMTCL) GO TO 32
34	CONTINUE
	GO TO 1000	
32	IB=IB+1
	WRITE(5,5)BELL,BELL,BELL
	WRITE(IOUT,11)NF
11	FORMAT(//,' FICHE #',I6,)
33	FORMAT(/1X,10(18A1,1X,6A1,1X))
	IF (I.LE.5) WRITE(IOUT,33)((A(K,I),K=1,18),(P(K,I),K=1,6)
	1,I=1,NA)
	IF (I.GT.5) WRITE(IOUT,33)((AD(K,I-5),K=1,18),(PD(K,I-5)
	1,K=1,6),I=1,NA)
	I=1
18	WRITE(IOUT,691)(T(K,I),K=1,72)
691	FORMAT(1X,72A1)
	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	WRITE(IOUT,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	WRITE(IOUT,9)BOOK,VOL,PAGE,NAN
9	FORMAT(/,' ',36A1,';',4A1,':',10A1,'(',I4,')')
	WRITE(IOUT,105)TAP
105	FORMAT(/,' T-A-P:',10A1)
	WRITE(IOUT,700)DAY,ICM
700	FORMAT(/,' FICHE ENTREE OU MODIFIEE LE ',9A1,
	2' SOUS L''UIC NUMERO [ 204,',O3,' ]')
	IF (IOUT.EQ.5) TYPE 37,BELL
37	FORMAT(1H$,A1,'Taper RETURN pour passer a la suivante')
	IF (IOUT.EQ.5) ACCEPT 21,IGO
1000	CONTINUE
	TYPE 8,BELL,BELL,BELL
8	FORMAT(//,1X,3A1,'Ici BIBAUTASK,j''ai termine',/)
	IF (IB.GT.0) TYPE 95,IB,PA,ASK,KAN1,KAN2,KMTCL
95	FORMAT(' J''ai trouve',I5,' fiches avec ',6A1,1X,18A1,
	1' entre ',I4,' et ',I4/1X,'avec le mmot cle',I4/)
	IF ((IOUT.EQ.6).AND.(IB.GT.0)) TYPE 97
97	FORMAT(' Voyez le listing AUTASK.LST sous votre UIC sur 
	2l''imprimante.')
	IF (IB.EQ.0) TYPE 96,PA,ASK,KAN1,KAN2,KMTCL
96	FORMAT(' Je n''ai pas trouve de fiche avec ',6A1,1X,18A1,/
	1' entre ',I4,' et ',I4,'; mot cle # ',I4' !!'/)
	GO TO 1500
1600	CLOSE (UNIT=1)
	CLOSE (UNIT=4)
	IF ((IOUT.EQ.6).AND.(IB.EQ.0)) CLOSE (UNIT=6,DISP='DELETE')
	IF ((IOUT.EQ.6).AND.(IB.GT.0)) CLOSE (UNIT=6,DISP='PRINT')
	STOP
	END