source/unres/src-HCD-5D/econstr_qlike.F

   1       subroutine Econstr_back_qlike
   2 c     MD with umbrella_sampling using Wolyne's distance measure as a constraint
   3       implicit real*8 (a-h,o-z)
   4       include 'DIMENSIONS'
   5       include 'COMMON.CONTROL'
   6       include 'COMMON.VAR'
   7       include 'COMMON.MD'
   8 #ifndef LANG0
   9       include 'COMMON.LANGEVIN'
  10 #else
  11       include 'COMMON.LANGEVIN.lang0'
  12 #endif
  13       include 'COMMON.CHAIN'
  14       include 'COMMON.DERIV'
  15       include 'COMMON.GEO'
  16       include 'COMMON.LOCAL'
  17       include 'COMMON.INTERACT'
  18       include 'COMMON.IOUNITS'
  19       include 'COMMON.NAMES'
  20       include 'COMMON.TIME1'
  21       double precision sigmaang/0.1d0/,sigmadih /0.1d0/,sigmasc /0.1d0/
  22 c      double precision sigmaang/0.2d0/,sigmadih /0.4d0/,sigmasc /0.5d0/
  23       double precision auxvec(maxres),auxtab(3,maxres),
  24      & auxtab1(3,maxres),auxtabx(3,maxres)
  25       Uconst_back=0.0d0
  26       do i=1,nres
  27         dutheta(i)=0.0d0
  28         dugamma(i)=0.0d0
  29         do j=1,3
  30           duscdiff(j,i)=0.0d0
  31           duscdiffx(j,i)=0.0d0
  32         enddo
  33       enddo
  34 c      write (iout,*) "Econstr_back_qlike",nfrag_back," iset",iset
  35       do i=1,nfrag_back
  36         if (wfrag_back(1,i,iset).gt.0.0d0) then
  37         ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
  38 c        write (iout,*) "i",i," ifrag_back",ifrag_back(1,i,iset),
  39 c     &     ifrag_back(2,i,iset)," ii",ii
  40 c
  41 c Deviations from theta angles
  42 c
  43         utheta_i=0.0d0
  44         do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
  45           dtheta_i=theta(j)-thetaref(j)
  46           expthet=dexp(-0.5d0*dtheta_i*dtheta_i/sigmaang)
  47 c          expthet=0.5d0*dtheta_i*dtheta_i
  48           utheta_i=utheta_i+expthet
  49           auxvec(j-2)=expthet*dtheta_i/sigmaang
  50 c          auxvec(j-2)=dtheta_i
  51 c          write (iout,*) "j",j," theta",theta(j)," thetaref",thetaref(j)
  52 c          write (iout,*) "expthet",expthet
  53         enddo
  54         qloc(1,i)=1.0d0-utheta_i/(ii-1)
  55 c        qloc(1,i,iset)=utheta_i/(ii-1)
  56 c        utheta(i)=(qloc(1,i,iset)-qin_back(1,i,iset))**2
  57         utheta(i)=(qloc(1,i)-qin_back(1,i,iset))**2
  58 c        utheta(i)=qloc(1,i,iset)
  59 c        write (iout,*) "utheta",utheta(i)
  60         do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
  61 c          dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*auxvec(j-2)
  62 c     &                  /(ii-1)
  63           dutheta(j-2)=dutheta(j-2)+2*wfrag_back(1,i,iset)*auxvec(j-2)
  64      &                  *(qloc(1,i)-qin_back(1,i,iset))/(ii-1)
  65 c          write (iout,*) i,j," dutheta",dutheta(j-2)
  66         enddo
  67         endif
  68 c
  69 c Deviations from gamma angles
  70 c
  71         if (wfrag_back(2,i,iset).gt.0.0d0) then
  72         ugamma_i=0.0d0
  73         do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
  74           dgamma_i=pinorm(phi(j)-phiref(j))
  75 c          write (iout,*) j,phi(j),phi(j)-phiref(j)
  76           expgam=dexp(-0.5d0*dgamma_i*dgamma_i/sigmadih)
  77           ugamma_i=ugamma_i+expgam
  78           auxvec(j-3)=expgam*dgamma_i/sigmadih
  79         enddo
  80         qloc(2,i)=1.0d0-ugamma_i/(ii-2)
  81         ugamma(i)=(qloc(2,i)-qin_back(2,i,iset))**2
  82         do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
  83           dugamma(j-3)=dugamma(j-3)+2*wfrag_back(2,i,iset)*auxvec(j-3)*
  84      &        (qloc(2,i)-qin_back(2,i,iset))/(ii-2)
  85 c          write (iout,*) i,j," dugamma",dugamma(j-3)
  86         enddo
  87         endif
  88 c
  89 c Deviations from local SC geometry
  90 c
  91         if (wfrag_back(3,i,iset).gt.0.0d0) then
  92         usc_i=0.0d0
  93         do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
  94 c          write (iout,*) "uscdif j=",j
  95           if (itype(j).ne.10) then
  96           dxx=xxtab(j)-xxref(j)
  97           dyy=yytab(j)-yyref(j)
  98           dzz=zztab(j)-zzref(j)
  99           expsc=dexp(-0.5d0*(dxx*dxx+dyy*dyy+dzz*dzz)/sigmasc)
 100           usc_i=usc_i+expsc
 101           expsc=expsc/sigmasc
 102           do k=1,3
 103             auxtab1(k,j-1)=expsc*
 104      &       (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)
 105             auxtab(k,j)=expsc*
 106      &       (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)
 107             auxtabx(k,j)=expsc*
 108      &     (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz)
 109           enddo
 110 c          write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
 111 c     &      xxref(j),yyref(j),zzref(j)
 112           endif
 113         enddo
 114         qloc(3,i)=1.0d0-usc_i/(ii-1)
 115         uscdiff(i)=(qloc(3,i)-qin_back(3,i,iset))**2
 116         do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
 117           if (itype(j).ne.10) then
 118           do k=1,3
 119             duscdiff(k,j-1)=duscdiff(k,j-1)+2*wfrag_back(3,i,iset)
 120      &       *auxtab1(k,j-1)*(qloc(3,i)-qin_back(3,i,iset))/(ii-1)
 121             duscdiff(k,j)=duscdiff(k,j)+2*wfrag_back(3,i,iset)
 122      &       *auxtab(k,j)*(qloc(3,i)-qin_back(3,i,iset))/(ii-1)
 123             duscdiffx(k,j)=duscdiffx(k,j)+2*wfrag_back(3,i,iset)
 124      &       *auxtabx(k,j)*(qloc(3,i)-qin_back(3,i,iset))/(ii-1)
 125           enddo
 126 c          write (iout,*) i,j," duscdiff",(duscdiff(k,j),k=1,3)
 127           endif
 128         enddo
 129 c        write (iout,*) i," uscdiff",uscdiff(i)
 130         endif
 131 c
 132 c Put together deviations from local geometry
 133 c
 134 c        Uconst_back=Uconst_back+
 135 c     &    wfrag_back(3,i,iset)*uscdiff(i)
 136         Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
 137      &    wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
 138 c        write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
 139 c     &   " uscdiff",uscdiff(i)," uconst_back",uconst_back
 140         utheta(i)=qloc(1,i)
 141         ugamma(i)=qloc(2,i)
 142         uscdiff(i)=qloc(3,i)
 143       enddo
 144       return
 145       end