c.....This program scales (amplifies) and smooths 8-bit digitized time 
c.....histories.  This improves the clarity of digitized sound.
c.....
c.....I give this program to the public domain.  If you modify it, or
c.....have suggestions or comments, please drop me a note at 
c.....Comp-U-Ease, 408-286-8332, or The Engineers' Club, 408-265-3353.
c.....
c.....          Usage:  dig infile outfile
c.....                                                    --Bill Weitze
c.....
c.....04-16-91, Rev. 1.1:  Now reads input into a vector, speeding things.
c.....06-10-91, Rev. 1.2:  Added smoothing option and other improvements.
c.....09-24-91, Rev. 1.3:  Simplified code, adapted for MS Fortran 5.1.
c.....
      character ampc(20000)
      integer*2 amp, iend, ifile, ispike, ave
      open (unit=14,file=' ',status='old',form='binary',blocksize=16384)
      open (unit=15,file=' ',status='unknown',form='binary')
      write (*,*) 'Enter volume factor'
      read (*, '(f10.0)') factor
      write (*,*) 'Enter spike limit (0=smoothest, 255=spikiest):'
      read (*,*) ispike
      write (*,*) 'Would you like a data listing (type 1 for yes)?'
      write (*,*) '(file is 12 times the size of the input file.)'
      read (*,*) ifile
      if (ifile.eq.1) OPEN (UNIT=13,FILE=' ',STATUS='new')
c
c.....Read file and store data in array
c
      amp=0
      itot=0
   10 iend=1
      write (*,*) 'Reading input file at byte ', itot
      do 15 j=1,20000
   15 read (14,end=20) ampc(j)
      iend=0
   20 j1=j-1
      write (*,*) 'Modifying ', j1, ' bytes'
      do 30 j=1,j1
        ave = (amp + ichar(ampc(j+1))-128) / 2
        amp = ichar(ampc(j))-128
        if (j.eq.j1) ave = amp
        ampc(j) = char(min( max( int(factor*amp),-128,ave-ispike ),
     &  ave+ispike,127 )+128)
   30 continue
      write (*,*) 'Writing output file ...'
      write (15) (ampc(j), j=1,j1)
      if (ifile.eq.1) write (13,910)(j+itot,ichar(ampc(j))-128, j=1,j1)
      itot=itot+j1
      if (iend.eq.0) goto 10
      close (13)
      close (14)
      close (15)
      stop
  910 format (2i5)
      end
