Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50342/avail.f4
There are no other files named avail.f4 in the archive.
C PROGRAM AVAIL
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C THIS IS THE MAIN PROGRAM WHICH CALLS THE SUBROUTINES
C WHICH DO THE WORK.
C
COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15,6), KEYLEN(6)
COMMON / AVLUNS / LUTT , LUFL ,LULP , LURN
C
LUTT = 5
LUFL = 26
LULP = 3
LURN = 27
C
C GIVE THE USER SOME INSTRUCTIONS ON THE PROGRAM.
CALL AVINST
C
C GET THE LIST OF NON-INDEXED WORDS.
CALL AVSTOP
C
C GET THE KEYWORDS FOR THE SEARCH.
10 CALL AVKEYS
C
C SEARCH THE INDEX FILE.
CALL AVINDX
C
C IF THERE WERE NO HITS, CHECK WHETHER THE USER WISHES TO TRY AGAIN.
IF ( NHITS .LE. 0 ) GO TO 70
C
C IF THERE WERE HITS IN THE SEARCH, SUMMARIZE THE RESULTS.
CALL AVSUMM
C
C TELL THE USER THE RESULTS.
CALL AVRSLT
C
C DOES THE USER WISH TO CONTINUE?
WRITE ( LUTT, 25 )
25 FORMAT ( / ' DO YOU WISH TO TRY ANOTHER SEARCH? ' $ )
IF ( AVANSR ( LUTT ) ) GO TO 10
C
C IF NOT, STOP.
GO TO 90
C
C DOES THE USER WISH TO TRY AGAIN?
70 WRITE ( LUTT, 75 )
75 FORMAT ( / ' THERE WERE NO HITS WITH THOSE KEYWORDS.' /
1 ' DO YOU WISH TO TRY AGAIN WITH NEW ONES? ' $ )
IF ( AVANSR ( LUTT ) ) GO TO 10
C
C IF THE USER IS FINISHED, THANK HIM AND QUIT.
90 WRITE ( LUTT, 95 )
95 FORMAT ( / ' THANK YOU. I HOPE YOU FOUND THIS HELPFUL.' /
1 ' PETE SCHILLING (X2693) WOULD APPRECIATE' /
2 ' YOUR COMMENTS AND SUGGESTIONS.' / )
C
CALL EXIT
END
SUBROUTINE AVINST
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C GIVE THE USER SOME INSTRUCTIONS.
C
COMMON / AVLUNS / LUTT
C
WRITE ( LUTT, 15 )
15 FORMAT ( / ' SEARCH OF AVAILABLE SOFTWARE' /
1 ' FOR THE DECSYSTEM-10' //
2 ' DO YOU WANT INSTRUCTIONS? ' $ )
C
C IF THE USER DOES NOT WANT INSTRUCTIONS, SKIP THEM.
IF ( .NOT. AVANSR ( LUTT ) ) GO TO 70
C
C IF THE USER DOES WANT INSTRUCTIONS, TYPE THEM.
WRITE ( LUTT, 25 )
25 FORMAT ( / ' YOU MAY SPECIFY UP TO SIX KEYWORDS TO BE USED' /
1 ' IN THE SEARCH. ENTER EACH KEYWORD WITH NO' /
2 ' LEADING OR EMBEDDED BLANKS WHEN IT IS REQUESTED.' /
3 ' END EACH ONE WITH A <CARRIAGE RETURN>. IF YOU' /
4 ' WISH TO USE FEWER THAN SIX, JUST ENTER <CARRIAGE' /
5 ' RETURN> WHEN ASKED FOR THE NEXT KEYWORD AFTER YOU' /
6 ' HAVE ENTERED YOUR LAST ONE. ' )
C
WRITE ( LUTT, 35 )
35 FORMAT (/ ' IN SELECTING KEYWORDS, KEEP THESE POINTS IN MIND:'/
1 ' AVOID COMMONLY-USED WORDS LIKE AND, THE, A, PROGRAM.' /
2 ' AVOID PLURALS; USE MATRIX, NOT MATRICES; USE' /
3 ' ELEMENT, NOT ELEMENTS.' /
4 ' AVOID WORDS WITH SUFFIXES; USE RANDOM, NOT RANDOMLY;' /
5 ' USE SEQUENCE, NOT SEQUENCING.' /
6 ' THE FIRST PART OF A WORD MAY BE USED AS A KEYWORD' /
7 ' TO SEARCH FOR SEVERAL DIFFERENT INDEX WORDS;' /
8 ' INTEGR RETRIEVES INTEGRAL AND INTEGRATE.' )
C
WRITE ( LUTT, 45 )
45 FORMAT (/' THE SEARCH RESULTS MAY BE TYPED AND/OR PRINTED, AS' /
1 ' YOU SPECIFY, STARTING WITH THE BEST-MATCHED SOFTWARE', /
2 ' ITEMS, AND CONTINUING WITH THE LESS WELL-MATCHED ITEMS.' /
3 ' ALL OF THE ITEMS WHICH ARE HIT BY YOUR KEYWORDS CAN BE' /
4 ' DISPLAYED, OR A SMALLER NUMBER. FOR EACH ITEM, A' /
5 ' THREE LETTER CODE FOR THE SOURCE LANGUAGE IS FOLLOWED' /
6 ' BY THE SPECIFICATION FOR THE FILE(S) CONTAINING' /
7 ' THE ITEM, WHICH IS FOLLOWED BY A DESCRIPTION.' /
8 ' TO OBTAIN AN ITEM, JUST COPY THE SPECIFIED FILE(S).' )
C
WRITE ( LUTT, 55 )
55 FORMAT (/ ' IF YOU DON''T FIND WHAT YOU NEED WITH YOUR FIRST' /
9 ' CHOICE OF KEYWORDS, REPHRASE YOUR REQUIREMENTS,' /
1 ' CHOOSE NEW KEYWORDS, AND TRY AGAIN. IN ORDER TO GET' /
2 ' A CORRECT ANSWER, YOU MUST ASK A CORRECT QUESTION.' /
3 ' CALL PETE SCHILLING (EXTENSION 2693) FOR HELP.' /
4 ' GOOD LUCK.' / )
C
70 RETURN
END
SUBROUTINE AVKEYS
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C GET THE KEYWORDS FOR A SEARCH.
C
DIMENSION INPUT(15)
C
COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15, 6), KEYLEN(6)
COMMON / AVLUNS / LUTT
COMMON / AVNONW / NSTOP, KSTOP(12,150)
C
DATA IBLNK / ' ' /
C
C CLEAR THE KEYWORD ARRAYS.
NKEYS = 0
NERRS = 0
CALL FILL ( KEYLEN, 1, 6, 0 )
CALL FILL ( KEYWDS, 1, 90, IBLNK )
C
C CLEAR THE INPUT ARRAY.
10 CALL FILL ( INPUT, 1, 15, IBLNK )
NKEYS = NKEYS + 1
C
C ASK FOR THE KEYWORDS.
WRITE ( LUTT, 15 ) NKEYS
15 FORMAT ( ' KEYWORD', I2, 3X $ )
READ ( LUTT, 25 ) INPUT
25 FORMAT ( 15A1 )
C
C HOW MANY CHARACTERS WERE ENTERED IN THIS KEYWORD?
DO 30 NCHAR = 1, 15
IF ( INPUT(NCHAR) .EQ. IBLNK ) GO TO 40
30 CONTINUE
C
NCHAR = 16
C
40 NCHAR = NCHAR - 1
IF ( NCHAR .EQ. 0 ) GO TO 100
C
C A SINGLE-CHARACTER KEYWORD BECOMES 'X ' BY REQUIRING AT LEAST
C TWO CHARACTERS.
IF ( NCHAR .LT. 2 ) NCHAR = 2
C
C CHECK THE KEYWORD AGAINST THE ONES ENTERED PREVIOUSLY.
IF ( NKEYS .LE. 1 ) GO TO 48
DO 45 I = 1, NKEYS
IF ( NCOMP ( INPUT, 1, NCHAR, KEYWDS(1,I), 1 ) ) 41, 42, 41
41 IF ( NCOMP ( KEYWDS(1,I), 1, KEYLEN(I), INPUT, 1 ) ) 45, 42, 45
C
42 WRITE ( LUTT, 43 )
43 FORMAT ( ' THAT KEYWORD IS ALREADY IN USE.' )
GO TO 70
C
45 CONTINUE
C
C CHECK THE KEYWORD AGAINST THE STOP LIST.
48 DO 50 I = 1, NSTOP
IF ( NCOMP ( INPUT, 1, 12, KSTOP(1,I), 1 ) ) 90, 60, 50
50 CONTINUE
GO TO 90
C
C THE KEYWORD IS ON THE STOP LIST.
60 WRITE ( LUTT, 65 )
65 FORMAT ( ' THAT WORD IS NOT USED IN THE INDEX.' )
C
C AFTER TWO BAD ENTRIES, OFFER SOME HELP.
NERRS = NERRS + 1
IF ( NERRS .LT. 2 ) GO TO 70
WRITE ( LUTT, 67 )
67 FORMAT ( ' DO YOU WISH TO SEE A LIST OF NON-INDEXED WORDS? '$)
IF ( .NOT. AVANSR ( LUTT ) ) GO TO 80
WRITE ( LUTT, 69 ) ( ( KSTOP(I,J), I = 1, 12 ), J = 1, NSTOP )
69 FORMAT ( 1X, 12A1, 1X, 12A1, 1X, 12A1, 1X, 12A1, 1X, 12A1 )
GO TO 80
C
70 WRITE ( LUTT, 75 )
75 FORMAT ( ' SELECT A DIFFERENT ONE.' )
C
C IF THE WORD IS ON THE 'STOP' LIST, DO NOT ACCEPT IT.
80 NKEYS = NKEYS - 1
GO TO 10
C
C SAVE A GOOD KEYWORD.
90 CALL MOVE ( INPUT, 1, NCHAR, KEYWDS, 15 * NKEYS - 14 )
KEYLEN(NKEYS) = NCHAR
IF ( NKEYS .LT. 6 ) GO TO 10
GO TO 110
C
C IF NO KEYWORDS ARE ENTERED, TELL THE USER HOW TO STOP.
100 NKEYS = NKEYS - 1
IF ( NKEYS .GT. 0 ) GO TO 110
WRITE ( LUTT, 105 )
105 FORMAT ( / ' TO SEARCH, YOU MUST ENTER AT LEAST ONE KEYWORD.' /
1 ' TO STOP, ENTER <CONTROL C>.' )
GO TO 10
C
C SORT THE KEYWORDS.
110 IF ( NKEYS .LT. 2 ) GO TO 150
C
IMAX = NKEYS - 1
DO 140 I = 1, IMAX
I1 = 15 * I - 14
J0 = I + 1
C
DO 130 J = J0, NKEYS
J1 = 15 * J - 14
IF ( NCOMP ( KEYWDS, I1, I1 + 14, KEYWDS, J1 ) ) 130, 130, 120
C
120 CALL MOVE ( KEYWDS, I1, I1 + 14, INPUT , 1 )
NCHAR = KEYLEN(I)
CALL MOVE ( KEYWDS, J1, J1 + 14, KEYWDS, I1 )
KEYLEN(I) = KEYLEN(J)
CALL MOVE ( INPUT , 1, 15, KEYWDS, J1 )
KEYLEN(J) = NCHAR
C
130 CONTINUE
C
140 CONTINUE
C
C TYPE THE KEYWORDS.
150 WRITE ( LUTT, 155 ) NKEYS,
1 ( ( KEYWDS(I,J), I = 1, 15 ), J = 1, NKEYS )
155 FORMAT ( / ' A SEARCH WILL BE MADE FOR THESE', I2, ' KEYWORDS:' /
1 ( 1X, 15A1, 1X, 15A1, 1X, 15A1 ) )
C
RETURN
END
SUBROUTINE AVINDX
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C PROCESS THE INDEX FILE LOOKING FOR THE SPECIFIED KEYWORDS.
C
DIMENSION INPUT(21), JNPUT(15)
C
COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15, 6), KEYLEN(6)
COMMON / AVLUNS / LUTT , LUFL
COMMON / AVNONW / NRECS, KHITS(600), KTIMS(600), KWRDS(600)
C
EQUIVALENCE ( INPUT(1), JNPUT(1) )
C
DATA LFBRKT / '<' /
DATA MXHITS / 600 /
C
C OPEN THE INDEX FILE.
OPEN ( UNIT = LUFL, MODE = 'ASCII', DIRECTORY = '101,15',
1 ACCESS = 'SEQIN', FILE = 'PROGMS.IDX', DEVICE = 'DSK:',
2 DISPOSE = 'SAVE' )
C
C CLEAR THE HIT INDICATORS.
CALL FILL ( KHITS, 1, MXHITS, 0 )
CALL FILL ( KWRDS, 1, MXHITS, 0 )
NHITS = 0
LHITS = 0
I1 = 1
J0 = 1
J1 = KEYLEN(I1)
MARKR = 32
C
C TELL THE USER THAT THE SEARCH HAS STARTED.
WRITE ( LUTT, 5 )
5 FORMAT ( / ' SEARCHING....' )
C
C PROCESS THE INDEX FILE.
C
C READ A RECORD FROM THE INDEX FILE.
10 READ ( LUFL, 15, END = 100 ) INPUT
15 FORMAT ( 21A1 )
C
C COMPARE THIS KEYWORD AGAINST THE CURRENT SEARCH WORD.
20 IF ( NCOMP ( KEYWDS, J0, J1, INPUT, 1 ) ) 70, 30, 10
C
C A HIT.
30 NHITS = NHITS + 1
LHITS = LHITS + 1
KWRDS(NHITS) = MARKR
C
C SAVE THE INDEX POINTER.
DO 40 I = 3, 16
IF ( INPUT(I) .EQ. LFBRKT ) GO TO 45
40 CONTINUE
I = 17
C
45 I0 = I + 1
IMAX = I + 4
ENCODE ( 5, 50, ITEMP ) ( INPUT(I), I = I0, IMAX )
50 FORMAT ( 1X, 4A1 )
DECODE ( 5, 55, ITEMP ) KHITS(NHITS)
55 FORMAT ( I5 )
C
C CHECK WHETHER THE LIST OF HITS IS FILLED.
IF ( NHITS .LT. MXHITS ) GO TO 10
WRITE ( LUTT , 60 ) INPUT
60 FORMAT ( / ' TOO MANY HITS HAVE BEEN FOUND. SEARCH' /
1 ' IS ENDING AT INDEX WORD ', 21A1 )
GO TO 100
C
C IF THERE WERE NO HITS FOR THIS KEYWORD, SHOW THE USER THE TWO
C PRECEDING AND THE TWO FOLLOWING INDEX WORDS.
70 IF ( LHITS .GT. 0 ) GO TO 95
BACKSPACE LUFL
BACKSPACE LUFL
BACKSPACE LUFL
WRITE ( LUTT, 75 ) ( KEYWDS(I,I1), I = 1, 15 )
75 FORMAT ( / ' NO HITS FOUND FOR KEYWORD ', 15A1 /
1 ' THESE INDEX WORDS MAY BE SIMILAR:' )
C
DO 85 I = 1, 4
READ ( LUFL, 15, END = 100 ) INPUT
WRITE ( LUTT, 80 ) JNPUT
80 FORMAT ( 1X, 15A1, 1X, $ )
85 CONTINUE
C
BACKSPACE LUFL
BACKSPACE LUFL
BACKSPACE LUFL
BACKSPACE LUFL
BACKSPACE LUFL
WRITE ( LUTT, 90 )
90 FORMAT ( / 1X )
C
C GO ON TO THE NEXT KEYWORD.
95 I1 = I1 + 1
IF ( I1 .GT. NKEYS ) GO TO 100
LHITS = 0
MARKR = MARKR / 2
J0 = J0 + 15
J1 = J0 + KEYLEN(I1) - 1
GO TO 10
C
C AFTER EITHER THE INDEX OR THE KEYWORDS ARE EXHAUSTED, CLOSE THE FILE.
100 CLOSE ( UNIT = LUFL )
RETURN
END
SUBROUTINE AVSUMM
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C SUMMARIZE THE SEARCH RESULTS.
C
COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15,6), KEYDIS(6)
COMMON / AVLUNS / LUTT
COMMON / AVNONW / NRECS, KHITS(600), KTIMS(600), KWRDS(600)
C
DATA MXHITS / 600 /
C
C TELL THE USER HOW MANY HITS.
WRITE ( LUTT, 10 ) NHITS
10 FORMAT ( / I4, ' HITS' )
C
C INITIALIZE THE SOFTWARE ITEM INDICATORS.
NRECS = 1
CALL FILL ( KTIMS, 1, MXHITS, 1 )
C
C SORT THE LIST OF HITS.
IF ( NHITS .LT. 2 ) GO TO 80
C
IMAX = NHITS - 1
DO 30 I = 1, IMAX
J0 = I + 1
C
DO 20 J = J0, NHITS
IF ( KHITS(I) .LE. KHITS(J) ) GO TO 20
ITEMP = KHITS(I)
KHITS(I) = KHITS(J)
KHITS(J) = ITEMP
ITEMP = KWRDS(I)
KWRDS(I) = KWRDS(J)
KWRDS(J) = ITEMP
20 CONTINUE
C
30 CONTINUE
C
C PACK THE LIST OF HITS AND SAVE THE NUMBER OF OCCURENCES OF EACH HIT.
DO 50 I = 2, NHITS
IF ( KHITS(NRECS) .NE. KHITS(I) ) GO TO 40
KTIMS(NRECS) = KTIMS(NRECS) + 1
KWRDS(NRECS) = KWRDS(NRECS) .OR. KWRDS(I)
GO TO 50
C
40 NRECS = NRECS + 1
KHITS(NRECS) = KHITS(I)
KWRDS(NRECS) = KWRDS(I)
50 CONTINUE
C
C SORT THE LIST OF HITS INTO ORDER OF DECREASING NUMBER
C OF OCCURRENCES, AND INCREASING INDEX NUMBERS.
IF ( NRECS .LT. 2 ) GO TO 80
C
IMAX = NRECS - 1
DO 75 I = 1, IMAX
J0 = I + 1
C
DO 70 J = J0, NRECS
IF ( KTIMS(I) .GT. KTIMS(J) ) GO TO 70
IF ( KTIMS(I) .EQ. KTIMS(J) ) GO TO 60
C
C MUST BE LESS THAN.
ITEMP = KTIMS(I)
KTIMS(I) = KTIMS(J)
KTIMS(J) = ITEMP
GO TO 65
C
60 IF ( KHITS(I) .LE. KHITS(J) ) GO TO 70
65 ITEMP = KHITS(I)
KHITS(I) = KHITS(J)
KHITS(J) = ITEMP
ITEMP = KWRDS(I)
KWRDS(I) = KWRDS(J)
KWRDS(J) = ITEMP
70 CONTINUE
C
75 CONTINUE
C
C TALLY THE SEARCH RESULTS.
80 CALL FILL ( KEYDIS, 1, 6, 0 )
J = NKEYS
J0 = 1
DO 90 I = 1, NRECS
82 IF ( KTIMS(I) .GE. J ) GO TO 85
J = J - 1
IF ( J .LE. 0 ) GO TO 100
J0 = J0 + 1
GO TO 82
C
85 KEYDIS(J0) = KEYDIS(J0) + 1
90 CONTINUE
C
C SHOW THE DISTRIBUTION OF HITS.
100 WRITE ( LUTT, 110 ) NRECS
110 FORMAT ( / I4, ' SOFTWARE ITEMS WERE FOUND TO MATCH YOUR' /
1 ' REQUEST. THE HITS ARE DISTRIBUTED AS FOLLOWS:' //
2 ' HITS PER ITEM ITEMS' )
C
DO 130 I = 1, NKEYS
I1 = NKEYS + 1 - I
WRITE ( LUTT, 120 ) I1, KEYDIS(I)
120 FORMAT ( I8, I12 )
130 CONTINUE
C
RETURN
END
SUBROUTINE AVRSLT
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C TELL THE USER THE RESULTS OF THE SEARCH.
C
DIMENSION IDESCR(23)
C
COMMON / AVKEY1 / NKEYS, NHITS, KEYWDS(15, 6), KEYLEN(6)
COMMON / AVLUNS / LUTT , LUFL , LULP , LURN
COMMON / AVNONW / NRECS, KHITS(600), KTIMS(600), KWRDS(600)
C
DATA MXINDX / 10000 /
C
C ASK THE USER HOW MANY ITEMS HE WISHES TO DISPLAY.
WRITE ( LUTT, 10 )
10 FORMAT (/' HOW MANY OF THESE ITEMS DO YOU WANT TYPED? ' $ )
CALL AVCNVT ( NDISPT )
IF ( NDISPT .GT. NRECS ) NDISPT = NRECS
C
WRITE ( LUTT, 20 )
20 FORMAT (/' HOW MANY OF THESE ITEMS DO YOU WANT PRINTED? ' $ )
CALL AVCNVT ( NDISPP )
IF ( NDISPP .GT. NRECS ) NDISPP = NRECS
C
IF ( NDISPP .LE. 0 .AND. NDISPT .LE. 0 ) GO TO 170
C
C OPEN THE FILE OF AVAILABLE SOFTWARE, AND THE WORKING STORAGE FILE.
OPEN ( UNIT = LUFL, MODE = 'ASCII', DIRECTORY = '101,15',
1 ACCESS = 'SEQIN', FILE = 'PROGMS.ALL', DEVICE = 'DSK:',
2 DISPOSE = 'SAVE' )
OPEN ( UNIT = LURN, MODE = 'BINARY', ACCESS = 'RANDOM',
1 FILE = 'PROGMS.TMP', DEVICE = 'DSK:', DISPOSE = 'DELETE',
2 RECORD SIZE = 25 )
C
C FIND THE ITEMS TO BE DISPLAYED IN ORDER OF INDEX NUMBERS.
WRITE ( LUTT, 25 )
25 FORMAT ( / ' PREPARING THE RESULTS FOR DISPLAY MAY REQUIRE' /
1 ' A MINUTE OR TWO. PLEASE BE PATIENT....' )
WRITE ( LUTT, 30 )
30 FORMAT ( 1X )
C
DO 80 I = 1, NRECS
ITEMP = KHITS(I)
J0 = I
C
DO 40 J = 1, NRECS
IF ( ITEMP .LE. KHITS(J) ) GO TO 40
ITEMP = KHITS(J)
J0 = J
C
40 CONTINUE
C
60 READ ( LUFL, 70, END = 90 ) JTEMP, IDESCR
70 FORMAT ( I5, 1X, 23A5 )
IF ( JTEMP .LT. ITEMP ) GO TO 60
WRITE ( LURN ' J0 ) JTEMP, IDESCR
KHITS(J0) = MXINDX
C
80 CONTINUE
C
C DISPLAY THE REQUESTED ITEMS.
90 IF ( NDISPP .LE. 0 ) GO TO 120
WRITE ( LULP, 85 ) (J, (KEYWDS(I,J), I = 1, 15), J = 1, NKEYS )
85 FORMAT ( '1SEARCH OF AVAILABLE SOFTWARE FOR THE' /
1 ' DECSYSTEM-10, USING THESE KEYWORDS:' /
2 ( I5, 3X, 15A1 ) )
C
DO 110 I = 1, NDISPP
READ ( LURN ' I, END = 120 ) JTEMP, IDESCR
WRITE ( LULP, 100 ) IDESCR, KTIMS(I), JTEMP, KWRDS(I)
100 FORMAT ( 1X, 23A5, I2, I5, 1X, O2 )
110 CONTINUE
C
120 IF ( NDISPT .LE. 0 ) GO TO 150
WRITE ( LUTT, 30 )
C
DO 140 I = 1, NDISPT
READ ( LURN ' I, END = 150 ) JTEMP, IDESCR
WRITE ( LUTT, 100 ) IDESCR, KTIMS(I), JTEMP, KWRDS(I)
140 CONTINUE
C
C CLOSE THE FILES.
150 CLOSE ( UNIT = LUFL )
CLOSE ( UNIT = LURN )
C
170 RETURN
END
LOGICAL FUNCTION AVANSR ( LUTT )
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C GET THE USER'S ANSWER TO A QUESTION.
C
DIMENSION INPUT(10)
C
EQUIVALENCE ( INPUT(1), INPUT1 )
C
DATA IN / 'N' /
DATA IY / 'Y' /
C
C TO START, SET THE ANSWER .FALSE.
AVANSR = .FALSE.
C
C GET THE USER'S ANSWER.
10 READ ( LUTT, 15 ) INPUT
15 FORMAT ( 10A1 )
C
C THE ANSWER MUST START WITH 'Y' OR 'N'.
IF ( INPUT1 .EQ. IY .OR. INPUT1 .EQ. IN ) GO TO 25
WRITE ( LUTT, 20 )
20 FORMAT ( ' PLEASE ANSWER YES OR NO. ' $ )
GO TO 10
C
C IF IT STARTS WITH 'Y', SET THE FUNCTION .TRUE.
25 IF ( INPUT1 .EQ. IY ) AVANSR = .TRUE.
C
RETURN
END
SUBROUTINE AVSTOP
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C GET THE LIST OF NON-INDEXED WORDS.
C
COMMON / AVNONW / NSTOP, KSTOP(12,150)
COMMON / AVLUNS / LUTT, LUFL
C
DATA IBLNK / ' ' /
DATA MXSTOP / 150 /
C
CALL FILL ( KSTOP, 1, 1800, IBLNK )
C
C OPEN THE 'STOP' FILE.
OPEN ( UNIT = LUFL, MODE = 'ASCII', DIRECTORY = '101,15',
1 ACCESS = 'SEQIN', FILE = 'PROGMS.STP', DEVICE = 'DSK:',
2 DISPOSE = 'SAVE' )
C
C READ THE NON-INDEXING WORDS.
DO 20 NSTOP = 1, MXSTOP
READ ( LUFL, 15, END = 70 ) ( KSTOP(I,NSTOP), I = 1, 12 )
15 FORMAT ( 12A1 )
20 CONTINUE
NSTOP = MXSTOP + 1
C
C END-OF-FILE. CLOSE THE 'STOP' FILE.
70 NSTOP = NSTOP - 1
CLOSE ( UNIT = LUFL )
RETURN
END
SUBROUTINE AVCNVT ( NUMBER )
C
C SEARCH THE LIST OF AVAILABLE SOFTWARE
C
C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
C
C GET AN INTEGER-VALUED RESPONSE FROM THE USER
C
DIMENSION INPUT(10)
C
COMMON / AVLUNS / LUTT
C
DATA IBLNK / ' ' /
DATA I0 / '0' /
DATA I9 / '9' /
C
C READ THE RESPONSE.
10 NUMBER = 0
READ ( LUTT, 20 ) INPUT
20 FORMAT ( 10A1 )
C
C FIND THE LAST NON-BLANK CHARACTER.
DO 30 I = 1, 10
J = 11 - I
IF ( INPUT(J) .NE. IBLNK ) GO TO 40
30 CONTINUE
C
C IF THE RESPONSE IS ALL BLANKS, ZERO IS THE VALUE.
GO TO 100
C
C SCAN THE REST OF THE INPUT FOR BLANKS.
40 IMAX = J
J0 = 0
DO 60 I = 1, IMAX
IF ( INPUT(I) .NE. IBLNK ) GO TO 60
C
J0 = J0 + 1
IF ( J0 .EQ. I ) GO TO 60
C
WRITE ( LUTT, 50 )
50 FORMAT ( ' RE-ENTER THE VALUE WITH NO EMBEDDED BLANKS. ' $ )
GO TO 10
C
60 CONTINUE
C
C CHECK FOR NON-NUMERIC VALUES AND CONVERT THE NUMERIC ONES.
J1 = J0 + 1
DO 90 I = J1, IMAX
IF ( INPUT(I) .LE. I9 .AND. INPUT(I) .GE. I0 ) GO TO 80
C
WRITE ( LUTT, 70 )
70 FORMAT ( ' AN UNSIGNED NUMERIC VALUE IS REQUIRED. ' $ )
GO TO 10
C
80 ITEMP = ( INPUT(I) - I0 ) / 536870912
NUMBER = 10 * NUMBER + ITEMP
C
90 CONTINUE
C
100 RETURN
END