Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0080/avail.for
There are no other files named avail.for in the archive.
00100	C	PROGRAM AVAIL
00200	C
00300	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
00400	C
00500	C	PETE SCHILLING   ALCOA TECHNICAL CENTER   SEPTEMBER, 1974
00600	C
00700	C	THIS IS THE MAIN PROGRAM WHICH CALLS THE SUBROUTINES
00800	C	WHICH DO THE WORK.
00900	C
01000		COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15,6), KEYLEN(6)
01100		COMMON / AVLUNS / LUTT , LUFL ,LULP , LURN
01200	C
01300		LUTT = 5 
01400		LUFL = 26
01500		LULP = 3
01600		LURN = 27
01700	C
01800	C GIVE THE USER SOME INSTRUCTIONS ON THE PROGRAM.
01900		CALL AVINST
02000	C
02100	C GET THE LIST OF NON-INDEXED WORDS.
02200		CALL AVSTOP
02300	C
02400	C GET THE KEYWORDS FOR THE SEARCH.
02500	10	CALL AVKEYS
02600	C
02700	C SEARCH THE INDEX FILE.
02800		CALL AVINDX
02900	C
03000	C IF THERE WERE NO HITS, CHECK WHETHER THE USER WISHES TO TRY AGAIN.
03100		IF ( NHITS .LE. 0 ) GO TO 70
03200	C
03300	C IF THERE WERE HITS IN THE SEARCH, SUMMARIZE THE RESULTS.
03400		CALL AVSUMM
03500	C
03600	C TELL THE USER THE RESULTS.
03700		CALL AVRSLT
03800	C
03900	C DOES THE USER WISH TO CONTINUE?
04000		WRITE ( LUTT, 25 )
04100	25	FORMAT ( / ' DO YOU WISH TO TRY ANOTHER SEARCH?  ' $ )
04200		IF ( AVANSR ( LUTT ) ) GO TO 10
04300	C
04400	C IF NOT, STOP.
04500		GO TO 90
04600	C
04700	C DOES THE USER WISH TO TRY AGAIN?
04800	70	WRITE ( LUTT, 75 )
04900	75	FORMAT ( / ' THERE WERE NO HITS WITH THOSE KEYWORDS.' /
05000		1 ' DO YOU WISH TO TRY AGAIN WITH NEW ONES?   ' $ )
05100		IF ( AVANSR ( LUTT ) ) GO TO 10
05200	C
05300	C IF THE USER IS FINISHED, THANK HIM AND QUIT.
05400	90	WRITE ( LUTT, 95 )
05500	95	FORMAT ( / ' THANK YOU.  I HOPE YOU FOUND THIS HELPFUL.' /
05600		1 ' PETE SCHILLING (X2693) WOULD APPRECIATE' /
05700		2 ' YOUR COMMENTS AND SUGGESTIONS.' / )
05800	C
05900		CALL EXIT
06000		END
     
00100		SUBROUTINE AVINST
00200	C
00300	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
00400	C
00500	C	PETE SCHILLING   ALCOA TECHNICAL CENTER   SEPTEMBER, 1974
00600	C
00700	C	GIVE THE USER SOME INSTRUCTIONS.
00800	C
00900		COMMON / AVLUNS / LUTT
01000	C
01100		WRITE ( LUTT, 15 )
01200	15	FORMAT ( / ' SEARCH OF AVAILABLE SOFTWARE' /
01300		1 ' FOR THE DECSYSTEM-10' //
01400		2 ' DO YOU WANT INSTRUCTIONS?   ' $ )
01500	C
01600	C IF THE USER DOES NOT WANT INSTRUCTIONS, SKIP THEM.
01700		IF ( .NOT. AVANSR ( LUTT ) ) GO TO 70
01800	C
01900	C IF THE USER DOES WANT INSTRUCTIONS, TYPE THEM.
02000		WRITE ( LUTT, 25 )
02100	25	FORMAT ( / ' YOU MAY SPECIFY UP TO SIX KEYWORDS TO BE USED' /
02200		1 ' IN THE SEARCH.  ENTER EACH KEYWORD WITH NO' /
02300		2 ' LEADING OR EMBEDDED BLANKS WHEN IT IS REQUESTED.' /
02400		3 ' END EACH ONE WITH A <CARRIAGE RETURN>.  IF YOU' /
02500		4 ' WISH TO USE FEWER THAN SIX, JUST ENTER <CARRIAGE' /
02600		5 ' RETURN> WHEN ASKED FOR THE NEXT KEYWORD AFTER YOU' /
02700		6 ' HAVE ENTERED YOUR LAST ONE. ' )
02800	C
02900		WRITE ( LUTT, 35 )
03000	35	FORMAT (/ ' IN SELECTING KEYWORDS, KEEP THESE POINTS IN MIND:'/
03100		1 ' AVOID COMMONLY-USED WORDS LIKE AND, THE, A, PROGRAM.' /
03200		2 ' AVOID PLURALS;  USE MATRIX, NOT MATRICES;  USE' /
03300		3 '    ELEMENT, NOT ELEMENTS.' /
03400		4 ' AVOID WORDS WITH SUFFIXES; USE RANDOM, NOT RANDOMLY;' /
03500		5 '    USE SEQUENCE, NOT SEQUENCING.' /
03600		6 ' THE FIRST PART OF A WORD MAY BE USED AS A KEYWORD' /
03700		7 '    TO SEARCH FOR SEVERAL DIFFERENT INDEX WORDS;' /
03800		8 '    INTEGR RETRIEVES INTEGRAL AND INTEGRATE.' )
03900	C
04000		WRITE ( LUTT, 45 )
04100	45	FORMAT (/' THE SEARCH RESULTS MAY BE TYPED AND/OR PRINTED, AS' /
04200		1 ' YOU SPECIFY, STARTING WITH THE BEST-MATCHED SOFTWARE', /
04300		2 ' ITEMS, AND CONTINUING WITH THE LESS WELL-MATCHED ITEMS.' /
04400		3 ' ALL OF THE ITEMS WHICH ARE HIT BY YOUR KEYWORDS CAN BE' /
04500		4 ' DISPLAYED, OR A SMALLER NUMBER.  FOR EACH ITEM, A' /
04600		5 ' THREE LETTER CODE FOR THE SOURCE LANGUAGE IS FOLLOWED' /
04700		6 ' BY THE SPECIFICATION FOR THE FILE(S) CONTAINING' /
04800		7 ' THE ITEM, WHICH IS FOLLOWED BY A DESCRIPTION.' /
04900		8 ' TO OBTAIN AN ITEM, JUST COPY THE SPECIFIED FILE(S).' )
05000	C
05100		WRITE ( LUTT, 55 )
05200	55	FORMAT (/ ' IF YOU DON''T FIND WHAT YOU NEED WITH YOUR FIRST' /
05300		9 ' CHOICE OF KEYWORDS, REPHRASE YOUR REQUIREMENTS,' /
05400		1 ' CHOOSE NEW KEYWORDS, AND TRY AGAIN.  IN ORDER TO GET' /
05500		2 ' A CORRECT ANSWER, YOU MUST ASK A CORRECT QUESTION.' /
05600		3 ' CALL PETE SCHILLING (EXTENSION 2693) FOR HELP.' /
05700		4 ' GOOD LUCK.' / )
05800	C
05900	70	RETURN
06000		END
     
00100		SUBROUTINE AVKEYS
00200	C
00300	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
00400	C
00500	C	PETE SCHILLING   ALCOA TECHNICAL CENTER   SEPTEMBER, 1974
00600	C
00700	C	GET THE KEYWORDS FOR A SEARCH.
00800	C
00900		DIMENSION INPUT(15)
01000	C
01100		COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15, 6), KEYLEN(6)
01200		COMMON / AVLUNS / LUTT
01300		COMMON / AVNONW / NSTOP, KSTOP(12,150)
01400	C
01500		DATA IBLNK / ' ' /
01600	C
01700	C CLEAR THE KEYWORD ARRAYS.
01800		NKEYS = 0
01900		NERRS = 0
02000		CALL FILL ( KEYLEN, 1,  6,     0 )
02100		CALL FILL ( KEYWDS, 1, 90, IBLNK )
02200	C
02300	C CLEAR THE INPUT ARRAY.
02400	10	CALL FILL ( INPUT, 1, 15, IBLNK )
02500		NKEYS = NKEYS + 1
02600	C
02700	C ASK FOR THE KEYWORDS.
02800		WRITE ( LUTT, 15 ) NKEYS
02900	15	FORMAT ( ' KEYWORD', I2, 3X $ )
03000		READ  ( LUTT, 25 ) INPUT
03100	25	FORMAT ( 15A1 )
03200	C
03300	C HOW MANY CHARACTERS WERE ENTERED IN THIS KEYWORD?
03400		DO 30  NCHAR = 1, 15
03500		IF ( INPUT(NCHAR) .EQ. IBLNK ) GO TO 40
03600	30	CONTINUE
03700	C
03800		NCHAR = 16
03900	C
04000	40	NCHAR = NCHAR - 1
04100		IF ( NCHAR .EQ. 0 ) GO TO 100
04200	C
04300	C A SINGLE-CHARACTER KEYWORD BECOMES 'X ' BY REQUIRING AT LEAST
04400	C   TWO CHARACTERS.
04500		IF ( NCHAR .LT. 2 ) NCHAR = 2
04600	C
04700	C CHECK THE KEYWORD AGAINST THE ONES ENTERED PREVIOUSLY.
04800		IF ( NKEYS .LE. 1 ) GO TO 48
04900		DO 45  I = 1, NKEYS
05000		IF ( NCOMP ( INPUT, 1, NCHAR, KEYWDS(1,I), 1 ) ) 41, 42, 41
05100	41	IF ( NCOMP ( KEYWDS(1,I), 1, KEYLEN(I), INPUT, 1 ) ) 45, 42, 45
05200	C
05300	42	WRITE ( LUTT, 43 )
05400	43	FORMAT ( ' THAT KEYWORD IS ALREADY IN USE.' )
05500		GO TO 70
05600	C
05700	45	CONTINUE
05800	C
05900	C CHECK THE KEYWORD AGAINST THE STOP LIST.
06000	48	DO 50  I = 1, NSTOP
06100		IF ( NCOMP ( INPUT, 1, 12, KSTOP(1,I), 1 ) ) 90, 60, 50
06200	50	CONTINUE
06300		GO TO 90
06400	C
06500	C THE KEYWORD IS ON THE STOP LIST.
06600	60	WRITE ( LUTT, 65 )
06700	65	FORMAT ( ' THAT WORD IS NOT USED IN THE INDEX.' )
06800	C
06900	C AFTER TWO BAD ENTRIES, OFFER SOME HELP.
07000		NERRS = NERRS + 1
07100		IF ( NERRS .LT. 2 ) GO TO 70
07200		WRITE ( LUTT, 67 )
07300	67	FORMAT ( ' DO YOU WISH TO SEE A LIST OF NON-INDEXED WORDS?   '$)
07400		IF ( .NOT. AVANSR ( LUTT ) ) GO TO 80
07500		WRITE ( LUTT, 69 ) ( ( KSTOP(I,J), I = 1, 12 ), J = 1, NSTOP )
07600	69	FORMAT ( 1X, 12A1, 1X, 12A1, 1X, 12A1, 1X, 12A1, 1X, 12A1 )
07700		GO TO 80
07800	C
07900	70	WRITE ( LUTT, 75 )
08000	75	FORMAT ( ' SELECT A DIFFERENT ONE.' )
08100	C
08200	C IF THE WORD IS ON THE 'STOP' LIST, DO NOT ACCEPT IT.
08300	80	NKEYS = NKEYS - 1
08400		GO TO 10
08500	C
08600	C SAVE A GOOD KEYWORD.
08700	90	CALL MOVE ( INPUT, 1, NCHAR, KEYWDS, 15 * NKEYS - 14 )
08800		KEYLEN(NKEYS)  = NCHAR
08900		IF ( NKEYS .LT. 6 ) GO TO 10
09000		GO TO 110
09100	C
09200	C IF NO KEYWORDS ARE ENTERED, TELL THE USER HOW TO STOP.
09300	100	NKEYS = NKEYS - 1
09400		IF ( NKEYS .GT. 0 ) GO TO 110
09500		WRITE ( LUTT, 105 )
09600	105	FORMAT ( / ' TO SEARCH, YOU MUST ENTER AT LEAST ONE KEYWORD.' /
09700		1 ' TO STOP, ENTER <CONTROL C>.' )
09800		GO TO 10
09900	C
10000	C SORT THE KEYWORDS.
10100	110	IF ( NKEYS .LT. 2 ) GO TO 150
10200	C
10300		IMAX = NKEYS - 1
10400		DO 140  I = 1, IMAX
10500		I1 = 15 * I - 14
10600		J0 = I + 1
10700	C
10800		DO 130  J = J0, NKEYS
10900		J1 = 15 * J - 14
11000		IF ( NCOMP ( KEYWDS, I1, I1 + 14, KEYWDS, J1 ) ) 130, 130, 120
11100	C
11200	120	CALL MOVE ( KEYWDS, I1, I1 + 14, INPUT ,  1 )
11300		NCHAR     = KEYLEN(I)
11400		CALL MOVE ( KEYWDS, J1, J1 + 14, KEYWDS, I1 )
11500		KEYLEN(I) = KEYLEN(J)
11600		CALL MOVE ( INPUT ,  1,      15, KEYWDS, J1 )
11700		KEYLEN(J) = NCHAR
11800	C
11900	130	CONTINUE
12000	C
12100	140	CONTINUE
12200	C
12300	C TYPE THE KEYWORDS.
12400	150	WRITE ( LUTT, 155 ) NKEYS,
12500		1                   ( ( KEYWDS(I,J), I = 1, 15 ), J = 1, NKEYS )
12600	155	FORMAT ( / ' A SEARCH WILL BE MADE FOR THESE', I2, ' KEYWORDS:' /
12700		1 ( 1X, 15A1, 1X, 15A1, 1X, 15A1 ) )
12800	C
12900		RETURN
13000		END
     
00100		SUBROUTINE AVINDX
00200	C
00300	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
00400	C
00500	C	PETE SCHILLING   ALCOA TECHNICAL CENTER   SEPTEMBER, 1974
00600	C
00700	C	PROCESS THE INDEX FILE LOOKING FOR THE SPECIFIED KEYWORDS.
00800	C
00900		DIMENSION INPUT(21), JNPUT(15)
01000	C
01100		COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15, 6), KEYLEN(6)
01200		COMMON / AVLUNS / LUTT , LUFL
01300		COMMON / AVNONW / NRECS, KHITS(600), KTIMS(600), KWRDS(600)
01400	C
01500		EQUIVALENCE ( INPUT(1), JNPUT(1) )
01600	C
01700		DATA LFBRKT / '<' /
01800		DATA MXHITS / 600 /
01900	C
02000	C OPEN THE INDEX FILE.
02100		OPEN ( UNIT = LUFL, MODE = 'ASCII', DIRECTORY = '101,15',
02200		1      ACCESS = 'SEQIN', FILE = 'PROGMS.IDX', DEVICE = 'DSK:',
02300		2      DISPOSE = 'SAVE' )
02400	C
02500	C CLEAR THE HIT INDICATORS.
02600		CALL FILL ( KHITS, 1, MXHITS, 0 )
02700		CALL FILL ( KWRDS, 1, MXHITS, 0 )
02800		NHITS = 0
02900		LHITS = 0
03000		I1 = 1
03100		J0 = 1
03200		J1 = KEYLEN(I1)
03300		MARKR = 32
03400	C
03500	C TELL THE USER THAT THE SEARCH HAS STARTED.
03600		WRITE ( LUTT, 5 )
03700	5	FORMAT ( / ' SEARCHING....' )
03800	C
03900	C PROCESS THE INDEX FILE.
04000	C
04100	C READ A RECORD FROM THE INDEX FILE.
04200	10	READ ( LUFL, 15, END = 100 ) INPUT
04300	15	FORMAT ( 21A1 )
04400	C
04500	C COMPARE THIS KEYWORD AGAINST THE CURRENT SEARCH WORD.
04600	20	IF ( NCOMP ( KEYWDS, J0, J1, INPUT, 1 ) ) 70, 30, 10
04700	C
04800	C A HIT.
04900	30	NHITS = NHITS + 1
05000		LHITS = LHITS + 1
05100		KWRDS(NHITS) = MARKR
05200	C
05300	C SAVE THE INDEX POINTER.
05400		DO 40  I = 3, 16
05500		IF ( INPUT(I) .EQ. LFBRKT ) GO TO 45
05600	40	CONTINUE
05700		I = 17
05800	C
05900	45	I0 = I + 1
06000		IMAX = I + 4
06100		ENCODE ( 5, 50, ITEMP ) ( INPUT(I), I = I0, IMAX )
06200	50	FORMAT ( 1X, 4A1 )
06300		DECODE ( 5, 55, ITEMP ) KHITS(NHITS)
06400	55	FORMAT ( I5 )
06500	C
06600	C CHECK WHETHER THE LIST OF HITS IS FILLED.
06700		IF ( NHITS .LT. MXHITS ) GO TO 10
06800		WRITE ( LUTT , 60 ) INPUT
06900	60	FORMAT ( / ' TOO MANY HITS HAVE BEEN FOUND.  SEARCH' /
07000		1 ' IS ENDING AT INDEX WORD ', 21A1 )
07100		GO TO 100
07200	C
07300	C IF THERE WERE NO HITS FOR THIS KEYWORD, SHOW THE USER THE TWO
07400	C   PRECEDING AND THE TWO FOLLOWING INDEX WORDS.
07500	70	IF ( LHITS .GT. 0 ) GO TO 95
07600		BACKSPACE LUFL
07700		BACKSPACE LUFL
07800		BACKSPACE LUFL
07900		WRITE ( LUTT, 75 ) ( KEYWDS(I,I1), I = 1, 15 )
08000	75	FORMAT ( / ' NO HITS FOUND FOR KEYWORD ', 15A1 /
08100		1 ' THESE INDEX WORDS MAY BE SIMILAR:' )
08200	C
08300		DO 85  I = 1, 4
08400		READ ( LUFL, 15, END = 100 ) INPUT
08500		WRITE ( LUTT, 80 ) JNPUT
08600	80	FORMAT ( 1X, 15A1, 1X, $ )
08700	85	CONTINUE
08800	C
08900		BACKSPACE LUFL
09000		BACKSPACE LUFL
09100		BACKSPACE LUFL
09200		BACKSPACE LUFL
09300		BACKSPACE LUFL
09400		WRITE ( LUTT, 90 )
09500	90	FORMAT ( / 1X )
09600	C
09700	C GO ON TO THE NEXT KEYWORD.
09800	95	I1 = I1 + 1
09900		IF ( I1 .GT. NKEYS ) GO TO 100
10000		LHITS = 0
10100		MARKR = MARKR / 2
10200		J0 = J0 + 15
10300		J1 = J0 + KEYLEN(I1) - 1
10400		GO TO 10
10500	C
10600	C AFTER EITHER THE INDEX OR THE KEYWORDS ARE EXHAUSTED, CLOSE THE FILE.
10700	100	CLOSE ( UNIT = LUFL )
10800		RETURN
10900		END
     
00100		SUBROUTINE AVSUMM
00200	C
00300	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
00400	C
00500	C	PETE SCHILLING     ALCOA TECHNICAL CENTER     SEPTEMBER, 1974
00600	C
00700	C	SUMMARIZE THE SEARCH RESULTS.
00800	C
00900		COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15,6), KEYDIS(6)
01000		COMMON / AVLUNS / LUTT
01100		COMMON / AVNONW / NRECS, KHITS(600), KTIMS(600), KWRDS(600)
01200	C
01300		DATA MXHITS / 600 /
01400	C
01500	C TELL THE USER HOW MANY HITS.
01600		WRITE ( LUTT, 10 ) NHITS
01700	10	FORMAT ( / I4, ' HITS' )
01800	C
01900	C INITIALIZE THE SOFTWARE ITEM INDICATORS.
02000		NRECS = 1
02100		CALL FILL ( KTIMS, 1, MXHITS, 1 )
02200	C
02300	C SORT THE LIST OF HITS.
02400		IF ( NHITS .LT. 2 ) GO TO 80
02500	C
02600		IMAX = NHITS - 1
02700		DO 30  I = 1, IMAX
02800		J0 = I + 1
02900	C
03000		DO 20  J = J0, NHITS
03100		IF ( KHITS(I) .LE. KHITS(J) ) GO TO 20
03200		ITEMP    = KHITS(I)
03300		KHITS(I) = KHITS(J)
03400		KHITS(J) = ITEMP
03500		ITEMP    = KWRDS(I)
03600		KWRDS(I) = KWRDS(J)
03700		KWRDS(J) = ITEMP
03800	20	CONTINUE
03900	C
04000	30	CONTINUE
04100	C
04200	C PACK THE LIST OF HITS AND SAVE THE NUMBER OF OCCURENCES OF EACH HIT.
04300		DO 50  I = 2, NHITS
04400		IF ( KHITS(NRECS) .NE. KHITS(I) ) GO TO 40
04500		KTIMS(NRECS) = KTIMS(NRECS) + 1
04600		KWRDS(NRECS) = KWRDS(NRECS) .OR. KWRDS(I)
04700		GO TO 50
04800	C
04900	40	NRECS = NRECS + 1
05000		KHITS(NRECS) = KHITS(I)
05100		KWRDS(NRECS) = KWRDS(I)
05200	50	CONTINUE
05300	C
05400	C SORT THE LIST OF HITS INTO ORDER OF DECREASING NUMBER
05500	C   OF OCCURRENCES, AND INCREASING INDEX NUMBERS.
05600		IF ( NRECS .LT. 2 ) GO TO 80
05700	C
05800		IMAX = NRECS - 1
05900		DO 75  I = 1, IMAX
06000		J0 = I + 1
06100	C
06200		DO 70  J = J0, NRECS
06300		IF ( KTIMS(I) .GT. KTIMS(J) ) GO TO 70
06400		IF ( KTIMS(I) .EQ. KTIMS(J) ) GO TO 60
06500	C
06600	C MUST BE LESS THAN.
06700		ITEMP    = KTIMS(I)
06800		KTIMS(I) = KTIMS(J)
06900		KTIMS(J) = ITEMP
07000		GO TO 65
07100	C
07200	60	IF ( KHITS(I) .LE. KHITS(J) ) GO TO 70
07300	65	ITEMP    = KHITS(I)
07400		KHITS(I) = KHITS(J)
07500		KHITS(J) = ITEMP
07600		ITEMP    = KWRDS(I)
07700		KWRDS(I) = KWRDS(J)
07800		KWRDS(J) = ITEMP
07900	70	CONTINUE
08000	C
08100	75	CONTINUE
08200	C
08300	C TALLY THE SEARCH RESULTS.
08400	80	CALL FILL ( KEYDIS, 1, 6, 0 )
08500		J = NKEYS
08600		J0 = 1
08700		DO 90  I = 1, NRECS
08800	82	IF ( KTIMS(I) .GE. J ) GO TO 85
08900		J = J - 1
09000		IF ( J .LE. 0 ) GO TO 100
09100		J0 = J0 + 1
09200		GO TO 82
09300	C
09400	85	KEYDIS(J0) = KEYDIS(J0) + 1
09500	90	CONTINUE
09600	C
09700	C SHOW THE DISTRIBUTION OF HITS.
09800	100	WRITE ( LUTT, 110 ) NRECS
09900	110	FORMAT ( / I4, ' SOFTWARE ITEMS WERE FOUND TO MATCH YOUR' /
10000		1 ' REQUEST.  THE HITS ARE DISTRIBUTED AS FOLLOWS:' //
10100		2 ' HITS PER ITEM   ITEMS' )
10200	
10300	C
10400		DO 130  I = 1, NKEYS
10500		I1 = NKEYS + 1 - I
10600		WRITE ( LUTT, 120 ) I1, KEYDIS(I)
10700	120	FORMAT ( I8, I12 )
10800	130	CONTINUE
10900	C
11000		RETURN
11100		END
11200		SUBROUTINE AVRSLT
11300	C
11400	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
11500	C
11600	C	PETE SCHILLING   ALCOA TECHNICAL CENTER   SEPTEMBER, 1974
11700	C
11800	C	TELL THE USER THE RESULTS OF THE SEARCH.
11900	C
12000		DIMENSION IDESCR(23)
12100	C
12200		COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15, 6), KEYLEN(6)
12300		COMMON / AVLUNS / LUTT , LUFL , LULP , LURN
12400		COMMON / AVNONW / NRECS, KHITS(600), KTIMS(600), KWRDS(600)
12500	C
12600		DATA MXINDX / 10000 /
12700	C
12800	C ASK THE USER HOW MANY ITEMS HE WISHES TO DISPLAY.
12900		WRITE ( LUTT, 10 )
13000	10	FORMAT (/' HOW MANY OF THESE ITEMS DO YOU WANT TYPED?   ' $ )
13100		CALL AVCNVT ( NDISPT )
13200		IF ( NDISPT .GT. NRECS ) NDISPT = NRECS
13300	C
13400		WRITE ( LUTT, 20 )
13500	20	FORMAT (/' HOW MANY OF THESE ITEMS DO YOU WANT PRINTED?   ' $ )
13600		CALL AVCNVT ( NDISPP )
13700		IF ( NDISPP .GT. NRECS ) NDISPP = NRECS
13800	C
13900		IF ( NDISPP .LE. 0 .AND. NDISPT .LE. 0 ) GO TO 170
14000	C
14100	C OPEN THE FILE OF AVAILABLE SOFTWARE, AND THE WORKING STORAGE FILE.
14200		OPEN ( UNIT = LUFL, MODE = 'ASCII', DIRECTORY = '101,15',
14300		1      ACCESS = 'SEQIN', FILE = 'PROGMS.ALL', DEVICE = 'DSK:',
14400		2      DISPOSE = 'SAVE' )
14500		OPEN ( UNIT = LURN, MODE = 'BINARY', ACCESS = 'RANDOM',
14600		1 FILE = 'PROGMS.TMP', DEVICE = 'DSK:', DISPOSE = 'DELETE',
14700		2 RECORD SIZE = 25 )
14800	C
14900	C FIND THE ITEMS TO BE DISPLAYED IN ORDER OF INDEX NUMBERS.
15000		WRITE ( LUTT, 25 )
15100	25	FORMAT ( / ' PREPARING THE RESULTS FOR DISPLAY MAY REQUIRE' /
15200		1 ' A MINUTE OR TWO.  PLEASE BE PATIENT....' )
15300		WRITE ( LUTT, 30 )
15400	30	FORMAT ( 1X )
15500	C
15600		DO 80  I = 1, NRECS
15700		ITEMP = KHITS(I)
15800		J0 = I
15900	C
16000		DO 40  J = 1, NRECS
16100		IF ( ITEMP .LE. KHITS(J) ) GO TO 40
16200		ITEMP = KHITS(J)
16300		J0 = J
16400	C
16500	40	CONTINUE
16600	C
16700	60	READ ( LUFL, 70, END = 90 ) JTEMP, IDESCR
16800	70	FORMAT ( I5, 1X, 23A5 )
16900		IF ( JTEMP .LT. ITEMP ) GO TO 60
17000		WRITE ( LURN ' J0 ) JTEMP, IDESCR
17100		KHITS(J0) = MXINDX
17200	C
17300	80	CONTINUE
17400	C
17500	C DISPLAY THE REQUESTED ITEMS.
17600	90	IF ( NDISPP .LE. 0 ) GO TO 120
17700		WRITE ( LULP, 85 ) (J, (KEYWDS(I,J), I = 1, 15), J = 1, NKEYS )
17800	85	FORMAT ( '1SEARCH OF AVAILABLE SOFTWARE FOR THE' /
17900		1 ' DECSYSTEM-10, USING THESE KEYWORDS:' /
18000		2 ( I5, 3X, 15A1 ) )
18100	C
18200		DO 110  I = 1, NDISPP
18300		READ  ( LURN ' I, END = 120 ) JTEMP, IDESCR
18400		WRITE ( LULP, 100 ) IDESCR, KTIMS(I), JTEMP, KWRDS(I)
18500	100	FORMAT ( 1X, 23A5, I2, I5, 1X, O2 )
18600	110	CONTINUE
18700	C
18800	120	IF ( NDISPT .LE. 0 ) GO TO 150
18900		WRITE ( LUTT, 30 )
19000	C
19100		DO 140  I = 1, NDISPT
19200		READ ( LURN ' I, END = 150 ) JTEMP, IDESCR
19300		WRITE ( LUTT, 100 ) IDESCR, KTIMS(I), JTEMP, KWRDS(I)
19400	140	CONTINUE
19500	C
19600	C CLOSE THE FILES.
19700	150	CLOSE ( UNIT = LUFL )
19800		CLOSE ( UNIT = LURN )
19900	C
20000	170	RETURN
20100		END
20200		LOGICAL FUNCTION AVANSR ( LUTT )
20300	C
20400	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
20500	C
20600	C	PETE SCHILLING   ALCOA TECHNICAL CENTER   SEPTEMBER, 1974
20700	C
20800	C	GET THE USER'S ANSWER TO A QUESTION.
20900	C
21000		DIMENSION INPUT(10)
21100	C
21200		EQUIVALENCE ( INPUT(1), INPUT1 )
21300	C
21400		DATA IN    / 'N' /
21500		DATA IY    / 'Y' /
21600	C
21700	C TO START, SET THE ANSWER .FALSE.
21800		AVANSR = .FALSE.
21900	C
22000	C GET THE USER'S ANSWER.
22100	10	READ ( LUTT, 15 ) INPUT
22200	15	FORMAT ( 10A1 )
22300	C
22400	C THE ANSWER MUST START WITH 'Y' OR 'N'.
22500		IF ( INPUT1 .EQ. IY .OR. INPUT1 .EQ. IN ) GO TO 25
22600		WRITE ( LUTT, 20 )
22700	20	FORMAT ( ' PLEASE ANSWER YES OR NO.   ' $ )
22800		GO TO 10
22900	C
23000	C IF IT STARTS WITH 'Y', SET THE FUNCTION .TRUE.
23100	25	IF ( INPUT1 .EQ. IY ) AVANSR = .TRUE.
23200	C
23300		RETURN
23400		END
23500		SUBROUTINE AVSTOP
23600	C
23700	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
23800	C
23900	C	PETE SCHILLING   ALCOA TECHNICAL CENTER   SEPTEMBER, 1974
24000	C
24100	C	GET THE LIST OF NON-INDEXED WORDS.
24200	C
24300		COMMON / AVNONW / NSTOP, KSTOP(12,150)
24400		COMMON / AVLUNS / LUTT, LUFL
24500	C
24600		DATA IBLNK  / ' ' /
24700		DATA MXSTOP / 150 /
24800	C
24900		CALL FILL ( KSTOP, 1, 1800, IBLNK )
25000	C
25100	C OPEN THE 'STOP' FILE.
25200		OPEN ( UNIT = LUFL, MODE = 'ASCII', DIRECTORY = '101,15',
25300		1      ACCESS = 'SEQIN', FILE = 'PROGMS.STP', DEVICE = 'DSK:',
25400		2      DISPOSE = 'SAVE' )
25500	C
25600	C READ THE NON-INDEXING WORDS.
25700		DO 20  NSTOP = 1, MXSTOP
25800		READ ( LUFL, 15, END = 70 ) ( KSTOP(I,NSTOP), I = 1, 12 )
25900	15	FORMAT ( 12A1 )
26000	20	CONTINUE
26100		NSTOP = MXSTOP + 1
26200	C
26300	C END-OF-FILE.  CLOSE THE 'STOP' FILE.
26400	70	NSTOP = NSTOP - 1
26500		CLOSE ( UNIT = LUFL )
26600		RETURN
26700		END
26800		SUBROUTINE AVCNVT ( NUMBER )
26900	C
27000	C	SEARCH THE LIST OF AVAILABLE SOFTWARE
27100	C
27200	C	PETE SCHILLING   ALCOA TECHNICAL CENTER   SEPTEMBER, 1974
27300	C
27400	C	GET AN INTEGER-VALUED RESPONSE FROM THE USER
27500	C
27600		DIMENSION INPUT(10)
27700	C
27800		COMMON / AVLUNS / LUTT
27900	C
28000		DATA IBLNK / ' ' /
28100		DATA I0    / '0' /
28200		DATA I9    / '9' /
28300	C
28400	C READ THE RESPONSE.
28500	10	NUMBER = 0
28600		READ ( LUTT, 20 ) INPUT
28700	20	FORMAT ( 10A1 )
28800	C
28900	C FIND THE LAST NON-BLANK CHARACTER.
29000		DO 30  I = 1, 10
29100		J = 11 - I
29200		IF ( INPUT(J) .NE. IBLNK ) GO TO 40
29300	30	CONTINUE
29400	C
29500	C IF THE RESPONSE IS ALL BLANKS, ZERO IS THE VALUE.
29600		GO TO 100
29700	C
29800	C SCAN THE REST OF THE INPUT FOR BLANKS.
29900	40	IMAX = J
30000		J0 = 0
30100		DO 60  I = 1, IMAX
30200		IF ( INPUT(I) .NE. IBLNK ) GO TO 60
30300	C
30400		J0 = J0 + 1
30500		IF ( J0 .EQ. I ) GO TO 60
30600	C
30700		WRITE ( LUTT, 50 )
30800	50	FORMAT ( ' RE-ENTER THE VALUE WITH NO EMBEDDED BLANKS.   ' $ )
30900		GO TO 10
31000	C
31100	60	CONTINUE
31200	C
31300	C CHECK FOR NON-NUMERIC VALUES AND CONVERT THE NUMERIC ONES.
31400		J1 = J0 + 1
31500		DO 90  I = J1, IMAX
31600		IF ( INPUT(I) .LE. I9 .AND. INPUT(I) .GE. I0 ) GO TO 80
31700	C
31800		WRITE ( LUTT, 70 )
31900	70	FORMAT ( ' AN UNSIGNED NUMERIC VALUE IS REQUIRED.   ' $ )
32000		GO TO 10
32100	C
32200	80	ITEMP = ( INPUT(I) - I0 ) / 536870912
32300		NUMBER = 10 * NUMBER + ITEMP
32400	C
32500	90	CONTINUE
32600	C
32700	100	RETURN
32800		END