PDP-10 Archive: 43,50403/pdo.f4 from decuslib10-06

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50403/pdo.f4
There are no other files named pdo.f4 in the archive.
COMPLETE PERSONAL DECTAPE ORGANIZER......( PDO )
CREATED BY EUGENE L. ZIEGLER       FALL 1975
COLGATE UNIVERSITY COMPUTER CENTER

COMPUTER PROGRAM TO READ A DECTAPE DIRECTORY AND UPDATE OR
CORRECT A MASTER LIST ( FROM YOUR AREA ) OF THE NAMES OF FILES
CURRENTLY STORED ON YOUR DECTAPES.

*	NOTICE: ANY CHANGES MADE IN THIS PROGRAM ARE TO BE MADE UNDER
*		THE SUPERVISION OF THE SYSTEMS PROGRAMMER.  REVISIONS
*		SHOULD BE LISTED HERE IN THE FOLLOWING FORMAT AND 
*		ACTUAL CODE CHANGES SHOULD BE FLAGGED WITH THE PROG-
*		RAMMERS INITIALS:
*		REV. 0	1/1/76	E. L. ZIEGLER ( ORIGINAL )
*		REV. 1  3/9/76  G. ROSS  ( SUBROUTINE DIRDTA )

CORE NAME		DATA STRUCTURES
C  ID			= TAPE ID
C  TFB			= TAPE FREE BLOCKS
C  TFF			= TAPE FREE FILES
C  NFT			= NO. OF FILES ON TAPE (22-TFF)
C  NFML			= NO. OF FILE ENTRIES IN MASTER LIST
C  MFML			= MAXIMUM NO. OF FILES; NFML+22
C  NTML			= NO. OF TAPES ON MASTER LIST
C  MTML			= MAX NO. OF TAPES ON THE MASTER; NTML+1
C  TNB			= TOTAL NO. OF BLOCKS
C  NWM			= NO. OF WORDS FOR THE MASTER LIST
C  NWF			= NO. OF WORDS FOR THE FREE MATRIX
C  FREE(NTML+1,3)	= ID'S, BLOCKS & FILES FROM MASTER LIST
C  DIRECT(22,4)		= TAPE FILE LISTINGS
C  MASTER(NFML+22,12)	= MASTER FILE NAME LISTING
C  FLAG(22)		= ADDRESS IN MASTER: MATCH MADE

CORE STORAGE IS INITIALIZED....EVERYTHING IS INTEGER.
	IMPLICIT INTEGER (A-Z)
	COMMON NTML,NFML,REPEAT
*GR
	EXTERNAL CONTROL,DIRDTA

CONVEY SELECTION OF OPERATIONS
	CALL MENU(CHOICE)

CONSTRUCT A NEW LIST IF THE CHOICE IS 1
	IF(CHOICE.EQ.1) GO TO 10

CHOICE IS GREATER THAN 1......OPEN EXISTING FILE.
30	CALL IFILE(20,'MASTER')
	REPEAT=.FALSE.

CATCH THOSE PARAMETERS OFF THE TOP OF THE FILE!
	READ(20,20)NTML,NFML
CONTAINS: NTML TAPES NFML FILES
20	FORMAT(I4,6X,I)

CALCULATE THE SIZE OF THE ARRAYS AND TOTAL NO. OF WORDS NEEDED.
10	MFML=NFML+22
	MTML=NTML+1
	NWM=MFML*12
	NWF=MTML*3

CALL DYNAMIC DIMENSIONING ROUTINES FROM THE FORTRAN LIBRARY.
	CALL DYNDIM(MASTER,NWM,IFLAG)
	IF(IFLAG.NE.0)GO TO 6
	CALL DYNDIM(FREE,NWF,IFLAG)
	IF(IFLAG.NE.0) GO TO 6

CONNECT MAIN TO THE CONTROL SUBROUTINE WITH LINK ( FORLIB ).
	CALL LINK(2,CONTROL,MASTER,FREE,MTML,MFML,CHOICE)

	IF(REPEAT) GO TO 30
	STOP

6	TYPE 66,IFLAG
66	FORMAT(' DYNDIM ERROR****** FLAG = 'I4)

	END

*****************************************************************

C	CONTROL	CONTROL	CONTROL	CONTROL	CONTROL	CONTROL

**************************************************************
CONTROL SERVES AS A PSEUDO-MAIN PROGRAM.  HERE THE MASTER LIST IS
CALLED IN, DECTAPE DIRECTORIES ARE READ, AND THE MENU BRANCHING IS
CONDUCTED.

COME-FROM MAIN PROGRAM. 

	SUBROUTINE CONTROL(MASTER,FREE,MTML,MFML,CHOICE)
	IMPLICIT INTEGER (A-Z)
	DIMENSION MASTER(MFML,12),FREE(MTML,3), DIRECT(22,4),FLAG(22)
	COMMON NTML,NFML,REPEAT
	COMMON/T/ ID,TFB,TFF,NFT
	DOUBLE PRECISION TAPE

CAN'T READ A MASTER LIST IF THIS IS NEW.
	IF(CHOICE.EQ.1) GO TO 1051

CALL IN MASTER LIST ...FIRST THE SUMMARY OF TAPES, AND FREE SPACE.
	  READ(20,130)((FREE(I,J),J=1,3),I=1,NTML)
130	FORMAT(A5,2I)

COMPLETE LIST OF FILE NAMES IS NEXT...
	  READ(20,140)((MASTER(I,J),J=1,12),I=1,NFML)
140	FORMAT(A5,A2,A3,A5,I4,1X,7A5)

CHIOCE MAY INDICATE NO DECTAPE IS INVOLVED.
	IF(CHOICE.GT.2)GO TO 1050

COLLECT THE DIRECTORY FROM THE NEW TAPE. (GR: NEXT 11 LINES)
1051	TYPE 122
122	FORMAT(' ENTER DEVICE FOR DIRECTORY: '$)
	ACCEPT 222,TAPE
222	FORMAT(A10)
	CALL DIRDTA(TAPE,IFLAG)
	IF(IFLAG.NE.0)GO TO 20
	  OPEN(UNIT=1,DEVICE='DSK',MODE='ASCII',ACCESS='SEQIN')
	  READ(1,100)ID,TFB,TFF
	    NFT=22-TFF
	  READ(1,110)((DIRECT(I,J),J=1,4),I=1,NFT)
	  CLOSE(UNIT=1,DISPOSE='DELETE')
100	FORMAT(////9X,A5/6X,I3,7X,I2)
110	FORMAT(A5,A2,A3,I)

	TYPE 2000,ID,TFB,TFF
2000	FORMAT(/' TAPE ID: 'A5/' FREE BLOCKS'I/' FREE FILES'I/)

	CALL UPDATE(MASTER,FREE,DIRECT,MTML,MFML,CHOICE)

20	CALL MENU(CHOICE)

1050	GO TO(1,2,3,4,5,6,7,8,9),CHOICE

CHOICE (0): FINI
	TYPE 40
40	FORMAT(' END OF JOB!!!'//)
	RETURN

CHOICE (1): OPEN A NEW MASTER LIST
1	TYPE 41
41	FORMAT(' ***ERROR: FILE IS ALREADY OPEN***'/' CHOOSE AGAIN:'$)
	ACCEPT 76,CHOICE
76	FORMAT(I)
	GO TO 1050

CHOICE (2):UPDATE MASTER WITH NEW TAPE DIRECTORY
2	REPEAT=.TRUE.
	RETURN

CHOICE (3): SEARCH FOR A FILE
3	SEQNO=1
	CALL SEARCH(MASTER,MFML,SEQNO)
	GO TO 20

CHOICE (4): PREVIEW DIRECTORY OF A TAPE
4	TYPE 31
31	FORMAT(/' TAPE ID: '$)
	ACCEPT 2222,SID
2222	FORMAT(A5)

	DO 310 S=1,NTML
310	IF(FREE(S,1).EQ.SID) GO TO 3100

	TYPE 32,SID
32	FORMAT(' NO SUCH TAPE AS 'A5,' ON THE MASTER LIST!'/)
	GO TO 20

3100	TYPE 33,(FREE(S,COL),COL=1,3)
33	FORMAT(' FREE SPACE; 'A5,I5,' BLOCKS'I4,' FILES')

	DO 311 S=1,NFML
311	IF(MASTER(S,4).EQ.SID)TYPE 34,(MASTER(S,COL),COL=1,12)
34	FORMAT(1X,A5,A2,A3,2X,A5,I5,3X,7A5)
	PAUSE
	GO TO 20

CHOICE (5): LIST BY EXTENSION
5	TYPE 61
61	FORMAT(/' EXTENSION: '$)
	ACCEPT 2222,EXT

	DO 610 E=1,NFML
610	IF(MASTER(E,3).EQ.EXT)TYPE 34,(MASTER(E,COL),COL=1,12)
	PAUSE
	GO TO 20

CHOICE (6): LINE PRINTER LISTING.
6	CALL LIST(MASTER,FREE,MFML,MTML,3)
	GO TO 20

CHOICE (7): PREVIEW FREE SPACE.
7	TYPE 71,((FREE(R,C),C=1,3),R=1,NTML)
71	FORMAT(/' FREE SPACE REPORT:'/(10X,A5,I5,' BLOCKS'I5
	1  ,' FILES'))
	PAUSE
	GO TO 20

CHOICE (8): ANNOTATE MASTER LIST.
8	CALL ANNOTATE(MASTER,FREE,MFML,MTML)
	GO TO 20

CHOICE (9): PREVIEW MASTER LIST.
9	CALL LIST(MASTER,FREE,MFML,MTML,5)
	PAUSE
	GO TO 20
	END

********************************************************************

C	UPDATE		UPDATE		UPDATE		UPDATE

***********************************************************************
CHECKS TAPE DIRECTORY AGAINST MASTER LIST AND MAKES
CHANGES WHERE NECESSARY.  IT ADDS NEW FILES AND DELETES FILES
CLEARED FROM THE TAPE. WHEN FINISHED IT SORTS THE MASTER AND
CHANGES THE DISK FILE TO MATCH.

COME-FROM CONTROL

	SUBROUTINE UPDATE(MASTER,FREE,DIRECT,MTML,MFML,CHOICE)
	IMPLICIT INTEGER (A-Z)
	DIMENSION MASTER(MFML,12),FREE(MTML,3), DIRECT(22,4),FLAG(22)
	COMMON NTML,NFML,REPEAT
	COMMON/T/ ID,TFB,TFF,NFT
	NEW=.FALSE.

CHECK THE FREE SPACE AND UPDATE THE MASTER LIST IF NECESSARY
	DO 710 I=1,NTML

CONDUCT SEARCH FOR THE PROPER ID
710	  IF(ID.EQ.FREE(I,1))GO TO 800

CONCLUDE THIS TO BE A NEW TAPE IF IT DID NOT GO TO 800
	  TYPE 711
711	FORMAT(' THIS IS A NEW TAPE!!!'/)
	    NTML=NTML+1
	    FREE(NTML,1)=ID
	    FREE(NTML,2)=TFB
	    FREE(NTML,3)=TFF
	    NEW=.TRUE.
	GO TO 810

COMPARE FREE SPACE FOR CHANGES
800	IF(TFB.EQ.FREE(I,2).AND.TFF.EQ.FREE(I,3))GO TO 810

CHANGE THE FREE SPACE AND NOTIFY THE USER
	  TYPE  801,(FREE(I,J),J=1,3)
	    FREE(I,2)=TFB
	    FREE(I,3)=TFF
	  TYPE 802,(FREE(I,J),J=1,3)
801	FORMAT(' LISTING WAS 'A5,I5,I5)
802	FORMAT(' IS NOW      'A5,I5,I5)
810	CONTINUE

COMPLETED UPDATING OF THE FREE FILE AND WE ARE READY TO
CROSSCHECK THE TAPE LISTINGS WITH THE MASTER LIST

C  ....FOR EACH FILE ON THE DECTAPE DIRECTORY,
	DO 1000 I=1,NFT

C  ......SEARCH FOR A MATCH ON THE MASTER LIST
	IF(NEW)GO TO 300
	   DO 500 J=1,NFML
500	IF(DIRECT(I,1).EQ.MASTER(J,1).AND.DIRECT(I,2).EQ.MASTER(J,2)
	1.AND.DIRECT(I,3).EQ.MASTER(J,3).AND.ID.EQ.MASTER(J,4))
	2 GO TO 510

COULDN'T FIND IT.  MUST BE A NEW FILE.
300	NFML=NFML+1
	DO 75 K=1,3
75	MASTER(NFML,K)=DIRECT(I,K)
	MASTER(NFML,4)=ID
	MASTER(NFML,5)=DIRECT(I,4)
	FLAG(I)=NFML
	TYPE 501,(DIRECT(I,K),K=1,3)
501	FORMAT(1X,A5,A2,A3,' IS A NEW FILE; WILL BE ADDED TO MASTER')
	GO TO 1000

CHECK TO SEE IF BLOCK SIZE IS THE SAME
510	FLAG(I)=J
	IF(DIRECT(I,4).EQ.MASTER(J,5)) GO TO 1000
	TYPE 511,(MASTER(J,KKK),KKK=1,3), DIRECT(I,4),MASTER(J,5)
511	FORMAT(' ********WARNING: ON FILE 'A5,A2,A3/
	9' BLOCK SIZE DIFFERS.  TAPE IS'I4,
	1' MASTER LIST IS'I4/' FILES MAY BE DIFFERENT.  DO YOU WANT
	2 TO UPDATE THE MASTER?'$)
	ACCEPT 921,ANS
	IF(ANS.NE.'Y')GO TO 1000
	MASTER(J,5)=DIRECT(I,4)
1000	CONTINUE

	IF(NEW)GO TO 1

CHECK FOR FILES THAT ARE SUPPOSED TO BE ON THE TAPE, BUT ARN'T.
	DO 900 I=1,NFML

COMPARE ID'S
949	   IF(MASTER(I,4).NE.ID)GO TO 900
	   DO 910 J=1,NFT

CHECK TO SEE IF IT'S BEEN FLAGGED; I.E. IS ON THE TAPE.
		IF(FLAG(J).EQ.I)GO TO 900
 910	   CONTINUE

CONSULT USER...IS NO LONGER ON TAPE
	   TYPE 920,(MASTER(I,K),K=1,3)
920	FORMAT(1X,A5,A2,A3,' IS NO LONGER ON THIS TAPE. '/
	1' DO YOU WANT TO DELETE IT FROM THE MASTER FILE? '$)
	   ACCEPT 921,ANS
921	   FORMAT(A1)
	   IF(ANS.NE.'Y')GO TO 900
	   DO 931 J=1,NFT
931	   IF(FLAG(J).EQ.NFML) FLAG(J)=I
	   CALL SWAP(MASTER,I,NFML,MFML,12)
	   NFML=NFML-1
	GO TO 949
 900	CONTINUE

COORDINATE THE DISK FILE WITH THE NEW VERSION..SORT FIRST.
1	CALL SORT(MASTER,MFML,NFML)
	CALL REWRITE(MASTER,FREE,MFML,MTML)
	RETURN
	END
*******************************************************************

*	SORT	SORT	SORT	SORT	SORT	SORT

*******************************************************************

COMPLETE ALPHABETIZATION  A TO Z.....A MATRIX SORT.

COME-FROM UPDATE

	SUBROUTINE SORT(MASTER,MFML,NFML)
	IMPLICIT INTEGER (A-Z)
	DIMENSION MASTER(MFML,12)

CROSSCHECKING IS FINISHED....SORT THE MASTER LIST.
	DO 300 I=1,NFML-1
	   DO 300 J=I+1,NFML
300	      IF(MASTER(I,1).GT.MASTER(J,1).OR.MASTER(I,1).EQ.MASTER
	1     (J,1).AND.MASTER(I,2).GT.MASTER(J,2))CALL
	2     SWAP(MASTER,I,J,MFML,12)

	RETURN
	END

******************************************************************

*	REWRITE		REWRITE		REWRITE

******************************************************************
CONCLUDE OPERATIONS BY REWRITING THE MASTER FILE.

COME-FROM UPDATE OR ANNOTATE

	SUBROUTINE REWRITE(MASTER,FREE,MFML,MTML)
	IMPLICIT INTEGER (A-Z)
	DIMENSION MASTER(MFML,12), FREE(MTML,3)
	COMMON NTML,NFML,REPEAT

	CALL OFILE(20,'MASTER')
	WRITE(20,241)NTML,NFML,((FREE(I,J),J=1,3),I=1,NTML)
241	FORMAT(I4,' TAPES'I5,' FILES'/(A5,2I10))
	WRITE(20,242)((MASTER(I,J),J=1,12),I=1,NFML)
242	FORMAT(A5,A2,A3,A5,I4,1X,7A5)

	RETURN
	END

****************************************************************

*	LIST	LIST	LIST	LIST	LIST	LIST

******************************************************************

CAN LIST ON TERMINAL OR LINE PRINTER DEPENDING ON FROM WHERE IT WAS
CALLED.  ACTUALLY A DRESSED UP VERSION OF THE MASTER LIST.

COME-FROM CONTROL

	SUBROUTINE LIST(MASTER,FREE,MFML,MTML,OUT)
	IMPLICIT INTEGER (A-Z)
	DIMENSION MASTER(MFML,12), FREE(MTML,3),EXT(100)
	COMMON NTML,NFML,REPEAT

CHOICE OF THREE WAYS TO LIST.
1111	TYPE 111
111	FORMAT(/' (1) ALPHABETIZED BY FILE'/' (2) SECONDARY SORT ON
	1 EXTENSION'/' (3) SECONDARY SORT BY TAPE'/'	CHOOSE:'$)
	ACCEPT 112,CHO
112	FORMAT(I)

CONFORM OR ELSE.......
	IF(CHO.GT.3)GO TO 1111

COSMETIC OUTPUT.....LIST HEADER.
	WRITE(OUT,650)NTML
650	FORMAT(22X'******************************'/22X
	1'*				*'/22X'*
	2	DIRECTORY OF ALL	*'/22X'*	DECTAPE
	3 FILES		*'/22X'*				*'/
	4 22X'******************************'//25X
	5'  FREE SPACE ON'I4,' TAPES'/)

CHART OUT THE FREE SPACE
	WRITE(OUT,651)((FREE(I,J),J=1,3),I=1,NTML)
651	FORMAT(22X,A5,I6,' BLOCKS'I6,' FILES')
	WRITE(OUT,652)
652	FORMAT(/21X'-----------------------------------'/)
	WRITE(OUT,653)NFML

CHOSEN LISTING IS BRANCHED TO
	GO TO(61,62,63),CHO

CHOICE (1): ALPHABETIZED BY FILE
61	WRITE(OUT,654)((MASTER(I,J),J=1,12),I=1,NFML)
653	FORMAT(14X,I5,' FILES'//6X,'FILE NAME   TAPE ID   BLK SIZE
	1	DESCRIPTION'/)
654	FORMAT(6X,A5,A2,A3,5X,A5,I6,5X,7A5)
	RETURN

COLLECT A LIST OF THE DIFFERENT EXTENSIONS.
62	EX=1
	DO 10 IEX=1,NFML
	   DO 20 JEX=1,EX
20	   IF(MASTER(IEX,3).EQ.EXT(JEX))GO TO 10
	 EXT(EX+1)= MASTER(IEX,3)
	 EX=EX+1
	 IF(EX.GT.100)GO TO 30
10	CONTINUE

CHOICE (2): SECONDARY SORT BY EXTENSION.
	DO 55 IX=1,EX
	DO 50 JX=1,NFML
50	IF(MASTER(JX,3).EQ.EXT(IX))WRITE(OUT,654)(MASTER(JX,J),J=1,12)
	WRITE(OUT,77)
77	FORMAT(/)
55	CONTINUE
	RETURN

CAN'T COVER EVERYTHING. FIX THE ARRAY.
30	TYPE 31
31	FORMAT(' *******ERROR; NO. OF DIFFERENT EXTENSIONS EXCEEDS DIMEN
	1SIONED'/'	ARRAY (EXT) OF 100.  SEE SUBROUTINE LIST'/)
	RETURN

CHOICE (3): SECONDARY SORT BY TAPE.
63	DO 201 KK=1,NTML
	DO 200 JJ=1,NFML
200	IF(FREE(KK,1).EQ.MASTER(JJ,4))WRITE(OUT,654)
	1(MASTER(JJ,J),J=1,12)
201	WRITE(OUT,77)
	RETURN
	END

****************************************************************
*
*	SWAP	SWAP	SWAP	SWAP	SWAP	SWAP	SWAP   *
*
***************************************************************
CAN SWAP ONE ROW FOR ANOTHER IN A MATRIX

COME-FROM SORT

	SUBROUTINE SWAP(MAT,I,J,N,M)
	DIMENSION MAT(N,M)

CHANGE THE FILE NAMES AROUND AND CARRY THE DETAIL ALONG
	DO 10 K=1,M
	  LINE=MAT(I,K)
	  MAT(I,K)=MAT(J,K)
	  MAT(J,K)=LINE
10	CONTINUE

	RETURN
	END

***************************************************************

*	MENU	MENU	MENU	MENU	MENU	MENU	MENU

****************************************************************
CHOICE OF TEN OPERATIONS IS PRESENTED AND RESPONSE COLLECTED.

COME-FROM MAIN OR CONTROL

	SUBROUTINE MENU(CHOICE)
	INTEGER CHOICE
	TYPE 1
1	FORMAT(//15X,'PERSONAL DECTAPE ORGANIZER'/' OPERATION MENU:'/
	1 10X,'1) OPEN A NEW MASTER DECTAPE DIRECTORY.'/10X,'2) UPDATE
	2 MASTER LIST WITH CURRENT TAPE DIRECTORY.'/10X,'3) SEARCH FOR
	3 A FILE.'/10X,'4) PREVIEW DIRECTORY OF A TAPE FROM MASTER LIST.
	4 '/10X,'5) LIST FILES WITH A SPECIFIC EXTENSION.'/10X,'6)
	5 LINE PRINTER LISTING OF MASTER DIRECTORY.'/10X,'7)
	6 REVIEW FREE SPACE ON TAPES.'/10X,'8) ANNOTATE MASTER
	7 DIRECTORY.'/10X,'9) PREVIEW MASTER LIST.'/10X,'0)
	8 EXIT.'//5X,'CHOOSE:'$)

	ACCEPT 2, CHOICE
2	FORMAT(I)

	RETURN
	END
******************************************************************

C	SEARCH		SEARCH		SEARCH		SEARCH

*******************************************************************
COMPARE DESIRED FILE TO MASTER LIST AND TYPE MATCHES. EXTENSION
CAN BY USED OR NOT, AND WILD CARDS (?) ARE PERMITTED.  IF IT IS
CALLED FROM CONTROL ALL FILES THAT MATCH ARE LISTED. BUT IN THE
CASE OF ANNOTATE THE USER MUST CONFIRM THE FIND.

COME-FROM CONTROL OR ANNOTATE.

	SUBROUTINE SEARCH(MASTER,MFML,SEQNO)
	IMPLICIT INTEGER (A-Z)
	DIMENSION MASTER(MFML,12),MAST(10),FILE(10)
	COMMON NTML,NFML,REPEAT
	FLAG=0
	N=10
	TYPE 666
666	FORMAT(' A CARRIAGE RETURN WILL END THE SEARCHING.'//)

CAN YOU TELL ME WHAT YOU'RE LOOKING FOR?
11	TYPE 1
1	FORMAT(/' FILE NAME:'$)
	ACCEPT 2,FILE
2	FORMAT(10A1)
	IF(FILE(1).NE.' ')GO TO 3
	SEQNO=0
	RETURN

CAREFUL HERE....USERS SCREW UP SOME TIMES!!
3	DO 4 I=1,6
	IF(FILE(I+1).EQ.'.') GO TO 7
4	IF(FILE(I+1).EQ.' ')GO TO 6

CAN'T GET HERE AND STILL BE RIGHT.
8	TYPE 9,FILE
9	FORMAT(' ********ERROR IN FILE NAME******** '10A1)
	GO TO 11

CHECK TO MAKE SURE THERE IS NOTHING BEYOND THIS POINT.
6	DO 13 J=I+1,10
13	IF(FILE(J).NE.' ')GO TO 8
	GO TO 20

CHECK TO MAKE SURE THERE ARE NO MORE THAN 3 LETTER EXTENSIONS.
7	DO 14 J=I+5,10
	IF(J.GT.10)GO TO 20
14	IF(FILE(J).NE.' ')GO TO 8

CAN'T USE IT IN THIS FORM.....REARRANGE IT!
20	DO 150 K=1,10
	MAST(K)=FILE(K)
150	FILE(K)=' '
	DO 300 K=1,I
300	FILE(K)=MAST(K)
	FILE(7)='.'
	DO 301 K=8,10
301	FILE(K)=MAST(I+K-6)
	IF(FILE(8).EQ.' '.OR.FILE(8).EQ.'*')N=6

	CALL IFILE(20,'MASTER')

COUNT OFF THE TAPE DESCRIPTION LINES AND SKIP THEM.
	DO 200 K=1,NTML+1
200	READ(20,100)DUMMY
100	FORMAT(A1)

COMPARE TO FILE NAMES ON THE MASTER LIST
	DO 10 L=1,NFML
	READ(20,2)MAST

CHECK TO SEE IF WE ARE PAST IT IN THE ALPHABET
	IF(MAST(1).GT.FILE(1))GO TO 500

COMPARE CHARACTER BY CHARACTER
	DO 110 C=1,N
110	IF(MAST(C).NE.FILE(C).AND.FILE(C).NE.'?')GO TO 10

CITE ENTRY FROM MASTER LIST
	FLAG=1
	TYPE 600,(MASTER(L,LL),LL=1,12)
600	FORMAT(3X,A5,A2,A3,5X,A5,I6,5X,7A5)

CONTROL SEARCH.... SKIT TO 10 (NEXT FILE ON MASTER).
	IF(SEQNO.EQ.1)GO TO  10

	TYPE 777
777	FORMAT(/' CONFIRM:'$)
	ACCEPT 778,ANS
778	FORMAT(A1)

CAN'T BE IT...TRY AGAIN.
	IF(ANS.NE.'Y')GO TO 10

CONTAINS ADDRESS OF FILE IN MASTER ON RETURN TO ANNOTATE
	SEQNO=L
	RETURN
10	CONTINUE

	IF(SEQNO.EQ.1)GO TO 11
	FLAG=0
	SEQNO=0

500	IF(FLAG.EQ.0)TYPE 700
700	FORMAT(' NO SUCH FILE!!'/)
	GO TO 11
	END
***************************************************************

C	ANNOTATE	ANNOTATE	ANNOTATE	ANNOTATE

*****************************************************************
CALLS SEARCH, FINDS DESIRED FILE AND ALLOWS USER TO ENTER UP TO 35
CHARACTERS OF DESCRIPTIVE MATERIAL.

COMES-FROM CONTROL

	SUBROUTINE ANNOTATE(MASTER,FREE,MFML,MTML)
	IMPLICIT INTEGER (A-Z)
	DIMENSION MASTER(MFML,12),FREE(MTML,3)

6	SEQNO=2
	CALL SEARCH(MASTER,MFML,SEQNO)
	IF(SEQNO.EQ.0)GO TO 10
	TYPE 1
1	FORMAT(' ENTER DESCRIPTION (35 CHARACTERS MAX).'/
	1' ''                                   '' ')
	ACCEPT 2,(MASTER(SEQNO,I),I=6,12)
2	FORMAT(7A5)

10	TYPE 3
3	FORMAT(' OTHER ANNOTATIONS? '$)
	ACCEPT 4,ANS
4	FORMAT(A1)

	IF(ANS.EQ.'Y') GO TO 6
	CALL REWRITE(MASTER,FREE,MFML,MTML)
	RETURN
	END
*U*2*