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