--- /dev/null
+ subroutine geom_to_var(n,x)
+C
+C Transfer the geometry parameters to the variable array.
+C The positions of variables are as follows:
+C 1. Virtual-bond torsional angles: 1 thru nres-3
+C 2. Virtual-bond valence angles: nres-2 thru 2*nres-5
+C 3. The polar angles alpha of local SC orientation: 2*nres-4 thru
+C 2*nres-4+nside
+C 4. The torsional angles omega of SC orientation: 2*nres-4+nside+1
+C thru 2*nre-4+2*nside
+C
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.VAR'
+ include 'COMMON.GEO'
+ include 'COMMON.CHAIN'
+ double precision x(n)
+cd print *,'nres',nres,' nphi',nphi,' ntheta',ntheta,' nvar',nvar
+ do i=4,nres
+ x(i-3)=phi(i)
+cd print *,i,i-3,phi(i)
+ enddo
+ if (n.eq.nphi) return
+ do i=3,nres
+ x(i-2+nphi)=theta(i)
+cd print *,i,i-2+nphi,theta(i)
+ enddo
+ if (n.eq.nphi+ntheta) return
+ do i=2,nres-1
+ if (ialph(i,1).gt.0) then
+ x(ialph(i,1))=alph(i)
+ x(ialph(i,1)+nside)=omeg(i)
+cd print *,i,ialph(i,1),ialph(i,1)+nside,alph(i),omeg(i)
+ endif
+ enddo
+ return
+ end
+C--------------------------------------------------------------------
+ subroutine var_to_geom(n,x)
+C
+C Update geometry parameters according to the variable array.
+C
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.VAR'
+ include 'COMMON.CHAIN'
+ include 'COMMON.GEO'
+ include 'COMMON.IOUNITS'
+ dimension x(n)
+ logical change,reduce
+ change=reduce(x)
+ if (n.gt.nphi+ntheta) then
+ do i=1,nside
+ ii=ialph(i,2)
+ alph(ii)=x(nphi+ntheta+i)
+ omeg(ii)=pinorm(x(nphi+ntheta+nside+i))
+ enddo
+ endif
+ do i=4,nres
+ phi(i)=x(i-3)
+ enddo
+ if (n.eq.nphi) return
+ do i=3,nres
+ theta(i)=x(i-2+nphi)
+ if (theta(i).eq.pi) theta(i)=0.99d0*pi
+ x(i-2+nphi)=theta(i)
+ enddo
+ return
+ end
+c-------------------------------------------------------------------------
+ logical function convert_side(alphi,omegi)
+ implicit none
+ double precision alphi,omegi
+ double precision pinorm
+ include 'COMMON.GEO'
+ convert_side=.false.
+C Apply periodicity restrictions.
+ if (alphi.gt.pi) then
+ alphi=dwapi-alphi
+ omegi=pinorm(omegi+pi)
+ convert_side=.true.
+ endif
+ return
+ end
+c-------------------------------------------------------------------------
+ logical function reduce(x)
+C
+C Apply periodic restrictions to variables.
+C
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.VAR'
+ include 'COMMON.CHAIN'
+ include 'COMMON.GEO'
+ logical zm,zmiana,convert_side
+ dimension x(nvar)
+ zmiana=.false.
+ do i=4,nres
+ x(i-3)=pinorm(x(i-3))
+ enddo
+ if (nvar.gt.nphi+ntheta) then
+ do i=1,nside
+ ii=nphi+ntheta+i
+ iii=ii+nside
+ x(ii)=thetnorm(x(ii))
+ x(iii)=pinorm(x(iii))
+C Apply periodic restrictions.
+ zm=convert_side(x(ii),x(iii))
+ zmiana=zmiana.or.zm
+ enddo
+ endif
+ if (nvar.eq.nphi) return
+ do i=3,nres
+ ii=i-2+nphi
+ iii=i-3
+ x(ii)=dmod(x(ii),dwapi)
+C Apply periodic restrictions.
+ if (x(ii).gt.pi) then
+ zmiana=.true.
+ x(ii)=dwapi-x(ii)
+ if (iii.gt.0) x(iii)=pinorm(x(iii)+pi)
+ if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi)
+ ii=ialph(i-1,1)
+ if (ii.gt.0) then
+ x(ii)=dmod(pi-x(ii),dwapi)
+ x(ii+nside)=pinorm(-x(ii+nside))
+ zm=convert_side(x(ii),x(ii+nside))
+ endif
+ else if (x(ii).lt.-pi) then
+ zmiana=.true.
+ x(ii)=dwapi+x(ii)
+ ii=ialph(i-1,1)
+ if (ii.gt.0) then
+ x(ii)=dmod(pi-x(ii),dwapi)
+ x(ii+nside)=pinorm(-pi-x(ii+nside))
+ zm=convert_side(x(ii),x(ii+nside))
+ endif
+ else if (x(ii).lt.0.0d0) then
+ zmiana=.true.
+ x(ii)=-x(ii)
+ if (iii.gt.0) x(iii)=pinorm(x(iii)+pi)
+ if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi)
+ ii=ialph(i-1,1)
+ if (ii.gt.0) then
+ x(ii+nside)=pinorm(-x(ii+nside))
+ zm=convert_side(x(ii),x(ii+nside))
+ endif
+ endif
+ enddo
+ reduce=zmiana
+ return
+ end
+c--------------------------------------------------------------------------
+ double precision function thetnorm(x)
+C This function puts x within [0,2Pi].
+ implicit none
+ double precision x,xx
+ include 'COMMON.GEO'
+ xx=dmod(x,dwapi)
+ if (xx.lt.0.0d0) xx=xx+dwapi
+ if (xx.gt.0.9999d0*pi) xx=0.9999d0*pi
+ thetnorm=xx
+ return
+ end
+C--------------------------------------------------------------------
+ subroutine var_to_geom_restr(n,xx)
+C
+C Update geometry parameters according to the variable array.
+C
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.VAR'
+ include 'COMMON.CHAIN'
+ include 'COMMON.GEO'
+ include 'COMMON.IOUNITS'
+ dimension x(maxvar),xx(maxvar)
+ logical change,reduce
+
+ call xx2x(x,xx)
+ change=reduce(x)
+ do i=1,nside
+ ii=ialph(i,2)
+ alph(ii)=x(nphi+ntheta+i)
+ omeg(ii)=pinorm(x(nphi+ntheta+nside+i))
+ enddo
+ do i=4,nres
+ phi(i)=x(i-3)
+ enddo
+ do i=3,nres
+ theta(i)=x(i-2+nphi)
+ if (theta(i).eq.pi) theta(i)=0.99d0*pi
+ x(i-2+nphi)=theta(i)
+ enddo
+ return
+ end
+c-------------------------------------------------------------------------
projects / unres.git / blobdiff