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