Adam's changes
[unres.git] / source / wham / src-restraints / rmscalc.f
1       double precision function rmscalc(ishif,i,j,jcon,lprn)
2       implicit real*8 (a-h,o-z)
3       include 'DIMENSIONS'
4       include 'DIMENSIONS.ZSCOPT'
5       include 'DIMENSIONS.COMPAR'
6       include 'COMMON.IOUNITS'
7       include 'COMMON.COMPAR'
8       include 'COMMON.CHAIN' 
9       include 'COMMON.INTERACT'
10       include 'COMMON.VAR'
11       double precision przes(3),obrot(3,3)
12       double precision creff(3,maxres2),cc(3,maxres2)
13       logical iadded(maxres)
14       integer inumber(2,maxres)
15       common /ccc/ creff,cc,iadded,inumber
16       logical lprn
17       logical non_conv
18       integer ishif,i,j
19       if (lprn) then
20       write (iout,*) "i",i," j",j," jcont",jcon," ishif",ishif
21       write (iout,*) "npiece",npiece(j,i)
22       endif
23       ii=0
24       do l=1,nres
25         iadded(l)=.false.
26       enddo
27       do k=1,npiece(j,i)
28         if (i.eq.1) then
29           if (lprn)
30      &    write (iout,*) "Level 1: j=",j,"k=",k," adding fragment",
31      &     ifrag(1,k,j),ifrag(2,k,j)
32           call cprep(ifrag(1,k,j),ifrag(2,k,j),ishif,ii)
33 c          write (iout,*) "ii=",ii
34         else
35           kk = ipiece(k,j,i)
36 c          write (iout,*) "kk",kk," npiece",npiece(kk,1)
37           do l=1,npiece(kk,1)
38             if (lprn)
39      &      write (iout,*) "Level",i,": j=",j,"k=",k," kk=",kk,
40      &       " l=",l," adding fragment",
41      &       ifrag(1,l,kk),ifrag(2,l,kk)
42             call cprep(ifrag(1,l,kk),ifrag(2,l,kk),ishif,ii)
43           enddo 
44         endif
45       enddo
46       if (lprn) then
47       do k=1,ii
48         write(iout,'(5i4,2(3f10.5,5x))') i,j,k,inumber(1,k),
49      &         inumber(2,k),(creff(l,k),l=1,3),(cc(l,k),l=1,3)
50       enddo
51       endif
52       call fitsq(rms,cc(1,1),creff(1,1),ii,przes,obrot,non_conv)
53       if (non_conv) then
54         print *,'Error: FITSQ non-convergent, jcon',jcon
55         rmscalc=1.0d2
56       else if (rms.lt.-1.0d-6) then 
57         print *,'Error: rms^2 = ',rms,jcon
58         rmscalc = 1.0d2
59       else if (rms.ge.1.0d-6 .and. rms.lt.0) then
60         rmscalc=0.0d0
61       else 
62         rmscalc = dsqrt(rms)
63       endif
64       return
65       end
66 c-------------------------------------------------------------------------
67       subroutine cprep(if1,if2,ishif,ii)
68       implicit real*8 (a-h,o-z)
69       include 'DIMENSIONS'
70       include 'DIMENSIONS.ZSCOPT'
71       include 'DIMENSIONS.COMPAR'
72       include 'COMMON.IOUNITS'
73       include 'COMMON.COMPAR'
74       include 'COMMON.CHAIN' 
75       include 'COMMON.INTERACT'
76       include 'COMMON.VAR'
77       double precision przes(3),obrot(3,3)
78       double precision creff(3,maxres2),cc(3,maxres2)
79       logical iadded(maxres)
80       integer inumber(2,maxres)
81       common /ccc/ creff,cc,iadded,inumber
82 c      write (iout,*) "Calling cprep"
83       do l=if1,if2
84 c        write (iout,*) "l",l," iadded",iadded(l)
85         if (l+ishif.gt.1 .and. l+ishif.le.nres .and. .not.iadded(l)) 
86      &  then
87           ii=ii+1
88           iadded(l)=.true.
89           inumber(1,ii)=l
90           inumber(2,ii)=l+ishif
91           do m=1,3
92             creff(m,ii)=cref(m,l)
93             cc(m,ii)=c(m,l+ishif)
94           enddo
95         endif
96       enddo
97       return
98       end
99 c-------------------------------------------------------------------------
100       double precision function rmsnat(jcon)
101       implicit real*8 (a-h,o-z)
102       include 'DIMENSIONS'
103       include 'DIMENSIONS.ZSCOPT'
104       include 'DIMENSIONS.COMPAR'
105       include 'COMMON.IOUNITS'
106       include 'COMMON.COMPAR'
107       include 'COMMON.CHAIN' 
108       include 'COMMON.INTERACT'
109       include 'COMMON.VAR'
110       double precision przes(3),obrot(3,3)
111       logical non_conv
112       integer ishif,i,j
113       call fitsq(rms,c(1,nstart_sup),cref(1,nstart_sup),nsup,
114      &  przes,obrot,non_conv)
115       if (non_conv) then
116         print *,'Error: FITSQ non-convergent, jcon',jcon
117         rmsnat=1.0d2
118       else if (rms.lt.-1.0d-6) then 
119         print *,'Error: rms^2 = ',rms,jcon
120         rmsnat = 1.0d2
121       else if (rms.ge.1.0d-6 .and. rms.lt.0) then
122         rmsnat=0.0d0
123       else 
124         rmsnat = dsqrt(rms)
125       endif
126       return
127       end
128 c-----------------------------------------------------------------------------
129       double precision function gyrate(jcon)
130       implicit real*8 (a-h,o-z)
131       include 'DIMENSIONS'
132       include 'COMMON.INTERACT'
133       include 'COMMON.CHAIN'
134       double precision cen(3),rg
135
136       do j=1,3
137        cen(j)=0.0d0
138       enddo
139
140       do i=nnt,nct
141           do j=1,3
142             cen(j)=cen(j)+c(j,i)
143           enddo
144       enddo
145       do j=1,3
146             cen(j)=cen(j)/dble(nct-nnt+1)
147       enddo
148       rg = 0.0d0
149       do i = nnt, nct
150         do j=1,3
151          rg = rg + (c(j,i)-cen(j))**2
152         enddo
153       end do
154       gyrate = dsqrt(rg/dble(nct-nnt+1))
155       return
156       end