Merge branch 'master' of mmka:unres into multichain
[unres.git] / source / unres / src_MD-M / energy_p_new_barrier.F
index 2097265..180f1bf 100644 (file)
@@ -24,6 +24,7 @@ cMS$ATTRIBUTES C ::  proc_proc
       include 'COMMON.MD'
       include 'COMMON.CONTROL'
       include 'COMMON.TIME1'
+      include 'COMMON.SPLITELE'
 #ifdef MPI      
 c      print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
 c     & " nfgtasks",nfgtasks
@@ -156,9 +157,9 @@ c      print *,"Processor",myrank," left VEC_AND_DERIV"
             eello_turn4=0.0d0
          endif
       else
-c        write (iout,*) "Soft-spheer ELEC potential"
-        call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
-     &   eello_turn4)
+        write (iout,*) "Soft-spheer ELEC potential"
+c        call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
+c     &   eello_turn4)
       endif
 c      print *,"Processor",myrank," computed UELEC"
 C
@@ -301,6 +302,8 @@ C
       energia(17)=estr
       energia(20)=Uconst+Uconst_back
       energia(21)=esccor
+c    Here are the energies showed per procesor if the are more processors 
+c    per molecule then we sum it up in sum_energy subroutine 
 c      print *," Processor",myrank," calls SUM_ENERGY"
       call sum_energy(energia,.true.)
       if (dyn_ss) call dyn_set_nss
@@ -441,7 +444,7 @@ cMS$ATTRIBUTES C ::  proc_proc
       include 'mpif.h'
 #endif
       double precision gradbufc(3,maxres),gradbufx(3,maxres),
-     &  glocbuf(4*maxres),gradbufc_sum(3,maxres)
+     &  glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
       include 'COMMON.SETUP'
       include 'COMMON.IOUNITS'
       include 'COMMON.FFIELD'
@@ -453,6 +456,7 @@ cMS$ATTRIBUTES C ::  proc_proc
       include 'COMMON.CONTROL'
       include 'COMMON.TIME1'
       include 'COMMON.MAXGRAD'
+      include 'COMMON.SCCOR'
 #ifdef TIMING
       time01=MPI_Wtime()
 #endif
@@ -695,7 +699,6 @@ c      enddo
      &   +wturn3*gel_loc_turn3(i)
      &   +wturn6*gel_loc_turn6(i)
      &   +wel_loc*gel_loc_loc(i)
-     &   +wsccor*gsccor_loc(i)
       enddo
 #ifdef DEBUG
       write (iout,*) "gloc after adding corr"
@@ -714,6 +717,21 @@ c      enddo
         do i=1,4*nres
           glocbuf(i)=gloc(i,icg)
         enddo
+c#define DEBUG
+#ifdef DEBUG
+      write (iout,*) "gloc_sc before reduce"
+      do i=1,nres
+       do j=1,1
+        write (iout,*) i,j,gloc_sc(j,i,icg)
+       enddo
+      enddo
+#endif
+c#undef DEBUG
+        do i=1,nres
+         do j=1,3
+          gloc_scbuf(j,i)=gloc_sc(j,i,icg)
+         enddo
+        enddo
         time00=MPI_Wtime()
         call MPI_Barrier(FG_COMM,IERR)
         time_barrier_g=time_barrier_g+MPI_Wtime()-time00
@@ -725,6 +743,19 @@ c      enddo
         call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
      &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
         time_reduce=time_reduce+MPI_Wtime()-time00
+        call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
+     &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+        time_reduce=time_reduce+MPI_Wtime()-time00
+c#define DEBUG
+#ifdef DEBUG
+      write (iout,*) "gloc_sc after reduce"
+      do i=1,nres
+       do j=1,1
+        write (iout,*) i,j,gloc_sc(j,i,icg)
+       enddo
+      enddo
+#endif
+c#undef DEBUG
 #ifdef DEBUG
       write (iout,*) "gloc after reduce"
       do i=1,4*nres
@@ -1031,9 +1062,9 @@ C
 c      write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
       do i=iatsc_s,iatsc_e
-        itypi=itype(i)
-        if (itypi.eq.21) cycle
-        itypi1=itype(i+1)
+        itypi=iabs(itype(i))
+        if (itypi.eq.ntyp1) cycle
+        itypi1=iabs(itype(i+1))
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
@@ -1046,8 +1077,8 @@ C
 cd        write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
 cd   &                  'iend=',iend(i,iint)
           do j=istart(i,iint),iend(i,iint)
-            itypj=itype(j)
-            if (itypj.eq.21) cycle
+            itypj=iabs(itype(j)) 
+            if (itypj.eq.ntyp1) cycle
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
@@ -1184,9 +1215,9 @@ C
 c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
       evdw=0.0D0
       do i=iatsc_s,iatsc_e
-        itypi=itype(i)
-        if (itypi.eq.21) cycle
-        itypi1=itype(i+1)
+        itypi=iabs(itype(i))
+        if (itypi.eq.ntyp1) cycle
+        itypi1=iabs(itype(i+1))
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
@@ -1195,8 +1226,8 @@ C Calculate SC interaction energy.
 C
         do iint=1,nint_gr(i)
           do j=istart(i,iint),iend(i,iint)
-            itypj=itype(j)
-            if (itypj.eq.21) cycle
+            itypj=iabs(itype(j))
+            if (itypj.eq.ntyp1) cycle
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
@@ -1277,9 +1308,9 @@ c     else
 c     endif
       ind=0
       do i=iatsc_s,iatsc_e
-        itypi=itype(i)
-        if (itypi.eq.21) cycle
-        itypi1=itype(i+1)
+        itypi=iabs(itype(i))
+        if (itypi.eq.ntyp1) cycle
+        itypi1=iabs(itype(i+1))
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
@@ -1294,8 +1325,8 @@ C
         do iint=1,nint_gr(i)
           do j=istart(i,iint),iend(i,iint)
             ind=ind+1
-            itypj=itype(j)
-            if (itypj.eq.21) cycle
+            itypj=iabs(itype(j))
+            if (itypj.eq.ntyp1) cycle
 c            dscj_inv=dsc_inv(itypj)
             dscj_inv=vbld_inv(j+nres)
             chi1=chi(itypi,itypj)
@@ -1388,8 +1419,10 @@ C
       include 'COMMON.IOUNITS'
       include 'COMMON.CALC'
       include 'COMMON.CONTROL'
+      include 'COMMON.SPLITELE'
       include 'COMMON.SBRIDGE'
       logical lprn
+      integer xshift,yshift,zshift
       evdw=0.0D0
 ccccc      energy_dec=.false.
 c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
@@ -1397,13 +1430,53 @@ c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
       lprn=.false.
 c     if (icall.eq.0) lprn=.false.
       ind=0
+C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
+C we have the original box)
+C      do xshift=-1,1
+C      do yshift=-1,1
+C      do zshift=-1,1
       do i=iatsc_s,iatsc_e
-        itypi=itype(i)
-        if (itypi.eq.21) cycle
-        itypi1=itype(i+1)
+        itypi=iabs(itype(i))
+        if (itypi.eq.ntyp1) cycle
+        itypi1=iabs(itype(i+1))
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
+C Return atom into box, boxxsize is size of box in x dimension
+c  134   continue
+c        if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
+c        if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
+C Condition for being inside the proper box
+c        if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
+c     &       (xi.lt.((xshift-0.5d0)*boxxsize))) then
+c        go to 134
+c        endif
+c  135   continue
+c        if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
+c        if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
+C Condition for being inside the proper box
+c        if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
+c     &       (yi.lt.((yshift-0.5d0)*boxysize))) then
+c        go to 135
+c        endif
+c  136   continue
+c        if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
+c        if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
+C Condition for being inside the proper box
+c        if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
+c     &       (zi.lt.((zshift-0.5d0)*boxzsize))) then
+c        go to 136
+c        endif
+          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
+C          xi=xi+xshift*boxxsize
+C          yi=yi+yshift*boxysize
+C          zi=zi+zshift*boxzsize
+
         dxi=dc_norm(1,nres+i)
         dyi=dc_norm(2,nres+i)
         dzi=dc_norm(3,nres+i)
@@ -1423,8 +1496,8 @@ C
      &                        'evdw',i,j,evdwij,' ss'
             ELSE
             ind=ind+1
-            itypj=itype(j)
-            if (itypj.eq.21) cycle
+            itypj=iabs(itype(j))
+            if (itypj.eq.ntyp1) cycle
 c            dscj_inv=dsc_inv(itypj)
             dscj_inv=vbld_inv(j+nres)
 c            write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
@@ -1450,17 +1523,88 @@ c           chip12=0.0D0
 c           alf1=0.0D0
 c           alf2=0.0D0
 c           alf12=0.0D0
-            xj=c(1,nres+j)-xi
-            yj=c(2,nres+j)-yi
-            zj=c(3,nres+j)-zi
+            xj=c(1,nres+j)
+            yj=c(2,nres+j)
+            zj=c(3,nres+j)
+C Return atom J into box the original box
+c  137   continue
+c        if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
+c        if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
+C Condition for being inside the proper box
+c        if ((xj.gt.((0.5d0)*boxxsize)).or.
+c     &       (xj.lt.((-0.5d0)*boxxsize))) then
+c        go to 137
+c        endif
+c  138   continue
+c        if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
+c        if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
+C Condition for being inside the proper box
+c        if ((yj.gt.((0.5d0)*boxysize)).or.
+c     &       (yj.lt.((-0.5d0)*boxysize))) then
+c        go to 138
+c        endif
+c  139   continue
+c        if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
+c        if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
+C Condition for being inside the proper box
+c        if ((zj.gt.((0.5d0)*boxzsize)).or.
+c     &       (zj.lt.((-0.5d0)*boxzsize))) then
+c        go to 139
+c        endif
+          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
             dxj=dc_norm(1,nres+j)
             dyj=dc_norm(2,nres+j)
             dzj=dc_norm(3,nres+j)
+C            xj=xj-xi
+C            yj=yj-yi
+C            zj=zj-zi
 c            write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
 c            write (iout,*) "j",j," dc_norm",
 c     &       dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
             rij=dsqrt(rrij)
+            sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
+            sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
+             
+c            write (iout,'(a7,4f8.3)') 
+c    &      "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
+            if (sss.gt.0.0d0) then
 C Calculate angle-dependent terms of energy and contributions to their
 C derivatives.
             call sc_angular
@@ -1489,7 +1633,7 @@ c---------------------------------------------------------------
 c            write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
 c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
             evdwij=evdwij*eps2rt*eps3rt
-            evdw=evdw+evdwij
+            evdw=evdw+evdwij*sss
             if (lprn) then
             sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
             epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
@@ -1509,6 +1653,9 @@ C Calculate gradient components.
             fac=-expon*(e1+evdwij)*rij_shift
             sigder=fac*sigder
             fac=rij*fac
+c            print '(2i4,6f8.4)',i,j,sss,sssgrad*
+c     &      evdwij,fac,sigma(itypi,itypj),expon
+            fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
 c            fac=0.0d0
 C Calculate the radial part of the gradient
             gg(1)=xj*fac
@@ -1520,6 +1667,9 @@ C Calculate angular part of the gradient.
           enddo      ! j
         enddo        ! iint
       enddo          ! i
+C      enddo          ! zshift
+C      enddo          ! yshift
+C      enddo          ! xshift
 c      write (iout,*) "Number of loop steps in EGB:",ind
 cccc      energy_dec=.false.
       return
@@ -1550,9 +1700,9 @@ c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
 c     if (icall.eq.0) lprn=.true.
       ind=0
       do i=iatsc_s,iatsc_e
-        itypi=itype(i)
-        if (itypi.eq.21) cycle
-        itypi1=itype(i+1)
+        itypi=iabs(itype(i))
+        if (itypi.eq.ntyp1) cycle
+        itypi1=iabs(itype(i+1))
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
@@ -1567,8 +1717,8 @@ C
         do iint=1,nint_gr(i)
           do j=istart(i,iint),iend(i,iint)
             ind=ind+1
-            itypj=itype(j)
-            if (itypj.eq.21) cycle
+            itypj=iabs(itype(j))
+            if (itypj.eq.ntyp1) cycle
 c            dscj_inv=dsc_inv(itypj)
             dscj_inv=vbld_inv(j+nres)
             sig0ij=sigma(itypi,itypj)
@@ -1727,6 +1877,7 @@ C----------------------------------------------------------------------------
       include 'COMMON.CALC'
       include 'COMMON.IOUNITS'
       double precision dcosom1(3),dcosom2(3)
+cc      print *,'sss=',sss
       eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
       eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
       eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
@@ -1745,16 +1896,16 @@ c      write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
         dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
       enddo
       do k=1,3
-        gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+        gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
       enddo 
 c      write (iout,*) "gg",(gg(k),k=1,3)
       do k=1,3
         gvdwx(k,i)=gvdwx(k,i)-gg(k)
      &            +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-     &            +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+     &            +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
         gvdwx(k,j)=gvdwx(k,j)+gg(k)
      &            +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-     &            +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+     &            +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
 c        write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
 c     &            +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
 c        write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
@@ -1798,9 +1949,9 @@ C
 cd    print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
       evdw=0.0D0
       do i=iatsc_s,iatsc_e
-        itypi=itype(i)
-        if (itypi.eq.21) cycle
-        itypi1=itype(i+1)
+        itypi=iabs(itype(i))
+        if (itypi.eq.ntyp1) cycle
+        itypi1=iabs(itype(i+1))
         xi=c(1,nres+i)
         yi=c(2,nres+i)
         zi=c(3,nres+i)
@@ -1811,8 +1962,8 @@ C
 cd        write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
 cd   &                  'iend=',iend(i,iint)
           do j=istart(i,iint),iend(i,iint)
-            itypj=itype(j)
-            if (itypj.eq.21) cycle
+            itypj=iabs(itype(j))
+            if (itypj.eq.ntyp1) cycle
             xj=c(1,nres+j)-xi
             yj=c(2,nres+j)-yi
             zj=c(3,nres+j)-zi
@@ -1872,7 +2023,7 @@ C
       include 'COMMON.VECTORS'
       include 'COMMON.FFIELD'
       dimension ggg(3)
-cd      write(iout,*) 'In EELEC_soft_sphere'
+C      write(iout,*) 'In EELEC_soft_sphere'
       ees=0.0D0
       evdw1=0.0D0
       eel_loc=0.0d0 
@@ -1880,17 +2031,23 @@ cd      write(iout,*) 'In EELEC_soft_sphere'
       eello_turn4=0.0d0
       ind=0
       do i=iatel_s,iatel_e
-        if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+        if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
         dxi=dc(1,i)
         dyi=dc(2,i)
         dzi=dc(3,i)
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
+          xmedi=mod(xmedi,boxxsize)
+          if (xmedi.lt.0) xmedi=xmedi+boxxsize
+          ymedi=mod(ymedi,boxysize)
+          if (ymedi.lt.0) ymedi=ymedi+boxysize
+          zmedi=mod(zmedi,boxzsize)
+          if (zmedi.lt.0) zmedi=zmedi+boxzsize
         num_conti=0
 c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
         do j=ielstart(i),ielend(i)
-          if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
+          if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
           ind=ind+1
           iteli=itel(i)
           itelj=itel(j)
@@ -1900,10 +2057,49 @@ c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
           dxj=dc(1,j)
           dyj=dc(2,j)
           dzj=dc(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
+          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
+      isubchap=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
+            isubchap=1
+          endif
+       enddo
+       enddo
+       enddo
+       if (isubchap.eq.1) then
+          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
+            sss=sscale(sqrt(rij))
+            sssgrad=sscagrad(sqrt(rij))
           if (rij.lt.r0ijsq) then
             evdw1ij=0.25d0*(rij-r0ijsq)**2
             fac=rij-r0ijsq
@@ -1911,13 +2107,13 @@ c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
             evdw1ij=0.0d0
             fac=0.0d0
           endif
-          evdw1=evdw1+evdw1ij
+          evdw1=evdw1+evdw1ij*sss
 C
 C Calculate contributions to the Cartesian gradient.
 C
-          ggg(1)=fac*xj
-          ggg(2)=fac*yj
-          ggg(3)=fac*zj
+          ggg(1)=fac*xj*sssgrad
+          ggg(2)=fac*yj*sssgrad
+          ggg(3)=fac*zj*sssgrad
           do k=1,3
             gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
             gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
@@ -2311,13 +2507,13 @@ c        if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
         if (i.gt. nnt+2 .and. i.lt.nct+2) then
           iti = itortyp(itype(i-2))
         else
-          iti=ntortyp+1
+          iti=ntortyp
         endif
 c        if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
         if (i.gt. nnt+1 .and. i.lt.nct+1) then
           iti1 = itortyp(itype(i-1))
         else
-          iti1=ntortyp+1
+          iti1=ntortyp
         endif
 cd        write (iout,*) '*******i',i,' iti1',iti
 cd        write (iout,*) 'b1',b1(:,iti)
@@ -2355,9 +2551,13 @@ c        if (i .gt. iatel_s+2) then
         enddo
 c        if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
         if (i.gt. nnt+1 .and. i.lt.nct+1) then
-          iti1 = itortyp(itype(i-1))
+          if (itype(i-1).le.ntyp) then
+            iti1 = itortyp(itype(i-1))
+          else
+            iti1=ntortyp
+          endif
         else
-          iti1=ntortyp+1
+          iti1=ntortyp
         endif
         do k=1,2
           mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
@@ -2686,6 +2886,7 @@ C
       include 'COMMON.VECTORS'
       include 'COMMON.FFIELD'
       include 'COMMON.TIME1'
+      include 'COMMON.SPLITELE'
       dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
      &          erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
       double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
@@ -2768,9 +2969,14 @@ c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
 C
 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
 C
+C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
       do i=iturn3_start,iturn3_end
-        if (itype(i).eq.21 .or. itype(i+1).eq.21 
-     &  .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle
+        if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+     &  .or. itype(i+2).eq.ntyp1
+     &  .or. itype(i+3).eq.ntyp1
+     &  .or. itype(i-1).eq.ntyp1
+     &  .or. itype(i+4).eq.ntyp1
+     &  ) cycle
         dxi=dc(1,i)
         dyi=dc(2,i)
         dzi=dc(3,i)
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
+          xmedi=mod(xmedi,boxxsize)
+          if (xmedi.lt.0) xmedi=xmedi+boxxsize
+          ymedi=mod(ymedi,boxysize)
+          if (ymedi.lt.0) ymedi=ymedi+boxysize
+          zmedi=mod(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)
         num_cont_hb(i)=num_conti
       enddo
       do i=iturn4_start,iturn4_end
-        if (itype(i).eq.21 .or. itype(i+1).eq.21
-     &    .or. itype(i+3).eq.21
-     &    .or. itype(i+4).eq.21) cycle
+        if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+     &    .or. itype(i+3).eq.ntyp1
+     &    .or. itype(i+4).eq.ntyp1
+     &    .or. itype(i+5).eq.ntyp1
+     &    .or. itype(i).eq.ntyp1
+     &    .or. itype(i-1).eq.ntyp1
+     &                             ) cycle
         dxi=dc(1,i)
         dyi=dc(2,i)
         dzi=dc(3,i)
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
+C Return atom into box, boxxsize is size of box in x dimension
+c  194   continue
+c        if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
+c        if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
+C Condition for being inside the proper box
+c        if ((xmedi.gt.((0.5d0)*boxxsize)).or.
+c     &       (xmedi.lt.((-0.5d0)*boxxsize))) then
+c        go to 194
+c        endif
+c  195   continue
+c        if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
+c        if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
+C Condition for being inside the proper box
+c        if ((ymedi.gt.((0.5d0)*boxysize)).or.
+c     &       (ymedi.lt.((-0.5d0)*boxysize))) then
+c        go to 195
+c        endif
+c  196   continue
+c        if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
+c        if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
+C Condition for being inside the proper box
+c        if ((zmedi.gt.((0.5d0)*boxzsize)).or.
+c     &       (zmedi.lt.((-0.5d0)*boxzsize))) then
+c        go to 196
+c        endif
+          xmedi=mod(xmedi,boxxsize)
+          if (xmedi.lt.0) xmedi=xmedi+boxxsize
+          ymedi=mod(ymedi,boxysize)
+          if (ymedi.lt.0) ymedi=ymedi+boxysize
+          zmedi=mod(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.21) 
+        if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) 
      &   call eturn4(i,eello_turn4)
         num_cont_hb(i)=num_conti
       enddo   ! i
+C Loop over all neighbouring boxes
+C      do xshift=-1,1
+C      do yshift=-1,1
+C      do zshift=-1,1
 c
 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
 c
       do i=iatel_s,iatel_e
-        if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+        if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+     &  .or. itype(i+2).eq.ntyp1
+     &  .or. itype(i-1).eq.ntyp1
+     &                ) cycle
         dxi=dc(1,i)
         dyi=dc(2,i)
         dzi=dc(3,i)
         xmedi=c(1,i)+0.5d0*dxi
         ymedi=c(2,i)+0.5d0*dyi
         zmedi=c(3,i)+0.5d0*dzi
+          xmedi=mod(xmedi,boxxsize)
+          if (xmedi.lt.0) xmedi=xmedi+boxxsize
+          ymedi=mod(ymedi,boxysize)
+          if (ymedi.lt.0) ymedi=ymedi+boxysize
+          zmedi=mod(zmedi,boxzsize)
+          if (zmedi.lt.0) zmedi=zmedi+boxzsize
+C          xmedi=xmedi+xshift*boxxsize
+C          ymedi=ymedi+yshift*boxysize
+C          zmedi=zmedi+zshift*boxzsize
+
+C Return tom into box, boxxsize is size of box in x dimension
+c  164   continue
+c        if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
+c        if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
+C Condition for being inside the proper box
+c        if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
+c     &       (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
+c        go to 164
+c        endif
+c  165   continue
+c        if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
+c        if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
+C Condition for being inside the proper box
+c        if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
+c     &       (ymedi.lt.((yshift-0.5d0)*boxysize))) then
+c        go to 165
+c        endif
+c  166   continue
+c        if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
+c        if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
+cC Condition for being inside the proper box
+c        if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
+c     &       (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
+c        go to 166
+c        endif
+
 c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
         num_conti=num_cont_hb(i)
         do j=ielstart(i),ielend(i)
 c          write (iout,*) i,j,itype(i),itype(j)
-          if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
+          if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
+     & .or.itype(j+2).eq.ntyp1
+     & .or.itype(j-1).eq.ntyp1
+     &) cycle
           call eelecij(i,j,ees,evdw1,eel_loc)
         enddo ! j
         num_cont_hb(i)=num_conti
       enddo   ! i
+C     enddo   ! zshift
+C      enddo   ! yshift
+C      enddo   ! xshift
+
 c      write (iout,*) "Number of loop steps in EELEC:",ind
 cd      do i=1,nres
 cd        write (iout,'(i3,3f10.5,5x,3f10.5)') 
@@ -2857,6 +3155,7 @@ C-------------------------------------------------------------------------------
       include 'COMMON.VECTORS'
       include 'COMMON.FFIELD'
       include 'COMMON.TIME1'
+      include 'COMMON.SPLITELE'
       dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
      &          erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
       double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
@@ -2891,10 +3190,84 @@ c          ind=ind+1
           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
+C          xj=c(1,j)+0.5D0*dxj-xmedi
+C          yj=c(2,j)+0.5D0*dyj-ymedi
+C          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
+          if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
+      dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
+      xj_safe=xj
+      yj_safe=yj
+      zj_safe=zj
+      isubchap=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-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
+          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
+C        if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
+c  174   continue
+c        if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
+c        if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
+C Condition for being inside the proper box
+c        if ((xj.gt.((0.5d0)*boxxsize)).or.
+c     &       (xj.lt.((-0.5d0)*boxxsize))) then
+c        go to 174
+c        endif
+c  175   continue
+c        if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
+c        if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
+C Condition for being inside the proper box
+c        if ((yj.gt.((0.5d0)*boxysize)).or.
+c     &       (yj.lt.((-0.5d0)*boxysize))) then
+c        go to 175
+c        endif
+c  176   continue
+c        if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
+c        if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
+C Condition for being inside the proper box
+c        if ((zj.gt.((0.5d0)*boxzsize)).or.
+c     &       (zj.lt.((-0.5d0)*boxzsize))) then
+c        go to 176
+c        endif
+C        endif !endPBC condintion
+C        xj=xj-xmedi
+C        yj=yj-ymedi
+C        zj=zj-zmedi
           rij=xj*xj+yj*yj+zj*zj
+
+            sss=sscale(sqrt(rij))
+            sssgrad=sscagrad(sqrt(rij))
+c            if (sss.gt.0.0d0) then  
           rrmij=1.0D0/rij
           rij=dsqrt(rij)
           rmij=1.0D0/rij
@@ -2910,21 +3283,24 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
           ev2=bbb*r6ij
           fac3=ael6i*r6ij
           fac4=ael3i*r3ij
-          evdwij=ev1+ev2
+          evdwij=(ev1+ev2)
           el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
           el2=fac4*fac       
-          eesij=el1+el2
+C MARYSIA
+          eesij=(el1+el2)
 C 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
+          evdw1=evdw1+evdwij*sss
 cd          write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
 cd     &      iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
 cd     &      1.0D0/dsqrt(rrmij),evdwij,eesij,
 cd     &      xmedi,ymedi,zmedi,xj,yj,zj
 
           if (energy_dec) then 
-              write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
+              write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') 
+     &'evdw1',i,j,evdwij
+     &,iteli,itelj,aaa,evdw1
               write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
           endif
 
@@ -2932,7 +3308,7 @@ C
 C Calculate contributions to the Cartesian gradient.
 C
 #ifdef SPLITELE
-          facvdw=-6*rrmij*(ev1+evdwij)
+          facvdw=-6*rrmij*(ev1+evdwij)*sss
           facel=-3*rrmij*(el1+eesij)
           fac1=fac
           erij(1)=xj*rmij
@@ -2962,9 +3338,15 @@ cgrad            do l=1,3
 cgrad              gelc(l,k)=gelc(l,k)+ggg(l)
 cgrad            enddo
 cgrad          enddo
-          ggg(1)=facvdw*xj
-          ggg(2)=facvdw*yj
-          ggg(3)=facvdw*zj
+          if (sss.gt.0.0) then
+          ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
+          ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
+          ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
+          else
+          ggg(1)=0.0
+          ggg(2)=0.0
+          ggg(3)=0.0
+          endif
 c          do k=1,3
 c            ghalf=0.5D0*ggg(k)
 c            gvdwpp(k,i)=gvdwpp(k,i)+ghalf
@@ -2984,8 +3366,9 @@ cgrad              gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
 cgrad            enddo
 cgrad          enddo
 #else
-          facvdw=ev1+evdwij 
-          facel=el1+eesij  
+C MARYSIA
+          facvdw=(ev1+evdwij)*sss
+          facel=(el1+eesij)
           fac1=fac
           fac=-3*rrmij*(facvdw+facvdw+facel)
           erij(1)=xj*rmij
@@ -3016,9 +3399,9 @@ cgrad              gelc(l,k)=gelc(l,k)+ggg(l)
 cgrad            enddo
 cgrad          enddo
 c 9/28/08 AL Gradient compotents will be summed only at the end
-          ggg(1)=facvdw*xj
-          ggg(2)=facvdw*yj
-          ggg(3)=facvdw*zj
+          ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
+          ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
+          ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
           do k=1,3
             gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
             gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
@@ -3057,14 +3440,16 @@ cgrad            enddo
 cgrad          enddo
           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)
+     &           +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
+     &           + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
             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)
+     &           +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
+     &           + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
             gelc_long(k,j)=gelc_long(k,j)+ggg(k)
             gelc_long(k,i)=gelc_long(k,i)-ggg(k)
           enddo
+C MARYSIA
+c          endif !sscale
           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
@@ -3252,10 +3637,14 @@ cgrad            endif
 C Contribution to the local-electrostatic energy coming from the i-j pair
           eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
      &     +a33*muij(4)
-cd          write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
+c          write (iout,*) 'i',i,' j',j,itype(i),itype(j),
+c     &                     ' eel_loc_ij',eel_loc_ij
 
           if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
      &            'eelloc',i,j,eel_loc_ij
+c           if (eel_loc_ij.ne.0)
+c     &      write (iout,'(a4,2i4,8f9.5)')'chuj',
+c     &     i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
 
           eel_loc=eel_loc+eel_loc_ij
 C Partial derivatives in virtual-bond dihedral angles gamma
@@ -3283,14 +3672,14 @@ cgrad            enddo
 cgrad          enddo
 C 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))
+            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))
           enddo
           ENDIF
 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
@@ -3644,8 +4033,9 @@ c        write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
         call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
         s3=0.5d0*(pizda(1,1)+pizda(2,2))
         eello_turn4=eello_turn4-(s1+s2+s3)
-        if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
-     &      'eturn4',i,j,-(s1+s2+s3)
+c             write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
+        if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
+     &      'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
 cd        write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
 cd     &    ' eello_turn4_num',8*eello_turn4_num
 C Derivatives in gamma(i)
       r0_scp=4.5d0
 cd    print '(a)','Enter ESCP'
 cd    write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
+C      do xshift=-1,1
+C      do yshift=-1,1
+C      do zshift=-1,1
       do i=iatscp_s,iatscp_e
-        if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+        if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
         iteli=itel(i)
         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))
-
+C Return atom into box, boxxsize is size of box in x dimension
+c  134   continue
+c        if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
+c        if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
+C Condition for being inside the proper box
+c        if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
+c     &       (xi.lt.((xshift-0.5d0)*boxxsize))) then
+c        go to 134
+c        endif
+c  135   continue
+c        if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
+c        if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
+C Condition for being inside the proper box
+c        if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
+c     &       (yi.lt.((yshift-0.5d0)*boxysize))) then
+c        go to 135
+c c       endif
+c  136   continue
+c        if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
+c        if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
+cC Condition for being inside the proper box
+c        if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
+c     &       (zi.lt.((zshift-0.5d0)*boxzsize))) then
+c        go to 136
+c        endif
+          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
+C          xi=xi+xshift*boxxsize
+C          yi=yi+yshift*boxysize
+C          zi=zi+zshift*boxzsize
         do iint=1,nscp_gr(i)
 
         do j=iscpstart(i,iint),iscpend(i,iint)
-          if (itype(j).eq.21) cycle
-          itypj=itype(j)
+          if (itype(j).eq.ntyp1) cycle
+          itypj=iabs(itype(j))
 C Uncomment following three lines for SC-p interactions
 c         xj=c(1,nres+j)-xi
 c         yj=c(2,nres+j)-yi
 c         zj=c(3,nres+j)-zi
 C 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)
+          yj=c(2,j)
+          zj=c(3,j)
+c  174   continue
+c        if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
+c        if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
+C Condition for being inside the proper box
+c        if ((xj.gt.((0.5d0)*boxxsize)).or.
+c     &       (xj.lt.((-0.5d0)*boxxsize))) then
+c        go to 174
+c        endif
+c  175   continue
+c        if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
+c        if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
+cC Condition for being inside the proper box
+c        if ((yj.gt.((0.5d0)*boxysize)).or.
+c     &       (yj.lt.((-0.5d0)*boxysize))) then
+c        go to 175
+c        endif
+c  176   continue
+c        if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
+c        if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
+C Condition for being inside the proper box
+c        if ((zj.gt.((0.5d0)*boxzsize)).or.
+c     &       (zj.lt.((-0.5d0)*boxzsize))) then
+c        go to 176
+          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
+c c       endif
+C          xj=xj-xi
+C          yj=yj-yi
+C          zj=zj-zi
           rij=xj*xj+yj*yj+zj*zj
+
           r0ij=r0_scp
           r0ijsq=r0ij*r0ij
           if (rij.lt.r0ijsq) then
@@ -3886,6 +4377,9 @@ cgrad          enddo
 
         enddo ! iint
       enddo ! i
+C      enddo !zshift
+C      enddo !yshift
+C      enddo !xshift
       return
       end
 C-----------------------------------------------------------------------------
       include 'COMMON.FFIELD'
       include 'COMMON.IOUNITS'
       include 'COMMON.CONTROL'
+      include 'COMMON.SPLITELE'
       dimension ggg(3)
       evdw2=0.0D0
       evdw2_14=0.0d0
+c        print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
 cd    print '(a)','Enter ESCP'
 cd    write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
+C      do xshift=-1,1
+C      do yshift=-1,1
+C      do zshift=-1,1
       do i=iatscp_s,iatscp_e
-        if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+        if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
         iteli=itel(i)
         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
+c          xi=xi+xshift*boxxsize
+c          yi=yi+yshift*boxysize
+c          zi=zi+zshift*boxzsize
+c        print *,xi,yi,zi,'polozenie i'
+C Return atom into box, boxxsize is size of box in x dimension
+c  134   continue
+c        if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
+c        if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
+C Condition for being inside the proper box
+c        if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
+c     &       (xi.lt.((xshift-0.5d0)*boxxsize))) then
+c        go to 134
+c        endif
+c  135   continue
+c          print *,xi,boxxsize,"pierwszy"
 
+c        if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
+c        if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
+C Condition for being inside the proper box
+c        if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
+c     &       (yi.lt.((yshift-0.5d0)*boxysize))) then
+c        go to 135
+c        endif
+c  136   continue
+c        if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
+c        if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
+C Condition for being inside the proper box
+c        if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
+c     &       (zi.lt.((zshift-0.5d0)*boxzsize))) then
+c        go to 136
+c        endif
         do iint=1,nscp_gr(i)
 
         do j=iscpstart(i,iint),iscpend(i,iint)
-          itypj=itype(j)
-          if (itypj.eq.21) cycle
+          itypj=iabs(itype(j))
+          if (itypj.eq.ntyp1) cycle
 C Uncomment following three lines for SC-p interactions
 c         xj=c(1,nres+j)-xi
 c         yj=c(2,nres+j)-yi
 c         zj=c(3,nres+j)-zi
 C 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)
+          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
+c  174   continue
+c        if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
+c        if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
+C Condition for being inside the proper box
+c        if ((xj.gt.((0.5d0)*boxxsize)).or.
+c     &       (xj.lt.((-0.5d0)*boxxsize))) then
+c        go to 174
+c        endif
+c  175   continue
+c        if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
+c        if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
+cC Condition for being inside the proper box
+c        if ((yj.gt.((0.5d0)*boxysize)).or.
+c     &       (yj.lt.((-0.5d0)*boxysize))) then
+c        go to 175
+c        endif
+c  176   continue
+c        if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
+c        if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
+C Condition for being inside the proper box
+c        if ((zj.gt.((0.5d0)*boxzsize)).or.
+c     &       (zj.lt.((-0.5d0)*boxzsize))) then
+c        go to 176
+c        endif
+CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
+      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
+c          print *,xj,yj,zj,'polozenie j'
           rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+c          print *,rrij
+          sss=sscale(1.0d0/(dsqrt(rrij)))
+c          print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
+c          if (sss.eq.0) print *,'czasem jest OK'
+          if (sss.le.0.0d0) cycle
+          sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
           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
           endif
           evdwij=e1+e2
-          evdw2=evdw2+evdwij
-          if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
-     &        'evdw2',i,j,evdwij
+          evdw2=evdw2+evdwij*sss
+          if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
+     &        'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
+     &       bad(itypj,iteli)
 C
 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
 C
-          fac=-(evdwij+e1)*rrij
+          fac=-(evdwij+e1)*rrij*sss
+          fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
           ggg(1)=xj*fac
           ggg(2)=yj*fac
           ggg(3)=zj*fac
@@ -3982,10 +4588,14 @@ cgrad          enddo
             gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
             gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
           enddo
-        enddo
+c        endif !endif for sscale cutoff
+        enddo ! j
 
         enddo ! iint
       enddo ! i
+c      enddo !zshift
+c      enddo !yshift
+c      enddo !xshift
       do i=1,nct
         do j=1,3
           gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
@@ -4039,12 +4649,15 @@ c        write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
 c     &    dhpb(i),dhpb1(i),forcon(i)
 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
 C    distance and angle dependent SS bond potential.
+        if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+     & iabs(itype(jjj)).eq.1) then
 cmc        if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
         if (.not.dyn_ss .and. i.le.nss) then
 C 15/02/13 CC dynamic SSbond - additional check
          if (ii.gt.nres 
      &       .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then 
+>>>>>>> f5379d3246c4bd95e946c4d35d4a1c13e329c4cb
           call ssbond_ene(iii,jjj,eij)
           ehpb=ehpb+2*eij
          endif
@@ -4109,7 +4722,7 @@ C
       include 'COMMON.VAR'
       include 'COMMON.IOUNITS'
       double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
-      itypi=itype(i)
+      itypi=iabs(itype(i))
       xi=c(1,nres+i)
       yi=c(2,nres+i)
       zi=c(3,nres+i)
@@ -4118,7 +4731,7 @@ C
       dzi=dc_norm(3,nres+i)
 c      dsci_inv=dsc_inv(itypi)
       dsci_inv=vbld_inv(nres+i)
-      itypj=itype(j)
+      itypj=iabs(itype(j))
 c      dscj_inv=dsc_inv(itypj)
       dscj_inv=vbld_inv(nres+j)
       xj=c(1,nres+j)-xi
       estr=0.0d0
       estr1=0.0d0
       do i=ibondp_start,ibondp_end
-        if (itype(i-1).eq.21 .or. itype(i).eq.21) then
-          estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
-          do j=1,3
-          gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
-     &      *dc(j,i-1)/vbld(i)
-          enddo
-          if (energy_dec) write(iout,*) 
-     &       "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
-        else
+        if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
+c          estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
+c          do j=1,3
+c          gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
+c     &      *dc(j,i-1)/vbld(i)
+c          enddo
+c          if (energy_dec) write(iout,*) 
+c     &       "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
+c        else
+C       Checking if it involves dummy (NH3+ or COO-) group
+         if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
+C YES   vbldpDUM is the equlibrium length of spring for Dummy atom
+        diff = vbld(i)-vbldpDUM
+         else
+C NO    vbldp0 is the equlibrium lenght of spring for peptide group
         diff = vbld(i)-vbldp0
-        if (energy_dec) write (iout,*) 
+         endif 
+        if (energy_dec)    write (iout,'(a7,i5,4f7.3)') 
      &     "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
         estr=estr+diff*diff
         do j=1,3
           gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
         enddo
 c        write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
-        endif
+c        endif
       enddo
       estr=0.5d0*AKP*estr+estr1
 c
 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
 c
       do i=ibond_start,ibond_end
-        iti=itype(i)
-        if (iti.ne.10 .and. iti.ne.21) then
+        iti=iabs(itype(i))
+        if (iti.ne.10 .and. iti.ne.ntyp1) then
           nbi=nbondterm(iti)
           if (nbi.eq.1) then
             diff=vbld(i+nres)-vbldsc0(1,iti)
-            if (energy_dec) write (iout,*) 
+            if (energy_dec)  write (iout,*) 
      &      "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
      &      AKSC(1,iti),AKSC(1,iti)*diff*diff
             estr=estr+0.5d0*AKSC(1,iti)*diff*diff
@@ -4298,11 +4918,25 @@ c      time12=1.0d0
       etheta=0.0D0
 c     write (*,'(a,i2)') 'EBEND ICG=',icg
       do i=ithet_start,ithet_end
-        if (itype(i-1).eq.21) cycle
+        if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
+     &  .or.itype(i).eq.ntyp1) cycle
 C Zero the energy function and its derivative at 0 or pi.
         call splinthet(theta(i),0.5d0*delta,ss,ssd)
         it=itype(i-1)
-        if (i.gt.3 .and. itype(i-2).ne.21) then
+        ichir1=isign(1,itype(i-2))
+        ichir2=isign(1,itype(i))
+         if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
+         if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
+         if (itype(i-1).eq.10) then
+          itype1=isign(10,itype(i-2))
+          ichir11=isign(1,itype(i-2))
+          ichir12=isign(1,itype(i-2))
+          itype2=isign(10,itype(i))
+          ichir21=isign(1,itype(i))
+          ichir22=isign(1,itype(i))
+         endif
+
+        if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
 #ifdef OSF
          phii=phi(i)
           if (phii.ne.phii) phii=150.0
@@ -4315,7 +4949,7 @@ C Zero the energy function and its derivative at 0 or pi.
           y(1)=0.0D0
           y(2)=0.0D0
         endif
-        if (i.lt.nres .and. itype(i).ne.21) then
+        if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
 #ifdef OSF
          phii1=phi(i+1)
           if (phii1.ne.phii1) phii1=150.0
@@ -4323,8 +4957,8 @@ C Zero the energy function and its derivative at 0 or pi.
           z(1)=cos(phii1)
 #else
           phii1=phi(i+1)
-          z(1)=dcos(phii1)
 #endif
+          z(1)=dcos(phii1)
           z(2)=dsin(phii1)
         else
           z(1)=0.0D0
@@ -4335,15 +4969,28 @@ C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
 C In following comments this theta will be referred to as t_c.
         thet_pred_mean=0.0d0
         do k=1,2
-          athetk=athet(k,it)
-          bthetk=bthet(k,it)
-          thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
+            athetk=athet(k,it,ichir1,ichir2)
+            bthetk=bthet(k,it,ichir1,ichir2)
+          if (it.eq.10) then
+             athetk=athet(k,itype1,ichir11,ichir12)
+             bthetk=bthet(k,itype2,ichir21,ichir22)
+          endif
+         thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
+c         write(iout,*) 'chuj tu', y(k),z(k)
         enddo
         dthett=thet_pred_mean*ssd
         thet_pred_mean=thet_pred_mean*ss+a0thet(it)
 C Derivatives of the "mean" values in gamma1 and gamma2.
-        dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
-        dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
+        dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
+     &+athet(2,it,ichir1,ichir2)*y(1))*ss
+         dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
+     &          +bthet(2,it,ichir1,ichir2)*z(1))*ss
+         if (it.eq.10) then
+      dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
+     &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
+        dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
+     &         +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
+         endif
         if (theta(i).gt.pi-delta) then
           call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
      &         E_tc0)
@@ -4366,11 +5013,11 @@ C Derivatives of the "mean" values in gamma1 and gamma2.
      &        E_theta,E_tc)
         endif
         etheta=etheta+ethetai
-        if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
-     &      'ebend',i,ethetai
+        if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
+     &      'ebend',i,ethetai,theta(i),itype(i)
         if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
         if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
-        gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
+        gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
       enddo
 C Ufff.... We've done all this!!! 
       return
@@ -4388,7 +5035,8 @@ C---------------------------------------------------------------------------
 C Calculate the contributions to both Gaussian lobes.
 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
 C The "polynomial part" of the "standard deviation" of this part of 
-C the distribution.
+C the distributioni.
+ccc        write (iout,*) thetai,thet_pred_mean
         sig=polthet(3,it)
         do j=2,0,-1
           sig=sig*thet_pred_mean+polthet(j,it)
@@ -4418,6 +5066,7 @@ C Following variable is sigma(t_c)**(-2)
         delthe0=thetai-theta0i
         term1=-0.5D0*sigcsq*delthec*delthec
         term2=-0.5D0*sig0inv*delthe0*delthe0
+C        write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
 C NaNs in taking the logarithm. We extract the largest exponent which is added
 C to the energy (this being the log of the distribution) at the end of energy
@@ -4445,6 +5094,7 @@ C Contribution of the bending energy from this theta is just the -log of
 C the sum of the contributions from the two lobes and the pre-exponential
 C factor. Simple enough, isn't it?
         ethetai=(-dlog(termexp)-termm+dlog(termpre))
+C       write (iout,*) 'termexp',termexp,termm,termpre,i
 C NOW the derivatives!!!
 C 6/6/97 Take into account the deformation.
         E_theta=(delthec*sigcsq*term1
       logical lprn /.false./, lprn1 /.false./
       etheta=0.0D0
       do i=ithet_start,ithet_end
-        if (itype(i-1).eq.21) cycle
+c        print *,i,itype(i-1),itype(i),itype(i-2)
+        if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
+     &  .or.itype(i).eq.ntyp1) cycle
+C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
+
+        if (iabs(itype(i+1)).eq.20) iblock=2
+        if (iabs(itype(i+1)).ne.20) iblock=1
         dethetai=0.0d0
         dephii=0.0d0
         dephii1=0.0d0
         theti2=0.5d0*theta(i)
-        ityp2=ithetyp(itype(i-1))
+        ityp2=ithetyp((itype(i-1)))
         do k=1,nntheterm
           coskt(k)=dcos(k*theti2)
           sinkt(k)=dsin(k*theti2)
         enddo
-        if (i.gt.3 .and. itype(i-2).ne.21) then
+        if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
 #ifdef OSF
           phii=phi(i)
           if (phii.ne.phii) phii=150.0
 #else
           phii=phi(i)
 #endif
-          ityp1=ithetyp(itype(i-2))
+          ityp1=ithetyp((itype(i-2)))
+C propagation of chirality for glycine type
           do k=1,nsingle
             cosph1(k)=dcos(k*phii)
             sinph1(k)=dsin(k*phii)
@@ -4541,7 +5198,7 @@ C
             sinph1(k)=0.0d0
           enddo 
         endif
-        if (i.lt.nres .and. itype(i).ne.21) then
+        if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
 #ifdef OSF
           phii1=phi(i+1)
           if (phii1.ne.phii1) phii1=150.0
@@ -4549,7 +5206,7 @@ C
 #else
           phii1=phi(i+1)
 #endif
-          ityp3=ithetyp(itype(i))
+          ityp3=ithetyp((itype(i)))
           do k=1,nsingle
             cosph2(k)=dcos(k*phii1)
             sinph2(k)=dsin(k*phii1)
@@ -4562,7 +5219,7 @@ C
             sinph2(k)=0.0d0
           enddo
         endif  
-        ethetai=aa0thet(ityp1,ityp2,ityp3)
+        ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
         do k=1,ndouble
           do l=1,k-1
             ccl=cosph1(l)*cosph2(k-l)
         enddo
         endif
         do k=1,ntheterm
-          ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
-          dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
+          ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
+          dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
      &      *coskt(k)
           if (lprn)
-     &    write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
+     &    write (iout,*) "k",k,"
+     &     aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
      &     " ethetai",ethetai
         enddo
         if (lprn) then
         endif
         do m=1,ntheterm2
           do k=1,nsingle
-            aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
-     &         +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
-     &         +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
-     &         +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
+            aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
+     &         +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
+     &         +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
+     &         +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
             ethetai=ethetai+sinkt(m)*aux
             dethetai=dethetai+0.5d0*m*aux*coskt(m)
             dephii=dephii+k*sinkt(m)*(
-     &          ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
-     &          bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
+     &          ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
+     &          bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
             dephii1=dephii1+k*sinkt(m)*(
-     &          eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
-     &          ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
+     &          eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
+     &          ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
             if (lprn)
      &      write (iout,*) "m",m," k",k," bbthet",
-     &         bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
-     &         ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
-     &         ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
-     &         eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
+     &         bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
+     &         ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
+     &         ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
+     &         eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
           enddo
         enddo
         if (lprn)
         do m=1,ntheterm3
           do k=2,ndouble
             do l=1,k-1
-              aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
-     &            ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
-     &            ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
-     &            ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
+              aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
+     &            ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
+     &            ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
+     &            ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
               ethetai=ethetai+sinkt(m)*aux
               dethetai=dethetai+0.5d0*m*coskt(m)*aux
               dephii=dephii+l*sinkt(m)*(
-     &           -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
-     &            ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
-     &            ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
-     &            ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+     &           -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
+     &            ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
+     &            ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
+     &            ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
               dephii1=dephii1+(k-l)*sinkt(m)*(
-     &           -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
-     &            ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
-     &            ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
-     &            ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+     &           -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
+     &            ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
+     &            ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
+     &            ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
               if (lprn) then
               write (iout,*) "m",m," k",k," l",l," ffthet",
-     &            ffthet(l,k,m,ityp1,ityp2,ityp3),
-     &            ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
-     &            ggthet(l,k,m,ityp1,ityp2,ityp3),
-     &            ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
+     &            ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
+     &            ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
+     &            ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
+     &            ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
+     &            " ethetai",ethetai
               write (iout,*) cosph1ph2(l,k)*sinkt(m),
      &            cosph1ph2(k,l)*sinkt(m),
      &            sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
           enddo
         enddo
 10      continue
-        if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') 
+c        lprn1=.true.
+        if (lprn1) 
+     &    write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') 
      &   i,theta(i)*rad2deg,phii*rad2deg,
      &   phii1*rad2deg,ethetai
+c        lprn1=.false.
         etheta=etheta+ethetai
         if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
         if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
-        gloc(nphi+i-2,icg)=wang*dethetai
+        gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
       enddo
       return
       end
@@ -4699,9 +5361,9 @@ C ALPHA and OMEGA.
 c     write (iout,'(a)') 'ESC'
       do i=loc_start,loc_end
         it=itype(i)
-        if (it.eq.21) cycle
+        if (it.eq.ntyp1) cycle
         if (it.eq.10) goto 1
-        nlobit=nlob(it)
+        nlobit=nlob(iabs(it))
 c       print *,'i=',i,' it=',it,' nlobit=',nlobit
 c       write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
         theti=theta(i+1)-pipol
@@ -4858,11 +5520,11 @@ C Compute the contribution to SC energy and derivatives
 
           do j=1,nlobit
 #ifdef OSF
-            adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
+            adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
             if(adexp.ne.adexp) adexp=1.0
             expfac=dexp(adexp)
 #else
-            expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
+            expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
 #endif
 cd          print *,'j=',j,' expfac=',expfac
             escloc_i=escloc_i+expfac
@@ -4944,7 +5606,7 @@ C Compute the contribution to SC energy and derivatives
 
       dersc12=0.0d0
       do j=1,nlobit
-        expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
+        expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
         escloc_i=escloc_i+expfac
         do k=1,2
           dersc(k)=dersc(k)+Ax(k,j)*expfac
@@ -4998,7 +5660,7 @@ C
       delta=0.02d0*pi
       escloc=0.0D0
       do i=loc_start,loc_end
-        if (itype(i).eq.21) cycle
+        if (itype(i).eq.ntyp1) cycle
         costtab(i+1) =dcos(theta(i+1))
         sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
         cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
@@ -5007,7 +5669,7 @@ C
         cosfac=dsqrt(cosfac2)
         sinfac2=0.5d0/(1.0d0-costtab(i+1))
         sinfac=dsqrt(sinfac2)
-        it=itype(i)
+        it=iabs(itype(i))
         if (it.eq.10) goto 1
 c
 C  Compute the axes of tghe local cartesian coordinates system; store in
@@ -5025,7 +5687,7 @@ C     &   dc_norm(3,i+nres)
           y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
         enddo
         do j = 1,3
-          z_prime(j) = -uz(j,i-1)
+          z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
         enddo     
 c       write (2,*) "i",i
 c       write (2,*) "x_prime",(x_prime(j),j=1,3)
@@ -5057,7 +5719,7 @@ C
 C Compute the energy of the ith side cbain
 C
 c        write (2,*) "xx",xx," yy",yy," zz",zz
-        it=itype(i)
+        it=iabs(itype(i))
         do j = 1,65
           x(j) = sc_parmin(j,it) 
         enddo
@@ -5065,7 +5727,7 @@ c        write (2,*) "xx",xx," yy",yy," zz",zz
 Cc diagnostics - remove later
         xx1 = dcos(alph(2))
         yy1 = dsin(alph(2))*dcos(omeg(2))
-        zz1 = -dsin(alph(2))*dsin(omeg(2))
+        zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
         write(2,'(3f8.1,3f9.3,1x,3f9.3)') 
      &    alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
      &    xx1,yy1,zz1
@@ -5107,7 +5769,9 @@ c     &   sumene4,
 c     &   dscp1,dscp2,sumene
 c        sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
         escloc = escloc + sumene
-c        write (2,*) "i",i," escloc",sumene,escloc
+c        write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
+c     & ,zz,xx,yy
+c#define DEBUG
 #ifdef DEBUG
 C
 C This section to check the numerical derivatives of the energy of ith side
@@ -5151,6 +5815,7 @@ C End of diagnostics section.
 C        
 C Compute the gradient of esc
 C
+c        zz=zz*dsign(1.0,dfloat(itype(i)))
         pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
         pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
         pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
@@ -5175,7 +5840,7 @@ C
      &        +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
      &        +(pom1+pom2)*pom_dx
 #ifdef DEBUG
-        write(2,*), "de_dxx = ", de_dxx,de_dxx_num
+        write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
 #endif
 C
         sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
@@ -5190,7 +5855,7 @@ C
      &        +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
      &        +(pom1-pom2)*pom_dy
 #ifdef DEBUG
-        write(2,*), "de_dyy = ", de_dyy,de_dyy_num
+        write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
 #endif
 C
         de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
      &  +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
      &  + ( x(14) + 2*x(17)*zz+  x(18)*xx + x(20)*yy)*(s2+s2_6)
 #ifdef DEBUG
-        write(2,*), "de_dzz = ", de_dzz,de_dzz_num
+        write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
 #endif
 C
         de_dt =  0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) 
      &  -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
      &  +pom1*pom_dt1+pom2*pom_dt2
 #ifdef DEBUG
-        write(2,*), "de_dt = ", de_dt,de_dt_num
+        write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
 #endif
+c#undef DEBUG
 c 
 C
        cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
@@ -5235,13 +5901,16 @@ c     &   (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
          dZZ_Ci1(k)=0.0d0
          dZZ_Ci(k)=0.0d0
          do j=1,3
-           dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
-           dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
+           dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
+     &     *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
+           dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
+     &     *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
          enddo
           
          dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
          dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
-         dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
+         dZZ_XYZ(k)=vbld_inv(i+nres)*
+     &   (z_prime(k)-zz*dC_norm(k,i+nres))
 c
          dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
          dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
@@ -5426,10 +6095,10 @@ c      lprn=.true.
       etors=0.0D0
       do i=iphi_start,iphi_end
       etors_ii=0.0D0
-        if (itype(i-2).eq.21 .or. itype(i-1).eq.21 
-     &      .or. itype(i).eq.21) cycle
-       itori=itortyp(itype(i-2))
-       itori1=itortyp(itype(i-1))
+        if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
+     &      .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
+        itori=itortyp(itype(i-2))
+        itori1=itortyp(itype(i-1))
         phii=phi(i)
         gloci=0.0D0
 C Proline-Proline pair is a special case...
@@ -5523,17 +6192,29 @@ C Set lprn=.true. for debugging
 c     lprn=.true.
       etors=0.0D0
       do i=iphi_start,iphi_end
-        if (itype(i-2).eq.21 .or. itype(i-1).eq.21 
-     &       .or. itype(i).eq.21) cycle
-      etors_ii=0.0D0
+C ANY TWO ARE DUMMY ATOMS in row CYCLE
+c        if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
+c     &      ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1))  .or.
+c     &      ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
+        if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
+     &      .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
+C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
+C For introducing the NH3+ and COO- group please check the etor_d for reference
+C and guidance
+        etors_ii=0.0D0
+         if (iabs(itype(i)).eq.20) then
+         iblock=2
+         else
+         iblock=1
+         endif
         itori=itortyp(itype(i-2))
         itori1=itortyp(itype(i-1))
         phii=phi(i)
         gloci=0.0D0
 C Regular cosine and sine terms
-        do j=1,nterm(itori,itori1)
-          v1ij=v1(j,itori,itori1)
-          v2ij=v2(j,itori,itori1)
+        do j=1,nterm(itori,itori1,iblock)
+          v1ij=v1(j,itori,itori1,iblock)
+          v2ij=v2(j,itori,itori1,iblock)
           cosphi=dcos(j*phii)
           sinphi=dsin(j*phii)
           etors=etors+v1ij*cosphi+v2ij*sinphi
@@ -5548,7 +6229,7 @@ C          [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
 C
         cosphi=dcos(0.5d0*phii)
         sinphi=dsin(0.5d0*phii)
-        do j=1,nlor(itori,itori1)
+        do j=1,nlor(itori,itori1,iblock)
           vl1ij=vlor1(j,itori,itori1)
           vl2ij=vlor2(j,itori,itori1)
           vl3ij=vlor3(j,itori,itori1)
           gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
         enddo
 C Subtract the constant term
-        etors=etors-v0(itori,itori1)
+        etors=etors-v0(itori,itori1,iblock)
           if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
-     &         'etor',i,etors_ii-v0(itori,itori1)
+     &         'etor',i,etors_ii-v0(itori,itori1,iblock)
         if (lprn)
      &  write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
      &  restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
-     &  (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
+     &  (v1(j,itori,itori1,iblock),j=1,6),
+     &  (v2(j,itori,itori1,iblock),j=1,6)
         gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
 c       write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
       enddo
@@ -5617,9 +6299,17 @@ C Set lprn=.true. for debugging
       lprn=.false.
 c     lprn=.true.
       etors_d=0.0D0
+c      write(iout,*) "a tu??"
       do i=iphid_start,iphid_end
-        if (itype(i-2).eq.21 .or. itype(i-1).eq.21
-     &      .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+C ANY TWO ARE DUMMY ATOMS in row CYCLE
+C        if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
+C     &      ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
+C     &      ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))  .or.
+C     &      ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
+         if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
+     &  (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
+     &  (itype(i+1).eq.ntyp1)) cycle
+C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
         itori=itortyp(itype(i-2))
         itori1=itortyp(itype(i-1))
         itori2=itortyp(itype(i))
@@ -5627,12 +6317,27 @@ c     lprn=.true.
         phii1=phi(i+1)
         gloci1=0.0D0
         gloci2=0.0D0
+        iblock=1
+        if (iabs(itype(i+1)).eq.20) iblock=2
+C Iblock=2 Proline type
+C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
+C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
+C        if (itype(i+1).eq.ntyp1) iblock=3
+C The problem of NH3+ group can be resolved by adding new parameters please note if there
+C IS or IS NOT need for this
+C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
+C        is (itype(i-3).eq.ntyp1) ntblock=2
+C        ntblock is N-terminal blocking group
+
 C Regular cosine and sine terms
-        do j=1,ntermd_1(itori,itori1,itori2)
-          v1cij=v1c(1,j,itori,itori1,itori2)
-          v1sij=v1s(1,j,itori,itori1,itori2)
-          v2cij=v1c(2,j,itori,itori1,itori2)
-          v2sij=v1s(2,j,itori,itori1,itori2)
+        do j=1,ntermd_1(itori,itori1,itori2,iblock)
+C Example of changes for NH3+ blocking group
+C       do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
+C          v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
+          v1cij=v1c(1,j,itori,itori1,itori2,iblock)
+          v1sij=v1s(1,j,itori,itori1,itori2,iblock)
+          v2cij=v1c(2,j,itori,itori1,itori2,iblock)
+          v2sij=v1s(2,j,itori,itori1,itori2,iblock)
           cosphi1=dcos(j*phii)
           sinphi1=dsin(j*phii)
           cosphi2=dcos(j*phii1)
@@ -5642,12 +6347,12 @@ C Regular cosine and sine terms
           gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
           gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
         enddo
-        do k=2,ntermd_2(itori,itori1,itori2)
+        do k=2,ntermd_2(itori,itori1,itori2,iblock)
           do l=1,k-1
-            v1cdij = v2c(k,l,itori,itori1,itori2)
-            v2cdij = v2c(l,k,itori,itori1,itori2)
-            v1sdij = v2s(k,l,itori,itori1,itori2)
-            v2sdij = v2s(l,k,itori,itori1,itori2)
+            v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
+            v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
+            v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
+            v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
             cosphi1p2=dcos(l*phii+(k-l)*phii1)
             cosphi1m2=dcos(l*phii-(k-l)*phii1)
             sinphi1p2=dsin(l*phii+(k-l)*phii1)
@@ -5692,29 +6397,53 @@ c        amino-acid residues.
 C Set lprn=.true. for debugging
       lprn=.false.
 c      lprn=.true.
-c      write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
+c      write (iout,*) "EBACK_SC_COR",itau_start,itau_end
       esccor=0.0D0
-      do i=iphi_start,iphi_end
-        if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle
+      do i=itau_start,itau_end
+        if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
         esccor_ii=0.0D0
-        itori=itype(i-2)
-        itori1=itype(i-1)
+        isccori=isccortyp(itype(i-2))
+        isccori1=isccortyp(itype(i-1))
+c      write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
         phii=phi(i)
+        do intertyp=1,3 !intertyp
+cc Added 09 May 2012 (Adasko)
+cc  Intertyp means interaction type of backbone mainchain correlation: 
+c   1 = SC...Ca...Ca...Ca
+c   2 = Ca...Ca...Ca...SC
+c   3 = SC...Ca...Ca...SCi
         gloci=0.0D0
-        do j=1,nterm_sccor
-          v1ij=v1sccor(j,itori,itori1)
-          v2ij=v2sccor(j,itori,itori1)
-          cosphi=dcos(j*phii)
-          sinphi=dsin(j*phii)
+        if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
+     &      (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
+     &      (itype(i-1).eq.ntyp1)))
+     &    .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
+     &     .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
+     &     .or.(itype(i).eq.ntyp1)))
+     &    .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
+     &      (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
+     &      (itype(i-3).eq.ntyp1)))) cycle
+        if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
+        if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
+     & cycle
+       do j=1,nterm_sccor(isccori,isccori1)
+          v1ij=v1sccor(j,intertyp,isccori,isccori1)
+          v2ij=v2sccor(j,intertyp,isccori,isccori1)
+          cosphi=dcos(j*tauangle(intertyp,i))
+          sinphi=dsin(j*tauangle(intertyp,i))
           esccor=esccor+v1ij*cosphi+v2ij*sinphi
           gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
         enddo
+c      write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
+        gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
         if (lprn)
      &  write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
-     &  restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
-     &  (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
+     &  restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
+     &  (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
+     & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
         gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
+       enddo !intertyp
       enddo
+
       return
       end
 c----------------------------------------------------------------------------
@@ -6719,7 +7448,7 @@ C---------------------------------------------------------------------------
       if (j.lt.nres-1) then
         itj1 = itortyp(itype(j+1))
       else
-        itj1=ntortyp+1
+        itj1=ntortyp
       endif
       do iii=1,2
         dipi(iii,1)=Ub2(iii,i)
@@ -6809,14 +7538,14 @@ C parallel orientation of the two CA-CA-CA frames.
         if (i.gt.1) then
           iti=itortyp(itype(i))
         else
-          iti=ntortyp+1
+          iti=ntortyp
         endif
         itk1=itortyp(itype(k+1))
         itj=itortyp(itype(j))
         if (l.lt.nres-1) then
           itl1=itortyp(itype(l+1))
         else
-          itl1=ntortyp+1
+          itl1=ntortyp
         endif
 C A1 kernel(j+1) A2T
 cd        do iii=1,2
@@ -6962,7 +7691,7 @@ C Antiparallel orientation of the two CA-CA-CA frames.
         if (i.gt.1) then
           iti=itortyp(itype(i))
         else
-          iti=ntortyp+1
+          iti=ntortyp
         endif
         itk1=itortyp(itype(k+1))
         itl=itortyp(itype(l))
@@ -6970,7 +7699,7 @@ C Antiparallel orientation of the two CA-CA-CA frames.
         if (j.lt.nres-1) then
           itj1=itortyp(itype(j+1))
         else 
-          itj1=ntortyp+1
+          itj1=ntortyp
         endif
 C A2 kernel(j-1)T A1T
         call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
@@ -8124,14 +8853,14 @@ C           energy moment and not to the cluster cumulant.
       if (j.lt.nres-1) then
         itj1=itortyp(itype(j+1))
       else
-        itj1=ntortyp+1
+        itj1=ntortyp
       endif
       itk=itortyp(itype(k))
       itk1=itortyp(itype(k+1))
       if (l.lt.nres-1) then
         itl1=itortyp(itype(l+1))
       else
-        itl1=ntortyp+1
+        itl1=ntortyp
       endif
 #ifdef MOMENT
       s1=dip(4,jj,i)*dip(4,kk,k)
@@ -8243,19 +8972,19 @@ cd      write (2,*) 'eello_graph4: wturn6',wturn6
       if (j.lt.nres-1) then
         itj1=itortyp(itype(j+1))
       else
-        itj1=ntortyp+1
+        itj1=ntortyp
       endif
       itk=itortyp(itype(k))
       if (k.lt.nres-1) then
         itk1=itortyp(itype(k+1))
       else
-        itk1=ntortyp+1
+        itk1=ntortyp
       endif
       itl=itortyp(itype(l))
       if (l.lt.nres-1) then
         itl1=itortyp(itype(l+1))
       else
-        itl1=ntortyp+1
+        itl1=ntortyp
       endif
 cd      write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
 cd      write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,