Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0080/avclnr.for
There are no other files named avclnr.for in the archive.
00100 C PROGRAM AVCLNR
00200 C
00300 C SEARCH LIST OF AVAILABLE SOFTWARE
00400 C
00500 C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
00600 C
00700 C CLEAN THE INDEX OF AVAILABLE SOFTWARE. READ AND REWRITE THE
00800 C INDEX FILE, ELIMINATING DUPLICATE ENTRIES AND 'STOP' WORDS,
00900 C AND PRINTING A FREQUENCY TABLE.
01000 C
01100 DIMENSION INPUT(21), JNPUT(21), KNPUT(21)
01200 C
01300 COMMON / AVLUNS / LUTT, LUFL
01400 COMMON / AVNONW / NSTOP, KSTOP(12,150)
01500 C
01600 DATA IBLNK / ' ' /
01700 DATA INPUT / 21 * ' ' /
01800 DATA JNPUT / 21 * ' ' /
01900 DATA LUFL / 26 /
02000 DATA LUOU / 27 /
02100 DATA LULP / 3 /
02200 DATA LUTT / 5 /
02300 C
02400 C TO START - -
02500 C
02600 C GET THE LIST OF 'STOP' WORDS.
02700 CALL AVSTOP
02800 C
02900 C OPEN THE INPUT AND OUTPUT FILES.
03000 OPEN ( UNIT = LUFL, MODE = 'ASCII', ACCESS = 'SEQIN',
03100 1 FILE = 'PROGMS.IDX', DEVICE = 'DSK:', DISPOSE = 'SAVE',
03200 2 DIRECTORY = '101,15' )
03300 OPEN ( UNIT = LUOU, MODE = 'ASCII', ACCESS = 'SEQOUT',
03400 1 FILE = 'PROGMS.NWX', DEVICE = 'DSK:', DISPOSE = 'SAVE',
03500 2 DIRECTORY = '101,15' )
03600 C
03700 C INITIALIZE THE COUNTERS.
03800 I0 = 1
03900 KOUNT = 0
04000 NCHAR = 1
04100 NRECS = 0
04200 NWRDS = 0
04300 C
04400 C PRINT A PAGE HEADING.
04500 WRITE ( LUTT, 10 )
04600 WRITE ( LULP, 10 )
04700 10 FORMAT ( '1FREQUENCY DISTRIBUTION OF WORDS IN INDEX OF' /
04800 1 ' AVAILABLE SOFTWARE FOR THE DECSYSTEM-10.' / )
04900 C
05000 C MAIN PROCESSING LOOP * * * * * * * * * * * * * * * * * * * * * * *
05100 C
05200 C READ AN INPUT RECORD.
05300 20 READ ( LUFL, 25, END = 200 ) KNPUT
05400 25 FORMAT ( 21A1 )
05500 C
05600 C FIND THE BLANK CHARACTER AT THE END OF THE CURRENT ENTRY.
05700 DO 30 I = 2, 16
05800 IF ( KNPUT(I) .EQ. IBLNK ) GO TO 40
05900 30 CONTINUE
06000 I = 17
06100 C
06200 40 KCHAR = I
06300 C
06400 C COMPARE THE CURRENT ENTRY WITH THE 'STOP' LIST. IF IT IS IN THAT
06500 C LIST, DO NOT REWRITE IT.
06600 DO 50 I = I0, NSTOP
06700 IF ( NCOMP ( KNPUT, 1, KCHAR, KSTOP(1,I), 1 ) ) 60, 20, 50
06800 50 CONTINUE
06900 I = NSTOP + 1
07000 C
07100 60 I0 = I - 1
07200 C
07300 C COMPARE THE CURRENT ENTRY WITH THE PREVIOUS GOOD ONE.
07400 IF ( NCOMP ( KNPUT, 1, 21, JNPUT, 1 ) ) 70, 20, 70
07500 C
07600 C IF THE CURRENT ENTRY IS NOT IDENTICAL TO THE PREVIOUS GOOD ONE, SAVE
07700 C AND COUNT IT.
07800 70 WRITE ( LUOU, 25 ) KNPUT
07900 CALL MOVE ( KNPUT, 1, 21, JNPUT, 1 )
08000 NRECS = NRECS + 1
08100 C
08200 C COMPARE THE FREQUENCY TABLE ENTRY WITH THE CURRENT ONE.
08300 IF ( NCOMP ( INPUT, 1, NCHAR, KNPUT, 1 ) ) 90, 80, 90
08400 C
08500 C IF THE NEW ENTRY IS THE SAME, COUNT IT.
08600 80 KOUNT = KOUNT + 1
08700 GO TO 20
08800 C
08900 C IF THE NEW ENTRY IS DIFFERENT, PRINT AND COUNT THE OLD ONE.
09000 90 WRITE ( LULP, 100 ) KOUNT, ( INPUT(I), I = 1, NCHAR )
09100 100 FORMAT ( I5, 1X, 21A1 )
09200 NWRDS = NWRDS + 1
09300 C
09400 C RESET THE COUNT AND SAVE THE CURRENT ENTRY.
09500 KOUNT = 1
09600 CALL MOVE ( KNPUT, 1, 21, INPUT, 1 )
09700 NCHAR = KCHAR
09800 C
09900 C GO GET THE NEXT INPUT RECORD.
10000 GO TO 20
10100 C
10200 C END-OF-FILE PROCESSING * * * * * * * * * * * * * * * * * * * * * * * *
10300 C
10400 C PRINT THE LAST FREQUENCY ENTRY AND THE COUNT.
10500 200 WRITE ( LULP, 100 ) KOUNT, ( INPUT(I), I = 1, NCHAR )
10600 C
10700 C PRINT THE GRAND TOTAL OF WORDS AND ENTRIES.
10800 WRITE ( LUTT, 210 ) NWRDS, NRECS
10900 WRITE ( LULP, 210 ) NWRDS, NRECS
11000 210 FORMAT ( / ' THE INDEX CONTAINS', I5, ' DIFFERENT WORDS'
11100 1 ' AND', I5, ' ENTRIES.' )
11200 C
11300 C CLOSE THE INPUT AND OUTPUT FILES.
11400 CLOSE ( UNIT = LUFL )
11500 ENDFILE LUOU
11600 CALL EXIT
11700 END
11800 SUBROUTINE AVSTOP
11900 C
12000 C SEARCH THE LIST OF AVAILABLE SOFTWARE
12100 C
12200 C PETE SCHILLING ALCOA TECHNICAL CENTER SEPTEMBER, 1974
12300 C
12400 C GET THE LIST OF NON-INDEXED WORDS.
12500 C
12600 COMMON / AVNONW / NSTOP, KSTOP(12,150)
12700 COMMON / AVLUNS / LUTT, LUFL
12800 C
12900 DATA IBLNK / ' ' /
13000 DATA MXSTOP / 150 /
13100 C
13200 CALL FILL ( KSTOP, 1, 1800, IBLNK )
13300 C
13400 C OPEN THE 'STOP' FILE.
13500 OPEN ( UNIT = LUFL, MODE = 'ASCII', DIRECTORY = '101,15',
13600 1 ACCESS = 'SEQIN', FILE = 'PROGMS.STP', DEVICE = 'DSK:',
13700 2 DISPOSE = 'SAVE' )
13800 C
13900 C READ THE NON-INDEXING WORDS.
14000 DO 20 NSTOP = 1, MXSTOP
14100 READ ( LUFL, 15, END = 70 ) ( KSTOP(I,NSTOP), I = 1, 12 )
14200 15 FORMAT ( 12A1 )
14300 20 CONTINUE
14400 NSTOP = MXSTOP + 1
14500 C
14600 C END-OF-FILE. CLOSE THE 'STOP' FILE.
14700 70 NSTOP = NSTOP - 1
14800 CLOSE ( UNIT = LUFL )
14900 RETURN
15000 END