1 double precision function rmscalc_frag(ishif,i,j,jcon,kkk,
3 implicit real*8 (a-h,o-z)
5 include 'DIMENSIONS.ZSCOPT'
6 include 'DIMENSIONS.COMPAR'
7 include 'COMMON.IOUNITS'
8 include 'COMMON.COMPAR'
10 include 'COMMON.INTERACT'
12 include 'COMMON.CONTROL'
13 double precision przes(3),obrot(3,3)
14 double precision creff(3,maxres2),cc(3,maxres2)
15 logical iadded(maxres)
16 integer inumber(2,maxres)
17 common /ccc/ creff,cc,iadded,inumber
23 write (iout,*) "i",i," j",j," jcont",jcon," ishif",ishif
24 write (iout,*) "npiece",npiece(j,i)
25 write (iout,*) "kkk",kkk
28 c write (iout,*) "symetr",symetr
34 c write (iout,*) "nperm",nperm
41 c write (iout,*) "kkk",kkk
46 write (iout,*) "Level 1: j=",j,"k=",k," adding fragment",
47 & ifrag(1,k,j),ifrag(2,k,j)
50 call cprep(ifrag(1,k,j),ifrag(2,k,j),ishif,idup,kkk)
51 c write (iout,*) "Exit cprep"
53 c write (iout,*) "ii=",ii
56 c write (iout,*) "kk",kk," npiece",npiece(kk,1)
59 write (iout,*) "Level",i,": j=",j,"k=",k," kk=",kk,
60 & " l=",l," adding fragment",
61 & ifrag(1,l,kk),ifrag(2,l,kk)
64 call cprep(ifrag(1,l,kk),ifrag(2,l,kk),ishif,idup,kkk)
65 c write (iout,*) "After cprep"
71 write (iout,*) "tuszukaj"
74 write(iout,'(5i4,2(3f10.5,5x))') i,j,k,inumber(1,k),
75 & inumber(2,k),(creff(l,k),l=1,3),(cc(l,k),l=1,3)
82 call fitsq(rms,cc(1,1),creff(1,1),idup,przes,obrot,non_conv)
84 print *,'Error: FITSQ non-convergent, jcon',jcon,i
86 else if (rms.lt.-1.0d-6) then
87 print *,'Error: rms^2 = ',rms,jcon,i
89 else if (rms.ge.1.0d-6 .and. rms.lt.0) then
92 c write (iout,*) "rmsmin", rminrms, "rms", rms
93 c if (rms.le.rminrms) rminrms=rms
95 rmscalc_frag = dsqrt(rms)
96 c write (iout, *) "analysys", rmscalc,anatemp
99 c-------------------------------------------------------------------------
100 subroutine cprep(if1,if2,ishif,idup,kwa)
101 implicit real*8 (a-h,o-z)
103 include 'DIMENSIONS.ZSCOPT'
104 include 'DIMENSIONS.COMPAR'
105 include 'COMMON.CONTROL'
106 include 'COMMON.IOUNITS'
107 include 'COMMON.COMPAR'
108 include 'COMMON.CHAIN'
109 include 'COMMON.INTERACT'
111 double precision przes(3),obrot(3,3)
112 double precision creff(3,maxres2),cc(3,maxres2)
113 logical iadded(maxres)
114 integer inumber(2,maxres),iistrart,kwa,blar
115 common /ccc/ creff,cc,iadded,inumber
117 c write (iout,*) "Calling cprep if1",if1," if2",if2," ishif",ishif,
123 c write (iout,*) "nperm",nperm
127 c write (iout,*) "l",l," iadded",iadded(l)," ireschain",
128 c & ireschain(l),ireschain(l+ishif)
130 if (l+ishif.gt.1 .and. l+ishif.le.nres .and. .not.iadded(l)
131 & .and. ireschain(l+ishif).gt.0 .and. ireschain(l).gt.0 .and.
132 & ireschain(l).eq.ireschain(l+ishif)) then
136 inumber(2,idup)=l+ishif
137 ll=iperm(l+ishif,kwa)
139 creff(m,idup)=cref(m,l)
142 c write (iout,'(2i5,3f10.5,5x,3f10.5)') l,ll,
143 c & (creff(m,idup),m=1,3),(cc(m,idup),m=1,3)
146 c write (iout,*) "idup",idup
149 c-------------------------------------------------------------------------
150 double precision function rmsnat(jcon,ipermmin)
151 implicit real*8 (a-h,o-z)
153 include 'DIMENSIONS.ZSCOPT'
154 include 'DIMENSIONS.COMPAR'
155 include 'COMMON.IOUNITS'
156 include 'COMMON.COMPAR'
157 include 'COMMON.CHAIN'
158 include 'COMMON.INTERACT'
160 include 'COMMON.CONTROL'
162 rmsnat = rmscalc(c(1,1),cref(1,1),ipermmin)
165 c-----------------------------------------------------------------------------
166 double precision function rmscalc(ccc,cccref,ipermmin)
169 include 'COMMON.IOUNITS'
170 include 'COMMON.CHAIN'
171 include 'COMMON.INTERACT'
173 double precision cccref(3,maxres2),creff(3,maxres2),
174 & ccc(3,maxres2),cc(3,maxres2)
175 double precision przes(3),obrot(3,3)
177 integer i,ii,j,ib,ichain,indchain,ichain1,ichain2,
179 double precision rms,rmsmin
180 C Loop over chain permutations
181 c write (iout,*) "iz_sc",iz_sc
183 DO IPERM=1,NPERMCHAIN
184 c write (iout,*) "iperm",iperm
188 indchain=tabpermchain(ichain,iperm)
190 write (iout,*) "ichain",ichain," indchain",indchain
191 write (iout,*) "chain_border",chain_border(1,ichain),
192 & chain_border(2,ichain)
194 do i=1,chain_length(ichain)
195 c do i=nstart_sup(ichain),nend_sup(ichain)
196 ichain1=chain_border(1,ichain)+i-1
197 ichain2=chain_border(1,indchain)+i-1
198 if (ichain1.lt.nstart_sup .or. ichain1.gt.nend_sup .or.
199 & ichain2.lt.nstart_sup .or. ichain2.gt.nend_sup) cycle
202 write (iout,*) "back",ii," ichain1",ichain1,
203 & " ichain2",ichain2," i",i,chain_border(1,ichain)+i-1
206 cc(j,ii)=ccc(j,ichain2)
207 creff(j,ii)=cccref(j,ichain1)
210 write (iout,'(2i5,3f10.5,5x,3f10.5)')
211 & ichain1,ii,(cc(j,ii),j=1,3),(creff(j,ii),j=1,3)
218 indchain=tabpermchain(ichain,iperm)
219 do i=1,chain_length(ichain)
220 c do i=nstart_sup(ichain),nend_sup(ichain)
221 ichain1=chain_border(1,ichain)+i-1
222 ichain2=chain_border(1,indchain)+i-1
223 if (ichain1.lt.nstart_sup .or. ichain1.gt.nend_sup .or.
224 & ichain2.lt.nstart_sup .or. ichain2.gt.nend_sup) cycle
225 if (itype(ichain1).ne.10) then
228 write (iout,*) "side",ii," ichain1",ichain1,
232 cc(j,ii)=ccc(j,ichain2+nres)
233 creff(j,ii)=cccref(j,ichain1+nres)
236 write (iout,'(2i5,3f10.5,5x,3f10.5)')
237 & ichain1+nres,ii,(cc(j,ii),j=1,3),(creff(j,ii),j=1,3)
243 c write (iout,*) "rmscalc: iprot",iprot," nsup",nsup(iprot)," ii",ii
244 call fitsq(rms,cc(1,1),creff(1,1),ii,przes,obrot,non_conv)
246 write (iout,*) 'Error: FITSQ non-convergent'
248 else if (rms.lt.-1.0d-6) then
249 print *,'Error: rms^2 = ',rms
251 else if (rms.ge.1.0d-6 .and. rms.lt.0) then
256 if (rms.lt.rmsmin) then
261 write (iout,*) "iperm",iperm," rms",rms
266 write (iout,*) "ipermmin",ipermmin," rmsmin",rmsmin
270 c-----------------------------------------------------------------------------
271 double precision function gyrate(jcon)
272 implicit real*8 (a-h,o-z)
274 include 'COMMON.INTERACT'
275 include 'COMMON.CHAIN'
276 include 'COMMON.IOUNITS'
277 double precision cen(3),rg
285 if (itype(i).eq.ntyp1) cycle
292 cen(j)=cen(j)/dble(ii)
296 if (itype(i).eq.ntyp1) cycle
298 rg = rg + (c(j,i)-cen(j))**2
301 gyrate = dsqrt(rg/dble(ii))