c====================================================================== c GATHER STATISTICS ON A FILE CONTAINING WORDS c====================================================================== implicit none integer*4 max_word_length parameter (max_word_length = 32) character*132 filename,buffer,prior_word integer*4 i,j,filelen,bufferlen integer*4 record_count,large_word_count integer*4 word_count,blank_count,char_count,dup_count integer*4 smallest_word,largest_word integer*4 stats(max_word_length) logical*4 get_command_line_parameter real average c initilize words word_count = 0 blank_count = 0 char_count = 0 largest_word = 0 smallest_word = 9999 prior_word = ' ' c file name write (*,1000) read (*,1001) filelen,filename if (filelen.eq.0) goto 999 call str$upcase(filename,filename) c open text file open (unit=7,file=filename,READONLY,err=100,status='OLD') c read a record 10 read(unit=7,end=40,err=110,fmt=1001) bufferlen,buffer record_count = record_count + 1 if(mod(record_count,500).eq.0) x type *,' Reading Record ',record_count,' ', x buffer(1:bufferlen) c test for zero length record if (bufferlen.eq.0) then blank_count = blank_count + 1 goto 10 end if c find first nonblank character do i = 1,bufferlen if (buffer(i:i).ne.' ') goto 20 end do blank_count = blank_count + 1 goto 10 c find last nonblank character 20 do j = i,bufferlen if (buffer(i:i).eq.' ') goto 30 end do c test for word that exceeded the maximum word size 30 j = j - 1 if (len(buffer(i:j)).gt.max_word_length) then large_word_count = large_word_count + 1 goto 10 end if c update statistics word_count = word_count + 1 stats(j-i+1) = stats(j-i+1) + 1 char_count = char_count + j - i if (j-i+1.lt.smallest_word) smallest_word = j-i+1 if (j-1+1.gt.largest_word) largest_word = j-i+1 if (buffer(i:j).eq.prior_word) dup_count = dup_count + 1 prior_word = buffer(i:j) goto 10 c display and write out statistics 40 close(unit=7) open (unit=7,file='STATS.DAT',err=120,status='NEW') write (*,2000) filename(1:filelen) write (7,2000) filename(1:filelen) do i = 1,max_word_length write (*,2010) i,stats(i) write (7,2010) i,stats(i) end do average = float(char_count)/float(word_count) write (*,2020) average write (7,2020) average write (*,2030) record_count,word_count,blank_count, x large_word_count,smallest_word, x largest_word,dup_count write (7,2030) record_count,word_count,blank_count, x large_word_count,smallest_word, x largest_word,dup_count goto 999 c error mesages 100 type *,'Error opening text file ',filename(1:filelen) goto 999 110 type *,'Error reading text file ',filename(1:filelen) 120 type *,'Error statistics file STAT.DAT' goto 999 130 type *,'Error writting statistics file STAT.DAT' goto 999 c end of program 999 close(unit=7) 1000 format (/,' Enter text file to be checked : ',$) 1001 format (q,a) 2000 format (//,' Statistics Collected From File ',a,//) 2010 format (' Word size and count ',2i8) 2020 format (//,' Average word length ',f6.2) 2030 format (//,' Record count ',i8, x /,' Word count ',i8, x /,' Blank record count ',i8, x /,' Large word count ',i8, x /,' Smallest word size ',i8, x /,' Largest word size ',i8, x /,' Duplicate word count ',i8,//) end