source/maxlik/src-Fmatch_safe/convert.f

   1       subroutine geom_to_var(n,x)
   2 C
   3 C Transfer the geometry parameters to the variable array.
   4 C The positions of variables are as follows:
   5 C 1. Virtual-bond torsional angles: 1 thru nres-3
   6 C 2. Virtual-bond valence angles: nres-2 thru 2*nres-5
   7 C 3. The polar angles alpha of local SC orientation: 2*nres-4 thru
   8 C    2*nres-4+nside
   9 C 4. The torsional angles omega of SC orientation: 2*nres-4+nside+1
  10 C    thru 2*nre-4+2*nside
  11 C
  12       implicit real*8 (a-h,o-z)
  13       include 'DIMENSIONS'
  14       include 'DIMENSIONS.ZSCOPT'
  15       include 'COMMON.VAR'
  16       include 'COMMON.GEO'
  17       include 'COMMON.CHAIN'
  18       double precision x(maxvar)
  19 cd    print *,'nres',nres,' nphi',nphi,' ntheta',ntheta,' nvar',nvar
  20       do i=4,nres
  21         x(i-3)=phi(i)
  22 cd      print *,i,i-3,phi(i)
  23       enddo
  24       if (n.eq.nphi) return
  25       do i=3,nres
  26         x(i-2+nphi)=theta(i)
  27 cd      print *,i,i-2+nphi,theta(i)
  28       enddo
  29       if (n.eq.nphi+ntheta) return
  30       do i=2,nres-1
  31         if (ialph(i,1).gt.0) then
  32           x(ialph(i,1))=alph(i)
  33           x(ialph(i,1)+nside)=omeg(i)
  34 cd        print *,i,ialph(i,1),ialph(i,1)+nside,alph(i),omeg(i)
  35         endif
  36       enddo
  37       return
  38       end
  39 C--------------------------------------------------------------------
  40       subroutine var_to_geom(n,x)
  41 C
  42 C Update geometry parameters according to the variable array.
  43 C
  44       implicit real*8 (a-h,o-z)
  45       include 'DIMENSIONS'
  46       include 'DIMENSIONS.ZSCOPT'
  47       include 'COMMON.VAR'
  48       include 'COMMON.CHAIN'
  49       include 'COMMON.GEO'
  50       include 'COMMON.IOUNITS'
  51       dimension x(maxvar)
  52       logical change,reduce
  53       change=reduce(x)
  54       if (n.gt.nphi+ntheta) then
  55         do i=1,nside
  56           ii=ialph(i,2)
  57           alph(ii)=x(nphi+ntheta+i)
  58           omeg(ii)=pinorm(x(nphi+ntheta+nside+i))
  59         enddo
  60       endif
  61       do i=4,nres
  62         phi(i)=x(i-3)
  63       enddo
  64       if (n.eq.nphi) return
  65       do i=3,nres
  66         theta(i)=x(i-2+nphi)
  67         if (theta(i).eq.pi) theta(i)=0.99d0*pi
  68         x(i-2+nphi)=theta(i)
  69       enddo
  70       return
  71       end
  72 c-------------------------------------------------------------------------
  73       logical function convert_side(alphi,omegi)
  74       implicit none
  75       double precision alphi,omegi
  76       double precision pinorm
  77       include 'COMMON.GEO'
  78       convert_side=.false.
  79 C Apply periodicity restrictions.
  80       if (alphi.gt.pi) then
  81         alphi=dwapi-alphi
  82         omegi=pinorm(omegi+pi)
  83         convert_side=.true.
  84       endif
  85       return
  86       end
  87 c-------------------------------------------------------------------------
  88       logical function reduce(x)
  89 C
  90 C Apply periodic restrictions to variables.
  91 C
  92       implicit real*8 (a-h,o-z)
  93       include 'DIMENSIONS'
  94       include 'DIMENSIONS.ZSCOPT'
  95       include 'COMMON.VAR'
  96       include 'COMMON.CHAIN'
  97       include 'COMMON.GEO'
  98       logical zm,zmiana,convert_side
  99       dimension x(maxvar)
 100       zmiana=.false.
 101       do i=4,nres
 102         x(i-3)=pinorm(x(i-3))
 103       enddo
 104       if (nvar.gt.nphi+ntheta) then
 105         do i=1,nside
 106           ii=nphi+ntheta+i
 107           iii=ii+nside
 108           x(ii)=thetnorm(x(ii))
 109           x(iii)=pinorm(x(iii))
 110 C Apply periodic restrictions.
 111           zm=convert_side(x(ii),x(iii))
 112           zmiana=zmiana.or.zm
 113         enddo
 114       endif
 115       if (nvar.eq.nphi) return
 116       do i=3,nres
 117         ii=i-2+nphi
 118         iii=i-3
 119         x(ii)=dmod(x(ii),dwapi)
 120 C Apply periodic restrictions.
 121         if (x(ii).gt.pi) then
 122           zmiana=.true.
 123           x(ii)=dwapi-x(ii)
 124           if (iii.gt.0) x(iii)=pinorm(x(iii)+pi)
 125           if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi)
 126           ii=ialph(i-1,1)
 127           if (ii.gt.0) then
 128             x(ii)=dmod(pi-x(ii),dwapi)
 129             x(ii+nside)=pinorm(-x(ii+nside))
 130             zm=convert_side(x(ii),x(ii+nside))
 131           endif
 132         else if (x(ii).lt.-pi) then
 133           zmiana=.true.
 134           x(ii)=dwapi+x(ii)
 135           ii=ialph(i-1,1)
 136           if (ii.gt.0) then
 137             x(ii)=dmod(pi-x(ii),dwapi)
 138             x(ii+nside)=pinorm(-pi-x(ii+nside))
 139             zm=convert_side(x(ii),x(ii+nside))
 140           endif
 141         else if (x(ii).lt.0.0d0) then
 142           zmiana=.true.
 143           x(ii)=-x(ii)
 144           if (iii.gt.0) x(iii)=pinorm(x(iii)+pi)
 145           if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi)
 146           ii=ialph(i-1,1)
 147           if (ii.gt.0) then
 148             x(ii+nside)=pinorm(-x(ii+nside))
 149             zm=convert_side(x(ii),x(ii+nside))
 150           endif
 151         endif
 152       enddo
 153       reduce=zmiana
 154       return
 155       end
 156 c--------------------------------------------------------------------------
 157       double precision function thetnorm(x)
 158 C This function puts x within [0,0.9999*Pi].
 159       implicit none
 160       double precision x,xx
 161       include 'COMMON.GEO'
 162       xx=dmod(x,dwapi)
 163       if (xx.lt.-pi) then
 164         xx=xx+dwapi
 165       else if (xx.lt.0.0d0) then
 166         xx=-xx
 167       else if (xx.gt.pi) then
 168         xx=dwapi-xx
 169       endif
 170       if (xx.gt.0.9999d0*pi) xx=0.9999d0*pi
 171       thetnorm=xx
 172       return
 173       end