Gradient correct, 180deg problem unresolved
[unres4.git] / source / unres / energy.f90
index 1d58136..949e678 100644 (file)
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
+          xmedi=dmod(xmedi,boxxsize)
+          if (xmedi.lt.0) xmedi=xmedi+boxxsize
+          ymedi=dmod(ymedi,boxysize)
+          if (ymedi.lt.0) ymedi=ymedi+boxysize
+          zmedi=dmod(zmedi,boxzsize)
+          if (zmedi.lt.0) zmedi=zmedi+boxzsize
         num_conti=0
         call eelecij(i,i+2,ees,evdw1,eel_loc)
         if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
+          xmedi=dmod(xmedi,boxxsize)
+          if (xmedi.lt.0) xmedi=xmedi+boxxsize
+          ymedi=dmod(ymedi,boxysize)
+          if (ymedi.lt.0) ymedi=ymedi+boxysize
+          zmedi=dmod(zmedi,boxzsize)
+          if (zmedi.lt.0) zmedi=zmedi+boxzsize
         num_conti=num_cont_hb(i)
         call eelecij(i,i+3,ees,evdw1,eel_loc)
         if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) &
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
+          xmedi=dmod(xmedi,boxxsize)
+          if (xmedi.lt.0) xmedi=xmedi+boxxsize
+          ymedi=dmod(ymedi,boxysize)
+          if (ymedi.lt.0) ymedi=ymedi+boxysize
+          zmedi=dmod(zmedi,boxzsize)
+          if (zmedi.lt.0) zmedi=zmedi+boxzsize
+
 !        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
         num_conti=num_cont_hb(i)
         do j=ielstart(i),ielend(i)
 !      include 'COMMON.VECTORS'
 !      include 'COMMON.FFIELD'
 !      include 'COMMON.TIME1'
-      real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
+      real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
       real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
       real(kind=8),dimension(2,2) :: acipa !el,a_temp
 !el      real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
       real(kind=8),dimension(4) :: muij
+      real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+                    dist_temp, dist_init
+      integer xshift,yshift,zshift
 !el      integer :: num_conti,j1,j2
 !el      real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
 !el        dz_normi,xmedi,ymedi,zmedi
                                              0.0d0,0.0d0,1.0d0/),shape(unmat)) 
 !      integer :: maxconts=nres/4
 !el local variables
-      integer :: k,i,j,iteli,itelj,kkk,l,kkll,m
+      integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
       real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
       real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
       real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
           dx_normj=dc_norm(1,j)
           dy_normj=dc_norm(2,j)
           dz_normj=dc_norm(3,j)
-          xj=c(1,j)+0.5D0*dxj-xmedi
-          yj=c(2,j)+0.5D0*dyj-ymedi
-          zj=c(3,j)+0.5D0*dzj-zmedi
+!          xj=c(1,j)+0.5D0*dxj-xmedi
+!          yj=c(2,j)+0.5D0*dyj-ymedi
+!          zj=c(3,j)+0.5D0*dzj-zmedi
+          xj=c(1,j)+0.5D0*dxj
+          yj=c(2,j)+0.5D0*dyj
+          zj=c(3,j)+0.5D0*dzj
+          xj=mod(xj,boxxsize)
+          if (xj.lt.0) xj=xj+boxxsize
+          yj=mod(yj,boxysize)
+          if (yj.lt.0) yj=yj+boxysize
+          zj=mod(zj,boxzsize)
+          if (zj.lt.0) zj=zj+boxzsize
+      dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+      xj_safe=xj
+      yj_safe=yj
+      zj_safe=zj
+      do xshift=-1,1
+      do yshift=-1,1
+      do zshift=-1,1
+          xj=xj_safe+xshift*boxxsize
+          yj=yj_safe+yshift*boxysize
+          zj=zj_safe+zshift*boxzsize
+          dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+          if(dist_temp.lt.dist_init) then
+            dist_init=dist_temp
+            xj_temp=xj
+            yj_temp=yj
+            zj_temp=zj
+            isubchap=1
+          endif
+       enddo
+       enddo
+       enddo
+       if (isubchap.eq.1) then
+!C          print *,i,j
+          xj=xj_temp-xmedi
+          yj=yj_temp-ymedi
+          zj=zj_temp-zmedi
+       else
+          xj=xj_safe-xmedi
+          yj=yj_safe-ymedi
+          zj=zj_safe-zmedi
+       endif
+
           rij=xj*xj+yj*yj+zj*zj
           rrmij=1.0D0/rij
           rij=dsqrt(rij)
+!C            print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
+            sss_ele_cut=sscale_ele(rij)
+            sss_ele_grad=sscagrad_ele(rij)
+!             sss_ele_cut=1.0d0
+!             sss_ele_grad=0.0d0
+!            print *,sss_ele_cut,sss_ele_grad,&
+!            (rij),r_cut_ele,rlamb_ele
+!            if (sss_ele_cut.le.0.0) go to 128
+
           rmij=1.0D0/rij
           r3ij=rrmij*rmij
           r6ij=r3ij*r3ij  
           eesij=el1+el2
 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
           ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
-          ees=ees+eesij
-          evdw1=evdw1+evdwij
+          ees=ees+eesij*sss_ele_cut
+          evdw1=evdw1+evdwij*sss_ele_cut
 !d          write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
 !d     &      iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
 !d     &      1.0D0/dsqrt(rrmij),evdwij,eesij,
 ! Calculate contributions to the Cartesian gradient.
 !
 #ifdef SPLITELE
-          facvdw=-6*rrmij*(ev1+evdwij)
-          facel=-3*rrmij*(el1+eesij)
+          facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut
+          facel=-3*rrmij*(el1+eesij)*sss_ele_cut
           fac1=fac
           erij(1)=xj*rmij
           erij(2)=yj*rmij
 !
 ! Radial derivatives. First process both termini of the fragment (i,j)
 !
-          ggg(1)=facel*xj
-          ggg(2)=facel*yj
-          ggg(3)=facel*zj
+          ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
+          ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
+          ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
+
 !          do k=1,3
 !            ghalf=0.5D0*ggg(k)
 !            gelc(k,i)=gelc(k,i)+ghalf
 !grad              gelc(l,k)=gelc(l,k)+ggg(l)
 !grad            enddo
 !grad          enddo
-          ggg(1)=facvdw*xj
-          ggg(2)=facvdw*yj
-          ggg(3)=facvdw*zj
+          ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj
+          ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj
+          ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj
 !          do k=1,3
 !            ghalf=0.5D0*ggg(k)
 !            gvdwpp(k,i)=gvdwpp(k,i)+ghalf
 !grad            enddo
 !grad          enddo
 #else
-          facvdw=ev1+evdwij 
-          facel=el1+eesij  
+          facvdw=(ev1+evdwij)*sss_ele_cut
+          facel=(el1+eesij)*sss_ele_cut
           fac1=fac
           fac=-3*rrmij*(facvdw+facvdw+facel)
           erij(1)=xj*rmij
 !
 ! Radial derivatives. First process both termini of the fragment (i,j)
 ! 
-          ggg(1)=fac*xj
-          ggg(2)=fac*yj
-          ggg(3)=fac*zj
+          ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
+          ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
+          ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
 !          do k=1,3
 !            ghalf=0.5D0*ggg(k)
 !            gelc(k,i)=gelc(k,i)+ghalf
 !d        print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
 !d   &          (dcosg(k),k=1,3)
           do k=1,3
-            ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) 
+            ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut
           enddo
 !          do k=1,3
 !            ghalf=0.5D0*ggg(k)
           do k=1,3
             gelc(k,i)=gelc(k,i) &
                      +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
-                     + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+                     + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
+                     *sss_ele_cut
             gelc(k,j)=gelc(k,j) &
                      +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
-                     + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+                     + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
+                     *sss_ele_cut
             gelc_long(k,j)=gelc_long(k,j)+ggg(k)
             gelc_long(k,i)=gelc_long(k,i)-ggg(k)
           enddo
+
           IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
               .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
               .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
           eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
            +a33*muij(4)
 !          write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
-
+!           eel_loc_ij=0.0
           if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
                   'eelloc',i,j,eel_loc_ij
 !          if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
 !          if (energy_dec) write (iout,*) "muij",muij
 !              write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
-
-          eel_loc=eel_loc+eel_loc_ij
+           
+          eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
 ! Partial derivatives in virtual-bond dihedral angles gamma
           if (i.gt.1) &
           gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
-                  a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
-                 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
+                  (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
+                 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
+                 *sss_ele_cut
           gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
-                  a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
-                 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
+                  (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
+                 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
+                 *sss_ele_cut
 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
-          do l=1,3
-            ggg(l)=agg(l,1)*muij(1)+ &
-                agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
+!          do l=1,3
+!            ggg(1)=(agg(1,1)*muij(1)+ &
+!                agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
+!            *sss_ele_cut &
+!             +eel_loc_ij*sss_ele_grad*rmij*xj
+!            ggg(2)=(agg(2,1)*muij(1)+ &
+!                agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
+!            *sss_ele_cut &
+!             +eel_loc_ij*sss_ele_grad*rmij*yj
+!            ggg(3)=(agg(3,1)*muij(1)+ &
+!                agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
+!            *sss_ele_cut &
+!             +eel_loc_ij*sss_ele_grad*rmij*zj
+           xtemp(1)=xj
+           xtemp(2)=yj
+           xtemp(3)=zj
+
+           do l=1,3
+            ggg(l)=(agg(l,1)*muij(1)+ &
+                agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
+            *sss_ele_cut &
+             +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
+
             gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
             gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
 !grad            ghalf=0.5d0*ggg(l)
 !grad          enddo
 ! Remaining derivatives of eello
           do l=1,3
-            gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ &
-                aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
-            gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ &
-                aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
-            gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ &
-                aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
-            gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ &
-                aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
+            gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
+                aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
+            *sss_ele_cut
+!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
+            gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
+                aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
+            +aggi1(l,4)*muij(4))&
+            *sss_ele_cut
+!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
+            gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
+                aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
+            *sss_ele_cut
+!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
+            gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
+                aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
+            +aggj1(l,4)*muij(4))&
+            *sss_ele_cut
+!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
           enddo
           ENDIF
 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
                   ees0mij=0
                 endif
 !               ees0mij=0.0D0
-                ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
-                ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
+                ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
+                     *sss_ele_cut
+
+                ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
+                     *sss_ele_cut
+
 ! Diagnostics. Comment out or remove after debugging!
 !               ees0p(num_conti,i)=0.5D0*fac3*ees0pij
 !               ees0m(num_conti,i)=0.5D0*fac3*ees0mij
                   gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
                   gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
                 enddo
-                gggp(1)=gggp(1)+ees0pijp*xj
-                gggp(2)=gggp(2)+ees0pijp*yj
-                gggp(3)=gggp(3)+ees0pijp*zj
-                gggm(1)=gggm(1)+ees0mijp*xj
-                gggm(2)=gggm(2)+ees0mijp*yj
-                gggm(3)=gggm(3)+ees0mijp*zj
+                gggp(1)=gggp(1)+ees0pijp*xj &
+                  +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
+                gggp(2)=gggp(2)+ees0pijp*yj &
+               +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
+                gggp(3)=gggp(3)+ees0pijp*zj &
+               +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
+
+                gggm(1)=gggm(1)+ees0mijp*xj &
+               +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
+
+                gggm(2)=gggm(2)+ees0mijp*yj &
+               +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
+
+                gggm(3)=gggm(3)+ees0mijp*zj &
+               +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
+
 ! Derivatives due to the contact function
                 gacont_hbr(1,num_conti,i)=fprimcont*xj
                 gacont_hbr(2,num_conti,i)=fprimcont*yj
 !grad                  ghalfm=0.5D0*gggm(k)
                   gacontp_hb1(k,num_conti,i)= & !ghalfp+
                     (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
-                   + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+                   + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
+                     *sss_ele_cut
+
                   gacontp_hb2(k,num_conti,i)= & !ghalfp+
                     (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
-                   + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
-                  gacontp_hb3(k,num_conti,i)=gggp(k)
+                   + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
+                     *sss_ele_cut
+
+                  gacontp_hb3(k,num_conti,i)=gggp(k) &
+                     *sss_ele_cut
+
                   gacontm_hb1(k,num_conti,i)= & !ghalfm+
                     (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
-                   + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+                   + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
+                     *sss_ele_cut
+
                   gacontm_hb2(k,num_conti,i)= & !ghalfm+
                     (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
-                   + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
-                  gacontm_hb3(k,num_conti,i)=gggm(k)
+                   + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
+                     *sss_ele_cut
+
+                  gacontm_hb3(k,num_conti,i)=gggm(k) &
+                     *sss_ele_cut
+
                 enddo
 ! Diagnostics. Comment out or remove after debugging!
 !diag           do k=1,3
               enddo
             endif
           endif
+ 128  continue
 !          t_eelecij=t_eelecij+MPI_Wtime()-time00
       return
       end subroutine eelecij
 !      include 'COMMON.CONTROL'
       real(kind=8),dimension(3) :: ggg
 !el local variables
-      integer :: i,iint,j,k,iteli,itypj
+      integer :: i,iint,j,k,iteli,itypj,subchap
       real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
-                   e1,e2,evdwij
+                   e1,e2,evdwij,rij
+      real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
+                    dist_temp, dist_init
+      integer xshift,yshift,zshift
 
       evdw2=0.0D0
       evdw2_14=0.0d0
         xi=0.5D0*(c(1,i)+c(1,i+1))
         yi=0.5D0*(c(2,i)+c(2,i+1))
         zi=0.5D0*(c(3,i)+c(3,i+1))
+          xi=mod(xi,boxxsize)
+          if (xi.lt.0) xi=xi+boxxsize
+          yi=mod(yi,boxysize)
+          if (yi.lt.0) yi=yi+boxysize
+          zi=mod(zi,boxzsize)
+          if (zi.lt.0) zi=zi+boxzsize
 
         do iint=1,nscp_gr(i)
 
 !         yj=c(2,nres+j)-yi
 !         zj=c(3,nres+j)-zi
 ! Uncomment following three lines for Ca-p interactions
-          xj=c(1,j)-xi
-          yj=c(2,j)-yi
-          zj=c(3,j)-zi
+!          xj=c(1,j)-xi
+!          yj=c(2,j)-yi
+!          zj=c(3,j)-zi
+          xj=c(1,j)
+          yj=c(2,j)
+          zj=c(3,j)
+          xj=mod(xj,boxxsize)
+          if (xj.lt.0) xj=xj+boxxsize
+          yj=mod(yj,boxysize)
+          if (yj.lt.0) yj=yj+boxysize
+          zj=mod(zj,boxzsize)
+          if (zj.lt.0) zj=zj+boxzsize
+      dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+      xj_safe=xj
+      yj_safe=yj
+      zj_safe=zj
+      subchap=0
+      do xshift=-1,1
+      do yshift=-1,1
+      do zshift=-1,1
+          xj=xj_safe+xshift*boxxsize
+          yj=yj_safe+yshift*boxysize
+          zj=zj_safe+zshift*boxzsize
+          dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
+          if(dist_temp.lt.dist_init) then
+            dist_init=dist_temp
+            xj_temp=xj
+            yj_temp=yj
+            zj_temp=zj
+            subchap=1
+          endif
+       enddo
+       enddo
+       enddo
+       if (subchap.eq.1) then
+          xj=xj_temp-xi
+          yj=yj_temp-yi
+          zj=zj_temp-zi
+       else
+          xj=xj_safe-xi
+          yj=yj_safe-yi
+          zj=zj_safe-zi
+       endif
+
           rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+          rij=dsqrt(1.0d0/rrij)
+            sss_ele_cut=sscale_ele(rij)
+            sss_ele_grad=sscagrad_ele(rij)
+!            print *,sss_ele_cut,sss_ele_grad,&
+!            (rij),r_cut_ele,rlamb_ele
+            if (sss_ele_cut.le.0.0) cycle
           fac=rrij**expon2
           e1=fac*fac*aad(itypj,iteli)
           e2=fac*bad(itypj,iteli)
           if (iabs(j-i) .le. 2) then
             e1=scal14*e1
             e2=scal14*e2
-            evdw2_14=evdw2_14+e1+e2
+            evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
           endif
           evdwij=e1+e2
-          evdw2=evdw2+evdwij
+          evdw2=evdw2+evdwij*sss_ele_cut
 !          if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
 !             'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
           if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
 !
 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
 !
-          fac=-(evdwij+e1)*rrij
+          fac=-(evdwij+e1)*rrij*sss_ele_cut
+          fac=fac+evdwij*sss_ele_grad/rij/expon
           ggg(1)=xj*fac
           ggg(2)=yj*fac
           ggg(3)=zj*fac
 ! Check the gradient of the virtual-bond and SC vectors in the internal
 ! coordinates.
 !    
-      aincr=1.0d-7  
-      aincr2=5.0d-8   
+      aincr=1.0d-6  
+      aincr2=5.0d-7   
       call cartder
       write (iout,'(a)') '**************** dx/dalpha'
       write (iout,'(a)')
       nf=0
       nfl=0                
       call zerograd
-      aincr=1.0D-7
-      print '(a)','CG processor',me,' calling CHECK_CART.'
+      aincr=1.0D-5
+      print '(a)','CG processor',me,' calling CHECK_CART.',aincr
       nf=0
       icall=0
       call geom_to_var(nvar,x)
@@ -10594,8 +10786,8 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
 !      call intcartderiv
 !      call checkintcartgrad
       call zerograd
-      aincr=1.0D-6
-      write(iout,*) 'Calling CHECK_ECARTINT.'
+      aincr=2.0D-5
+      write(iout,*) 'Calling CHECK_ECARTINT.',aincr
       nf=0
       icall=0
       call geom_to_var(nvar,x)
@@ -10999,6 +11191,20 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
       endif
       return
       end function sscale
+      real(kind=8) function sscale_grad(r)
+!      include "COMMON.SPLITELE"
+      real(kind=8) :: r,gamm
+      if(r.lt.r_cut-rlamb) then
+        sscale_grad=0.0d0
+      else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
+        gamm=(r-(r_cut-rlamb))/rlamb
+        sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
+      else
+        sscale_grad=0d0
+      endif
+      return
+      end function sscale_grad
+
 !!!!!!!!!! PBCSCALE
       real(kind=8) function sscale_ele(r)
 !      include "COMMON.SPLITELE"
@@ -11648,7 +11854,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
 !el local variables
       integer :: iint,itypi,itypi1,itypj,subchap
       real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
-      real(kind=8) :: sss,e1,e2,evdw
+      real(kind=8) :: sss,e1,e2,evdw,sss_grad
       real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
                     dist_temp, dist_init
 
@@ -11752,6 +11958,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
             sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
             sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
             sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
+            sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
             if (sss_ele_cut.le.0.0) cycle
             if (sss.lt.1.0d0) then
 
@@ -11805,8 +12012,9 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
               fac=-expon*(e1+evdwij)*rij_shift
               sigder=fac*sigder
               fac=rij*fac
-              fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
-            /sigma(itypi,itypj)*rij
+              fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
+            /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij  &
+            /sigmaii(itypi,itypj))
 !              fac=0.0d0
 ! Calculate the radial part of the gradient
               gg(1)=xj*fac
@@ -11845,7 +12053,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
 !el local variables
       integer :: iint,itypi,itypi1,itypj,subchap
       real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
-      real(kind=8) :: sss,e1,e2,evdw,rij_shift
+      real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
       real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
                     dist_temp, dist_init
       evdw=0.0D0
@@ -11955,6 +12163,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
             rij=dsqrt(rrij)
             sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
+            sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
             sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
             sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
             if (sss_ele_cut.le.0.0) cycle
@@ -11989,7 +12198,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
 !              write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
 !     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
               evdwij=evdwij*eps2rt*eps3rt
-              evdw=evdw+evdwij*sss
+              evdw=evdw+evdwij*sss*sss_ele_cut
               if (lprn) then
               sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
               epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
@@ -12011,8 +12220,9 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
               fac=-expon*(e1+evdwij)*rij_shift
               sigder=fac*sigder
               fac=rij*fac
-              fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
-            /sigma(itypi,itypj)*rij
+              fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
+            /sigma(itypi,itypj)*rij+sss_grad/sss*rij  &
+            /sigmaii(itypi,itypj))
 
 !              fac=0.0d0
 ! Calculate the radial part of the gradient
@@ -14618,7 +14828,7 @@ write(iout,*) 'Calling CHECK_ECARTIN else.'
 !    Obtaining the gamma derivatives from sine derivative                               
        if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
            phi(i).gt.pi34.and.phi(i).le.pi.or. &
-           phi(i).gt.-pi.and.phi(i).le.-pi34) then
+           phi(i).ge.-pi.and.phi(i).le.-pi34) then
          call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
          call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
          call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)