cb:: cr8ser
      program cr8ser        
c
c  Name:       cr8ser
c  Version:    v 1.2  (9703.31)
c  Written by: Jim Mosier (fortran version)
c  Purpose:    To read B-file *25* record ssns and station ids and
c              create an output file named "serfil" of unique station 
c              ids and their corresponding ssns.  The last ssn found for
c              each unique station id is retained.  The file "serfil" is
c              then read by program compgb.
c
c  Local Variables and Constants:
c  ------------------------------
c  
c  bfile            user defined name of B-file             
c  serfil           output file of station ids and ssns
c  resp             user response (y/n)        
c  rec              generic record read from B-file
c  ssn              *25* rec ssn 
c  tssns(5999)      array of ssns
c  id               *25* rec station id
c  tids(5999)       array of station ids
c  idcnt            unique station id count from B-file *25* records
c        
c  Global Variables and Constants: none
c  
c  References:  RM/FORTRAN Manual, OMNI Programming Standards
c  
c  Comments:  5999 G-file C/F vector records allowed
c
c  Modification History:
c::9008.23, version 1.1, Flavius A. Galiber 
c::  Written in Borland International's TURBO C++ v 1.0.  Read  G-file C
c::  vector ssns and station ids to create a "serfil" output file.  The
c::  G-file long vector F records do not contain the station ids, thus
c::  can not be used to create an output "serfil" file.
ce::
      character*80 rec
      character*15 bfile
      character*4  tssns(5999),tids(5999),ssn,id,idtemp,sntemp
      character*1  resp
      integer idcnt,i,j,k
        
C    initialize arrays and variable

      do 3 i = 1,5999
	tssns(i) = '    '
	tids(i)  = '    '
 3    continue
      idcnt=0
      print *
      print *,'Welcome to program cr8ser v 1.2'        
      print *
      i=1
      k=1
 9    print *,'Enter the B-filename:  '         
      read(5,'(a15)') bfile        
      if(i .le. 2) then
        print *,bfile, ' entered as the correct bfile? (y/n): '
        read(5,'(a1)') resp 
        if(.not.((resp .eq. 'Y') .or. (resp .eq.  'y'))) then
          i=i+1	
	  goto 9
        endif
      endif
      open(10,file=bfile,iostat=ios,err=100,status='old')
 100  if(ios .ne. 0) then
        if(k .le. 2) then
	  print *, 'Error condition occurred while trying to open',
     *             ' input file ', bfile
	  print *,'Try again'
          print *
	  k=k+1
	  goto 9
	else
	  stop 'Execution terminated, input file not found'
        endif
      endif

      open(11,file='serfil',iostat=ios,err=190,status='unknown')

 190  if(ios .ne. 0) then
	  close(10,status='keep')
	  print *, 'Error condition occurred while trying to open',
     *             ' output file, serfil.'
          print *
	  stop 'Execution terminated.'
      endif

C    store unique station ids and their corresponding ssns from the 
c    bfile *25* records.  For duplicate station ids, use last ssn found

 200  read(10,'(80a)',end=300) rec  
      if(rec(8:9) .eq. '25') then
        read(rec,'(10x,a4,6x,a4)') ssn,id
        do 210 i = 1,3
	  if(ssn(i:i) .eq.' ') ssn(i:i) = '0'
 210    continue
        idcnt = idcnt + 1
        if(idcnt.ge.5999) then
	  print *,'** number of *25* records exceeds 6000'
	  print *, '** execution terminated '
	  write(11,220)
 220      format (/,'** number of *25* records exceeds '/,
     *            '6000, execution terminated',/)
	  close(10,status='keep')
	  close(11,status='keep')
	  stop
        elseif(idcnt.eq.1) then
	  tssns(idcnt) = ssn
	  tids(idcnt)  = id
        else
	  do 280 i = 1,idcnt-1
	    if(id.eq.tids(i)) then
	      tssns(i) = ssn
              idcnt = idcnt-1
	      goto 200
            endif
 280      continue
          tids(idcnt) = id
	  tssns(idcnt) = ssn
        endif
      endif
      goto 200
 300  continue

c    sort tids array

      do 305 i = 1,idcnt-1
	k = i
	id = tids(i)
	do 310 j = i+1,idcnt
	  if(tids(j).lt.id) then
	    k = j
	    id = tids(j)
          endif
 310   continue
       if(k.ne.i) then
	 idtemp = tids(k)
	 sntemp = tssns(k)
	 tids(k) = tids(i)
	 tssns(k) = tssns(i)
	 tids(i) = idtemp
	 tssns(i) = sntemp
        endif
 305  continue

c    write station id and ssn arrays to output file

      do 400 i = 1,idcnt
	write(11,320) tids(i),tssns(i)
 320    format(a4,3x,a4)
	write(6,321) tids(i),tssns(i)
 321    format(1x,a4,3x,a4)
 400  continue
      print *
      print *, 'At end of cr8ser ' 
      print *
      close(10,status='keep')
      close(11,status='keep')
      stop
      end