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