dimension ncode(2000)
      character*4 jcode(2000)*4,icode*4,infile*65
      print 500
  500 format (' COUNTDMA.F, Plouff 2-94.  Program to list the unique ',
     1 '4-digit names and how',/,'  many occurences there are for the',
     2 ' first four columns of every line in',/,'  a file.  The ',
     3 'intent mostly is to summarize the source code part of',/,
     4 '  8-digit station names derived from DMA gravity data files ',
     5 '(plouff, e.g.).',/,' The output of this program is a file of ',
     6 'single lines with source codes followed',/,'  by the total ',
     7 'number of stations with that code (format 1x,a4,i5).',/,
     8 ' Sorting by code and/or total number is suggested.',/,' The ',
     9 'name of that output file is COUNTDMA.PNT (**overwrites).')
      print 502
  502 format (' TYPE the name of your input file (<66 cols):')
      read 565, infile
  565 format (a65)
      open (13,file=infile,status='old',form='formatted')
      open (14,file='COUNTDMA.PNT',status='unknown',form='formatted')
      read (13,100) icode
  100 format (a4)
      ncode(1)=1
      jcode(1)=icode
      n=1
      m=1
    1 read (13,100,end=9) icode
      m=m+1
      do 2 j=1,n
      if (icode .ne. jcode(j)) go to 2
      ncode(j)=ncode(j)+1
      go to 1
    2 continue
      n=n+1
      if (n .gt. 2000) go to 8
      jcode(n)=icode
      ncode(n)=1
      go to 1
    8 print 599
      write (14,599)
  599 format (' Number of unique source codes exceeds 2000.',/,
     1 ' Only the first 2000 will be listed.')
    9 print 600, n,m
  600 format (i4,' source codes for',i5,' stations')
      write (14,140) (jcode(j),ncode(j),j=1,n)
  140 format (1x,a4,i5)
      close (13)
      close (14)
      stop
      end