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