1      logical function argos_prep_sgmnum(lfnout,
2     + lseq,cseq,mseq,nseq,nsgm)
3c
4c $Id$
5c
6c     function to scan database for unique segments in sequence
7c
8c     in  : filnam    = dbase file name
9c           lfnout    = output file logical file number
10c           lseq(1,*) = sequence segment numbers
11c           cseq(2,*) = sequence segment names
12c           mseq      = dimension of the sequence list
13c           nseq      = length of sequence list
14c
15c     out : lseq(2,*) = index to segment list
16c
17      implicit none
18c
19#include "util.fh"
20c
21      integer lfnout,mseq,nseq,nsgm
22      integer lseq(6,mseq)
23      character*5 cseq(2,mseq)
24c
25      integer i,j
26c
27      if(util_print('sequence',print_high)) then
28      write(lfnout,2000)
29 2000 format(/,' Unique segments  ',/)
30      endif
31c
32      nsgm=0
33      do 1 i=1,nseq
34      do 2 j=1,i-1
35      if(cseq(2,i).eq.cseq(2,j)) then
36      lseq(2,i)=lseq(2,j)
37      goto 1
38      endif
39    2 continue
40      nsgm=nsgm+1
41      lseq(2,i)=nsgm
42      if(util_print('sequence',print_high)) then
43      write(lfnout,2001) lseq(2,i),cseq(2,i)
44 2001 format(i5,2x,a)
45      endif
46    1 continue
47c
48      argos_prep_sgmnum=.true.
49      return
50      end
51