1      logical function argos_prepare_sgmndx(iunit,
2     + lfnout,lseq,cseq,mseq,nseq,lsgm,csgm,msgm,nsgm,mato)
3c
4c $Id$
5c
6c     function to scan database directories for segments in sequence
7c
8c     in  : iunit        = dbase logical file number
9c           lfnout       = output file logical file number
10c           lseq(1,mseq) = segment number
11c           lseq(2,mseq) = index to segment list
12c           cseq(2,mseq) = segment name on topology
13c           mseq         = dimension of the sequence list
14c           nseq         = length of sequence list
15c           msgm         = dimension of segment list
16c           msgm         = length of segment list
17c
18c     out : lseq(1,mseq) = segment numbers
19c                2       = number of atoms
20c                3       = index to unique segment
21c           csgm(msgm)   = unique segment names
22c           lsgm(1,msgm) = number of segments of type i
23c                2       = source: 0=not found; sgm: 1=s; 2=x; 3=u; 4=t;
24c                                               frg:-1=s;-2=x;-3=u;-4=t;
25c                3       = number of atoms in segment
26c
27      implicit none
28c
29#include "util.fh"
30#include "argos_prepare_common.fh"
31c
32      integer iunit,lfnout,mseq,nseq,msgm,nsgm,mato
33      integer lseq(6,mseq),lsgm(3,msgm)
34      character*5 cseq(2,mseq),csgm(msgm)
35      character*255 filnam
36c
37      integer length
38      integer i,j
39c
40      if(util_print('sequence',print_high)) then
41      write(lfnout,2000)
42 2000 format(/,' Segment definition files ',/)
43      endif
44c
45      argos_prepare_sgmndx=.true.
46c
47c     initialize  number of segments to zero
48c     ----------  source of segments to unknown
49c
50      do 1 i=1,nsgm
51      lsgm(1,i)=0
52      lsgm(2,i)=0
53      lsgm(3,i)=0
54    1 continue
55c
56c     find all unique segments in sequence csgm(1:nsgm) = segment names
57c     ------------------------------------ lsgm(1,1:nsgm)
58c
59      mato=0
60      do 2 i=1,nseq
61      mato=max(mato,lseq(3,i+1)-lseq(3,i))
62      csgm(lseq(2,i))=cseq(2,i)
63      lsgm(1,lseq(2,i))=lsgm(1,lseq(2,i))+1
64      if(lsgm(1,lseq(2,i)).eq.1) then
65      csgm(lseq(2,i))=cseq(2,i)
66      lsgm(3,lseq(2,i))=lseq(3,i+1)-lseq(3,i)
67      endif
68    2 continue
69c
70c     find segment files for the segments in the list
71c     -----------------------------------------------
72c
73      do 3 i=1,nsgm
74      length=index(csgm(i),' ')-1
75      if(length.le.0) length=5
76      lsgm(2,i)=0
77c
78c     check the temporary dbase directory
79c
80      do 4 j=mdirpar,1,-1
81      if(nfilpar(j).gt.0) then
82      filnam=
83     + dirpar(j)(1:index(dirpar(j),' ')-1)//csgm(i)(1:length)//'.sgm '
84      open(iunit,file=filnam(1:index(filnam,' ')-1),form='formatted',
85     + status='old',err=5)
86      lsgm(2,i)=j
87      close(iunit)
88      goto 6
89    5 continue
90      filnam=
91     + dirpar(j)(1:index(dirpar(j),' ')-1)//csgm(i)(1:length)//'.frg '
92      open(iunit,file=filnam(1:index(filnam,' ')-1),form='formatted',
93     + status='old',err=4)
94      lsgm(2,i)=-j
95      close(iunit)
96      goto 6
97      endif
98    4 continue
99    6 continue
100c
101      if(lsgm(2,i).eq.0) argos_prepare_sgmndx=.false.
102c
103      if(util_print('sequence',print_high)) then
104      if(lsgm(2,i).lt.0)
105     + write(lfnout,1001) i,csgm(i),lsgm(1,i),lsgm(2,i),
106     + dirpar(-lsgm(2,i))(1:index(dirpar(-lsgm(2,i)),' ')-1)//
107     + csgm(i)(1:length)//'.frg '
108      if(lsgm(2,i).gt.0)
109     + write(lfnout,1001) i,csgm(i),lsgm(1,i),lsgm(2,i),
110     + dirpar(lsgm(2,i))(1:index(dirpar(lsgm(2,i)),' ')-1)//
111     + csgm(i)(1:length)//'.sgm '
112 1001 format(i5,2x,a5,i5,2x,i5,1x,a)
113      if(lsgm(2,i).eq.0)write(lfnout,1002) i,csgm(i),lsgm(1,i),
114     + lsgm(2,i)
115 1002 format(i5,2x,a5,i5,2x,i5,1x,' no definition file found')
116      endif
117c
118    3 continue
119c
120      return
121      end
122