X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_MD-M-newcorr%2Fenergy_p_new_barrier.F;fp=source%2Funres%2Fsrc_MD-M-newcorr%2Fenergy_p_new_barrier.F;h=42005e116fd798257402fec1a165c5b11f1c05da;hb=e74a1da46f47c86b0c46679481b757c425642977;hp=0000000000000000000000000000000000000000;hpb=d0bc9ab44e8f75f5cb92a01cda9daba97791e379;p=unres.git

diff --git a/source/unres/src_MD-M-newcorr/energy_p_new_barrier.F b/source/unres/src_MD-M-newcorr/energy_p_new_barrier.F
new file mode 100644
index 0000000..42005e1
--- /dev/null
+++ b/source/unres/src_MD-M-newcorr/energy_p_new_barrier.F
@@ -0,0 +1,9245 @@
+      subroutine etotal(energia)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+#ifndef ISNAN
+      external proc_proc
+#ifdef WINPGI
+cMS$ATTRIBUTES C ::  proc_proc
+#endif
+#endif
+#ifdef MPI
+      include "mpif.h"
+      double precision weights_(n_ene)
+#endif
+      include 'COMMON.SETUP'
+      include 'COMMON.IOUNITS'
+      double precision energia(0:n_ene)
+      include 'COMMON.LOCAL'
+      include 'COMMON.FFIELD'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VAR'
+      include 'COMMON.MD'
+      include 'COMMON.CONTROL'
+      include 'COMMON.TIME1'
+#ifdef MPI      
+c      print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
+c     & " nfgtasks",nfgtasks
+      if (nfgtasks.gt.1) then
+        time00=MPI_Wtime()
+C FG slaves call the following matching MPI_Bcast in ERGASTULUM
+        if (fg_rank.eq.0) then
+          call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
+c          print *,"Processor",myrank," BROADCAST iorder"
+C FG master sets up the WEIGHTS_ array which will be broadcast to the 
+C FG slaves as WEIGHTS array.
+          weights_(1)=wsc
+          weights_(2)=wscp
+          weights_(3)=welec
+          weights_(4)=wcorr
+          weights_(5)=wcorr5
+          weights_(6)=wcorr6
+          weights_(7)=wel_loc
+          weights_(8)=wturn3
+          weights_(9)=wturn4
+          weights_(10)=wturn6
+          weights_(11)=wang
+          weights_(12)=wscloc
+          weights_(13)=wtor
+          weights_(14)=wtor_d
+          weights_(15)=wstrain
+          weights_(16)=wvdwpp
+          weights_(17)=wbond
+          weights_(18)=scal14
+          weights_(21)=wsccor
+C FG Master broadcasts the WEIGHTS_ array
+          call MPI_Bcast(weights_(1),n_ene,
+     &        MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
+        else
+C FG slaves receive the WEIGHTS array
+          call MPI_Bcast(weights(1),n_ene,
+     &        MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
+          wsc=weights(1)
+          wscp=weights(2)
+          welec=weights(3)
+          wcorr=weights(4)
+          wcorr5=weights(5)
+          wcorr6=weights(6)
+          wel_loc=weights(7)
+          wturn3=weights(8)
+          wturn4=weights(9)
+          wturn6=weights(10)
+          wang=weights(11)
+          wscloc=weights(12)
+          wtor=weights(13)
+          wtor_d=weights(14)
+          wstrain=weights(15)
+          wvdwpp=weights(16)
+          wbond=weights(17)
+          scal14=weights(18)
+          wsccor=weights(21)
+        endif
+        time_Bcast=time_Bcast+MPI_Wtime()-time00
+        time_Bcastw=time_Bcastw+MPI_Wtime()-time00
+c        call chainbuild_cart
+      endif
+c      print *,'Processor',myrank,' calling etotal ipot=',ipot
+c      print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
+#else
+c      if (modecalc.eq.12.or.modecalc.eq.14) then
+c        call int_from_cart1(.false.)
+c      endif
+#endif     
+#ifdef TIMING
+      time00=MPI_Wtime()
+#endif
+C 
+C Compute the side-chain and electrostatic interaction energy
+C
+      goto (101,102,103,104,105,106) ipot
+C Lennard-Jones potential.
+  101 call elj(evdw)
+cd    print '(a)','Exit ELJ'
+      goto 107
+C Lennard-Jones-Kihara potential (shifted).
+  102 call eljk(evdw)
+      goto 107
+C Berne-Pechukas potential (dilated LJ, angular dependence).
+  103 call ebp(evdw)
+      goto 107
+C Gay-Berne potential (shifted LJ, angular dependence).
+  104 call egb(evdw)
+      goto 107
+C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
+  105 call egbv(evdw)
+      goto 107
+C Soft-sphere potential
+  106 call e_softsphere(evdw)
+C
+C Calculate electrostatic (H-bonding) energy of the main chain.
+C
+  107 continue
+c      print *,"Processor",myrank," computed USCSC"
+#ifdef TIMING
+      time01=MPI_Wtime() 
+#endif
+      call vec_and_deriv
+#ifdef TIMING
+      time_vec=time_vec+MPI_Wtime()-time01
+#endif
+c      print *,"Processor",myrank," left VEC_AND_DERIV"
+      if (ipot.lt.6) then
+#ifdef SPLITELE
+         if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
+     &       wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
+     &       .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
+     &       .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
+#else
+         if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
+     &       wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
+     &       .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 
+     &       .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
+#endif
+            call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
+         else
+            ees=0.0d0
+            evdw1=0.0d0
+            eel_loc=0.0d0
+            eello_turn3=0.0d0
+            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)
+      endif
+c      print *,"Processor",myrank," computed UELEC"
+C
+C Calculate excluded-volume interaction energy between peptide groups
+C and side chains.
+C
+      if (ipot.lt.6) then
+       if(wscp.gt.0d0) then
+        call escp(evdw2,evdw2_14)
+       else
+        evdw2=0
+        evdw2_14=0
+       endif
+      else
+c        write (iout,*) "Soft-sphere SCP potential"
+        call escp_soft_sphere(evdw2,evdw2_14)
+      endif
+c
+c Calculate the bond-stretching energy
+c
+      call ebond(estr)
+C 
+C Calculate the disulfide-bridge and other energy and the contributions
+C from other distance constraints.
+cd    print *,'Calling EHPB'
+      call edis(ehpb)
+cd    print *,'EHPB exitted succesfully.'
+C
+C Calculate the virtual-bond-angle energy.
+C
+      if (wang.gt.0d0) then
+        call ebend(ebe)
+      else
+        ebe=0
+      endif
+c      print *,"Processor",myrank," computed UB"
+C
+C Calculate the SC local energy.
+C
+      call esc(escloc)
+c      print *,"Processor",myrank," computed USC"
+C
+C Calculate the virtual-bond torsional energy.
+C
+cd    print *,'nterm=',nterm
+      if (wtor.gt.0) then
+       call etor(etors,edihcnstr)
+      else
+       etors=0
+       edihcnstr=0
+      endif
+c      print *,"Processor",myrank," computed Utor"
+C
+C 6/23/01 Calculate double-torsional energy
+C
+      if (wtor_d.gt.0) then
+       call etor_d(etors_d)
+      else
+       etors_d=0
+      endif
+c      print *,"Processor",myrank," computed Utord"
+C
+C 21/5/07 Calculate local sicdechain correlation energy
+C
+      if (wsccor.gt.0.0d0) then
+        call eback_sc_corr(esccor)
+      else
+        esccor=0.0d0
+      endif
+c      print *,"Processor",myrank," computed Usccorr"
+C 
+C 12/1/95 Multi-body terms
+C
+      n_corr=0
+      n_corr1=0
+      if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 
+     &    .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
+         call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
+cd         write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
+cd     &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
+      else
+         ecorr=0.0d0
+         ecorr5=0.0d0
+         ecorr6=0.0d0
+         eturn6=0.0d0
+      endif
+      if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
+         call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
+cd         write (iout,*) "multibody_hb ecorr",ecorr
+      endif
+c      print *,"Processor",myrank," computed Ucorr"
+C 
+C If performing constraint dynamics, call the constraint energy
+C  after the equilibration time
+      if(usampl.and.totT.gt.eq_time) then
+         call EconstrQ   
+         call Econstr_back
+      else
+         Uconst=0.0d0
+         Uconst_back=0.0d0
+      endif
+#ifdef TIMING
+      time_enecalc=time_enecalc+MPI_Wtime()-time00
+#endif
+c      print *,"Processor",myrank," computed Uconstr"
+#ifdef TIMING
+      time00=MPI_Wtime()
+#endif
+c
+C Sum the energies
+C
+      energia(1)=evdw
+#ifdef SCP14
+      energia(2)=evdw2-evdw2_14
+      energia(18)=evdw2_14
+#else
+      energia(2)=evdw2
+      energia(18)=0.0d0
+#endif
+#ifdef SPLITELE
+      energia(3)=ees
+      energia(16)=evdw1
+#else
+      energia(3)=ees+evdw1
+      energia(16)=0.0d0
+#endif
+      energia(4)=ecorr
+      energia(5)=ecorr5
+      energia(6)=ecorr6
+      energia(7)=eel_loc
+      energia(8)=eello_turn3
+      energia(9)=eello_turn4
+      energia(10)=eturn6
+      energia(11)=ebe
+      energia(12)=escloc
+      energia(13)=etors
+      energia(14)=etors_d
+      energia(15)=ehpb
+      energia(19)=edihcnstr
+      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.)
+c      print *," Processor",myrank," left SUM_ENERGY"
+#ifdef TIMING
+      time_sumene=time_sumene+MPI_Wtime()-time00
+#endif
+      return
+      end
+c-------------------------------------------------------------------------------
+      subroutine sum_energy(energia,reduce)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+#ifndef ISNAN
+      external proc_proc
+#ifdef WINPGI
+cMS$ATTRIBUTES C ::  proc_proc
+#endif
+#endif
+#ifdef MPI
+      include "mpif.h"
+#endif
+      include 'COMMON.SETUP'
+      include 'COMMON.IOUNITS'
+      double precision energia(0:n_ene),enebuff(0:n_ene+1)
+      include 'COMMON.FFIELD'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VAR'
+      include 'COMMON.CONTROL'
+      include 'COMMON.TIME1'
+      logical reduce
+#ifdef MPI
+      if (nfgtasks.gt.1 .and. reduce) then
+#ifdef DEBUG
+        write (iout,*) "energies before REDUCE"
+        call enerprint(energia)
+        call flush(iout)
+#endif
+        do i=0,n_ene
+          enebuff(i)=energia(i)
+        enddo
+        time00=MPI_Wtime()
+        call MPI_Barrier(FG_COMM,IERR)
+        time_barrier_e=time_barrier_e+MPI_Wtime()-time00
+        time00=MPI_Wtime()
+        call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
+     &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+#ifdef DEBUG
+        write (iout,*) "energies after REDUCE"
+        call enerprint(energia)
+        call flush(iout)
+#endif
+        time_Reduce=time_Reduce+MPI_Wtime()-time00
+      endif
+      if (fg_rank.eq.0) then
+#endif
+      evdw=energia(1)
+#ifdef SCP14
+      evdw2=energia(2)+energia(18)
+      evdw2_14=energia(18)
+#else
+      evdw2=energia(2)
+#endif
+#ifdef SPLITELE
+      ees=energia(3)
+      evdw1=energia(16)
+#else
+      ees=energia(3)
+      evdw1=0.0d0
+#endif
+      ecorr=energia(4)
+      ecorr5=energia(5)
+      ecorr6=energia(6)
+      eel_loc=energia(7)
+      eello_turn3=energia(8)
+      eello_turn4=energia(9)
+      eturn6=energia(10)
+      ebe=energia(11)
+      escloc=energia(12)
+      etors=energia(13)
+      etors_d=energia(14)
+      ehpb=energia(15)
+      edihcnstr=energia(19)
+      estr=energia(17)
+      Uconst=energia(20)
+      esccor=energia(21)
+#ifdef SPLITELE
+      etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
+     & +wang*ebe+wtor*etors+wscloc*escloc
+     & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
+     & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
+     & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
+     & +wbond*estr+Uconst+wsccor*esccor
+#else
+      etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
+     & +wang*ebe+wtor*etors+wscloc*escloc
+     & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
+     & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
+     & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
+     & +wbond*estr+Uconst+wsccor*esccor
+#endif
+      energia(0)=etot
+c detecting NaNQ
+#ifdef ISNAN
+#ifdef AIX
+      if (isnan(etot).ne.0) energia(0)=1.0d+99
+#else
+      if (isnan(etot)) energia(0)=1.0d+99
+#endif
+#else
+      i=0
+#ifdef WINPGI
+      idumm=proc_proc(etot,i)
+#else
+      call proc_proc(etot,i)
+#endif
+      if(i.eq.1)energia(0)=1.0d+99
+#endif
+#ifdef MPI
+      endif
+#endif
+      return
+      end
+c-------------------------------------------------------------------------------
+      subroutine sum_gradient
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+#ifndef ISNAN
+      external proc_proc
+#ifdef WINPGI
+cMS$ATTRIBUTES C ::  proc_proc
+#endif
+#endif
+#ifdef MPI
+      include 'mpif.h'
+      double precision gradbufc(3,maxres),gradbufx(3,maxres),
+     &  glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
+#endif
+      include 'COMMON.SETUP'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VAR'
+      include 'COMMON.CONTROL'
+      include 'COMMON.TIME1'
+      include 'COMMON.MAXGRAD'
+      include 'COMMON.SCCOR'
+#ifdef TIMING
+      time01=MPI_Wtime()
+#endif
+#ifdef DEBUG
+      write (iout,*) "sum_gradient gvdwc, gvdwx"
+      do i=1,nres
+        write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') 
+     &   i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
+      enddo
+      call flush(iout)
+#endif
+#ifdef MPI
+C FG slaves call the following matching MPI_Bcast in ERGASTULUM
+        if (nfgtasks.gt.1 .and. fg_rank.eq.0) 
+     &    call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
+#endif
+C
+C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
+C            in virtual-bond-vector coordinates
+C
+#ifdef DEBUG
+c      write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
+c      do i=1,nres-1
+c        write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') 
+c     &   i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
+c      enddo
+c      write (iout,*) "gel_loc_tur3 gel_loc_turn4"
+c      do i=1,nres-1
+c        write (iout,'(i5,3f10.5,2x,f10.5)') 
+c     &  i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
+c      enddo
+      write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
+      do i=1,nres
+        write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') 
+     &   i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
+     &   g_corr5_loc(i)
+      enddo
+      call flush(iout)
+#endif
+#ifdef SPLITELE
+      do i=1,nct
+        do j=1,3
+          gradbufc(j,i)=wsc*gvdwc(j,i)+
+     &                wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
+     &                welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
+     &                wel_loc*gel_loc_long(j,i)+
+     &                wcorr*gradcorr_long(j,i)+
+     &                wcorr5*gradcorr5_long(j,i)+
+     &                wcorr6*gradcorr6_long(j,i)+
+     &                wturn6*gcorr6_turn_long(j,i)+
+     &                wstrain*ghpbc(j,i)
+        enddo
+      enddo 
+#else
+      do i=1,nct
+        do j=1,3
+          gradbufc(j,i)=wsc*gvdwc(j,i)+
+     &                wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
+     &                welec*gelc_long(j,i)+
+     &                wbond*gradb(j,i)+
+     &                wel_loc*gel_loc_long(j,i)+
+     &                wcorr*gradcorr_long(j,i)+
+     &                wcorr5*gradcorr5_long(j,i)+
+     &                wcorr6*gradcorr6_long(j,i)+
+     &                wturn6*gcorr6_turn_long(j,i)+
+     &                wstrain*ghpbc(j,i)
+        enddo
+      enddo 
+#endif
+#ifdef MPI
+      if (nfgtasks.gt.1) then
+      time00=MPI_Wtime()
+#ifdef DEBUG
+      write (iout,*) "gradbufc before allreduce"
+      do i=1,nres
+        write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+      enddo
+      call flush(iout)
+#endif
+      do i=1,nres
+        do j=1,3
+          gradbufc_sum(j,i)=gradbufc(j,i)
+        enddo
+      enddo
+c      call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
+c     &    MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
+c      time_reduce=time_reduce+MPI_Wtime()-time00
+#ifdef DEBUG
+c      write (iout,*) "gradbufc_sum after allreduce"
+c      do i=1,nres
+c        write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
+c      enddo
+c      call flush(iout)
+#endif
+#ifdef TIMING
+c      time_allreduce=time_allreduce+MPI_Wtime()-time00
+#endif
+      do i=nnt,nres
+        do k=1,3
+          gradbufc(k,i)=0.0d0
+        enddo
+      enddo
+#ifdef DEBUG
+      write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
+      write (iout,*) (i," jgrad_start",jgrad_start(i),
+     &                  " jgrad_end  ",jgrad_end(i),
+     &                  i=igrad_start,igrad_end)
+#endif
+c
+c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
+c do not parallelize this part.
+c
+c      do i=igrad_start,igrad_end
+c        do j=jgrad_start(i),jgrad_end(i)
+c          do k=1,3
+c            gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
+c          enddo
+c        enddo
+c      enddo
+      do j=1,3
+        gradbufc(j,nres-1)=gradbufc_sum(j,nres)
+      enddo
+      do i=nres-2,nnt,-1
+        do j=1,3
+          gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
+        enddo
+      enddo
+#ifdef DEBUG
+      write (iout,*) "gradbufc after summing"
+      do i=1,nres
+        write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+      enddo
+      call flush(iout)
+#endif
+      else
+#endif
+#ifdef DEBUG
+      write (iout,*) "gradbufc"
+      do i=1,nres
+        write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+      enddo
+      call flush(iout)
+#endif
+      do i=1,nres
+        do j=1,3
+          gradbufc_sum(j,i)=gradbufc(j,i)
+          gradbufc(j,i)=0.0d0
+        enddo
+      enddo
+      do j=1,3
+        gradbufc(j,nres-1)=gradbufc_sum(j,nres)
+      enddo
+      do i=nres-2,nnt,-1
+        do j=1,3
+          gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
+        enddo
+      enddo
+c      do i=nnt,nres-1
+c        do k=1,3
+c          gradbufc(k,i)=0.0d0
+c        enddo
+c        do j=i+1,nres
+c          do k=1,3
+c            gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
+c          enddo
+c        enddo
+c      enddo
+#ifdef DEBUG
+      write (iout,*) "gradbufc after summing"
+      do i=1,nres
+        write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
+      enddo
+      call flush(iout)
+#endif
+#ifdef MPI
+      endif
+#endif
+      do k=1,3
+        gradbufc(k,nres)=0.0d0
+      enddo
+      do i=1,nct
+        do j=1,3
+#ifdef SPLITELE
+          gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
+     &                wel_loc*gel_loc(j,i)+
+     &                0.5d0*(wscp*gvdwc_scpp(j,i)+
+     &                welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
+     &                wel_loc*gel_loc_long(j,i)+
+     &                wcorr*gradcorr_long(j,i)+
+     &                wcorr5*gradcorr5_long(j,i)+
+     &                wcorr6*gradcorr6_long(j,i)+
+     &                wturn6*gcorr6_turn_long(j,i))+
+     &                wbond*gradb(j,i)+
+     &                wcorr*gradcorr(j,i)+
+     &                wturn3*gcorr3_turn(j,i)+
+     &                wturn4*gcorr4_turn(j,i)+
+     &                wcorr5*gradcorr5(j,i)+
+     &                wcorr6*gradcorr6(j,i)+
+     &                wturn6*gcorr6_turn(j,i)+
+     &                wsccor*gsccorc(j,i)
+     &               +wscloc*gscloc(j,i)
+#else
+          gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
+     &                wel_loc*gel_loc(j,i)+
+     &                0.5d0*(wscp*gvdwc_scpp(j,i)+
+     &                welec*gelc_long(j,i)
+     &                wel_loc*gel_loc_long(j,i)+
+     &                wcorr*gcorr_long(j,i)+
+     &                wcorr5*gradcorr5_long(j,i)+
+     &                wcorr6*gradcorr6_long(j,i)+
+     &                wturn6*gcorr6_turn_long(j,i))+
+     &                wbond*gradb(j,i)+
+     &                wcorr*gradcorr(j,i)+
+     &                wturn3*gcorr3_turn(j,i)+
+     &                wturn4*gcorr4_turn(j,i)+
+     &                wcorr5*gradcorr5(j,i)+
+     &                wcorr6*gradcorr6(j,i)+
+     &                wturn6*gcorr6_turn(j,i)+
+     &                wsccor*gsccorc(j,i)
+     &               +wscloc*gscloc(j,i)
+#endif
+          gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
+     &                  wbond*gradbx(j,i)+
+     &                  wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
+     &                  wsccor*gsccorx(j,i)
+     &                 +wscloc*gsclocx(j,i)
+        enddo
+      enddo 
+#ifdef DEBUG
+      write (iout,*) "gloc before adding corr"
+      do i=1,4*nres
+        write (iout,*) i,gloc(i,icg)
+      enddo
+#endif
+      do i=1,nres-3
+        gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
+     &   +wcorr5*g_corr5_loc(i)
+     &   +wcorr6*g_corr6_loc(i)
+     &   +wturn4*gel_loc_turn4(i)
+     &   +wturn3*gel_loc_turn3(i)
+     &   +wturn6*gel_loc_turn6(i)
+     &   +wel_loc*gel_loc_loc(i)
+      enddo
+#ifdef DEBUG
+      write (iout,*) "gloc after adding corr"
+      do i=1,4*nres
+        write (iout,*) i,gloc(i,icg)
+      enddo
+#endif
+#ifdef MPI
+      if (nfgtasks.gt.1) then
+        do j=1,3
+          do i=1,nres
+            gradbufc(j,i)=gradc(j,i,icg)
+            gradbufx(j,i)=gradx(j,i,icg)
+          enddo
+        enddo
+        do i=1,4*nres
+          glocbuf(i)=gloc(i,icg)
+        enddo
+#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
+#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
+        time00=MPI_Wtime()
+        call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
+     &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+        call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
+     &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+        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
+#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
+#undef DEBUG
+#ifdef DEBUG
+      write (iout,*) "gloc after reduce"
+      do i=1,4*nres
+        write (iout,*) i,gloc(i,icg)
+      enddo
+#endif
+      endif
+#endif
+      if (gnorm_check) then
+c
+c Compute the maximum elements of the gradient
+c
+      gvdwc_max=0.0d0
+      gvdwc_scp_max=0.0d0
+      gelc_max=0.0d0
+      gvdwpp_max=0.0d0
+      gradb_max=0.0d0
+      ghpbc_max=0.0d0
+      gradcorr_max=0.0d0
+      gel_loc_max=0.0d0
+      gcorr3_turn_max=0.0d0
+      gcorr4_turn_max=0.0d0
+      gradcorr5_max=0.0d0
+      gradcorr6_max=0.0d0
+      gcorr6_turn_max=0.0d0
+      gsccorc_max=0.0d0
+      gscloc_max=0.0d0
+      gvdwx_max=0.0d0
+      gradx_scp_max=0.0d0
+      ghpbx_max=0.0d0
+      gradxorr_max=0.0d0
+      gsccorx_max=0.0d0
+      gsclocx_max=0.0d0
+      do i=1,nct
+        gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
+        if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
+        gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
+        if (gvdwc_scp_norm.gt.gvdwc_scp_max) 
+     &   gvdwc_scp_max=gvdwc_scp_norm
+        gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
+        if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
+        gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
+        if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
+        gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
+        if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
+        ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
+        if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
+        gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
+        if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
+        gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
+        if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
+        gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
+     &    gcorr3_turn(1,i)))
+        if (gcorr3_turn_norm.gt.gcorr3_turn_max) 
+     &    gcorr3_turn_max=gcorr3_turn_norm
+        gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
+     &    gcorr4_turn(1,i)))
+        if (gcorr4_turn_norm.gt.gcorr4_turn_max) 
+     &    gcorr4_turn_max=gcorr4_turn_norm
+        gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
+        if (gradcorr5_norm.gt.gradcorr5_max) 
+     &    gradcorr5_max=gradcorr5_norm
+        gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
+        if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
+        gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
+     &    gcorr6_turn(1,i)))
+        if (gcorr6_turn_norm.gt.gcorr6_turn_max) 
+     &    gcorr6_turn_max=gcorr6_turn_norm
+        gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
+        if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
+        gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
+        if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
+        gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
+        if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
+        gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
+        if (gradx_scp_norm.gt.gradx_scp_max) 
+     &    gradx_scp_max=gradx_scp_norm
+        ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
+        if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
+        gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
+        if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
+        gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
+        if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
+        gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
+        if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
+      enddo 
+      if (gradout) then
+#ifdef AIX
+        open(istat,file=statname,position="append")
+#else
+        open(istat,file=statname,access="append")
+#endif
+        write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
+     &     gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
+     &     gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
+     &     gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
+     &     gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
+     &     gsccorx_max,gsclocx_max
+        close(istat)
+        if (gvdwc_max.gt.1.0d4) then
+          write (iout,*) "gvdwc gvdwx gradb gradbx"
+          do i=nnt,nct
+            write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
+     &        gradb(j,i),gradbx(j,i),j=1,3)
+          enddo
+          call pdbout(0.0d0,'cipiszcze',iout)
+          call flush(iout)
+        endif
+      endif
+      endif
+#ifdef DEBUG
+      write (iout,*) "gradc gradx gloc"
+      do i=1,nres
+        write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') 
+     &   i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
+      enddo 
+#endif
+#ifdef TIMING
+      time_sumgradient=time_sumgradient+MPI_Wtime()-time01
+#endif
+      return
+      end
+c-------------------------------------------------------------------------------
+      subroutine rescale_weights(t_bath)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.SBRIDGE'
+      double precision kfac /2.4d0/
+      double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
+c      facT=temp0/t_bath
+c      facT=2*temp0/(t_bath+temp0)
+      if (rescale_mode.eq.0) then
+        facT=1.0d0
+        facT2=1.0d0
+        facT3=1.0d0
+        facT4=1.0d0
+        facT5=1.0d0
+      else if (rescale_mode.eq.1) then
+        facT=kfac/(kfac-1.0d0+t_bath/temp0)
+        facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
+        facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
+        facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
+        facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
+      else if (rescale_mode.eq.2) then
+        x=t_bath/temp0
+        x2=x*x
+        x3=x2*x
+        x4=x3*x
+        x5=x4*x
+        facT=licznik/dlog(dexp(x)+dexp(-x))
+        facT2=licznik/dlog(dexp(x2)+dexp(-x2))
+        facT3=licznik/dlog(dexp(x3)+dexp(-x3))
+        facT4=licznik/dlog(dexp(x4)+dexp(-x4))
+        facT5=licznik/dlog(dexp(x5)+dexp(-x5))
+      else
+        write (iout,*) "Wrong RESCALE_MODE",rescale_mode
+        write (*,*) "Wrong RESCALE_MODE",rescale_mode
+#ifdef MPI
+       call MPI_Finalize(MPI_COMM_WORLD,IERROR)
+#endif
+       stop 555
+      endif
+      welec=weights(3)*fact
+      wcorr=weights(4)*fact3
+      wcorr5=weights(5)*fact4
+      wcorr6=weights(6)*fact5
+      wel_loc=weights(7)*fact2
+      wturn3=weights(8)*fact2
+      wturn4=weights(9)*fact3
+      wturn6=weights(10)*fact5
+      wtor=weights(13)*fact
+      wtor_d=weights(14)*fact2
+      wsccor=weights(21)*fact
+
+      return
+      end
+C------------------------------------------------------------------------
+      subroutine enerprint(energia)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.MD'
+      double precision energia(0:n_ene)
+      etot=energia(0)
+      evdw=energia(1)
+      evdw2=energia(2)
+#ifdef SCP14
+      evdw2=energia(2)+energia(18)
+#else
+      evdw2=energia(2)
+#endif
+      ees=energia(3)
+#ifdef SPLITELE
+      evdw1=energia(16)
+#endif
+      ecorr=energia(4)
+      ecorr5=energia(5)
+      ecorr6=energia(6)
+      eel_loc=energia(7)
+      eello_turn3=energia(8)
+      eello_turn4=energia(9)
+      eello_turn6=energia(10)
+      ebe=energia(11)
+      escloc=energia(12)
+      etors=energia(13)
+      etors_d=energia(14)
+      ehpb=energia(15)
+      edihcnstr=energia(19)
+      estr=energia(17)
+      Uconst=energia(20)
+      esccor=energia(21)
+#ifdef SPLITELE
+      write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
+     &  estr,wbond,ebe,wang,
+     &  escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
+     &  ecorr,wcorr,
+     &  ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
+     &  eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
+     &  edihcnstr,ebr*nss,
+     &  Uconst,etot
+   10 format (/'Virtual-chain energies:'//
+     & 'EVDW=  ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
+     & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
+     & 'EES=   ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
+     & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
+     & 'ESTR=  ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
+     & 'EBE=   ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
+     & 'ESC=   ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
+     & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
+     & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
+     & 'EHBP=  ',1pE16.6,' WEIGHT=',1pD16.6,
+     & ' (SS bridges & dist. cnstr.)'/
+     & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
+     & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
+     & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
+     & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
+     & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
+     & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
+     & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
+     & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
+     & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
+     & 'ESS=   ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
+     & 'UCONST= ',1pE16.6,' (Constraint energy)'/ 
+     & 'ETOT=  ',1pE16.6,' (total)')
+#else
+      write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
+     &  estr,wbond,ebe,wang,
+     &  escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
+     &  ecorr,wcorr,
+     &  ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
+     &  eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
+     &  ebr*nss,Uconst,etot
+   10 format (/'Virtual-chain energies:'//
+     & 'EVDW=  ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
+     & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
+     & 'EES=   ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
+     & 'ESTR=  ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
+     & 'EBE=   ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
+     & 'ESC=   ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
+     & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
+     & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
+     & 'EHBP=  ',1pE16.6,' WEIGHT=',1pD16.6,
+     & ' (SS bridges & dist. cnstr.)'/
+     & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
+     & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
+     & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
+     & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
+     & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
+     & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
+     & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
+     & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
+     & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
+     & 'ESS=   ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
+     & 'UCONST=',1pE16.6,' (Constraint energy)'/ 
+     & 'ETOT=  ',1pE16.6,' (total)')
+#endif
+      return
+      end
+C-----------------------------------------------------------------------
+      subroutine elj(evdw)
+C
+C This subroutine calculates the interaction energy of nonbonded side chains
+C assuming the LJ potential of interaction.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      parameter (accur=1.0d-10)
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.TORSION'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.NAMES'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CONTACTS'
+      dimension gg(3)
+c      write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
+      evdw=0.0D0
+      do i=iatsc_s,iatsc_e
+        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 Change 12/1/95
+        num_conti=0
+C
+C Calculate SC interaction energy.
+C
+        do iint=1,nint_gr(i)
+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=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
+C Change 12/1/95 to calculate four-body interactions
+            rij=xj*xj+yj*yj+zj*zj
+            rrij=1.0D0/rij
+c           write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
+            eps0ij=eps(itypi,itypj)
+            fac=rrij**expon2
+            e1=fac*fac*aa(itypi,itypj)
+            e2=fac*bb(itypi,itypj)
+            evdwij=e1+e2
+cd          sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+cd          epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+cd          write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
+cd   &        restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
+cd   &        bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
+cd   &        (c(k,i),k=1,3),(c(k,j),k=1,3)
+            evdw=evdw+evdwij
+C 
+C Calculate the components of the gradient in DC and X
+C
+            fac=-rrij*(e1+evdwij)
+            gg(1)=xj*fac
+            gg(2)=yj*fac
+            gg(3)=zj*fac
+            do k=1,3
+              gvdwx(k,i)=gvdwx(k,i)-gg(k)
+              gvdwx(k,j)=gvdwx(k,j)+gg(k)
+              gvdwc(k,i)=gvdwc(k,i)-gg(k)
+              gvdwc(k,j)=gvdwc(k,j)+gg(k)
+            enddo
+cgrad            do k=i,j-1
+cgrad              do l=1,3
+cgrad                gvdwc(l,k)=gvdwc(l,k)+gg(l)
+cgrad              enddo
+cgrad            enddo
+C
+C 12/1/95, revised on 5/20/97
+C
+C Calculate the contact function. The ith column of the array JCONT will 
+C contain the numbers of atoms that make contacts with the atom I (of numbers
+C greater than I). The arrays FACONT and GACONT will contain the values of
+C the contact function and its derivative.
+C
+C Uncomment next line, if the correlation interactions include EVDW explicitly.
+c           if (j.gt.i+1 .and. evdwij.le.0.0D0) then
+C Uncomment next line, if the correlation interactions are contact function only
+            if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
+              rij=dsqrt(rij)
+              sigij=sigma(itypi,itypj)
+              r0ij=rs0(itypi,itypj)
+C
+C Check whether the SC's are not too far to make a contact.
+C
+              rcut=1.5d0*r0ij
+              call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
+C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
+C
+              if (fcont.gt.0.0D0) then
+C If the SC-SC distance if close to sigma, apply spline.
+cAdam           call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
+cAdam &             fcont1,fprimcont1)
+cAdam           fcont1=1.0d0-fcont1
+cAdam           if (fcont1.gt.0.0d0) then
+cAdam             fprimcont=fprimcont*fcont1+fcont*fprimcont1
+cAdam             fcont=fcont*fcont1
+cAdam           endif
+C Uncomment following 4 lines to have the geometric average of the epsilon0's
+cga             eps0ij=1.0d0/dsqrt(eps0ij)
+cga             do k=1,3
+cga               gg(k)=gg(k)*eps0ij
+cga             enddo
+cga             eps0ij=-evdwij*eps0ij
+C Uncomment for AL's type of SC correlation interactions.
+cadam           eps0ij=-evdwij
+                num_conti=num_conti+1
+                jcont(num_conti,i)=j
+                facont(num_conti,i)=fcont*eps0ij
+                fprimcont=eps0ij*fprimcont/rij
+                fcont=expon*fcont
+cAdam           gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
+cAdam           gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
+cAdam           gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
+C Uncomment following 3 lines for Skolnick's type of SC correlation.
+                gacont(1,num_conti,i)=-fprimcont*xj
+                gacont(2,num_conti,i)=-fprimcont*yj
+                gacont(3,num_conti,i)=-fprimcont*zj
+cd              write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
+cd              write (iout,'(2i3,3f10.5)') 
+cd   &           i,j,(gacont(kk,num_conti,i),kk=1,3)
+              endif
+            endif
+          enddo      ! j
+        enddo        ! iint
+C Change 12/1/95
+        num_cont(i)=num_conti
+      enddo          ! i
+      do i=1,nct
+        do j=1,3
+          gvdwc(j,i)=expon*gvdwc(j,i)
+          gvdwx(j,i)=expon*gvdwx(j,i)
+        enddo
+      enddo
+C******************************************************************************
+C
+C                              N O T E !!!
+C
+C To save time, the factor of EXPON has been extracted from ALL components
+C of GVDWC and GRADX. Remember to multiply them by this factor before further 
+C use!
+C
+C******************************************************************************
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine eljk(evdw)
+C
+C This subroutine calculates the interaction energy of nonbonded side chains
+C assuming the LJK potential of interaction.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.NAMES'
+      dimension gg(3)
+      logical scheck
+c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
+      evdw=0.0D0
+      do i=iatsc_s,iatsc_e
+        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
+C Calculate SC interaction energy.
+C
+        do iint=1,nint_gr(i)
+          do j=istart(i,iint),iend(i,iint)
+            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
+            rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+            fac_augm=rrij**expon
+            e_augm=augm(itypi,itypj)*fac_augm
+            r_inv_ij=dsqrt(rrij)
+            rij=1.0D0/r_inv_ij 
+            r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
+            fac=r_shift_inv**expon
+            e1=fac*fac*aa(itypi,itypj)
+            e2=fac*bb(itypi,itypj)
+            evdwij=e_augm+e1+e2
+cd          sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+cd          epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+cd          write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
+cd   &        restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
+cd   &        bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
+cd   &        sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
+cd   &        (c(k,i),k=1,3),(c(k,j),k=1,3)
+            evdw=evdw+evdwij
+C 
+C Calculate the components of the gradient in DC and X
+C
+            fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
+            gg(1)=xj*fac
+            gg(2)=yj*fac
+            gg(3)=zj*fac
+            do k=1,3
+              gvdwx(k,i)=gvdwx(k,i)-gg(k)
+              gvdwx(k,j)=gvdwx(k,j)+gg(k)
+              gvdwc(k,i)=gvdwc(k,i)-gg(k)
+              gvdwc(k,j)=gvdwc(k,j)+gg(k)
+            enddo
+cgrad            do k=i,j-1
+cgrad              do l=1,3
+cgrad                gvdwc(l,k)=gvdwc(l,k)+gg(l)
+cgrad              enddo
+cgrad            enddo
+          enddo      ! j
+        enddo        ! iint
+      enddo          ! i
+      do i=1,nct
+        do j=1,3
+          gvdwc(j,i)=expon*gvdwc(j,i)
+          gvdwx(j,i)=expon*gvdwx(j,i)
+        enddo
+      enddo
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine ebp(evdw)
+C
+C This subroutine calculates the interaction energy of nonbonded side chains
+C assuming the Berne-Pechukas potential of interaction.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.NAMES'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CALC'
+      common /srutu/ icall
+c     double precision rrsave(maxdim)
+      logical lprn
+      evdw=0.0D0
+c     print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
+      evdw=0.0D0
+c     if (icall.eq.0) then
+c       lprn=.true.
+c     else
+        lprn=.false.
+c     endif
+      ind=0
+      do i=iatsc_s,iatsc_e
+        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)
+        dxi=dc_norm(1,nres+i)
+        dyi=dc_norm(2,nres+i)
+        dzi=dc_norm(3,nres+i)
+c        dsci_inv=dsc_inv(itypi)
+        dsci_inv=vbld_inv(i+nres)
+C
+C Calculate SC interaction energy.
+C
+        do iint=1,nint_gr(i)
+          do j=istart(i,iint),iend(i,iint)
+            ind=ind+1
+            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)
+            chi2=chi(itypj,itypi)
+            chi12=chi1*chi2
+            chip1=chip(itypi)
+            chip2=chip(itypj)
+            chip12=chip1*chip2
+            alf1=alp(itypi)
+            alf2=alp(itypj)
+            alf12=0.5D0*(alf1+alf2)
+C For diagnostics only!!!
+c           chi1=0.0D0
+c           chi2=0.0D0
+c           chi12=0.0D0
+c           chip1=0.0D0
+c           chip2=0.0D0
+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
+            dxj=dc_norm(1,nres+j)
+            dyj=dc_norm(2,nres+j)
+            dzj=dc_norm(3,nres+j)
+            rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+cd          if (icall.eq.0) then
+cd            rrsave(ind)=rrij
+cd          else
+cd            rrij=rrsave(ind)
+cd          endif
+            rij=dsqrt(rrij)
+C Calculate the angle-dependent terms of energy & contributions to derivatives.
+            call sc_angular
+C Calculate whole angle-dependent part of epsilon and contributions
+C to its derivatives
+            fac=(rrij*sigsq)**expon2
+            e1=fac*fac*aa(itypi,itypj)
+            e2=fac*bb(itypi,itypj)
+            evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+            eps2der=evdwij*eps3rt
+            eps3der=evdwij*eps2rt
+            evdwij=evdwij*eps2rt*eps3rt
+            evdw=evdw+evdwij
+            if (lprn) then
+            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+cd            write (iout,'(2(a3,i3,2x),15(0pf7.3))')
+cd     &        restyp(itypi),i,restyp(itypj),j,
+cd     &        epsi,sigm,chi1,chi2,chip1,chip2,
+cd     &        eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
+cd     &        om1,om2,om12,1.0D0/dsqrt(rrij),
+cd     &        evdwij
+            endif
+C Calculate gradient components.
+            e1=e1*eps1*eps2rt**2*eps3rt**2
+            fac=-expon*(e1+evdwij)
+            sigder=fac/sigsq
+            fac=rrij*fac
+C Calculate radial part of the gradient
+            gg(1)=xj*fac
+            gg(2)=yj*fac
+            gg(3)=zj*fac
+C Calculate the angular part of the gradient and sum add the contributions
+C to the appropriate components of the Cartesian gradient.
+            call sc_grad
+          enddo      ! j
+        enddo        ! iint
+      enddo          ! i
+c     stop
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine egb(evdw)
+C
+C This subroutine calculates the interaction energy of nonbonded side chains
+C assuming the Gay-Berne potential of interaction.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.NAMES'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CALC'
+      include 'COMMON.CONTROL'
+      logical lprn
+      evdw=0.0D0
+ccccc      energy_dec=.false.
+c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+      evdw=0.0D0
+      lprn=.false.
+c     if (icall.eq.0) lprn=.false.
+      ind=0
+      do i=iatsc_s,iatsc_e
+        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)
+        dxi=dc_norm(1,nres+i)
+        dyi=dc_norm(2,nres+i)
+        dzi=dc_norm(3,nres+i)
+c        dsci_inv=dsc_inv(itypi)
+        dsci_inv=vbld_inv(i+nres)
+c        write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
+c        write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
+C
+C Calculate SC interaction energy.
+C
+        do iint=1,nint_gr(i)
+          do j=istart(i,iint),iend(i,iint)
+            ind=ind+1
+            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,
+c     &       1.0d0/vbld(j+nres)
+c            write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
+            sig0ij=sigma(itypi,itypj)
+            chi1=chi(itypi,itypj)
+            chi2=chi(itypj,itypi)
+            chi12=chi1*chi2
+            chip1=chip(itypi)
+            chip2=chip(itypj)
+            chip12=chip1*chip2
+            alf1=alp(itypi)
+            alf2=alp(itypj)
+            alf12=0.5D0*(alf1+alf2)
+C For diagnostics only!!!
+c           chi1=0.0D0
+c           chi2=0.0D0
+c           chi12=0.0D0
+c           chip1=0.0D0
+c           chip2=0.0D0
+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
+            dxj=dc_norm(1,nres+j)
+            dyj=dc_norm(2,nres+j)
+            dzj=dc_norm(3,nres+j)
+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)
+C Calculate angle-dependent terms of energy and contributions to their
+C derivatives.
+            call sc_angular
+            sigsq=1.0D0/sigsq
+            sig=sig0ij*dsqrt(sigsq)
+            rij_shift=1.0D0/rij-sig+sig0ij
+c for diagnostics; uncomment
+c            rij_shift=1.2*sig0ij
+C I hate to put IF's in the loops, but here don't have another choice!!!!
+            if (rij_shift.le.0.0D0) then
+              evdw=1.0D20
+cd              write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+cd     &        restyp(itypi),i,restyp(itypj),j,
+cd     &        rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) 
+              return
+            endif
+            sigder=-sig*sigsq
+c---------------------------------------------------------------
+            rij_shift=1.0D0/rij_shift 
+            fac=rij_shift**expon
+            e1=fac*fac*aa(itypi,itypj)
+            e2=fac*bb(itypi,itypj)
+            evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+            eps2der=evdwij*eps3rt
+            eps3der=evdwij*eps2rt
+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
+            if (lprn) then
+            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+            write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+     &        restyp(itypi),i,restyp(itypj),j,
+     &        epsi,sigm,chi1,chi2,chip1,chip2,
+     &        eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
+     &        om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
+     &        evdwij
+            endif
+
+            if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') 
+     &                        'evdw',i,j,evdwij
+
+C Calculate gradient components.
+            e1=e1*eps1*eps2rt**2*eps3rt**2
+            fac=-expon*(e1+evdwij)*rij_shift
+            sigder=fac*sigder
+            fac=rij*fac
+c            fac=0.0d0
+C Calculate the radial part of the gradient
+            gg(1)=xj*fac
+            gg(2)=yj*fac
+            gg(3)=zj*fac
+C Calculate angular part of the gradient.
+            call sc_grad
+          enddo      ! j
+        enddo        ! iint
+      enddo          ! i
+c      write (iout,*) "Number of loop steps in EGB:",ind
+cccc      energy_dec=.false.
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine egbv(evdw)
+C
+C This subroutine calculates the interaction energy of nonbonded side chains
+C assuming the Gay-Berne-Vorobjev potential of interaction.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.NAMES'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CALC'
+      common /srutu/ icall
+      logical lprn
+      evdw=0.0D0
+c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
+      evdw=0.0D0
+      lprn=.false.
+c     if (icall.eq.0) lprn=.true.
+      ind=0
+      do i=iatsc_s,iatsc_e
+        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)
+        dxi=dc_norm(1,nres+i)
+        dyi=dc_norm(2,nres+i)
+        dzi=dc_norm(3,nres+i)
+c        dsci_inv=dsc_inv(itypi)
+        dsci_inv=vbld_inv(i+nres)
+C
+C Calculate SC interaction energy.
+C
+        do iint=1,nint_gr(i)
+          do j=istart(i,iint),iend(i,iint)
+            ind=ind+1
+            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)
+            r0ij=r0(itypi,itypj)
+            chi1=chi(itypi,itypj)
+            chi2=chi(itypj,itypi)
+            chi12=chi1*chi2
+            chip1=chip(itypi)
+            chip2=chip(itypj)
+            chip12=chip1*chip2
+            alf1=alp(itypi)
+            alf2=alp(itypj)
+            alf12=0.5D0*(alf1+alf2)
+C For diagnostics only!!!
+c           chi1=0.0D0
+c           chi2=0.0D0
+c           chi12=0.0D0
+c           chip1=0.0D0
+c           chip2=0.0D0
+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
+            dxj=dc_norm(1,nres+j)
+            dyj=dc_norm(2,nres+j)
+            dzj=dc_norm(3,nres+j)
+            rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+            rij=dsqrt(rrij)
+C Calculate angle-dependent terms of energy and contributions to their
+C derivatives.
+            call sc_angular
+            sigsq=1.0D0/sigsq
+            sig=sig0ij*dsqrt(sigsq)
+            rij_shift=1.0D0/rij-sig+r0ij
+C I hate to put IF's in the loops, but here don't have another choice!!!!
+            if (rij_shift.le.0.0D0) then
+              evdw=1.0D20
+              return
+            endif
+            sigder=-sig*sigsq
+c---------------------------------------------------------------
+            rij_shift=1.0D0/rij_shift 
+            fac=rij_shift**expon
+            e1=fac*fac*aa(itypi,itypj)
+            e2=fac*bb(itypi,itypj)
+            evdwij=eps1*eps2rt*eps3rt*(e1+e2)
+            eps2der=evdwij*eps3rt
+            eps3der=evdwij*eps2rt
+            fac_augm=rrij**expon
+            e_augm=augm(itypi,itypj)*fac_augm
+            evdwij=evdwij*eps2rt*eps3rt
+            evdw=evdw+evdwij+e_augm
+            if (lprn) then
+            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
+            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
+            write (iout,'(2(a3,i3,2x),17(0pf7.3))')
+     &        restyp(itypi),i,restyp(itypj),j,
+     &        epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
+     &        chi1,chi2,chip1,chip2,
+     &        eps1,eps2rt**2,eps3rt**2,
+     &        om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
+     &        evdwij+e_augm
+            endif
+C Calculate gradient components.
+            e1=e1*eps1*eps2rt**2*eps3rt**2
+            fac=-expon*(e1+evdwij)*rij_shift
+            sigder=fac*sigder
+            fac=rij*fac-2*expon*rrij*e_augm
+C Calculate the radial part of the gradient
+            gg(1)=xj*fac
+            gg(2)=yj*fac
+            gg(3)=zj*fac
+C Calculate angular part of the gradient.
+            call sc_grad
+          enddo      ! j
+        enddo        ! iint
+      enddo          ! i
+      end
+C-----------------------------------------------------------------------------
+      subroutine sc_angular
+C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
+C om12. Called by ebp, egb, and egbv.
+      implicit none
+      include 'COMMON.CALC'
+      include 'COMMON.IOUNITS'
+      erij(1)=xj*rij
+      erij(2)=yj*rij
+      erij(3)=zj*rij
+      om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
+      om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
+      om12=dxi*dxj+dyi*dyj+dzi*dzj
+      chiom12=chi12*om12
+C Calculate eps1(om12) and its derivative in om12
+      faceps1=1.0D0-om12*chiom12
+      faceps1_inv=1.0D0/faceps1
+      eps1=dsqrt(faceps1_inv)
+C Following variable is eps1*deps1/dom12
+      eps1_om12=faceps1_inv*chiom12
+c diagnostics only
+c      faceps1_inv=om12
+c      eps1=om12
+c      eps1_om12=1.0d0
+c      write (iout,*) "om12",om12," eps1",eps1
+C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
+C and om12.
+      om1om2=om1*om2
+      chiom1=chi1*om1
+      chiom2=chi2*om2
+      facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
+      sigsq=1.0D0-facsig*faceps1_inv
+      sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
+      sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
+      sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
+c diagnostics only
+c      sigsq=1.0d0
+c      sigsq_om1=0.0d0
+c      sigsq_om2=0.0d0
+c      sigsq_om12=0.0d0
+c      write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
+c      write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
+c     &    " eps1",eps1
+C Calculate eps2 and its derivatives in om1, om2, and om12.
+      chipom1=chip1*om1
+      chipom2=chip2*om2
+      chipom12=chip12*om12
+      facp=1.0D0-om12*chipom12
+      facp_inv=1.0D0/facp
+      facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
+c      write (iout,*) "chipom1",chipom1," chipom2",chipom2,
+c     &  " chipom12",chipom12," facp",facp," facp_inv",facp_inv
+C Following variable is the square root of eps2
+      eps2rt=1.0D0-facp1*facp_inv
+C Following three variables are the derivatives of the square root of eps
+C in om1, om2, and om12.
+      eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
+      eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
+      eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2 
+C Evaluate the "asymmetric" factor in the VDW constant, eps3
+      eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12 
+c      write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
+c      write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
+c     &  " eps2rt_om12",eps2rt_om12
+C Calculate whole angle-dependent part of epsilon and contributions
+C to its derivatives
+      return
+      end
+C----------------------------------------------------------------------------
+      subroutine sc_grad
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.CALC'
+      include 'COMMON.IOUNITS'
+      double precision dcosom1(3),dcosom2(3)
+      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
+     &     -2.0D0*alf12*eps3der+sigder*sigsq_om12
+c diagnostics only
+c      eom1=0.0d0
+c      eom2=0.0d0
+c      eom12=evdwij*eps1_om12
+c end diagnostics
+c      write (iout,*) "eps2der",eps2der," eps3der",eps3der,
+c     &  " sigder",sigder
+c      write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
+c      write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
+      do k=1,3
+        dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
+        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)
+      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
+        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
+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))
+c     &            +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+      enddo
+C 
+C Calculate the components of the gradient in DC and X
+C
+cgrad      do k=i,j-1
+cgrad        do l=1,3
+cgrad          gvdwc(l,k)=gvdwc(l,k)+gg(l)
+cgrad        enddo
+cgrad      enddo
+      do l=1,3
+        gvdwc(l,i)=gvdwc(l,i)-gg(l)
+        gvdwc(l,j)=gvdwc(l,j)+gg(l)
+      enddo
+      return
+      end
+C-----------------------------------------------------------------------
+      subroutine e_softsphere(evdw)
+C
+C This subroutine calculates the interaction energy of nonbonded side chains
+C assuming the LJ potential of interaction.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      parameter (accur=1.0d-10)
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.TORSION'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.NAMES'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CONTACTS'
+      dimension gg(3)
+cd    print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
+      evdw=0.0D0
+      do i=iatsc_s,iatsc_e
+        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
+C Calculate SC interaction energy.
+C
+        do iint=1,nint_gr(i)
+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=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
+            rij=xj*xj+yj*yj+zj*zj
+c           write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
+            r0ij=r0(itypi,itypj)
+            r0ijsq=r0ij*r0ij
+c            print *,i,j,r0ij,dsqrt(rij)
+            if (rij.lt.r0ijsq) then
+              evdwij=0.25d0*(rij-r0ijsq)**2
+              fac=rij-r0ijsq
+            else
+              evdwij=0.0d0
+              fac=0.0d0
+            endif
+            evdw=evdw+evdwij
+C 
+C Calculate the components of the gradient in DC and X
+C
+            gg(1)=xj*fac
+            gg(2)=yj*fac
+            gg(3)=zj*fac
+            do k=1,3
+              gvdwx(k,i)=gvdwx(k,i)-gg(k)
+              gvdwx(k,j)=gvdwx(k,j)+gg(k)
+              gvdwc(k,i)=gvdwc(k,i)-gg(k)
+              gvdwc(k,j)=gvdwc(k,j)+gg(k)
+            enddo
+cgrad            do k=i,j-1
+cgrad              do l=1,3
+cgrad                gvdwc(l,k)=gvdwc(l,k)+gg(l)
+cgrad              enddo
+cgrad            enddo
+          enddo ! j
+        enddo ! iint
+      enddo ! i
+      return
+      end
+C--------------------------------------------------------------------------
+      subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
+     &              eello_turn4)
+C
+C Soft-sphere potential of p-p interaction
+C 
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.CONTROL'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VECTORS'
+      include 'COMMON.FFIELD'
+      dimension ggg(3)
+cd      write(iout,*) 'In EELEC_soft_sphere'
+      ees=0.0D0
+      evdw1=0.0D0
+      eel_loc=0.0d0 
+      eello_turn3=0.0d0
+      eello_turn4=0.0d0
+      ind=0
+      do i=iatel_s,iatel_e
+        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
+        num_conti=0
+c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+        do j=ielstart(i),ielend(i)
+          if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
+          ind=ind+1
+          iteli=itel(i)
+          itelj=itel(j)
+          if (j.eq.i+2 .and. itelj.eq.2) iteli=2
+          r0ij=rpp(iteli,itelj)
+          r0ijsq=r0ij*r0ij 
+          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
+          rij=xj*xj+yj*yj+zj*zj
+          if (rij.lt.r0ijsq) then
+            evdw1ij=0.25d0*(rij-r0ijsq)**2
+            fac=rij-r0ijsq
+          else
+            evdw1ij=0.0d0
+            fac=0.0d0
+          endif
+          evdw1=evdw1+evdw1ij
+C
+C Calculate contributions to the Cartesian gradient.
+C
+          ggg(1)=fac*xj
+          ggg(2)=fac*yj
+          ggg(3)=fac*zj
+          do k=1,3
+            gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+            gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
+          enddo
+*
+* Loop over residues i+1 thru j-1.
+*
+cgrad          do k=i+1,j-1
+cgrad            do l=1,3
+cgrad              gelc(l,k)=gelc(l,k)+ggg(l)
+cgrad            enddo
+cgrad          enddo
+        enddo ! j
+      enddo   ! i
+cgrad      do i=nnt,nct-1
+cgrad        do k=1,3
+cgrad          gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
+cgrad        enddo
+cgrad        do j=i+1,nct-1
+cgrad          do k=1,3
+cgrad            gelc(k,i)=gelc(k,i)+gelc(k,j)
+cgrad          enddo
+cgrad        enddo
+cgrad      enddo
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine vec_and_deriv
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+#ifdef MPI
+      include 'mpif.h'
+#endif
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VECTORS'
+      include 'COMMON.SETUP'
+      include 'COMMON.TIME1'
+      dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
+C Compute the local reference systems. For reference system (i), the
+C X-axis points from CA(i) to CA(i+1), the Y axis is in the 
+C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
+#ifdef PARVEC
+      do i=ivec_start,ivec_end
+#else
+      do i=1,nres-1
+#endif
+          if (i.eq.nres-1) then
+C Case of the last full residue
+C Compute the Z-axis
+            call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
+            costh=dcos(pi-theta(nres))
+            fac=1.0d0/dsqrt(1.0d0-costh*costh)
+            do k=1,3
+              uz(k,i)=fac*uz(k,i)
+            enddo
+C Compute the derivatives of uz
+            uzder(1,1,1)= 0.0d0
+            uzder(2,1,1)=-dc_norm(3,i-1)
+            uzder(3,1,1)= dc_norm(2,i-1) 
+            uzder(1,2,1)= dc_norm(3,i-1)
+            uzder(2,2,1)= 0.0d0
+            uzder(3,2,1)=-dc_norm(1,i-1)
+            uzder(1,3,1)=-dc_norm(2,i-1)
+            uzder(2,3,1)= dc_norm(1,i-1)
+            uzder(3,3,1)= 0.0d0
+            uzder(1,1,2)= 0.0d0
+            uzder(2,1,2)= dc_norm(3,i)
+            uzder(3,1,2)=-dc_norm(2,i) 
+            uzder(1,2,2)=-dc_norm(3,i)
+            uzder(2,2,2)= 0.0d0
+            uzder(3,2,2)= dc_norm(1,i)
+            uzder(1,3,2)= dc_norm(2,i)
+            uzder(2,3,2)=-dc_norm(1,i)
+            uzder(3,3,2)= 0.0d0
+C Compute the Y-axis
+            facy=fac
+            do k=1,3
+              uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
+            enddo
+C Compute the derivatives of uy
+            do j=1,3
+              do k=1,3
+                uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
+     &                        -dc_norm(k,i)*dc_norm(j,i-1)
+                uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
+              enddo
+              uyder(j,j,1)=uyder(j,j,1)-costh
+              uyder(j,j,2)=1.0d0+uyder(j,j,2)
+            enddo
+            do j=1,2
+              do k=1,3
+                do l=1,3
+                  uygrad(l,k,j,i)=uyder(l,k,j)
+                  uzgrad(l,k,j,i)=uzder(l,k,j)
+                enddo
+              enddo
+            enddo 
+            call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
+            call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
+            call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
+            call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
+          else
+C Other residues
+C Compute the Z-axis
+            call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
+            costh=dcos(pi-theta(i+2))
+            fac=1.0d0/dsqrt(1.0d0-costh*costh)
+            do k=1,3
+              uz(k,i)=fac*uz(k,i)
+            enddo
+C Compute the derivatives of uz
+            uzder(1,1,1)= 0.0d0
+            uzder(2,1,1)=-dc_norm(3,i+1)
+            uzder(3,1,1)= dc_norm(2,i+1) 
+            uzder(1,2,1)= dc_norm(3,i+1)
+            uzder(2,2,1)= 0.0d0
+            uzder(3,2,1)=-dc_norm(1,i+1)
+            uzder(1,3,1)=-dc_norm(2,i+1)
+            uzder(2,3,1)= dc_norm(1,i+1)
+            uzder(3,3,1)= 0.0d0
+            uzder(1,1,2)= 0.0d0
+            uzder(2,1,2)= dc_norm(3,i)
+            uzder(3,1,2)=-dc_norm(2,i) 
+            uzder(1,2,2)=-dc_norm(3,i)
+            uzder(2,2,2)= 0.0d0
+            uzder(3,2,2)= dc_norm(1,i)
+            uzder(1,3,2)= dc_norm(2,i)
+            uzder(2,3,2)=-dc_norm(1,i)
+            uzder(3,3,2)= 0.0d0
+C Compute the Y-axis
+            facy=fac
+            do k=1,3
+              uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
+            enddo
+C Compute the derivatives of uy
+            do j=1,3
+              do k=1,3
+                uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
+     &                        -dc_norm(k,i)*dc_norm(j,i+1)
+                uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
+              enddo
+              uyder(j,j,1)=uyder(j,j,1)-costh
+              uyder(j,j,2)=1.0d0+uyder(j,j,2)
+            enddo
+            do j=1,2
+              do k=1,3
+                do l=1,3
+                  uygrad(l,k,j,i)=uyder(l,k,j)
+                  uzgrad(l,k,j,i)=uzder(l,k,j)
+                enddo
+              enddo
+            enddo 
+            call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
+            call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
+            call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
+            call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
+          endif
+      enddo
+      do i=1,nres-1
+        vbld_inv_temp(1)=vbld_inv(i+1)
+        if (i.lt.nres-1) then
+          vbld_inv_temp(2)=vbld_inv(i+2)
+          else
+          vbld_inv_temp(2)=vbld_inv(i)
+          endif
+        do j=1,2
+          do k=1,3
+            do l=1,3
+              uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
+              uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
+            enddo
+          enddo
+        enddo
+      enddo
+#if defined(PARVEC) && defined(MPI)
+      if (nfgtasks1.gt.1) then
+        time00=MPI_Wtime()
+c        print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
+c     &   " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
+c     &   " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
+        call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
+     &   ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
+     &   ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
+        call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
+     &   ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
+     &   ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
+        time_gather=time_gather+MPI_Wtime()-time00
+      endif
+c      if (fg_rank.eq.0) then
+c        write (iout,*) "Arrays UY and UZ"
+c        do i=1,nres-1
+c          write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
+c     &     (uz(k,i),k=1,3)
+c        enddo
+c      endif
+#endif
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine check_vecgrad
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VECTORS'
+      dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
+      dimension uyt(3,maxres),uzt(3,maxres)
+      dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
+      double precision delta /1.0d-7/
+      call vec_and_deriv
+cd      do i=1,nres
+crc          write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
+crc          write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
+crc          write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
+cd          write(iout,'(2i5,2(3f10.5,5x))') i,1,
+cd     &     (dc_norm(if90,i),if90=1,3)
+cd          write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
+cd          write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
+cd          write(iout,'(a)')
+cd      enddo
+      do i=1,nres
+        do j=1,2
+          do k=1,3
+            do l=1,3
+              uygradt(l,k,j,i)=uygrad(l,k,j,i)
+              uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
+            enddo
+          enddo
+        enddo
+      enddo
+      call vec_and_deriv
+      do i=1,nres
+        do j=1,3
+          uyt(j,i)=uy(j,i)
+          uzt(j,i)=uz(j,i)
+        enddo
+      enddo
+      do i=1,nres
+cd        write (iout,*) 'i=',i
+        do k=1,3
+          erij(k)=dc_norm(k,i)
+        enddo
+        do j=1,3
+          do k=1,3
+            dc_norm(k,i)=erij(k)
+          enddo
+          dc_norm(j,i)=dc_norm(j,i)+delta
+c          fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
+c          do k=1,3
+c            dc_norm(k,i)=dc_norm(k,i)/fac
+c          enddo
+c          write (iout,*) (dc_norm(k,i),k=1,3)
+c          write (iout,*) (erij(k),k=1,3)
+          call vec_and_deriv
+          do k=1,3
+            uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
+            uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
+            uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
+            uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
+          enddo 
+c          write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') 
+c     &      j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
+c     &      (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
+        enddo
+        do k=1,3
+          dc_norm(k,i)=erij(k)
+        enddo
+cd        do k=1,3
+cd          write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') 
+cd     &      k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
+cd     &      (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
+cd          write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') 
+cd     &      k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
+cd     &      (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
+cd          write (iout,'(a)')
+cd        enddo
+      enddo
+      return
+      end
+C--------------------------------------------------------------------------
+      subroutine set_matrices
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+#ifdef MPI
+      include "mpif.h"
+      include "COMMON.SETUP"
+      integer IERR
+      integer status(MPI_STATUS_SIZE)
+#endif
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VECTORS'
+      include 'COMMON.FFIELD'
+      double precision auxvec(2),auxmat(2,2)
+C
+C Compute the virtual-bond-torsional-angle dependent quantities needed
+C to calculate the el-loc multibody terms of various order.
+C
+c      write(iout,*) 'nphi=',nphi,nres
+#ifdef PARMAT
+      do i=ivec_start+2,ivec_end+2
+#else
+      do i=3,nres+1
+#endif
+#ifdef NEWCORR
+        if (i.gt. nnt+2 .and. i.lt.nct+2) then
+          iti = itortyp(itype(i-2))
+        else
+          iti=ntortyp+1
+        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
+        endif
+c        write(iout,*),i
+        b1(1,i-2)=bnew1(1,1,iti)*sin(theta(i-1)/2.0)
+     &           +bnew1(2,1,iti)*sin(theta(i-1))
+     &           +bnew1(3,1,iti)*cos(theta(i-1)/2.0)
+        gtb1(1,i-2)=bnew1(1,1,iti)*cos(theta(i-1)/2.0)/2.0
+     &             +bnew1(2,1,iti)*cos(theta(i-1))
+     &             -bnew1(3,1,iti)*sin(theta(i-1)/2.0)/2.0
+c     &           +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
+c     &*(cos(theta(i)/2.0)
+        b2(1,i-2)=bnew2(1,1,iti)*sin(theta(i-1)/2.0)
+     &           +bnew2(2,1,iti)*sin(theta(i-1))
+     &           +bnew2(3,1,iti)*cos(theta(i-1)/2.0)
+c     &           +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
+c     &*(cos(theta(i)/2.0)
+        gtb2(1,i-2)=bnew2(1,1,iti)*cos(theta(i-1)/2.0)/2.0
+     &             +bnew2(2,1,iti)*cos(theta(i-1))
+     &             -bnew2(3,1,iti)*sin(theta(i-1)/2.0)/2.0
+c        if (ggb1(1,i).eq.0.0d0) then
+c        write(iout,*) 'i=',i,ggb1(1,i),
+c     &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
+c     &bnew1(2,1,iti)*cos(theta(i)),
+c     &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
+c        endif
+        b1(2,i-2)=bnew1(1,2,iti)
+        gtb1(2,i-2)=0.0
+        b2(2,i-2)=bnew2(1,2,iti)
+        gtb2(2,i-2)=0.0
+        EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
+        EE(1,2,i-2)=eeold(1,2,iti)
+        EE(2,1,i-2)=eeold(2,1,iti)
+        EE(2,2,i-2)=eeold(2,2,iti)
+        gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
+        gtEE(1,2,i-2)=0.0d0
+        gtEE(2,2,i-2)=0.0d0
+        gtEE(2,1,i-2)=0.0d0
+c        EE(2,2,iti)=0.0d0
+c        EE(1,2,iti)=0.5d0*eenew(1,iti)
+c        EE(2,1,iti)=0.5d0*eenew(1,iti)
+c        b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
+c        b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
+       b1tilde(1,i-2)=b1(1,i-2)
+       b1tilde(2,i-2)=-b1(2,i-2)
+       b2tilde(1,i-2)=b2(1,i-2)
+       b2tilde(2,i-2)=-b2(2,i-2)
+c       write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
+c       write (iout,*) 'theta=', theta(i-1)
+       enddo
+#ifdef PARMAT
+      do i=ivec_start+2,ivec_end+2
+#else
+      do i=3,nres+1
+#endif
+#endif
+        if (i .lt. nres+1) then
+          sin1=dsin(phi(i))
+          cos1=dcos(phi(i))
+          sintab(i-2)=sin1
+          costab(i-2)=cos1
+          obrot(1,i-2)=cos1
+          obrot(2,i-2)=sin1
+          sin2=dsin(2*phi(i))
+          cos2=dcos(2*phi(i))
+          sintab2(i-2)=sin2
+          costab2(i-2)=cos2
+          obrot2(1,i-2)=cos2
+          obrot2(2,i-2)=sin2
+          Ug(1,1,i-2)=-cos1
+          Ug(1,2,i-2)=-sin1
+          Ug(2,1,i-2)=-sin1
+          Ug(2,2,i-2)= cos1
+          Ug2(1,1,i-2)=-cos2
+          Ug2(1,2,i-2)=-sin2
+          Ug2(2,1,i-2)=-sin2
+          Ug2(2,2,i-2)= cos2
+        else
+          costab(i-2)=1.0d0
+          sintab(i-2)=0.0d0
+          obrot(1,i-2)=1.0d0
+          obrot(2,i-2)=0.0d0
+          obrot2(1,i-2)=0.0d0
+          obrot2(2,i-2)=0.0d0
+          Ug(1,1,i-2)=1.0d0
+          Ug(1,2,i-2)=0.0d0
+          Ug(2,1,i-2)=0.0d0
+          Ug(2,2,i-2)=1.0d0
+          Ug2(1,1,i-2)=0.0d0
+          Ug2(1,2,i-2)=0.0d0
+          Ug2(2,1,i-2)=0.0d0
+          Ug2(2,2,i-2)=0.0d0
+        endif
+        if (i .gt. 3 .and. i .lt. nres+1) then
+          obrot_der(1,i-2)=-sin1
+          obrot_der(2,i-2)= cos1
+          Ugder(1,1,i-2)= sin1
+          Ugder(1,2,i-2)=-cos1
+          Ugder(2,1,i-2)=-cos1
+          Ugder(2,2,i-2)=-sin1
+          dwacos2=cos2+cos2
+          dwasin2=sin2+sin2
+          obrot2_der(1,i-2)=-dwasin2
+          obrot2_der(2,i-2)= dwacos2
+          Ug2der(1,1,i-2)= dwasin2
+          Ug2der(1,2,i-2)=-dwacos2
+          Ug2der(2,1,i-2)=-dwacos2
+          Ug2der(2,2,i-2)=-dwasin2
+        else
+          obrot_der(1,i-2)=0.0d0
+          obrot_der(2,i-2)=0.0d0
+          Ugder(1,1,i-2)=0.0d0
+          Ugder(1,2,i-2)=0.0d0
+          Ugder(2,1,i-2)=0.0d0
+          Ugder(2,2,i-2)=0.0d0
+          obrot2_der(1,i-2)=0.0d0
+          obrot2_der(2,i-2)=0.0d0
+          Ug2der(1,1,i-2)=0.0d0
+          Ug2der(1,2,i-2)=0.0d0
+          Ug2der(2,1,i-2)=0.0d0
+          Ug2der(2,2,i-2)=0.0d0
+        endif
+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
+        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
+        endif
+cd        write (iout,*) '*******i',i,' iti1',iti
+cd        write (iout,*) 'b1',b1(:,iti)
+cd        write (iout,*) 'b2',b2(:,iti)
+cd        write (iout,*) 'Ug',Ug(:,:,i-2)
+c        if (i .gt. iatel_s+2) then
+        if (i .gt. nnt+2) then
+          call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
+#ifdef NEWCORR
+          call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
+c          write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
+#endif
+c          write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
+c     &    EE(1,2,iti),EE(2,2,iti)
+          call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
+          call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
+c          write(iout,*) "Macierz EUG",
+c     &    eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
+c     &    eug(2,2,i-2)
+          if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) 
+     &    then
+          call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
+          call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
+          call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
+          call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
+          call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
+          endif
+        else
+          do k=1,2
+            Ub2(k,i-2)=0.0d0
+            Ctobr(k,i-2)=0.0d0 
+            Dtobr2(k,i-2)=0.0d0
+            do l=1,2
+              EUg(l,k,i-2)=0.0d0
+              CUg(l,k,i-2)=0.0d0
+              DUg(l,k,i-2)=0.0d0
+              DtUg2(l,k,i-2)=0.0d0
+            enddo
+          enddo
+        endif
+        call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
+        call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
+        do k=1,2
+          muder(k,i-2)=Ub2der(k,i-2)
+        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
+          if (itype(i-1).le.ntyp) then
+            iti1 = itortyp(itype(i-1))
+          else
+            iti1=ntortyp+1
+          endif
+        else
+          iti1=ntortyp+1
+        endif
+        do k=1,2
+          mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
+        enddo
+#ifdef MUOUT
+        write (iout,'(2hmu,i3,3f8.1,7f10.5)') i-2,rad2deg*theta(i-1),
+     &     rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
+     &       -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
+     &       dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
+     &      +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2)
+#endif
+cd        write (iout,*) 'mu ',mu(:,i-2)
+cd        write (iout,*) 'mu1',mu1(:,i-2)
+cd        write (iout,*) 'mu2',mu2(:,i-2)
+        if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
+     &  then  
+        call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
+        call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
+        call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
+        call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
+        call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
+C Vectors and matrices dependent on a single virtual-bond dihedral.
+        call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
+        call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2)) 
+        call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2)) 
+        call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
+        call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
+        call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
+        call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
+        call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
+        call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
+        endif
+      enddo
+C Matrices dependent on two consecutive virtual-bond dihedrals.
+C The order of matrices is from left to right.
+      if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
+     &then
+c      do i=max0(ivec_start,2),ivec_end
+      do i=2,nres-1
+        call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
+        call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
+        call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
+        call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
+        call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
+        call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
+        call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
+        call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
+      enddo
+      endif
+#if defined(MPI) && defined(PARMAT)
+#ifdef DEBUG
+c      if (fg_rank.eq.0) then
+        write (iout,*) "Arrays UG and UGDER before GATHER"
+        do i=1,nres-1
+          write (iout,'(i5,4f10.5,5x,4f10.5)') i,
+     &     ((ug(l,k,i),l=1,2),k=1,2),
+     &     ((ugder(l,k,i),l=1,2),k=1,2)
+        enddo
+        write (iout,*) "Arrays UG2 and UG2DER"
+        do i=1,nres-1
+          write (iout,'(i5,4f10.5,5x,4f10.5)') i,
+     &     ((ug2(l,k,i),l=1,2),k=1,2),
+     &     ((ug2der(l,k,i),l=1,2),k=1,2)
+        enddo
+        write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
+        do i=1,nres-1
+          write (iout,'(i5,4f10.5,5x,4f10.5)') i,
+     &     (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
+     &     (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
+        enddo
+        write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
+        do i=1,nres-1
+          write (iout,'(i5,4f10.5,5x,4f10.5)') i,
+     &     costab(i),sintab(i),costab2(i),sintab2(i)
+        enddo
+        write (iout,*) "Array MUDER"
+        do i=1,nres-1
+          write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
+        enddo
+c      endif
+#endif
+      if (nfgtasks.gt.1) then
+        time00=MPI_Wtime()
+c        write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
+c     &   " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
+c     &   " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
+#ifdef MATGATHER
+        call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
+     &   MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
+     &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
+        call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
+     &   MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
+     &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
+        call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
+     &   MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
+     &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
+        call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
+     &   MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
+     &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
+        if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
+     &  then
+        call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+       call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
+     &   ivec_count(fg_rank1),
+     &   MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
+     &   ivec_count(fg_rank1),
+     &   MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+       call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+       call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
+     &   MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
+     &   ivec_count(fg_rank1),
+     &   MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
+     &   ivec_count(fg_rank1),
+     &   MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
+     &   FG_COMM1,IERR)
+        call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
+     &   ivec_count(fg_rank1),
+     &   MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
+     &   MPI_MAT2,FG_COMM1,IERR)
+        call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
+     &   ivec_count(fg_rank1),
+     &   MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
+     &   MPI_MAT2,FG_COMM1,IERR)
+        endif
+#else
+c Passes matrix info through the ring
+      isend=fg_rank1
+      irecv=fg_rank1-1
+      if (irecv.lt.0) irecv=nfgtasks1-1 
+      iprev=irecv
+      inext=fg_rank1+1
+      if (inext.ge.nfgtasks1) inext=0
+      do i=1,nfgtasks1-1
+c        write (iout,*) "isend",isend," irecv",irecv
+c        call flush(iout)
+        lensend=lentyp(isend)
+        lenrecv=lentyp(irecv)
+c        write (iout,*) "lensend",lensend," lenrecv",lenrecv
+c        call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
+c     &   MPI_ROTAT1(lensend),inext,2200+isend,
+c     &   ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
+c     &   iprev,2200+irecv,FG_COMM,status,IERR)
+c        write (iout,*) "Gather ROTAT1"
+c        call flush(iout)
+c        call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
+c     &   MPI_ROTAT2(lensend),inext,3300+isend,
+c     &   obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
+c     &   iprev,3300+irecv,FG_COMM,status,IERR)
+c        write (iout,*) "Gather ROTAT2"
+c        call flush(iout)
+        call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
+     &   MPI_ROTAT_OLD(lensend),inext,4400+isend,
+     &   costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
+     &   iprev,4400+irecv,FG_COMM,status,IERR)
+c        write (iout,*) "Gather ROTAT_OLD"
+c        call flush(iout)
+        call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
+     &   MPI_PRECOMP11(lensend),inext,5500+isend,
+     &   mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
+     &   iprev,5500+irecv,FG_COMM,status,IERR)
+c        write (iout,*) "Gather PRECOMP11"
+c        call flush(iout)
+        call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
+     &   MPI_PRECOMP12(lensend),inext,6600+isend,
+     &   Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
+     &   iprev,6600+irecv,FG_COMM,status,IERR)
+c        write (iout,*) "Gather PRECOMP12"
+c        call flush(iout)
+        if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) 
+     &  then
+        call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
+     &   MPI_ROTAT2(lensend),inext,7700+isend,
+     &   ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
+     &   iprev,7700+irecv,FG_COMM,status,IERR)
+c        write (iout,*) "Gather PRECOMP21"
+c        call flush(iout)
+        call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
+     &   MPI_PRECOMP22(lensend),inext,8800+isend,
+     &   EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
+     &   iprev,8800+irecv,FG_COMM,status,IERR)
+c        write (iout,*) "Gather PRECOMP22"
+c        call flush(iout)
+        call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
+     &   MPI_PRECOMP23(lensend),inext,9900+isend,
+     &   Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
+     &   MPI_PRECOMP23(lenrecv),
+     &   iprev,9900+irecv,FG_COMM,status,IERR)
+c        write (iout,*) "Gather PRECOMP23"
+c        call flush(iout)
+        endif
+        isend=irecv
+        irecv=irecv-1
+        if (irecv.lt.0) irecv=nfgtasks1-1
+      enddo
+#endif
+        time_gather=time_gather+MPI_Wtime()-time00
+      endif
+#ifdef DEBUG
+c      if (fg_rank.eq.0) then
+        write (iout,*) "Arrays UG and UGDER"
+        do i=1,nres-1
+          write (iout,'(i5,4f10.5,5x,4f10.5)') i,
+     &     ((ug(l,k,i),l=1,2),k=1,2),
+     &     ((ugder(l,k,i),l=1,2),k=1,2)
+        enddo
+        write (iout,*) "Arrays UG2 and UG2DER"
+        do i=1,nres-1
+          write (iout,'(i5,4f10.5,5x,4f10.5)') i,
+     &     ((ug2(l,k,i),l=1,2),k=1,2),
+     &     ((ug2der(l,k,i),l=1,2),k=1,2)
+        enddo
+        write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
+        do i=1,nres-1
+          write (iout,'(i5,4f10.5,5x,4f10.5)') i,
+     &     (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
+     &     (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
+        enddo
+        write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
+        do i=1,nres-1
+          write (iout,'(i5,4f10.5,5x,4f10.5)') i,
+     &     costab(i),sintab(i),costab2(i),sintab2(i)
+        enddo
+        write (iout,*) "Array MUDER"
+        do i=1,nres-1
+          write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
+        enddo
+c      endif
+#endif
+#endif
+cd      do i=1,nres
+cd        iti = itortyp(itype(i))
+cd        write (iout,*) i
+cd        do j=1,2
+cd        write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)') 
+cd     &  (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
+cd        enddo
+cd      enddo
+      return
+      end
+C--------------------------------------------------------------------------
+      subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
+C
+C This subroutine calculates the average interaction energy and its gradient
+C in the virtual-bond vectors between non-adjacent peptide groups, based on 
+C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715. 
+C The potential depends both on the distance of peptide-group centers and on 
+C the orientation of the CA-CA virtual bonds.
+C 
+      implicit real*8 (a-h,o-z)
+#ifdef MPI
+      include 'mpif.h'
+#endif
+      include 'DIMENSIONS'
+      include 'COMMON.CONTROL'
+      include 'COMMON.SETUP'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VECTORS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.TIME1'
+      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),
+     &    aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
+      common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
+     &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
+     &    num_conti,j1,j2
+c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
+#ifdef MOMENT
+      double precision scal_el /1.0d0/
+#else
+      double precision scal_el /0.5d0/
+#endif
+C 12/13/98 
+C 13-go grudnia roku pamietnego... 
+      double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
+     &                   0.0d0,1.0d0,0.0d0,
+     &                   0.0d0,0.0d0,1.0d0/
+cd      write(iout,*) 'In EELEC'
+cd      do i=1,nloctyp
+cd        write(iout,*) 'Type',i
+cd        write(iout,*) 'B1',B1(:,i)
+cd        write(iout,*) 'B2',B2(:,i)
+cd        write(iout,*) 'CC',CC(:,:,i)
+cd        write(iout,*) 'DD',DD(:,:,i)
+cd        write(iout,*) 'EE',EE(:,:,i)
+cd      enddo
+cd      call check_vecgrad
+cd      stop
+      if (icheckgrad.eq.1) then
+        do i=1,nres-1
+          fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
+          do k=1,3
+            dc_norm(k,i)=dc(k,i)*fac
+          enddo
+c          write (iout,*) 'i',i,' fac',fac
+        enddo
+      endif
+      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
+c        call vec_and_deriv
+#ifdef TIMING
+        time01=MPI_Wtime()
+#endif
+        call set_matrices
+#ifdef TIMING
+        time_mat=time_mat+MPI_Wtime()-time01
+#endif
+      endif
+cd      do i=1,nres-1
+cd        write (iout,*) 'i=',i
+cd        do k=1,3
+cd        write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
+cd        enddo
+cd        do k=1,3
+cd          write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') 
+cd     &     uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
+cd        enddo
+cd      enddo
+      t_eelecij=0.0d0
+      ees=0.0D0
+      evdw1=0.0D0
+      eel_loc=0.0d0 
+      eello_turn3=0.0d0
+      eello_turn4=0.0d0
+      ind=0
+      do i=1,nres
+        num_cont_hb(i)=0
+      enddo
+cd      print '(a)','Enter EELEC'
+cd      write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
+      do i=1,nres
+        gel_loc_loc(i)=0.0d0
+        gcorr_loc(i)=0.0d0
+      enddo
+c
+c
+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
+      do i=iturn3_start,iturn3_end
+        if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+     &  .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
+        dxi=dc(1,i)
+        dyi=dc(2,i)
+        dzi=dc(3,i)
+        dx_normi=dc_norm(1,i)
+        dy_normi=dc_norm(2,i)
+        dz_normi=dc_norm(3,i)
+        xmedi=c(1,i)+0.5d0*dxi
+        ymedi=c(2,i)+0.5d0*dyi
+        zmedi=c(3,i)+0.5d0*dzi
+        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.ntyp1 .or. itype(i+1).eq.ntyp1
+     &    .or. itype(i+3).eq.ntyp1
+     &    .or. itype(i+4).eq.ntyp1) cycle
+        dxi=dc(1,i)
+        dyi=dc(2,i)
+        dzi=dc(3,i)
+        dx_normi=dc_norm(1,i)
+        dy_normi=dc_norm(2,i)
+        dz_normi=dc_norm(3,i)
+        xmedi=c(1,i)+0.5d0*dxi
+        ymedi=c(2,i)+0.5d0*dyi
+        zmedi=c(3,i)+0.5d0*dzi
+        num_conti=num_cont_hb(i)
+c        write(iout,*) "JESTEM W PETLI"
+        call eelecij(i,i+3,ees,evdw1,eel_loc)
+        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
+c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
+c
+      do i=iatel_s,iatel_e
+c       do i=7,7
+        if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+        dxi=dc(1,i)
+        dyi=dc(2,i)
+        dzi=dc(3,i)
+        dx_normi=dc_norm(1,i)
+        dy_normi=dc_norm(2,i)
+        dz_normi=dc_norm(3,i)
+        xmedi=c(1,i)+0.5d0*dxi
+        ymedi=c(2,i)+0.5d0*dyi
+        zmedi=c(3,i)+0.5d0*dzi
+c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
+        num_conti=num_cont_hb(i)
+        do j=ielstart(i),ielend(i)
+c         do j=13,13
+c          write (iout,*) 'tu wchodze',i,j,itype(i),itype(j)
+          if (itype(j).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      write (iout,*) "Number of loop steps in EELEC:",ind
+cd      do i=1,nres
+cd        write (iout,'(i3,3f10.5,5x,3f10.5)') 
+cd     &     i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
+cd      enddo
+c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
+ccc      eel_loc=eel_loc+eello_turn3
+cd      print *,"Processor",fg_rank," t_eelecij",t_eelecij
+      return
+      end
+C-------------------------------------------------------------------------------
+      subroutine eelecij(i,j,ees,evdw1,eel_loc)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+#ifdef MPI
+      include "mpif.h"
+#endif
+      include 'COMMON.CONTROL'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VECTORS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.TIME1'
+      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),
+     &    aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
+     &    gmuij2(4),gmuji2(4)
+      common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
+     &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
+     &    num_conti,j1,j2
+c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
+#ifdef MOMENT
+      double precision scal_el /1.0d0/
+#else
+      double precision scal_el /0.5d0/
+#endif
+C 12/13/98 
+C 13-go grudnia roku pamietnego... 
+      double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
+     &                   0.0d0,1.0d0,0.0d0,
+     &                   0.0d0,0.0d0,1.0d0/
+c          time00=MPI_Wtime()
+cd      write (iout,*) "eelecij",i,j
+c          ind=ind+1
+          iteli=itel(i)
+          itelj=itel(j)
+          if (j.eq.i+2 .and. itelj.eq.2) iteli=2
+          aaa=app(iteli,itelj)
+          bbb=bpp(iteli,itelj)
+          ael6i=ael6(iteli,itelj)
+          ael3i=ael3(iteli,itelj) 
+          dxj=dc(1,j)
+          dyj=dc(2,j)
+          dzj=dc(3,j)
+          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
+          rij=xj*xj+yj*yj+zj*zj
+          rrmij=1.0D0/rij
+          rij=dsqrt(rij)
+          rmij=1.0D0/rij
+          r3ij=rrmij*rmij
+          r6ij=r3ij*r3ij  
+          cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
+          cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
+          cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
+          fac=cosa-3.0D0*cosb*cosg
+          ev1=aaa*r6ij*r6ij
+c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
+          if (j.eq.i+2) ev1=scal_el*ev1
+          ev2=bbb*r6ij
+          fac3=ael6i*r6ij
+          fac4=ael3i*r3ij
+          evdwij=ev1+ev2
+          el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
+          el2=fac4*fac       
+          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
+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,2i5,2e11.3)') 
+     &'evdw1',i,j,evdwij
+     &,iteli,itelj,aaa,evdw1
+              write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
+          endif
+
+C
+C Calculate contributions to the Cartesian gradient.
+C
+#ifdef SPLITELE
+          facvdw=-6*rrmij*(ev1+evdwij)
+          facel=-3*rrmij*(el1+eesij)
+          fac1=fac
+          erij(1)=xj*rmij
+          erij(2)=yj*rmij
+          erij(3)=zj*rmij
+*
+* Radial derivatives. First process both termini of the fragment (i,j)
+*
+          ggg(1)=facel*xj
+          ggg(2)=facel*yj
+          ggg(3)=facel*zj
+c          do k=1,3
+c            ghalf=0.5D0*ggg(k)
+c            gelc(k,i)=gelc(k,i)+ghalf
+c            gelc(k,j)=gelc(k,j)+ghalf
+c          enddo
+c 9/28/08 AL Gradient compotents will be summed only at the end
+          do k=1,3
+            gelc_long(k,j)=gelc_long(k,j)+ggg(k)
+            gelc_long(k,i)=gelc_long(k,i)-ggg(k)
+          enddo
+*
+* Loop over residues i+1 thru j-1.
+*
+cgrad          do k=i+1,j-1
+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
+c          do k=1,3
+c            ghalf=0.5D0*ggg(k)
+c            gvdwpp(k,i)=gvdwpp(k,i)+ghalf
+c            gvdwpp(k,j)=gvdwpp(k,j)+ghalf
+c          enddo
+c 9/28/08 AL Gradient compotents will be summed only at the end
+          do k=1,3
+            gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
+            gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+          enddo
+*
+* Loop over residues i+1 thru j-1.
+*
+cgrad          do k=i+1,j-1
+cgrad            do l=1,3
+cgrad              gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
+cgrad            enddo
+cgrad          enddo
+#else
+          facvdw=ev1+evdwij 
+          facel=el1+eesij  
+          fac1=fac
+          fac=-3*rrmij*(facvdw+facvdw+facel)
+          erij(1)=xj*rmij
+          erij(2)=yj*rmij
+          erij(3)=zj*rmij
+*
+* Radial derivatives. First process both termini of the fragment (i,j)
+* 
+          ggg(1)=fac*xj
+          ggg(2)=fac*yj
+          ggg(3)=fac*zj
+c          do k=1,3
+c            ghalf=0.5D0*ggg(k)
+c            gelc(k,i)=gelc(k,i)+ghalf
+c            gelc(k,j)=gelc(k,j)+ghalf
+c          enddo
+c 9/28/08 AL Gradient compotents will be summed only at the end
+          do k=1,3
+            gelc_long(k,j)=gelc(k,j)+ggg(k)
+            gelc_long(k,i)=gelc(k,i)-ggg(k)
+          enddo
+*
+* Loop over residues i+1 thru j-1.
+*
+cgrad          do k=i+1,j-1
+cgrad            do l=1,3
+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
+          do k=1,3
+            gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
+            gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
+          enddo
+#endif
+*
+* Angular part
+*          
+          ecosa=2.0D0*fac3*fac1+fac4
+          fac4=-3.0D0*fac4
+          fac3=-6.0D0*fac3
+          ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
+          ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
+          do k=1,3
+            dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
+            dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
+          enddo
+cd        print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
+cd   &          (dcosg(k),k=1,3)
+          do k=1,3
+            ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) 
+          enddo
+c          do k=1,3
+c            ghalf=0.5D0*ggg(k)
+c            gelc(k,i)=gelc(k,i)+ghalf
+c     &               +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
+c     &               + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
+c            gelc(k,j)=gelc(k,j)+ghalf
+c     &               +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
+c     &               + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
+c          enddo
+cgrad          do k=i+1,j-1
+cgrad            do l=1,3
+cgrad              gelc(l,k)=gelc(l,k)+ggg(l)
+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)
+            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)
+            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
+C
+C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction 
+C   energy of a peptide unit is assumed in the form of a second-order 
+C   Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
+C   Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
+C   are computed for EVERY pair of non-contiguous peptide groups.
+C
+
+          if (j.lt.nres-1) then
+            j1=j+1
+            j2=j-1
+          else
+            j1=j-1
+            j2=j-2
+          endif
+          kkk=0
+          lll=0
+          do k=1,2
+            do l=1,2
+              kkk=kkk+1
+              muij(kkk)=mu(k,i)*mu(l,j)
+#ifdef NEWCORR
+             gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
+c             write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(k,i),k,i
+             gmuij2(kkk)=gUb2(k,i)*mu(l,j)
+             gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
+c             write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(l,j),l,j
+             gmuji2(kkk)=mu(k,i)*gUb2(l,j)
+#endif
+            enddo
+          enddo  
+cd         write (iout,*) 'EELEC: i',i,' j',j
+cd          write (iout,*) 'j',j,' j1',j1,' j2',j2
+cd          write(iout,*) 'muij',muij
+          ury=scalar(uy(1,i),erij)
+          urz=scalar(uz(1,i),erij)
+          vry=scalar(uy(1,j),erij)
+          vrz=scalar(uz(1,j),erij)
+          a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
+          a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
+          a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
+          a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
+          fac=dsqrt(-ael6i)*r3ij
+          a22=a22*fac
+          a23=a23*fac
+          a32=a32*fac
+          a33=a33*fac
+cd          write (iout,'(4i5,4f10.5)')
+cd     &     i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
+cd          write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
+cd          write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
+cd     &      uy(:,j),uz(:,j)
+cd          write (iout,'(4f10.5)') 
+cd     &      scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
+cd     &      scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
+cd          write (iout,'(4f10.5)') ury,urz,vry,vrz
+cd           write (iout,'(9f10.5/)') 
+cd     &      fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
+C Derivatives of the elements of A in virtual-bond vectors
+          call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
+          do k=1,3
+            uryg(k,1)=scalar(erder(1,k),uy(1,i))
+            uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
+            uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
+            urzg(k,1)=scalar(erder(1,k),uz(1,i))
+            urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
+            urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
+            vryg(k,1)=scalar(erder(1,k),uy(1,j))
+            vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
+            vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
+            vrzg(k,1)=scalar(erder(1,k),uz(1,j))
+            vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
+            vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
+          enddo
+C Compute radial contributions to the gradient
+          facr=-3.0d0*rrmij
+          a22der=a22*facr
+          a23der=a23*facr
+          a32der=a32*facr
+          a33der=a33*facr
+          agg(1,1)=a22der*xj
+          agg(2,1)=a22der*yj
+          agg(3,1)=a22der*zj
+          agg(1,2)=a23der*xj
+          agg(2,2)=a23der*yj
+          agg(3,2)=a23der*zj
+          agg(1,3)=a32der*xj
+          agg(2,3)=a32der*yj
+          agg(3,3)=a32der*zj
+          agg(1,4)=a33der*xj
+          agg(2,4)=a33der*yj
+          agg(3,4)=a33der*zj
+C Add the contributions coming from er
+          fac3=-3.0d0*fac
+          do k=1,3
+            agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
+            agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
+            agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
+            agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
+          enddo
+          do k=1,3
+C Derivatives in DC(i) 
+cgrad            ghalf1=0.5d0*agg(k,1)
+cgrad            ghalf2=0.5d0*agg(k,2)
+cgrad            ghalf3=0.5d0*agg(k,3)
+cgrad            ghalf4=0.5d0*agg(k,4)
+            aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
+     &      -3.0d0*uryg(k,2)*vry)!+ghalf1
+            aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
+     &      -3.0d0*uryg(k,2)*vrz)!+ghalf2
+            aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
+     &      -3.0d0*urzg(k,2)*vry)!+ghalf3
+            aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
+     &      -3.0d0*urzg(k,2)*vrz)!+ghalf4
+C Derivatives in DC(i+1)
+            aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
+     &      -3.0d0*uryg(k,3)*vry)!+agg(k,1)
+            aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
+     &      -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
+            aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
+     &      -3.0d0*urzg(k,3)*vry)!+agg(k,3)
+            aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
+     &      -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
+C Derivatives in DC(j)
+            aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
+     &      -3.0d0*vryg(k,2)*ury)!+ghalf1
+            aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
+     &      -3.0d0*vrzg(k,2)*ury)!+ghalf2
+            aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
+     &      -3.0d0*vryg(k,2)*urz)!+ghalf3
+            aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) 
+     &      -3.0d0*vrzg(k,2)*urz)!+ghalf4
+C Derivatives in DC(j+1) or DC(nres-1)
+            aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
+     &      -3.0d0*vryg(k,3)*ury)
+            aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
+     &      -3.0d0*vrzg(k,3)*ury)
+            aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
+     &      -3.0d0*vryg(k,3)*urz)
+            aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) 
+     &      -3.0d0*vrzg(k,3)*urz)
+cgrad            if (j.eq.nres-1 .and. i.lt.j-2) then
+cgrad              do l=1,4
+cgrad                aggj1(k,l)=aggj1(k,l)+agg(k,l)
+cgrad              enddo
+cgrad            endif
+          enddo
+          acipa(1,1)=a22
+          acipa(1,2)=a23
+          acipa(2,1)=a32
+          acipa(2,2)=a33
+          a22=-a22
+          a23=-a23
+          do l=1,2
+            do k=1,3
+              agg(k,l)=-agg(k,l)
+              aggi(k,l)=-aggi(k,l)
+              aggi1(k,l)=-aggi1(k,l)
+              aggj(k,l)=-aggj(k,l)
+              aggj1(k,l)=-aggj1(k,l)
+            enddo
+          enddo
+          if (j.lt.nres-1) then
+            a22=-a22
+            a32=-a32
+            do l=1,3,2
+              do k=1,3
+                agg(k,l)=-agg(k,l)
+                aggi(k,l)=-aggi(k,l)
+                aggi1(k,l)=-aggi1(k,l)
+                aggj(k,l)=-aggj(k,l)
+                aggj1(k,l)=-aggj1(k,l)
+              enddo
+            enddo
+          else
+            a22=-a22
+            a23=-a23
+            a32=-a32
+            a33=-a33
+            do l=1,4
+              do k=1,3
+                agg(k,l)=-agg(k,l)
+                aggi(k,l)=-aggi(k,l)
+                aggi1(k,l)=-aggi1(k,l)
+                aggj(k,l)=-aggj(k,l)
+                aggj1(k,l)=-aggj1(k,l)
+              enddo
+            enddo 
+          endif    
+          ENDIF ! WCORR
+          IF (wel_loc.gt.0.0d0) THEN
+c           if ((i.eq.8).and.(j.eq.14)) then
+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)
+C Calculate patrial derivative for theta angle
+#ifdef NEWCORR
+         geel_loc_ij=a22*gmuij1(1)
+     &     +a23*gmuij1(2)
+     &     +a32*gmuij1(3)
+     &     +a33*gmuij1(4)         
+c         write(iout,*) "derivative over thatai"
+c         write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
+c     &   a33*gmuij1(4) 
+         gloc(nphi+i,icg)=gloc(nphi+i,icg)+
+     &      geel_loc_ij*wel_loc
+c         write(iout,*) "derivative over thatai-1" 
+c         write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
+c     &   a33*gmuij2(4)
+         geel_loc_ij=a22*gmuij2(1)+a23*gmuij2(2)+a32*gmuij2(3)
+     &     +a33*gmuij2(4)
+         gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
+     &      geel_loc_ij*wel_loc
+         geel_loc_ji=a22*gmuji1(1)+a23*gmuji1(2)+a32*gmuji1(3)
+     &     +a33*gmuji1(4)
+c         write(iout,*) "derivative over thataj" 
+c         write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
+c     &   a33*gmuji1(4)
+
+         gloc(nphi+j,icg)=gloc(nphi+j,icg)+
+     &      geel_loc_ji*wel_loc
+         geel_loc_ji=a22*gmuji2(1)+a23*gmuji2(2)+a32*gmuji2(3)
+     &     +a33*gmuji2(4)
+c         write(iout,*) "derivative over thataj-1"
+c         write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
+c     &   a33*gmuji2(4)
+         gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
+     &      geel_loc_ji*wel_loc
+#endif
+cd          write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
+
+          if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
+     &            'eelloc',i,j,eel_loc_ij
+c              write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
+
+          eel_loc=eel_loc+eel_loc_ij
+C 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)
+          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)
+C 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)
+            gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
+            gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
+cgrad            ghalf=0.5d0*ggg(l)
+cgrad            gel_loc(l,i)=gel_loc(l,i)+ghalf
+cgrad            gel_loc(l,j)=gel_loc(l,j)+ghalf
+          enddo
+cgrad          do k=i+1,j2
+cgrad            do l=1,3
+cgrad              gel_loc(l,k)=gel_loc(l,k)+ggg(l)
+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)
+          enddo
+c          endif
+          ENDIF
+C Change 12/26/95 to calculate four-body contributions to H-bonding energy
+c          if (j.gt.i+1 .and. num_conti.le.maxconts) then
+          if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
+     &       .and. num_conti.le.maxconts) then
+c            write (iout,*) i,j," entered corr"
+C
+C Calculate the contact function. The ith column of the array JCONT will 
+C contain the numbers of atoms that make contacts with the atom I (of numbers
+C greater than I). The arrays FACONT and GACONT will contain the values of
+C the contact function and its derivative.
+c           r0ij=1.02D0*rpp(iteli,itelj)
+c           r0ij=1.11D0*rpp(iteli,itelj)
+            r0ij=2.20D0*rpp(iteli,itelj)
+c           r0ij=1.55D0*rpp(iteli,itelj)
+            call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
+            if (fcont.gt.0.0D0) then
+              num_conti=num_conti+1
+              if (num_conti.gt.maxconts) then
+                write (iout,*) 'WARNING - max. # of contacts exceeded;',
+     &                         ' will skip next contacts for this conf.'
+              else
+                jcont_hb(num_conti,i)=j
+cd                write (iout,*) "i",i," j",j," num_conti",num_conti,
+cd     &           " jcont_hb",jcont_hb(num_conti,i)
+                IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. 
+     &          wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
+C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
+C  terms.
+                d_cont(num_conti,i)=rij
+cd                write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
+C     --- Electrostatic-interaction matrix --- 
+                a_chuj(1,1,num_conti,i)=a22
+                a_chuj(1,2,num_conti,i)=a23
+                a_chuj(2,1,num_conti,i)=a32
+                a_chuj(2,2,num_conti,i)=a33
+C     --- Gradient of rij
+                do kkk=1,3
+                  grij_hb_cont(kkk,num_conti,i)=erij(kkk)
+                enddo
+                kkll=0
+                do k=1,2
+                  do l=1,2
+                    kkll=kkll+1
+                    do m=1,3
+                      a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
+                      a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
+                      a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
+                      a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
+                      a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
+                    enddo
+                  enddo
+                enddo
+                ENDIF
+                IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
+C Calculate contact energies
+                cosa4=4.0D0*cosa
+                wij=cosa-3.0D0*cosb*cosg
+                cosbg1=cosb+cosg
+                cosbg2=cosb-cosg
+c               fac3=dsqrt(-ael6i)/r0ij**3     
+                fac3=dsqrt(-ael6i)*r3ij
+c                 ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
+                ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
+                if (ees0tmp.gt.0) then
+                  ees0pij=dsqrt(ees0tmp)
+                else
+                  ees0pij=0
+                endif
+c                ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
+                ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
+                if (ees0tmp.gt.0) then
+                  ees0mij=dsqrt(ees0tmp)
+                else
+                  ees0mij=0
+                endif
+c               ees0mij=0.0D0
+                ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
+                ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
+C Diagnostics. Comment out or remove after debugging!
+c               ees0p(num_conti,i)=0.5D0*fac3*ees0pij
+c               ees0m(num_conti,i)=0.5D0*fac3*ees0mij
+c               ees0m(num_conti,i)=0.0D0
+C End diagnostics.
+c               write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
+c    & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
+C Angular derivatives of the contact function
+                ees0pij1=fac3/ees0pij 
+                ees0mij1=fac3/ees0mij
+                fac3p=-3.0D0*fac3*rrmij
+                ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
+                ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
+c               ees0mij1=0.0D0
+                ecosa1=       ees0pij1*( 1.0D0+0.5D0*wij)
+                ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
+                ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
+                ecosa2=       ees0mij1*(-1.0D0+0.5D0*wij)
+                ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2) 
+                ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
+                ecosap=ecosa1+ecosa2
+                ecosbp=ecosb1+ecosb2
+                ecosgp=ecosg1+ecosg2
+                ecosam=ecosa1-ecosa2
+                ecosbm=ecosb1-ecosb2
+                ecosgm=ecosg1-ecosg2
+C Diagnostics
+c               ecosap=ecosa1
+c               ecosbp=ecosb1
+c               ecosgp=ecosg1
+c               ecosam=0.0D0
+c               ecosbm=0.0D0
+c               ecosgm=0.0D0
+C End diagnostics
+                facont_hb(num_conti,i)=fcont
+                fprimcont=fprimcont/rij
+cd              facont_hb(num_conti,i)=1.0D0
+C Following line is for diagnostics.
+cd              fprimcont=0.0D0
+                do k=1,3
+                  dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
+                  dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
+                enddo
+                do k=1,3
+                  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
+C Derivatives due to the contact function
+                gacont_hbr(1,num_conti,i)=fprimcont*xj
+                gacont_hbr(2,num_conti,i)=fprimcont*yj
+                gacont_hbr(3,num_conti,i)=fprimcont*zj
+                do k=1,3
+c
+c 10/24/08 cgrad and ! comments indicate the parts of the code removed 
+c          following the change of gradient-summation algorithm.
+c
+cgrad                  ghalfp=0.5D0*gggp(k)
+cgrad                  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)
+                  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)
+                  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)
+                  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)
+                enddo
+C Diagnostics. Comment out or remove after debugging!
+cdiag           do k=1,3
+cdiag             gacontp_hb1(k,num_conti,i)=0.0D0
+cdiag             gacontp_hb2(k,num_conti,i)=0.0D0
+cdiag             gacontp_hb3(k,num_conti,i)=0.0D0
+cdiag             gacontm_hb1(k,num_conti,i)=0.0D0
+cdiag             gacontm_hb2(k,num_conti,i)=0.0D0
+cdiag             gacontm_hb3(k,num_conti,i)=0.0D0
+cdiag           enddo
+              ENDIF ! wcorr
+              endif  ! num_conti.le.maxconts
+            endif  ! fcont.gt.0
+          endif    ! j.gt.i+1
+          if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
+            do k=1,4
+              do l=1,3
+                ghalf=0.5d0*agg(l,k)
+                aggi(l,k)=aggi(l,k)+ghalf
+                aggi1(l,k)=aggi1(l,k)+agg(l,k)
+                aggj(l,k)=aggj(l,k)+ghalf
+              enddo
+            enddo
+            if (j.eq.nres-1 .and. i.lt.j-2) then
+              do k=1,4
+                do l=1,3
+                  aggj1(l,k)=aggj1(l,k)+agg(l,k)
+                enddo
+              enddo
+            endif
+          endif
+c          t_eelecij=t_eelecij+MPI_Wtime()-time00
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine eturn3(i,eello_turn3)
+C Third- and fourth-order contributions from turns
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VECTORS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.CONTROL'
+      dimension ggg(3)
+      double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
+     &  e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
+     &  e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
+     &  gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
+     &  auxgmat2(2,2),auxgmatt2(2,2)
+      double precision agg(3,4),aggi(3,4),aggi1(3,4),
+     &    aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
+      common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
+     &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
+     &    num_conti,j1,j2
+      j=i+2
+c      write (iout,*) "eturn3",i,j,j1,j2
+      a_temp(1,1)=a22
+      a_temp(1,2)=a23
+      a_temp(2,1)=a32
+      a_temp(2,2)=a33
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C               Third-order contributions
+C        
+C                 (i+2)o----(i+3)
+C                      | |
+C                      | |
+C                 (i+1)o----i
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC   
+cd        call checkint_turn3(i,a_temp,eello_turn3_num)
+        call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
+c auxalary matices for theta gradient
+c auxalary matrix for i+1 and constant i+2
+        call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
+c auxalary matrix for i+2 and constant i+1
+        call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
+        call transpose2(auxmat(1,1),auxmat1(1,1))
+        call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
+        call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
+        call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+        call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
+        call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
+        eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
+C Derivatives in theta
+        gloc(nphi+i,icg)=gloc(nphi+i,icg)
+     &  +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
+        gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
+     &  +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
+
+        if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
+     &          'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
+cd        write (2,*) 'i,',i,' j',j,'eello_turn3',
+cd     &    0.5d0*(pizda(1,1)+pizda(2,2)),
+cd     &    ' eello_turn3_num',4*eello_turn3_num
+C Derivatives in gamma(i)
+        call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
+        call transpose2(auxmat2(1,1),auxmat3(1,1))
+        call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
+        gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
+C Derivatives in gamma(i+1)
+        call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
+        call transpose2(auxmat2(1,1),auxmat3(1,1))
+        call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
+        gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
+     &    +0.5d0*(pizda(1,1)+pizda(2,2))
+C Cartesian derivatives
+        do l=1,3
+c            ghalf1=0.5d0*agg(l,1)
+c            ghalf2=0.5d0*agg(l,2)
+c            ghalf3=0.5d0*agg(l,3)
+c            ghalf4=0.5d0*agg(l,4)
+          a_temp(1,1)=aggi(l,1)!+ghalf1
+          a_temp(1,2)=aggi(l,2)!+ghalf2
+          a_temp(2,1)=aggi(l,3)!+ghalf3
+          a_temp(2,2)=aggi(l,4)!+ghalf4
+          call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+          gcorr3_turn(l,i)=gcorr3_turn(l,i)
+     &      +0.5d0*(pizda(1,1)+pizda(2,2))
+          a_temp(1,1)=aggi1(l,1)!+agg(l,1)
+          a_temp(1,2)=aggi1(l,2)!+agg(l,2)
+          a_temp(2,1)=aggi1(l,3)!+agg(l,3)
+          a_temp(2,2)=aggi1(l,4)!+agg(l,4)
+          call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+          gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
+     &      +0.5d0*(pizda(1,1)+pizda(2,2))
+          a_temp(1,1)=aggj(l,1)!+ghalf1
+          a_temp(1,2)=aggj(l,2)!+ghalf2
+          a_temp(2,1)=aggj(l,3)!+ghalf3
+          a_temp(2,2)=aggj(l,4)!+ghalf4
+          call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+          gcorr3_turn(l,j)=gcorr3_turn(l,j)
+     &      +0.5d0*(pizda(1,1)+pizda(2,2))
+          a_temp(1,1)=aggj1(l,1)
+          a_temp(1,2)=aggj1(l,2)
+          a_temp(2,1)=aggj1(l,3)
+          a_temp(2,2)=aggj1(l,4)
+          call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
+          gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
+     &      +0.5d0*(pizda(1,1)+pizda(2,2))
+        enddo
+      return
+      end
+C-------------------------------------------------------------------------------
+      subroutine eturn4(i,eello_turn4)
+C Third- and fourth-order contributions from turns
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VECTORS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.CONTROL'
+      dimension ggg(3)
+      double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
+     &  e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
+     &  e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
+     &  auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
+     &  gte1t(2,2),gte2t(2,2),gte3t(2,2),
+     &  gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
+     &  gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
+      double precision agg(3,4),aggi(3,4),aggi1(3,4),
+     &    aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
+      common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
+     &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
+     &    num_conti,j1,j2
+      j=i+3
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C               Fourth-order contributions
+C        
+C                 (i+3)o----(i+4)
+C                     /  |
+C               (i+2)o   |
+C                     \  |
+C                 (i+1)o----i
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC   
+cd        call checkint_turn4(i,a_temp,eello_turn4_num)
+c        write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
+c        write(iout,*)"WCHODZE W PROGRAM"
+        a_temp(1,1)=a22
+        a_temp(1,2)=a23
+        a_temp(2,1)=a32
+        a_temp(2,2)=a33
+        iti1=itortyp(itype(i+1))
+        iti2=itortyp(itype(i+2))
+        iti3=itortyp(itype(i+3))
+c        write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
+        call transpose2(EUg(1,1,i+1),e1t(1,1))
+        call transpose2(Eug(1,1,i+2),e2t(1,1))
+        call transpose2(Eug(1,1,i+3),e3t(1,1))
+C Ematrix derivative in theta
+        call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
+        call transpose2(gtEug(1,1,i+2),gte2t(1,1))
+        call transpose2(gtEug(1,1,i+3),gte3t(1,1))
+        call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
+c       eta1 in derivative theta
+        call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
+        call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
+c       auxgvec is derivative of Ub2 so i+3 theta
+        call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1)) 
+c       auxalary matrix of E i+1
+        call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
+c        s1=0.0
+c        gs1=0.0    
+        s1=scalar2(b1(1,i+2),auxvec(1))
+c derivative of theta i+2 with constant i+3
+        gs23=scalar2(gtb1(1,i+2),auxvec(1))
+c derivative of theta i+2 with constant i+2
+        gs32=scalar2(b1(1,i+2),auxgvec(1))
+c derivative of E matix in theta of i+1
+        gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
+
+        call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+c       ea31 in derivative theta
+        call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
+        call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) 
+c auxilary matrix auxgvec of Ub2 with constant E matirx
+        call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
+c auxilary matrix auxgEvec1 of E matix with Ub2 constant
+        call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
+
+c        s2=0.0
+c        gs2=0.0
+        s2=scalar2(b1(1,i+1),auxvec(1))
+c derivative of theta i+1 with constant i+3
+        gs13=scalar2(gtb1(1,i+1),auxvec(1))
+c derivative of theta i+2 with constant i+1
+        gs21=scalar2(b1(1,i+1),auxgvec(1))
+c derivative of theta i+3 with constant i+1
+        gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
+c        write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
+c     &  gtb1(1,i+1)
+        call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+c two derivatives over diffetent matrices
+c gtae3e2 is derivative over i+3
+        call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
+c ae3gte2 is derivative over i+2
+        call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
+        call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+c three possible derivative over theta E matices
+c i+1
+        call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
+c i+2
+        call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
+c i+3
+        call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
+        s3=0.5d0*(pizda(1,1)+pizda(2,2))
+
+        gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
+        gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
+        gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
+
+        eello_turn4=eello_turn4-(s1+s2+s3)
+#ifdef NEWCORR
+        gloc(nphi+i,icg)=gloc(nphi+i,icg)
+     &                  -(gs13+gsE13+gsEE1)*wturn4
+        gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
+     &                    -(gs23+gs21+gsEE2)*wturn4
+        gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
+     &                    -(gs32+gsE31+gsEE3)*wturn4
+c         gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
+c     &   gs2
+#endif
+        if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
+     &      'eturn4',i,j,-(s1+s2+s3)
+c        write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
+c     &    ' eello_turn4_num',8*eello_turn4_num
+C Derivatives in gamma(i)
+        call transpose2(EUgder(1,1,i+1),e1tder(1,1))
+        call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
+        call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
+        s1=scalar2(b1(1,i+2),auxvec(1))
+        call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
+        s3=0.5d0*(pizda(1,1)+pizda(2,2))
+        gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
+C Derivatives in gamma(i+1)
+        call transpose2(EUgder(1,1,i+2),e2tder(1,1))
+        call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) 
+        s2=scalar2(b1(1,i+1),auxvec(1))
+        call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
+        call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
+        s3=0.5d0*(pizda(1,1)+pizda(2,2))
+        gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
+C Derivatives in gamma(i+2)
+        call transpose2(EUgder(1,1,i+3),e3tder(1,1))
+        call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
+        s1=scalar2(b1(1,i+2),auxvec(1))
+        call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
+        call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1)) 
+        s2=scalar2(b1(1,i+1),auxvec(1))
+        call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
+        call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
+        s3=0.5d0*(pizda(1,1)+pizda(2,2))
+        gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
+C Cartesian derivatives
+C Derivatives of this turn contributions in DC(i+2)
+        if (j.lt.nres-1) then
+          do l=1,3
+            a_temp(1,1)=agg(l,1)
+            a_temp(1,2)=agg(l,2)
+            a_temp(2,1)=agg(l,3)
+            a_temp(2,2)=agg(l,4)
+            call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
+            call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
+            s1=scalar2(b1(1,i+2),auxvec(1))
+            call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+            call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) 
+            s2=scalar2(b1(1,i+1),auxvec(1))
+            call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+            call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+            s3=0.5d0*(pizda(1,1)+pizda(2,2))
+            ggg(l)=-(s1+s2+s3)
+            gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
+          enddo
+        endif
+C Remaining derivatives of this turn contribution
+        do l=1,3
+          a_temp(1,1)=aggi(l,1)
+          a_temp(1,2)=aggi(l,2)
+          a_temp(2,1)=aggi(l,3)
+          a_temp(2,2)=aggi(l,4)
+          call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
+          call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
+          s1=scalar2(b1(1,i+2),auxvec(1))
+          call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+          call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) 
+          s2=scalar2(b1(1,i+1),auxvec(1))
+          call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+          call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+          s3=0.5d0*(pizda(1,1)+pizda(2,2))
+          gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
+          a_temp(1,1)=aggi1(l,1)
+          a_temp(1,2)=aggi1(l,2)
+          a_temp(2,1)=aggi1(l,3)
+          a_temp(2,2)=aggi1(l,4)
+          call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
+          call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
+          s1=scalar2(b1(1,i+2),auxvec(1))
+          call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+          call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) 
+          s2=scalar2(b1(1,i+1),auxvec(1))
+          call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+          call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+          s3=0.5d0*(pizda(1,1)+pizda(2,2))
+          gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
+          a_temp(1,1)=aggj(l,1)
+          a_temp(1,2)=aggj(l,2)
+          a_temp(2,1)=aggj(l,3)
+          a_temp(2,2)=aggj(l,4)
+          call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
+          call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
+          s1=scalar2(b1(1,i+2),auxvec(1))
+          call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+          call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) 
+          s2=scalar2(b1(1,i+1),auxvec(1))
+          call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+          call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+          s3=0.5d0*(pizda(1,1)+pizda(2,2))
+          gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
+          a_temp(1,1)=aggj1(l,1)
+          a_temp(1,2)=aggj1(l,2)
+          a_temp(2,1)=aggj1(l,3)
+          a_temp(2,2)=aggj1(l,4)
+          call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
+          call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
+          s1=scalar2(b1(1,i+2),auxvec(1))
+          call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
+          call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) 
+          s2=scalar2(b1(1,i+1),auxvec(1))
+          call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
+          call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
+          s3=0.5d0*(pizda(1,1)+pizda(2,2))
+c          write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
+          gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
+        enddo
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine vecpr(u,v,w)
+      implicit real*8(a-h,o-z)
+      dimension u(3),v(3),w(3)
+      w(1)=u(2)*v(3)-u(3)*v(2)
+      w(2)=-u(1)*v(3)+u(3)*v(1)
+      w(3)=u(1)*v(2)-u(2)*v(1)
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine unormderiv(u,ugrad,unorm,ungrad)
+C This subroutine computes the derivatives of a normalized vector u, given
+C the derivatives computed without normalization conditions, ugrad. Returns
+C ungrad.
+      implicit none
+      double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
+      double precision vec(3)
+      double precision scalar
+      integer i,j
+c      write (2,*) 'ugrad',ugrad
+c      write (2,*) 'u',u
+      do i=1,3
+        vec(i)=scalar(ugrad(1,i),u(1))
+      enddo
+c      write (2,*) 'vec',vec
+      do i=1,3
+        do j=1,3
+          ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
+        enddo
+      enddo
+c      write (2,*) 'ungrad',ungrad
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine escp_soft_sphere(evdw2,evdw2_14)
+C
+C This subroutine calculates the excluded-volume interaction energy between
+C peptide-group centers and side chains and its gradient in virtual-bond and
+C side-chain vectors.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.FFIELD'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CONTROL'
+      dimension ggg(3)
+      evdw2=0.0D0
+      evdw2_14=0.0d0
+      r0_scp=4.5d0
+cd    print '(a)','Enter ESCP'
+cd    write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
+      do i=iatscp_s,iatscp_e
+        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))
+
+        do iint=1,nscp_gr(i)
+
+        do j=iscpstart(i,iint),iscpend(i,iint)
+          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
+          rij=xj*xj+yj*yj+zj*zj
+          r0ij=r0_scp
+          r0ijsq=r0ij*r0ij
+          if (rij.lt.r0ijsq) then
+            evdwij=0.25d0*(rij-r0ijsq)**2
+            fac=rij-r0ijsq
+          else
+            evdwij=0.0d0
+            fac=0.0d0
+          endif 
+          evdw2=evdw2+evdwij
+C
+C Calculate contributions to the gradient in the virtual-bond and SC vectors.
+C
+          ggg(1)=xj*fac
+          ggg(2)=yj*fac
+          ggg(3)=zj*fac
+cgrad          if (j.lt.i) then
+cd          write (iout,*) 'j<i'
+C Uncomment following three lines for SC-p interactions
+c           do k=1,3
+c             gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
+c           enddo
+cgrad          else
+cd          write (iout,*) 'j>i'
+cgrad            do k=1,3
+cgrad              ggg(k)=-ggg(k)
+C Uncomment following line for SC-p interactions
+c             gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
+cgrad            enddo
+cgrad          endif
+cgrad          do k=1,3
+cgrad            gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
+cgrad          enddo
+cgrad          kstart=min0(i+1,j)
+cgrad          kend=max0(i-1,j-1)
+cd        write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
+cd        write (iout,*) ggg(1),ggg(2),ggg(3)
+cgrad          do k=kstart,kend
+cgrad            do l=1,3
+cgrad              gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
+cgrad            enddo
+cgrad          enddo
+          do k=1,3
+            gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
+            gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
+          enddo
+        enddo
+
+        enddo ! iint
+      enddo ! i
+      return
+      end
+C-----------------------------------------------------------------------------
+      subroutine escp(evdw2,evdw2_14)
+C
+C This subroutine calculates the excluded-volume interaction energy between
+C peptide-group centers and side chains and its gradient in virtual-bond and
+C side-chain vectors.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+      include 'COMMON.LOCAL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.FFIELD'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CONTROL'
+      dimension ggg(3)
+      evdw2=0.0D0
+      evdw2_14=0.0d0
+cd    print '(a)','Enter ESCP'
+cd    write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
+      do i=iatscp_s,iatscp_e
+        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))
+
+        do iint=1,nscp_gr(i)
+
+        do j=iscpstart(i,iint),iscpend(i,iint)
+          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
+          rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+          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
+          endif
+          evdwij=e1+e2
+          evdw2=evdw2+evdwij
+          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
+          ggg(1)=xj*fac
+          ggg(2)=yj*fac
+          ggg(3)=zj*fac
+cgrad          if (j.lt.i) then
+cd          write (iout,*) 'j<i'
+C Uncomment following three lines for SC-p interactions
+c           do k=1,3
+c             gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
+c           enddo
+cgrad          else
+cd          write (iout,*) 'j>i'
+cgrad            do k=1,3
+cgrad              ggg(k)=-ggg(k)
+C Uncomment following line for SC-p interactions
+ccgrad             gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
+c             gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
+cgrad            enddo
+cgrad          endif
+cgrad          do k=1,3
+cgrad            gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
+cgrad          enddo
+cgrad          kstart=min0(i+1,j)
+cgrad          kend=max0(i-1,j-1)
+cd        write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
+cd        write (iout,*) ggg(1),ggg(2),ggg(3)
+cgrad          do k=kstart,kend
+cgrad            do l=1,3
+cgrad              gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
+cgrad            enddo
+cgrad          enddo
+          do k=1,3
+            gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
+            gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
+          enddo
+        enddo
+
+        enddo ! iint
+      enddo ! i
+      do i=1,nct
+        do j=1,3
+          gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
+          gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
+          gradx_scp(j,i)=expon*gradx_scp(j,i)
+        enddo
+      enddo
+C******************************************************************************
+C
+C                              N O T E !!!
+C
+C To save time the factor EXPON has been extracted from ALL components
+C of GVDWC and GRADX. Remember to multiply them by this factor before further 
+C use!
+C
+C******************************************************************************
+      return
+      end
+C--------------------------------------------------------------------------
+      subroutine edis(ehpb)
+C 
+C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.VAR'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      dimension ggg(3)
+      ehpb=0.0D0
+cd      write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
+cd      write(iout,*)'link_start=',link_start,' link_end=',link_end
+      if (link_end.eq.0) return
+      do i=link_start,link_end
+C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
+C CA-CA distance used in regularization of structure.
+        ii=ihpb(i)
+        jj=jhpb(i)
+C iii and jjj point to the residues for which the distance is assigned.
+        if (ii.gt.nres) then
+          iii=ii-nres
+          jjj=jj-nres 
+        else
+          iii=ii
+          jjj=jj
+        endif
+cd        write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
+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
+          call ssbond_ene(iii,jjj,eij)
+          ehpb=ehpb+2*eij
+cd          write (iout,*) "eij",eij
+        else
+C Calculate the distance between the two points and its difference from the
+C target distance.
+        dd=dist(ii,jj)
+        rdis=dd-dhpb(i)
+C Get the force constant corresponding to this distance.
+        waga=forcon(i)
+C Calculate the contribution to energy.
+        ehpb=ehpb+waga*rdis*rdis
+C
+C Evaluate gradient.
+C
+        fac=waga*rdis/dd
+cd      print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
+cd   &   ' waga=',waga,' fac=',fac
+        do j=1,3
+          ggg(j)=fac*(c(j,jj)-c(j,ii))
+        enddo
+cd      print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
+C If this is a SC-SC distance, we need to calculate the contributions to the
+C Cartesian gradient in the SC vectors (ghpbx).
+        if (iii.lt.ii) then
+          do j=1,3
+            ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
+            ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
+          enddo
+        endif
+cgrad        do j=iii,jjj-1
+cgrad          do k=1,3
+cgrad            ghpbc(k,j)=ghpbc(k,j)+ggg(k)
+cgrad          enddo
+cgrad        enddo
+        do k=1,3
+          ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
+          ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
+        enddo
+        endif
+      enddo
+      ehpb=0.5D0*ehpb
+      return
+      end
+C--------------------------------------------------------------------------
+      subroutine ssbond_ene(i,j,eij)
+C 
+C Calculate the distance and angle dependent SS-bond potential energy
+C using a free-energy function derived based on RHF/6-31G** ab initio
+C calculations of diethyl disulfide.
+C
+C A. Liwo and U. Kozlowska, 11/24/03
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.LOCAL'
+      include 'COMMON.INTERACT'
+      include 'COMMON.VAR'
+      include 'COMMON.IOUNITS'
+      double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
+      itypi=iabs(itype(i))
+      xi=c(1,nres+i)
+      yi=c(2,nres+i)
+      zi=c(3,nres+i)
+      dxi=dc_norm(1,nres+i)
+      dyi=dc_norm(2,nres+i)
+      dzi=dc_norm(3,nres+i)
+c      dsci_inv=dsc_inv(itypi)
+      dsci_inv=vbld_inv(nres+i)
+      itypj=iabs(itype(j))
+c      dscj_inv=dsc_inv(itypj)
+      dscj_inv=vbld_inv(nres+j)
+      xj=c(1,nres+j)-xi
+      yj=c(2,nres+j)-yi
+      zj=c(3,nres+j)-zi
+      dxj=dc_norm(1,nres+j)
+      dyj=dc_norm(2,nres+j)
+      dzj=dc_norm(3,nres+j)
+      rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
+      rij=dsqrt(rrij)
+      erij(1)=xj*rij
+      erij(2)=yj*rij
+      erij(3)=zj*rij
+      om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
+      om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
+      om12=dxi*dxj+dyi*dyj+dzi*dzj
+      do k=1,3
+        dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
+        dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
+      enddo
+      rij=1.0d0/rij
+      deltad=rij-d0cm
+      deltat1=1.0d0-om1
+      deltat2=1.0d0+om2
+      deltat12=om2-om1+2.0d0
+      cosphi=om12-om1*om2
+      eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
+     &  +akct*deltad*deltat12
+     &  +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
+c      write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
+c     &  " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
+c     &  " deltat12",deltat12," eij",eij 
+      ed=2*akcm*deltad+akct*deltat12
+      pom1=akct*deltad
+      pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
+      eom1=-2*akth*deltat1-pom1-om2*pom2
+      eom2= 2*akth*deltat2+pom1-om1*pom2
+      eom12=pom2
+      do k=1,3
+        ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
+        ghpbx(k,i)=ghpbx(k,i)-ggk
+     &            +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
+     &            +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
+        ghpbx(k,j)=ghpbx(k,j)+ggk
+     &            +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
+     &            +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
+        ghpbc(k,i)=ghpbc(k,i)-ggk
+        ghpbc(k,j)=ghpbc(k,j)+ggk
+      enddo
+C
+C Calculate the components of the gradient in DC and X
+C
+cgrad      do k=i,j-1
+cgrad        do l=1,3
+cgrad          ghpbc(l,k)=ghpbc(l,k)+gg(l)
+cgrad        enddo
+cgrad      enddo
+      return
+      end
+C--------------------------------------------------------------------------
+      subroutine ebond(estr)
+c
+c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
+c
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.LOCAL'
+      include 'COMMON.GEO'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.VAR'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.NAMES'
+      include 'COMMON.FFIELD'
+      include 'COMMON.CONTROL'
+      include 'COMMON.SETUP'
+      double precision u(3),ud(3)
+      estr=0.0d0
+      estr1=0.0d0
+      do i=ibondp_start,ibondp_end
+        if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) 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
+        diff = vbld(i)-vbldp0
+        if (energy_dec) write (iout,*) 
+     &     "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
+      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=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,*) 
+     &      "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
+            do j=1,3
+              gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
+            enddo
+          else
+            do j=1,nbi
+              diff=vbld(i+nres)-vbldsc0(j,iti) 
+              ud(j)=aksc(j,iti)*diff
+              u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
+            enddo
+            uprod=u(1)
+            do j=2,nbi
+              uprod=uprod*u(j)
+            enddo
+            usum=0.0d0
+            usumsqder=0.0d0
+            do j=1,nbi
+              uprod1=1.0d0
+              uprod2=1.0d0
+              do k=1,nbi
+                if (k.ne.j) then
+                  uprod1=uprod1*u(k)
+                  uprod2=uprod2*u(k)*u(k)
+                endif
+              enddo
+              usum=usum+uprod1
+              usumsqder=usumsqder+ud(j)*uprod2   
+            enddo
+            estr=estr+uprod/usum
+            do j=1,3
+             gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
+            enddo
+          endif
+        endif
+      enddo
+      return
+      end 
+#ifdef CRYST_THETA
+C--------------------------------------------------------------------------
+      subroutine ebend(etheta)
+C
+C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
+C angles gamma and its derivatives in consecutive thetas and gammas.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.LOCAL'
+      include 'COMMON.GEO'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.VAR'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.NAMES'
+      include 'COMMON.FFIELD'
+      include 'COMMON.CONTROL'
+      common /calcthet/ term1,term2,termm,diffak,ratak,
+     & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
+     & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
+      double precision y(2),z(2)
+      delta=0.02d0*pi
+c      time11=dexp(-2*time)
+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.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)
+        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-2).ne.ntyp1) then
+#ifdef OSF
+	  phii=phi(i)
+          if (phii.ne.phii) phii=150.0
+#else
+          phii=phi(i)
+#endif
+          y(1)=dcos(phii)
+          y(2)=dsin(phii)
+        else 
+          y(1)=0.0D0
+          y(2)=0.0D0
+        endif
+        if (i.lt.nres .and. itype(i).ne.ntyp1) then
+#ifdef OSF
+	  phii1=phi(i+1)
+          if (phii1.ne.phii1) phii1=150.0
+          phii1=pinorm(phii1)
+          z(1)=cos(phii1)
+#else
+          phii1=phi(i+1)
+          z(1)=dcos(phii1)
+#endif
+          z(2)=dsin(phii1)
+        else
+          z(1)=0.0D0
+          z(2)=0.0D0
+        endif  
+C Calculate the "mean" value of theta from the part of the distribution
+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,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)
+        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,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)
+          call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
+          call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
+          call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
+     &        E_theta)
+          call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
+     &        E_tc)
+        else if (theta(i).lt.delta) then
+          call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
+          call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
+          call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
+     &        E_theta)
+          call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
+          call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
+     &        E_tc)
+        else
+          call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
+     &        E_theta,E_tc)
+        endif
+        etheta=etheta+ethetai
+        if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
+     &      'ebend',i,ethetai
+        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)
+      enddo
+C Ufff.... We've done all this!!! 
+      return
+      end
+C---------------------------------------------------------------------------
+      subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
+     &     E_tc)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.LOCAL'
+      include 'COMMON.IOUNITS'
+      common /calcthet/ term1,term2,termm,diffak,ratak,
+     & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
+     & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
+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.
+        sig=polthet(3,it)
+        do j=2,0,-1
+          sig=sig*thet_pred_mean+polthet(j,it)
+        enddo
+C Derivative of the "interior part" of the "standard deviation of the" 
+C gamma-dependent Gaussian lobe in t_c.
+        sigtc=3*polthet(3,it)
+        do j=2,1,-1
+          sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
+        enddo
+        sigtc=sig*sigtc
+C Set the parameters of both Gaussian lobes of the distribution.
+C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
+        fac=sig*sig+sigc0(it)
+        sigcsq=fac+fac
+        sigc=1.0D0/sigcsq
+C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
+        sigsqtc=-4.0D0*sigcsq*sigtc
+c       print *,i,sig,sigtc,sigsqtc
+C Following variable (sigtc) is d[sigma(t_c)]/dt_c
+        sigtc=-sigtc/(fac*fac)
+C Following variable is sigma(t_c)**(-2)
+        sigcsq=sigcsq*sigcsq
+        sig0i=sig0(it)
+        sig0inv=1.0D0/sig0i**2
+        delthec=thetai-thet_pred_mean
+        delthe0=thetai-theta0i
+        term1=-0.5D0*sigcsq*delthec*delthec
+        term2=-0.5D0*sig0inv*delthe0*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
+C term evaluation for this virtual-bond angle.
+        if (term1.gt.term2) then
+          termm=term1
+          term2=dexp(term2-termm)
+          term1=1.0d0
+        else
+          termm=term2
+          term1=dexp(term1-termm)
+          term2=1.0d0
+        endif
+C The ratio between the gamma-independent and gamma-dependent lobes of
+C the distribution is a Gaussian function of thet_pred_mean too.
+        diffak=gthet(2,it)-thet_pred_mean
+        ratak=diffak/gthet(3,it)**2
+        ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
+C Let's differentiate it in thet_pred_mean NOW.
+        aktc=ak*ratak
+C Now put together the distribution terms to make complete distribution.
+        termexp=term1+ak*term2
+        termpre=sigc+ak*sig0i
+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 NOW the derivatives!!!
+C 6/6/97 Take into account the deformation.
+        E_theta=(delthec*sigcsq*term1
+     &       +ak*delthe0*sig0inv*term2)/termexp
+        E_tc=((sigtc+aktc*sig0i)/termpre
+     &      -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
+     &       aktc*term2)/termexp)
+      return
+      end
+c-----------------------------------------------------------------------------
+      subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.LOCAL'
+      include 'COMMON.IOUNITS'
+      common /calcthet/ term1,term2,termm,diffak,ratak,
+     & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
+     & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
+      delthec=thetai-thet_pred_mean
+      delthe0=thetai-theta0i
+C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
+      t3 = thetai-thet_pred_mean
+      t6 = t3**2
+      t9 = term1
+      t12 = t3*sigcsq
+      t14 = t12+t6*sigsqtc
+      t16 = 1.0d0
+      t21 = thetai-theta0i
+      t23 = t21**2
+      t26 = term2
+      t27 = t21*t26
+      t32 = termexp
+      t40 = t32**2
+      E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
+     & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
+     & *(-t12*t9-ak*sig0inv*t27)
+      return
+      end
+#else
+C--------------------------------------------------------------------------
+      subroutine ebend(etheta)
+C
+C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
+C angles gamma and its derivatives in consecutive thetas and gammas.
+C ab initio-derived potentials from 
+c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.LOCAL'
+      include 'COMMON.GEO'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.VAR'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.NAMES'
+      include 'COMMON.FFIELD'
+      include 'COMMON.CONTROL'
+      double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
+     & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
+     & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
+     & sinph1ph2(maxdouble,maxdouble)
+      logical lprn /.false./, lprn1 /.false./
+      etheta=0.0D0
+      do i=ithet_start,ithet_end
+        if (itype(i-1).eq.ntyp1) cycle
+        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)))
+        do k=1,nntheterm
+          coskt(k)=dcos(k*theti2)
+          sinkt(k)=dsin(k*theti2)
+        enddo
+        if (i.gt.3 .and. itype(i-2).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)))
+C propagation of chirality for glycine type
+          do k=1,nsingle
+            cosph1(k)=dcos(k*phii)
+            sinph1(k)=dsin(k*phii)
+          enddo
+        else
+          phii=0.0d0
+          ityp1=nthetyp+1
+          do k=1,nsingle
+            cosph1(k)=0.0d0
+            sinph1(k)=0.0d0
+          enddo 
+        endif
+        if (i.lt.nres .and. itype(i).ne.ntyp1) then
+#ifdef OSF
+          phii1=phi(i+1)
+          if (phii1.ne.phii1) phii1=150.0
+          phii1=pinorm(phii1)
+#else
+          phii1=phi(i+1)
+#endif
+          ityp3=ithetyp((itype(i)))
+          do k=1,nsingle
+            cosph2(k)=dcos(k*phii1)
+            sinph2(k)=dsin(k*phii1)
+          enddo
+        else
+          phii1=0.0d0
+          ityp3=nthetyp+1
+          do k=1,nsingle
+            cosph2(k)=0.0d0
+            sinph2(k)=0.0d0
+          enddo
+        endif  
+        ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
+        do k=1,ndouble
+          do l=1,k-1
+            ccl=cosph1(l)*cosph2(k-l)
+            ssl=sinph1(l)*sinph2(k-l)
+            scl=sinph1(l)*cosph2(k-l)
+            csl=cosph1(l)*sinph2(k-l)
+            cosph1ph2(l,k)=ccl-ssl
+            cosph1ph2(k,l)=ccl+ssl
+            sinph1ph2(l,k)=scl+csl
+            sinph1ph2(k,l)=scl-csl
+          enddo
+        enddo
+        if (lprn) then
+        write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
+     &    " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
+        write (iout,*) "coskt and sinkt"
+        do k=1,nntheterm
+          write (iout,*) k,coskt(k),sinkt(k)
+        enddo
+        endif
+        do k=1,ntheterm
+          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,iblock),
+     &     " ethetai",ethetai
+        enddo
+        if (lprn) then
+        write (iout,*) "cosph and sinph"
+        do k=1,nsingle
+          write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
+        enddo
+        write (iout,*) "cosph1ph2 and sinph2ph2"
+        do k=2,ndouble
+          do l=1,k-1
+            write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
+     &         sinph1ph2(l,k),sinph1ph2(k,l) 
+          enddo
+        enddo
+        write(iout,*) "ethetai",ethetai
+        endif
+        do m=1,ntheterm2
+          do k=1,nsingle
+            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,iblock)*cosph1(k)-
+     &          bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
+            dephii1=dephii1+k*sinkt(m)*(
+     &          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,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)
+     &  write(iout,*) "ethetai",ethetai
+        do m=1,ntheterm3
+          do k=2,ndouble
+            do l=1,k-1
+              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,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,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,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)
+              endif
+            enddo
+          enddo
+        enddo
+10      continue
+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)
+      enddo
+      return
+      end
+#endif
+#ifdef CRYST_SC
+c-----------------------------------------------------------------------------
+      subroutine esc(escloc)
+C Calculate the local energy of a side chain and its derivatives in the
+C corresponding virtual-bond valence angles THETA and the spherical angles 
+C ALPHA and OMEGA.
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.LOCAL'
+      include 'COMMON.VAR'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.NAMES'
+      include 'COMMON.FFIELD'
+      include 'COMMON.CONTROL'
+      double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
+     &     ddersc0(3),ddummy(3),xtemp(3),temp(3)
+      common /sccalc/ time11,time12,time112,theti,it,nlobit
+      delta=0.02d0*pi
+      escloc=0.0D0
+c     write (iout,'(a)') 'ESC'
+      do i=loc_start,loc_end
+        it=itype(i)
+        if (it.eq.ntyp1) cycle
+        if (it.eq.10) goto 1
+        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
+        x(1)=dtan(theti)
+        x(2)=alph(i)
+        x(3)=omeg(i)
+
+        if (x(2).gt.pi-delta) then
+          xtemp(1)=x(1)
+          xtemp(2)=pi-delta
+          xtemp(3)=x(3)
+          call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
+          xtemp(2)=pi
+          call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
+          call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
+     &        escloci,dersc(2))
+          call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
+     &        ddersc0(1),dersc(1))
+          call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
+     &        ddersc0(3),dersc(3))
+          xtemp(2)=pi-delta
+          call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
+          xtemp(2)=pi
+          call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
+          call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
+     &            dersc0(2),esclocbi,dersc02)
+          call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
+     &            dersc12,dersc01)
+          call splinthet(x(2),0.5d0*delta,ss,ssd)
+          dersc0(1)=dersc01
+          dersc0(2)=dersc02
+          dersc0(3)=0.0d0
+          do k=1,3
+            dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
+          enddo
+          dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
+c         write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
+c    &             esclocbi,ss,ssd
+          escloci=ss*escloci+(1.0d0-ss)*esclocbi
+c         escloci=esclocbi
+c         write (iout,*) escloci
+        else if (x(2).lt.delta) then
+          xtemp(1)=x(1)
+          xtemp(2)=delta
+          xtemp(3)=x(3)
+          call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
+          xtemp(2)=0.0d0
+          call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
+          call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
+     &        escloci,dersc(2))
+          call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
+     &        ddersc0(1),dersc(1))
+          call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
+     &        ddersc0(3),dersc(3))
+          xtemp(2)=delta
+          call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
+          xtemp(2)=0.0d0
+          call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
+          call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
+     &            dersc0(2),esclocbi,dersc02)
+          call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
+     &            dersc12,dersc01)
+          dersc0(1)=dersc01
+          dersc0(2)=dersc02
+          dersc0(3)=0.0d0
+          call splinthet(x(2),0.5d0*delta,ss,ssd)
+          do k=1,3
+            dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
+          enddo
+          dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
+c         write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
+c    &             esclocbi,ss,ssd
+          escloci=ss*escloci+(1.0d0-ss)*esclocbi
+c         write (iout,*) escloci
+        else
+          call enesc(x,escloci,dersc,ddummy,.false.)
+        endif
+
+        escloc=escloc+escloci
+        if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
+     &     'escloc',i,escloci
+c       write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
+
+        gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
+     &   wscloc*dersc(1)
+        gloc(ialph(i,1),icg)=wscloc*dersc(2)
+        gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
+    1   continue
+      enddo
+      return
+      end
+C---------------------------------------------------------------------------
+      subroutine enesc(x,escloci,dersc,ddersc,mixed)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.LOCAL'
+      include 'COMMON.IOUNITS'
+      common /sccalc/ time11,time12,time112,theti,it,nlobit
+      double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
+      double precision contr(maxlob,-1:1)
+      logical mixed
+c       write (iout,*) 'it=',it,' nlobit=',nlobit
+        escloc_i=0.0D0
+        do j=1,3
+          dersc(j)=0.0D0
+          if (mixed) ddersc(j)=0.0d0
+        enddo
+        x3=x(3)
+
+C Because of periodicity of the dependence of the SC energy in omega we have
+C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
+C To avoid underflows, first compute & store the exponents.
+
+        do iii=-1,1
+
+          x(3)=x3+iii*dwapi
+ 
+          do j=1,nlobit
+            do k=1,3
+              z(k)=x(k)-censc(k,j,it)
+            enddo
+            do k=1,3
+              Axk=0.0D0
+              do l=1,3
+                Axk=Axk+gaussc(l,k,j,it)*z(l)
+              enddo
+              Ax(k,j,iii)=Axk
+            enddo 
+            expfac=0.0D0 
+            do k=1,3
+              expfac=expfac+Ax(k,j,iii)*z(k)
+            enddo
+            contr(j,iii)=expfac
+          enddo ! j
+
+        enddo ! iii
+
+        x(3)=x3
+C As in the case of ebend, we want to avoid underflows in exponentiation and
+C subsequent NaNs and INFs in energy calculation.
+C Find the largest exponent
+        emin=contr(1,-1)
+        do iii=-1,1
+          do j=1,nlobit
+            if (emin.gt.contr(j,iii)) emin=contr(j,iii)
+          enddo 
+        enddo
+        emin=0.5D0*emin
+cd      print *,'it=',it,' emin=',emin
+
+C Compute the contribution to SC energy and derivatives
+        do iii=-1,1
+
+          do j=1,nlobit
+#ifdef OSF
+            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,iabs(it))-0.5D0*contr(j,iii)+emin)
+#endif
+cd          print *,'j=',j,' expfac=',expfac
+            escloc_i=escloc_i+expfac
+            do k=1,3
+              dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
+            enddo
+            if (mixed) then
+              do k=1,3,2
+                ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
+     &            +gaussc(k,2,j,it))*expfac
+              enddo
+            endif
+          enddo
+
+        enddo ! iii
+
+        dersc(1)=dersc(1)/cos(theti)**2
+        ddersc(1)=ddersc(1)/cos(theti)**2
+        ddersc(3)=ddersc(3)
+
+        escloci=-(dlog(escloc_i)-emin)
+        do j=1,3
+          dersc(j)=dersc(j)/escloc_i
+        enddo
+        if (mixed) then
+          do j=1,3,2
+            ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
+          enddo
+        endif
+      return
+      end
+C------------------------------------------------------------------------------
+      subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.LOCAL'
+      include 'COMMON.IOUNITS'
+      common /sccalc/ time11,time12,time112,theti,it,nlobit
+      double precision x(3),z(3),Ax(3,maxlob),dersc(3)
+      double precision contr(maxlob)
+      logical mixed
+
+      escloc_i=0.0D0
+
+      do j=1,3
+        dersc(j)=0.0D0
+      enddo
+
+      do j=1,nlobit
+        do k=1,2
+          z(k)=x(k)-censc(k,j,it)
+        enddo
+        z(3)=dwapi
+        do k=1,3
+          Axk=0.0D0
+          do l=1,3
+            Axk=Axk+gaussc(l,k,j,it)*z(l)
+          enddo
+          Ax(k,j)=Axk
+        enddo 
+        expfac=0.0D0 
+        do k=1,3
+          expfac=expfac+Ax(k,j)*z(k)
+        enddo
+        contr(j)=expfac
+      enddo ! j
+
+C As in the case of ebend, we want to avoid underflows in exponentiation and
+C subsequent NaNs and INFs in energy calculation.
+C Find the largest exponent
+      emin=contr(1)
+      do j=1,nlobit
+        if (emin.gt.contr(j)) emin=contr(j)
+      enddo 
+      emin=0.5D0*emin
+ 
+C Compute the contribution to SC energy and derivatives
+
+      dersc12=0.0d0
+      do j=1,nlobit
+        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
+        enddo
+        if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
+     &            +gaussc(1,2,j,it))*expfac
+        dersc(3)=0.0d0
+      enddo
+
+      dersc(1)=dersc(1)/cos(theti)**2
+      dersc12=dersc12/cos(theti)**2
+      escloci=-(dlog(escloc_i)-emin)
+      do j=1,2
+        dersc(j)=dersc(j)/escloc_i
+      enddo
+      if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
+      return
+      end
+#else
+c----------------------------------------------------------------------------------
+      subroutine esc(escloc)
+C Calculate the local energy of a side chain and its derivatives in the
+C corresponding virtual-bond valence angles THETA and the spherical angles 
+C ALPHA and OMEGA derived from AM1 all-atom calculations.
+C added by Urszula Kozlowska. 07/11/2007
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.GEO'
+      include 'COMMON.LOCAL'
+      include 'COMMON.VAR'
+      include 'COMMON.SCROT'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.NAMES'
+      include 'COMMON.FFIELD'
+      include 'COMMON.CONTROL'
+      include 'COMMON.VECTORS'
+      double precision x_prime(3),y_prime(3),z_prime(3)
+     &    , sumene,dsc_i,dp2_i,x(65),
+     &     xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
+     &    de_dxx,de_dyy,de_dzz,de_dt
+      double precision s1_t,s1_6_t,s2_t,s2_6_t
+      double precision 
+     & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
+     & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
+     & dt_dCi(3),dt_dCi1(3)
+      common /sccalc/ time11,time12,time112,theti,it,nlobit
+      delta=0.02d0*pi
+      escloc=0.0D0
+      do i=loc_start,loc_end
+        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)))
+        sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
+        cosfac2=0.5d0/(1.0d0+costtab(i+1))
+        cosfac=dsqrt(cosfac2)
+        sinfac2=0.5d0/(1.0d0-costtab(i+1))
+        sinfac=dsqrt(sinfac2)
+        it=iabs(itype(i))
+        if (it.eq.10) goto 1
+c
+C  Compute the axes of tghe local cartesian coordinates system; store in
+c   x_prime, y_prime and z_prime 
+c
+        do j=1,3
+          x_prime(j) = 0.00
+          y_prime(j) = 0.00
+          z_prime(j) = 0.00
+        enddo
+C        write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
+C     &   dc_norm(3,i+nres)
+        do j = 1,3
+          x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
+          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)*dsign(1.0d0,dfloat(itype(i)))
+        enddo     
+c       write (2,*) "i",i
+c       write (2,*) "x_prime",(x_prime(j),j=1,3)
+c       write (2,*) "y_prime",(y_prime(j),j=1,3)
+c       write (2,*) "z_prime",(z_prime(j),j=1,3)
+c       write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
+c      & " xy",scalar(x_prime(1),y_prime(1)),
+c      & " xz",scalar(x_prime(1),z_prime(1)),
+c      & " yy",scalar(y_prime(1),y_prime(1)),
+c      & " yz",scalar(y_prime(1),z_prime(1)),
+c      & " zz",scalar(z_prime(1),z_prime(1))
+c
+C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
+C to local coordinate system. Store in xx, yy, zz.
+c
+        xx=0.0d0
+        yy=0.0d0
+        zz=0.0d0
+        do j = 1,3
+          xx = xx + x_prime(j)*dc_norm(j,i+nres)
+          yy = yy + y_prime(j)*dc_norm(j,i+nres)
+          zz = zz + z_prime(j)*dc_norm(j,i+nres)
+        enddo
+
+        xxtab(i)=xx
+        yytab(i)=yy
+        zztab(i)=zz
+C
+C Compute the energy of the ith side cbain
+C
+c        write (2,*) "xx",xx," yy",yy," zz",zz
+        it=iabs(itype(i))
+        do j = 1,65
+          x(j) = sc_parmin(j,it) 
+        enddo
+#ifdef CHECK_COORD
+Cc diagnostics - remove later
+        xx1 = dcos(alph(2))
+        yy1 = dsin(alph(2))*dcos(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
+C,"  --- ", xx_w,yy_w,zz_w
+c end diagnostics
+#endif
+        sumene1= x(1)+  x(2)*xx+  x(3)*yy+  x(4)*zz+  x(5)*xx**2
+     &   + x(6)*yy**2+  x(7)*zz**2+  x(8)*xx*zz+  x(9)*xx*yy
+     &   + x(10)*yy*zz
+        sumene2=  x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
+     & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
+     & + x(20)*yy*zz
+        sumene3=  x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
+     &  +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
+     &  +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
+     &  +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
+     &  +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
+     &  +x(40)*xx*yy*zz
+        sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
+     &  +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
+     &  +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
+     &  +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
+     &  +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
+     &  +x(60)*xx*yy*zz
+        dsc_i   = 0.743d0+x(61)
+        dp2_i   = 1.9d0+x(62)
+        dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
+     &          *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
+        dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
+     &          *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
+        s1=(1+x(63))/(0.1d0 + dscp1)
+        s1_6=(1+x(64))/(0.1d0 + dscp1**6)
+        s2=(1+x(65))/(0.1d0 + dscp2)
+        s2_6=(1+x(65))/(0.1d0 + dscp2**6)
+        sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
+     & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
+c        write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
+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,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
+C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
+C #define DEBUG in the code to turn it on.
+C
+        write (2,*) "sumene               =",sumene
+        aincr=1.0d-7
+        xxsave=xx
+        xx=xx+aincr
+        write (2,*) xx,yy,zz
+        sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+        de_dxx_num=(sumenep-sumene)/aincr
+        xx=xxsave
+        write (2,*) "xx+ sumene from enesc=",sumenep
+        yysave=yy
+        yy=yy+aincr
+        write (2,*) xx,yy,zz
+        sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+        de_dyy_num=(sumenep-sumene)/aincr
+        yy=yysave
+        write (2,*) "yy+ sumene from enesc=",sumenep
+        zzsave=zz
+        zz=zz+aincr
+        write (2,*) xx,yy,zz
+        sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+        de_dzz_num=(sumenep-sumene)/aincr
+        zz=zzsave
+        write (2,*) "zz+ sumene from enesc=",sumenep
+        costsave=cost2tab(i+1)
+        sintsave=sint2tab(i+1)
+        cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
+        sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
+        sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
+        de_dt_num=(sumenep-sumene)/aincr
+        write (2,*) " t+ sumene from enesc=",sumenep
+        cost2tab(i+1)=costsave
+        sint2tab(i+1)=sintsave
+C End of diagnostics section.
+#endif
+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
+        pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
+        pom_dx=dsc_i*dp2_i*cost2tab(i+1)
+        pom_dy=dsc_i*dp2_i*sint2tab(i+1)
+        pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
+        pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
+        pom1=(sumene3*sint2tab(i+1)+sumene1)
+     &     *(pom_s1/dscp1+pom_s16*dscp1**4)
+        pom2=(sumene4*cost2tab(i+1)+sumene2)
+     &     *(pom_s2/dscp2+pom_s26*dscp2**4)
+        sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
+        sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
+     &  +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
+     &  +x(40)*yy*zz
+        sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
+        sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
+     &  +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
+     &  +x(60)*yy*zz
+        de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
+     &        +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
+     &        +(pom1+pom2)*pom_dx
+#ifdef DEBUG
+        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
+        sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
+     &  +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
+     &  +x(40)*xx*zz
+        sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
+        sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
+     &  +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
+     &  +x(59)*zz**2 +x(60)*xx*zz
+        de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
+     &        +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
+     &        +(pom1-pom2)*pom_dy
+#ifdef DEBUG
+        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
+     &  +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx 
+     &  +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) 
+     &  +(x(4) + 2*x(7)*zz+  x(8)*xx + x(10)*yy)*(s1+s1_6) 
+     &  +(x(44)+2*x(47)*zz +x(48)*xx   +x(50)*yy  +3*x(53)*zz**2   
+     &  +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*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,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,itype(i)
+#endif
+c#undef DEBUG
+c 
+C
+       cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
+       cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
+       cosfac2xx=cosfac2*xx
+       sinfac2yy=sinfac2*yy
+       do k = 1,3
+         dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
+     &      vbld_inv(i+1)
+         dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
+     &      vbld_inv(i)
+         pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
+         pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
+c         write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
+c     &    " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
+c         write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
+c     &   (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
+         dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
+         dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
+         dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
+         dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
+         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)
+     &     *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))
+c
+         dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
+         dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
+       enddo
+
+       do k=1,3
+         dXX_Ctab(k,i)=dXX_Ci(k)
+         dXX_C1tab(k,i)=dXX_Ci1(k)
+         dYY_Ctab(k,i)=dYY_Ci(k)
+         dYY_C1tab(k,i)=dYY_Ci1(k)
+         dZZ_Ctab(k,i)=dZZ_Ci(k)
+         dZZ_C1tab(k,i)=dZZ_Ci1(k)
+         dXX_XYZtab(k,i)=dXX_XYZ(k)
+         dYY_XYZtab(k,i)=dYY_XYZ(k)
+         dZZ_XYZtab(k,i)=dZZ_XYZ(k)
+       enddo
+
+       do k = 1,3
+c         write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
+c     &    dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
+c         write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
+c     &    dyy_ci(k)," dzz_ci",dzz_ci(k)
+c         write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
+c     &    dt_dci(k)
+c         write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
+c     &    dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) 
+         gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
+     &    +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
+         gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
+     &    +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
+         gsclocx(k,i)=                 de_dxx*dxx_XYZ(k)
+     &    +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
+       enddo
+c       write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
+c     &  (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)  
+
+C to check gradient call subroutine check_grad
+
+    1 continue
+      enddo
+      return
+      end
+c------------------------------------------------------------------------------
+      double precision function enesc(x,xx,yy,zz,cost2,sint2)
+      implicit none
+      double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
+     & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
+      sumene1= x(1)+  x(2)*xx+  x(3)*yy+  x(4)*zz+  x(5)*xx**2
+     &   + x(6)*yy**2+  x(7)*zz**2+  x(8)*xx*zz+  x(9)*xx*yy
+     &   + x(10)*yy*zz
+      sumene2=  x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
+     & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
+     & + x(20)*yy*zz
+      sumene3=  x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
+     &  +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
+     &  +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
+     &  +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
+     &  +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
+     &  +x(40)*xx*yy*zz
+      sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
+     &  +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
+     &  +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
+     &  +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
+     &  +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
+     &  +x(60)*xx*yy*zz
+      dsc_i   = 0.743d0+x(61)
+      dp2_i   = 1.9d0+x(62)
+      dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
+     &          *(xx*cost2+yy*sint2))
+      dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
+     &          *(xx*cost2-yy*sint2))
+      s1=(1+x(63))/(0.1d0 + dscp1)
+      s1_6=(1+x(64))/(0.1d0 + dscp1**6)
+      s2=(1+x(65))/(0.1d0 + dscp2)
+      s2_6=(1+x(65))/(0.1d0 + dscp2**6)
+      sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
+     & + (sumene4*cost2 +sumene2)*(s2+s2_6)
+      enesc=sumene
+      return
+      end
+#endif
+c------------------------------------------------------------------------------
+      subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
+C
+C This procedure calculates two-body contact function g(rij) and its derivative:
+C
+C           eps0ij                                     !       x < -1
+C g(rij) =  esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5)  ! -1 =< x =< 1
+C            0                                         !       x > 1
+C
+C where x=(rij-r0ij)/delta
+C
+C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
+C
+      implicit none
+      double precision rij,r0ij,eps0ij,fcont,fprimcont
+      double precision x,x2,x4,delta
+c     delta=0.02D0*r0ij
+c      delta=0.2D0*r0ij
+      x=(rij-r0ij)/delta
+      if (x.lt.-1.0D0) then
+        fcont=eps0ij
+        fprimcont=0.0D0
+      else if (x.le.1.0D0) then  
+        x2=x*x
+        x4=x2*x2
+        fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
+        fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
+      else
+        fcont=0.0D0
+        fprimcont=0.0D0
+      endif
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine splinthet(theti,delta,ss,ssder)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      thetup=pi-delta
+      thetlow=delta
+      if (theti.gt.pipol) then
+        call gcont(theti,thetup,1.0d0,delta,ss,ssder)
+      else
+        call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
+        ssder=-ssder
+      endif
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
+      implicit none
+      double precision x,x0,delta,f0,f1,fprim0,f,fprim
+      double precision ksi,ksi2,ksi3,a1,a2,a3
+      a1=fprim0*delta/(f1-f0)
+      a2=3.0d0-2.0d0*a1
+      a3=a1-2.0d0
+      ksi=(x-x0)/delta
+      ksi2=ksi*ksi
+      ksi3=ksi2*ksi  
+      f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
+      fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
+      implicit none
+      double precision x,x0,delta,f0x,f1x,fprim0x,fx
+      double precision ksi,ksi2,ksi3,a1,a2,a3
+      ksi=(x-x0)/delta  
+      ksi2=ksi*ksi
+      ksi3=ksi2*ksi
+      a1=fprim0x*delta
+      a2=3*(f1x-f0x)-2*fprim0x*delta
+      a3=fprim0x*delta-2*(f1x-f0x)
+      fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
+      return
+      end
+C-----------------------------------------------------------------------------
+#ifdef CRYST_TOR
+C-----------------------------------------------------------------------------
+      subroutine etor(etors,edihcnstr)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      include 'COMMON.LOCAL'
+      include 'COMMON.TORSION'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.CHAIN'
+      include 'COMMON.NAMES'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.TORCNSTR'
+      include 'COMMON.CONTROL'
+      logical lprn
+C Set lprn=.true. for debugging
+      lprn=.false.
+c      lprn=.true.
+      etors=0.0D0
+      do i=iphi_start,iphi_end
+      etors_ii=0.0D0
+        if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
+     &      .or. itype(i).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...
+        if (itori.eq.3 .and. itori1.eq.3) then
+          if (phii.gt.-dwapi3) then
+            cosphi=dcos(3*phii)
+            fac=1.0D0/(1.0D0-cosphi)
+            etorsi=v1(1,3,3)*fac
+            etorsi=etorsi+etorsi
+            etors=etors+etorsi-v1(1,3,3)
+            if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)      
+            gloci=gloci-3*fac*etorsi*dsin(3*phii)
+          endif
+          do j=1,3
+            v1ij=v1(j+1,itori,itori1)
+            v2ij=v2(j+1,itori,itori1)
+            cosphi=dcos(j*phii)
+            sinphi=dsin(j*phii)
+            etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
+            if (energy_dec) etors_ii=etors_ii+
+     &                              v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
+            gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
+          enddo
+        else 
+          do j=1,nterm_old
+            v1ij=v1(j,itori,itori1)
+            v2ij=v2(j,itori,itori1)
+            cosphi=dcos(j*phii)
+            sinphi=dsin(j*phii)
+            etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
+            if (energy_dec) etors_ii=etors_ii+
+     &                  v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
+            gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
+          enddo
+        endif
+        if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
+             'etor',i,etors_ii
+        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)
+        gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
+c       write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
+      enddo
+! 6/20/98 - dihedral angle constraints
+      edihcnstr=0.0d0
+      do i=1,ndih_constr
+        itori=idih_constr(i)
+        phii=phi(itori)
+        difi=phii-phi0(i)
+        if (difi.gt.drange(i)) then
+          difi=difi-drange(i)
+          edihcnstr=edihcnstr+0.25d0*ftors*difi**4
+          gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+        else if (difi.lt.-drange(i)) then
+          difi=difi+drange(i)
+          edihcnstr=edihcnstr+0.25d0*ftors*difi**4
+          gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+        endif
+!        write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
+!     &    rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
+      enddo
+!      write (iout,*) 'edihcnstr',edihcnstr
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine etor_d(etors_d)
+      etors_d=0.0d0
+      return
+      end
+c----------------------------------------------------------------------------
+#else
+      subroutine etor(etors,edihcnstr)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      include 'COMMON.LOCAL'
+      include 'COMMON.TORSION'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.CHAIN'
+      include 'COMMON.NAMES'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.TORCNSTR'
+      include 'COMMON.CONTROL'
+      logical lprn
+C Set lprn=.true. for debugging
+      lprn=.false.
+c     lprn=.true.
+      etors=0.0D0
+      do i=iphi_start,iphi_end
+        if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 
+     &       .or. itype(i).eq.ntyp1) cycle
+        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,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
+          if (energy_dec) etors_ii=etors_ii+
+     &                v1ij*cosphi+v2ij*sinphi
+          gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
+        enddo
+C Lorentz terms
+C                         v1
+C  E = SUM ----------------------------------- - v1
+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,iblock)
+          vl1ij=vlor1(j,itori,itori1)
+          vl2ij=vlor2(j,itori,itori1)
+          vl3ij=vlor3(j,itori,itori1)
+          pom=vl2ij*cosphi+vl3ij*sinphi
+          pom1=1.0d0/(pom*pom+1.0d0)
+          etors=etors+vl1ij*pom1
+          if (energy_dec) etors_ii=etors_ii+
+     &                vl1ij*pom1
+          pom=-pom*pom1*pom1
+          gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
+        enddo
+C Subtract the constant term
+        etors=etors-v0(itori,itori1,iblock)
+          if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
+     &         '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,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
+! 6/20/98 - dihedral angle constraints
+      edihcnstr=0.0d0
+c      do i=1,ndih_constr
+      do i=idihconstr_start,idihconstr_end
+        itori=idih_constr(i)
+        phii=phi(itori)
+        difi=pinorm(phii-phi0(i))
+        if (difi.gt.drange(i)) then
+          difi=difi-drange(i)
+          edihcnstr=edihcnstr+0.25d0*ftors*difi**4
+          gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+        else if (difi.lt.-drange(i)) then
+          difi=difi+drange(i)
+          edihcnstr=edihcnstr+0.25d0*ftors*difi**4
+          gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+        else
+          difi=0.0
+        endif
+cd        write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
+cd     &    rad2deg*phi0(i),  rad2deg*drange(i),
+cd     &    rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
+      enddo
+cd       write (iout,*) 'edihcnstr',edihcnstr
+      return
+      end
+c----------------------------------------------------------------------------
+      subroutine etor_d(etors_d)
+C 6/23/01 Compute double torsional energy
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      include 'COMMON.LOCAL'
+      include 'COMMON.TORSION'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.CHAIN'
+      include 'COMMON.NAMES'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.TORCNSTR'
+      logical lprn
+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.ntyp1 .or. itype(i-1).eq.ntyp1
+     &      .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+        itori=itortyp(itype(i-2))
+        itori1=itortyp(itype(i-1))
+        itori2=itortyp(itype(i))
+        phii=phi(i)
+        phii1=phi(i+1)
+        gloci1=0.0D0
+        gloci2=0.0D0
+        iblock=1
+        if (iabs(itype(i+1)).eq.20) iblock=2
+
+C Regular cosine and sine terms
+        do j=1,ntermd_1(itori,itori1,itori2,iblock)
+          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)
+          sinphi2=dsin(j*phii1)
+          etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
+     &     v2cij*cosphi2+v2sij*sinphi2
+          gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
+          gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
+        enddo
+        do k=2,ntermd_2(itori,itori1,itori2,iblock)
+          do l=1,k-1
+            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)
+            sinphi1m2=dsin(l*phii-(k-l)*phii1)
+            etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
+     &        v1sdij*sinphi1p2+v2sdij*sinphi1m2
+            gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
+     &        -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
+            gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
+     &        -v1cdij*sinphi1p2+v2cdij*sinphi1m2) 
+          enddo
+        enddo
+        gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
+        gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
+      enddo
+      return
+      end
+#endif
+c------------------------------------------------------------------------------
+      subroutine eback_sc_corr(esccor)
+c 7/21/2007 Correlations between the backbone-local and side-chain-local
+c        conformational states; temporarily implemented as differences
+c        between UNRES torsional potentials (dependent on three types of
+c        residues) and the torsional potentials dependent on all 20 types
+c        of residues computed from AM1  energy surfaces of terminally-blocked
+c        amino-acid residues.
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      include 'COMMON.LOCAL'
+      include 'COMMON.TORSION'
+      include 'COMMON.SCCOR'
+      include 'COMMON.INTERACT'
+      include 'COMMON.DERIV'
+      include 'COMMON.CHAIN'
+      include 'COMMON.NAMES'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.FFIELD'
+      include 'COMMON.CONTROL'
+      logical lprn
+C Set lprn=.true. for debugging
+      lprn=.false.
+c      lprn=.true.
+c      write (iout,*) "EBACK_SC_COR",itau_start,itau_end
+      esccor=0.0D0
+      do i=itau_start,itau_end
+        if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
+        esccor_ii=0.0D0
+        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
+        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,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----------------------------------------------------------------------------
+      subroutine multibody(ecorr)
+C This subroutine calculates multi-body contributions to energy following
+C the idea of Skolnick et al. If side chains I and J make a contact and
+C at the same time side chains I+1 and J+1 make a contact, an extra 
+C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      double precision gx(3),gx1(3)
+      logical lprn
+
+C Set lprn=.true. for debugging
+      lprn=.false.
+
+      if (lprn) then
+        write (iout,'(a)') 'Contact function values:'
+        do i=nnt,nct-2
+          write (iout,'(i2,20(1x,i2,f10.5))') 
+     &        i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
+        enddo
+      endif
+      ecorr=0.0D0
+      do i=nnt,nct
+        do j=1,3
+          gradcorr(j,i)=0.0D0
+          gradxorr(j,i)=0.0D0
+        enddo
+      enddo
+      do i=nnt,nct-2
+
+        DO ISHIFT = 3,4
+
+        i1=i+ishift
+        num_conti=num_cont(i)
+        num_conti1=num_cont(i1)
+        do jj=1,num_conti
+          j=jcont(jj,i)
+          do kk=1,num_conti1
+            j1=jcont(kk,i1)
+            if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
+cd          write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+cd   &                   ' ishift=',ishift
+C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. 
+C The system gains extra energy.
+              ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
+            endif   ! j1==j+-ishift
+          enddo     ! kk  
+        enddo       ! jj
+
+        ENDDO ! ISHIFT
+
+      enddo         ! i
+      return
+      end
+c------------------------------------------------------------------------------
+      double precision function esccorr(i,j,k,l,jj,kk)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      double precision gx(3),gx1(3)
+      logical lprn
+      lprn=.false.
+      eij=facont(jj,i)
+      ekl=facont(kk,k)
+cd    write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
+C Calculate the multi-body contribution to energy.
+C Calculate multi-body contributions to the gradient.
+cd    write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
+cd   & k,l,(gacont(m,kk,k),m=1,3)
+      do m=1,3
+        gx(m) =ekl*gacont(m,jj,i)
+        gx1(m)=eij*gacont(m,kk,k)
+        gradxorr(m,i)=gradxorr(m,i)-gx(m)
+        gradxorr(m,j)=gradxorr(m,j)+gx(m)
+        gradxorr(m,k)=gradxorr(m,k)-gx1(m)
+        gradxorr(m,l)=gradxorr(m,l)+gx1(m)
+      enddo
+      do m=i,j-1
+        do ll=1,3
+          gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
+        enddo
+      enddo
+      do m=k,l-1
+        do ll=1,3
+          gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
+        enddo
+      enddo 
+      esccorr=-eij*ekl
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
+C This subroutine calculates multi-body contributions to hydrogen-bonding 
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+#ifdef MPI
+      include "mpif.h"
+      parameter (max_cont=maxconts)
+      parameter (max_dim=26)
+      integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
+      double precision zapas(max_dim,maxconts,max_fg_procs),
+     &  zapas_recv(max_dim,maxconts,max_fg_procs)
+      common /przechowalnia/ zapas
+      integer status(MPI_STATUS_SIZE),req(maxconts*2),
+     &  status_array(MPI_STATUS_SIZE,maxconts*2)
+#endif
+      include 'COMMON.SETUP'
+      include 'COMMON.FFIELD'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.CONTROL'
+      include 'COMMON.LOCAL'
+      double precision gx(3),gx1(3),time00
+      logical lprn,ldone
+
+C Set lprn=.true. for debugging
+      lprn=.false.
+#ifdef MPI
+      n_corr=0
+      n_corr1=0
+      if (nfgtasks.le.1) goto 30
+      if (lprn) then
+        write (iout,'(a)') 'Contact function values before RECEIVE:'
+        do i=nnt,nct-2
+          write (iout,'(2i3,50(1x,i2,f5.2))') 
+     &    i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
+     &    j=1,num_cont_hb(i))
+        enddo
+      endif
+      call flush(iout)
+      do i=1,ntask_cont_from
+        ncont_recv(i)=0
+      enddo
+      do i=1,ntask_cont_to
+        ncont_sent(i)=0
+      enddo
+c      write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
+c     & ntask_cont_to
+C Make the list of contacts to send to send to other procesors
+c      write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
+c      call flush(iout)
+      do i=iturn3_start,iturn3_end
+c        write (iout,*) "make contact list turn3",i," num_cont",
+c     &    num_cont_hb(i)
+        call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
+      enddo
+      do i=iturn4_start,iturn4_end
+c        write (iout,*) "make contact list turn4",i," num_cont",
+c     &   num_cont_hb(i)
+        call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
+      enddo
+      do ii=1,nat_sent
+        i=iat_sent(ii)
+c        write (iout,*) "make contact list longrange",i,ii," num_cont",
+c     &    num_cont_hb(i)
+        do j=1,num_cont_hb(i)
+        do k=1,4
+          jjc=jcont_hb(j,i)
+          iproc=iint_sent_local(k,jjc,ii)
+c          write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
+          if (iproc.gt.0) then
+            ncont_sent(iproc)=ncont_sent(iproc)+1
+            nn=ncont_sent(iproc)
+            zapas(1,nn,iproc)=i
+            zapas(2,nn,iproc)=jjc
+            zapas(3,nn,iproc)=facont_hb(j,i)
+            zapas(4,nn,iproc)=ees0p(j,i)
+            zapas(5,nn,iproc)=ees0m(j,i)
+            zapas(6,nn,iproc)=gacont_hbr(1,j,i)
+            zapas(7,nn,iproc)=gacont_hbr(2,j,i)
+            zapas(8,nn,iproc)=gacont_hbr(3,j,i)
+            zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
+            zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
+            zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
+            zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
+            zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
+            zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
+            zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
+            zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
+            zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
+            zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
+            zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
+            zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
+            zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
+            zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
+            zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
+            zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
+            zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
+            zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
+          endif
+        enddo
+        enddo
+      enddo
+      if (lprn) then
+      write (iout,*) 
+     &  "Numbers of contacts to be sent to other processors",
+     &  (ncont_sent(i),i=1,ntask_cont_to)
+      write (iout,*) "Contacts sent"
+      do ii=1,ntask_cont_to
+        nn=ncont_sent(ii)
+        iproc=itask_cont_to(ii)
+        write (iout,*) nn," contacts to processor",iproc,
+     &   " of CONT_TO_COMM group"
+        do i=1,nn
+          write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
+        enddo
+      enddo
+      call flush(iout)
+      endif
+      CorrelType=477
+      CorrelID=fg_rank+1
+      CorrelType1=478
+      CorrelID1=nfgtasks+fg_rank+1
+      ireq=0
+C Receive the numbers of needed contacts from other processors 
+      do ii=1,ntask_cont_from
+        iproc=itask_cont_from(ii)
+        ireq=ireq+1
+        call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
+     &    FG_COMM,req(ireq),IERR)
+      enddo
+c      write (iout,*) "IRECV ended"
+c      call flush(iout)
+C Send the number of contacts needed by other processors
+      do ii=1,ntask_cont_to
+        iproc=itask_cont_to(ii)
+        ireq=ireq+1
+        call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
+     &    FG_COMM,req(ireq),IERR)
+      enddo
+c      write (iout,*) "ISEND ended"
+c      write (iout,*) "number of requests (nn)",ireq
+      call flush(iout)
+      if (ireq.gt.0) 
+     &  call MPI_Waitall(ireq,req,status_array,ierr)
+c      write (iout,*) 
+c     &  "Numbers of contacts to be received from other processors",
+c     &  (ncont_recv(i),i=1,ntask_cont_from)
+c      call flush(iout)
+C Receive contacts
+      ireq=0
+      do ii=1,ntask_cont_from
+        iproc=itask_cont_from(ii)
+        nn=ncont_recv(ii)
+c        write (iout,*) "Receiving",nn," contacts from processor",iproc,
+c     &   " of CONT_TO_COMM group"
+        call flush(iout)
+        if (nn.gt.0) then
+          ireq=ireq+1
+          call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
+     &    MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
+c          write (iout,*) "ireq,req",ireq,req(ireq)
+        endif
+      enddo
+C Send the contacts to processors that need them
+      do ii=1,ntask_cont_to
+        iproc=itask_cont_to(ii)
+        nn=ncont_sent(ii)
+c        write (iout,*) nn," contacts to processor",iproc,
+c     &   " of CONT_TO_COMM group"
+        if (nn.gt.0) then
+          ireq=ireq+1 
+          call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
+     &      iproc,CorrelType1,FG_COMM,req(ireq),IERR)
+c          write (iout,*) "ireq,req",ireq,req(ireq)
+c          do i=1,nn
+c            write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
+c          enddo
+        endif  
+      enddo
+c      write (iout,*) "number of requests (contacts)",ireq
+c      write (iout,*) "req",(req(i),i=1,4)
+c      call flush(iout)
+      if (ireq.gt.0) 
+     & call MPI_Waitall(ireq,req,status_array,ierr)
+      do iii=1,ntask_cont_from
+        iproc=itask_cont_from(iii)
+        nn=ncont_recv(iii)
+        if (lprn) then
+        write (iout,*) "Received",nn," contacts from processor",iproc,
+     &   " of CONT_FROM_COMM group"
+        call flush(iout)
+        do i=1,nn
+          write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
+        enddo
+        call flush(iout)
+        endif
+        do i=1,nn
+          ii=zapas_recv(1,i,iii)
+c Flag the received contacts to prevent double-counting
+          jj=-zapas_recv(2,i,iii)
+c          write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
+c          call flush(iout)
+          nnn=num_cont_hb(ii)+1
+          num_cont_hb(ii)=nnn
+          jcont_hb(nnn,ii)=jj
+          facont_hb(nnn,ii)=zapas_recv(3,i,iii)
+          ees0p(nnn,ii)=zapas_recv(4,i,iii)
+          ees0m(nnn,ii)=zapas_recv(5,i,iii)
+          gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
+          gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
+          gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
+          gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
+          gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
+          gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
+          gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
+          gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
+          gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
+          gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
+          gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
+          gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
+          gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
+          gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
+          gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
+          gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
+          gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
+          gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
+          gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
+          gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
+          gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
+        enddo
+      enddo
+      call flush(iout)
+      if (lprn) then
+        write (iout,'(a)') 'Contact function values after receive:'
+        do i=nnt,nct-2
+          write (iout,'(2i3,50(1x,i3,f5.2))') 
+     &    i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
+     &    j=1,num_cont_hb(i))
+        enddo
+        call flush(iout)
+      endif
+   30 continue
+#endif
+      if (lprn) then
+        write (iout,'(a)') 'Contact function values:'
+        do i=nnt,nct-2
+          write (iout,'(2i3,50(1x,i3,f5.2))') 
+     &    i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
+     &    j=1,num_cont_hb(i))
+        enddo
+      endif
+      ecorr=0.0D0
+C Remove the loop below after debugging !!!
+      do i=nnt,nct
+        do j=1,3
+          gradcorr(j,i)=0.0D0
+          gradxorr(j,i)=0.0D0
+        enddo
+      enddo
+C Calculate the local-electrostatic correlation terms
+      do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
+        i1=i+1
+        num_conti=num_cont_hb(i)
+        num_conti1=num_cont_hb(i+1)
+        do jj=1,num_conti
+          j=jcont_hb(jj,i)
+          jp=iabs(j)
+          do kk=1,num_conti1
+            j1=jcont_hb(kk,i1)
+            jp1=iabs(j1)
+c            write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+c     &         ' jj=',jj,' kk=',kk
+            if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 
+     &          .or. j.lt.0 .and. j1.gt.0) .and.
+     &         (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
+C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. 
+C The system gains extra energy.
+              ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
+              if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
+     &            'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
+              n_corr=n_corr+1
+            else if (j1.eq.j) then
+C Contacts I-J and I-(J+1) occur simultaneously. 
+C The system loses extra energy.
+c             ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) 
+            endif
+          enddo ! kk
+          do kk=1,num_conti
+            j1=jcont_hb(kk,i)
+c           write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+c    &         ' jj=',jj,' kk=',kk
+            if (j1.eq.j+1) then
+C Contacts I-J and (I+1)-J occur simultaneously. 
+C The system loses extra energy.
+c             ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
+            endif ! j1==j+1
+          enddo ! kk
+        enddo ! jj
+      enddo ! i
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine add_hb_contact(ii,jj,itask)
+      implicit real*8 (a-h,o-z)
+      include "DIMENSIONS"
+      include "COMMON.IOUNITS"
+      integer max_cont
+      integer max_dim
+      parameter (max_cont=maxconts)
+      parameter (max_dim=26)
+      include "COMMON.CONTACTS"
+      double precision zapas(max_dim,maxconts,max_fg_procs),
+     &  zapas_recv(max_dim,maxconts,max_fg_procs)
+      common /przechowalnia/ zapas
+      integer i,j,ii,jj,iproc,itask(4),nn
+c      write (iout,*) "itask",itask
+      do i=1,2
+        iproc=itask(i)
+        if (iproc.gt.0) then
+          do j=1,num_cont_hb(ii)
+            jjc=jcont_hb(j,ii)
+c            write (iout,*) "i",ii," j",jj," jjc",jjc
+            if (jjc.eq.jj) then
+              ncont_sent(iproc)=ncont_sent(iproc)+1
+              nn=ncont_sent(iproc)
+              zapas(1,nn,iproc)=ii
+              zapas(2,nn,iproc)=jjc
+              zapas(3,nn,iproc)=facont_hb(j,ii)
+              zapas(4,nn,iproc)=ees0p(j,ii)
+              zapas(5,nn,iproc)=ees0m(j,ii)
+              zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
+              zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
+              zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
+              zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
+              zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
+              zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
+              zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
+              zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
+              zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
+              zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
+              zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
+              zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
+              zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
+              zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
+              zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
+              zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
+              zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
+              zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
+              zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
+              zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
+              zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
+              exit
+            endif
+          enddo
+        endif
+      enddo
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
+     &  n_corr1)
+C This subroutine calculates multi-body contributions to hydrogen-bonding 
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+#ifdef MPI
+      include "mpif.h"
+      parameter (max_cont=maxconts)
+      parameter (max_dim=70)
+      integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
+      double precision zapas(max_dim,maxconts,max_fg_procs),
+     &  zapas_recv(max_dim,maxconts,max_fg_procs)
+      common /przechowalnia/ zapas
+      integer status(MPI_STATUS_SIZE),req(maxconts*2),
+     &  status_array(MPI_STATUS_SIZE,maxconts*2)
+#endif
+      include 'COMMON.SETUP'
+      include 'COMMON.FFIELD'
+      include 'COMMON.DERIV'
+      include 'COMMON.LOCAL'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.CONTROL'
+      double precision gx(3),gx1(3)
+      integer num_cont_hb_old(maxres)
+      logical lprn,ldone
+      double precision eello4,eello5,eelo6,eello_turn6
+      external eello4,eello5,eello6,eello_turn6
+C Set lprn=.true. for debugging
+      lprn=.false.
+      eturn6=0.0d0
+#ifdef MPI
+      do i=1,nres
+        num_cont_hb_old(i)=num_cont_hb(i)
+      enddo
+      n_corr=0
+      n_corr1=0
+      if (nfgtasks.le.1) goto 30
+      if (lprn) then
+        write (iout,'(a)') 'Contact function values before RECEIVE:'
+        do i=nnt,nct-2
+          write (iout,'(2i3,50(1x,i2,f5.2))') 
+     &    i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
+     &    j=1,num_cont_hb(i))
+        enddo
+      endif
+      call flush(iout)
+      do i=1,ntask_cont_from
+        ncont_recv(i)=0
+      enddo
+      do i=1,ntask_cont_to
+        ncont_sent(i)=0
+      enddo
+c      write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
+c     & ntask_cont_to
+C Make the list of contacts to send to send to other procesors
+      do i=iturn3_start,iturn3_end
+c        write (iout,*) "make contact list turn3",i," num_cont",
+c     &    num_cont_hb(i)
+        call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
+      enddo
+      do i=iturn4_start,iturn4_end
+c        write (iout,*) "make contact list turn4",i," num_cont",
+c     &   num_cont_hb(i)
+        call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
+      enddo
+      do ii=1,nat_sent
+        i=iat_sent(ii)
+c        write (iout,*) "make contact list longrange",i,ii," num_cont",
+c     &    num_cont_hb(i)
+        do j=1,num_cont_hb(i)
+        do k=1,4
+          jjc=jcont_hb(j,i)
+          iproc=iint_sent_local(k,jjc,ii)
+c          write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
+          if (iproc.ne.0) then
+            ncont_sent(iproc)=ncont_sent(iproc)+1
+            nn=ncont_sent(iproc)
+            zapas(1,nn,iproc)=i
+            zapas(2,nn,iproc)=jjc
+            zapas(3,nn,iproc)=d_cont(j,i)
+            ind=3
+            do kk=1,3
+              ind=ind+1
+              zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
+            enddo
+            do kk=1,2
+              do ll=1,2
+                ind=ind+1
+                zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
+              enddo
+            enddo
+            do jj=1,5
+              do kk=1,3
+                do ll=1,2
+                  do mm=1,2
+                    ind=ind+1
+                    zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
+                  enddo
+                enddo
+              enddo
+            enddo
+          endif
+        enddo
+        enddo
+      enddo
+      if (lprn) then
+      write (iout,*) 
+     &  "Numbers of contacts to be sent to other processors",
+     &  (ncont_sent(i),i=1,ntask_cont_to)
+      write (iout,*) "Contacts sent"
+      do ii=1,ntask_cont_to
+        nn=ncont_sent(ii)
+        iproc=itask_cont_to(ii)
+        write (iout,*) nn," contacts to processor",iproc,
+     &   " of CONT_TO_COMM group"
+        do i=1,nn
+          write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
+        enddo
+      enddo
+      call flush(iout)
+      endif
+      CorrelType=477
+      CorrelID=fg_rank+1
+      CorrelType1=478
+      CorrelID1=nfgtasks+fg_rank+1
+      ireq=0
+C Receive the numbers of needed contacts from other processors 
+      do ii=1,ntask_cont_from
+        iproc=itask_cont_from(ii)
+        ireq=ireq+1
+        call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
+     &    FG_COMM,req(ireq),IERR)
+      enddo
+c      write (iout,*) "IRECV ended"
+c      call flush(iout)
+C Send the number of contacts needed by other processors
+      do ii=1,ntask_cont_to
+        iproc=itask_cont_to(ii)
+        ireq=ireq+1
+        call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
+     &    FG_COMM,req(ireq),IERR)
+      enddo
+c      write (iout,*) "ISEND ended"
+c      write (iout,*) "number of requests (nn)",ireq
+      call flush(iout)
+      if (ireq.gt.0) 
+     &  call MPI_Waitall(ireq,req,status_array,ierr)
+c      write (iout,*) 
+c     &  "Numbers of contacts to be received from other processors",
+c     &  (ncont_recv(i),i=1,ntask_cont_from)
+c      call flush(iout)
+C Receive contacts
+      ireq=0
+      do ii=1,ntask_cont_from
+        iproc=itask_cont_from(ii)
+        nn=ncont_recv(ii)
+c        write (iout,*) "Receiving",nn," contacts from processor",iproc,
+c     &   " of CONT_TO_COMM group"
+        call flush(iout)
+        if (nn.gt.0) then
+          ireq=ireq+1
+          call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
+     &    MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
+c          write (iout,*) "ireq,req",ireq,req(ireq)
+        endif
+      enddo
+C Send the contacts to processors that need them
+      do ii=1,ntask_cont_to
+        iproc=itask_cont_to(ii)
+        nn=ncont_sent(ii)
+c        write (iout,*) nn," contacts to processor",iproc,
+c     &   " of CONT_TO_COMM group"
+        if (nn.gt.0) then
+          ireq=ireq+1 
+          call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
+     &      iproc,CorrelType1,FG_COMM,req(ireq),IERR)
+c          write (iout,*) "ireq,req",ireq,req(ireq)
+c          do i=1,nn
+c            write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
+c          enddo
+        endif  
+      enddo
+c      write (iout,*) "number of requests (contacts)",ireq
+c      write (iout,*) "req",(req(i),i=1,4)
+c      call flush(iout)
+      if (ireq.gt.0) 
+     & call MPI_Waitall(ireq,req,status_array,ierr)
+      do iii=1,ntask_cont_from
+        iproc=itask_cont_from(iii)
+        nn=ncont_recv(iii)
+        if (lprn) then
+        write (iout,*) "Received",nn," contacts from processor",iproc,
+     &   " of CONT_FROM_COMM group"
+        call flush(iout)
+        do i=1,nn
+          write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
+        enddo
+        call flush(iout)
+        endif
+        do i=1,nn
+          ii=zapas_recv(1,i,iii)
+c Flag the received contacts to prevent double-counting
+          jj=-zapas_recv(2,i,iii)
+c          write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
+c          call flush(iout)
+          nnn=num_cont_hb(ii)+1
+          num_cont_hb(ii)=nnn
+          jcont_hb(nnn,ii)=jj
+          d_cont(nnn,ii)=zapas_recv(3,i,iii)
+          ind=3
+          do kk=1,3
+            ind=ind+1
+            grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
+          enddo
+          do kk=1,2
+            do ll=1,2
+              ind=ind+1
+              a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
+            enddo
+          enddo
+          do jj=1,5
+            do kk=1,3
+              do ll=1,2
+                do mm=1,2
+                  ind=ind+1
+                  a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
+                enddo
+              enddo
+            enddo
+          enddo
+        enddo
+      enddo
+      call flush(iout)
+      if (lprn) then
+        write (iout,'(a)') 'Contact function values after receive:'
+        do i=nnt,nct-2
+          write (iout,'(2i3,50(1x,i3,5f6.3))') 
+     &    i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
+     &    ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
+        enddo
+        call flush(iout)
+      endif
+   30 continue
+#endif
+      if (lprn) then
+        write (iout,'(a)') 'Contact function values:'
+        do i=nnt,nct-2
+          write (iout,'(2i3,50(1x,i2,5f6.3))') 
+     &    i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
+     &    ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
+        enddo
+      endif
+      ecorr=0.0D0
+      ecorr5=0.0d0
+      ecorr6=0.0d0
+C Remove the loop below after debugging !!!
+      do i=nnt,nct
+        do j=1,3
+          gradcorr(j,i)=0.0D0
+          gradxorr(j,i)=0.0D0
+        enddo
+      enddo
+C Calculate the dipole-dipole interaction energies
+      if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
+      do i=iatel_s,iatel_e+1
+        num_conti=num_cont_hb(i)
+        do jj=1,num_conti
+          j=jcont_hb(jj,i)
+#ifdef MOMENT
+          call dipole(i,j,jj)
+#endif
+        enddo
+      enddo
+      endif
+C Calculate the local-electrostatic correlation terms
+c                write (iout,*) "gradcorr5 in eello5 before loop"
+c                do iii=1,nres
+c                  write (iout,'(i5,3f10.5)') 
+c     &             iii,(gradcorr5(jjj,iii),jjj=1,3)
+c                enddo
+      do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
+c        write (iout,*) "corr loop i",i
+        i1=i+1
+        num_conti=num_cont_hb(i)
+        num_conti1=num_cont_hb(i+1)
+        do jj=1,num_conti
+          j=jcont_hb(jj,i)
+          jp=iabs(j)
+          do kk=1,num_conti1
+            j1=jcont_hb(kk,i1)
+            jp1=iabs(j1)
+c            write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
+c     &         ' jj=',jj,' kk=',kk
+c            if (j1.eq.j+1 .or. j1.eq.j-1) then
+            if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 
+     &          .or. j.lt.0 .and. j1.gt.0) .and.
+     &         (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
+C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. 
+C The system gains extra energy.
+              n_corr=n_corr+1
+              sqd1=dsqrt(d_cont(jj,i))
+              sqd2=dsqrt(d_cont(kk,i1))
+              sred_geom = sqd1*sqd2
+              IF (sred_geom.lt.cutoff_corr) THEN
+                call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
+     &            ekont,fprimcont)
+cd               write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
+cd     &         ' jj=',jj,' kk=',kk
+                fac_prim1=0.5d0*sqd2/sqd1*fprimcont
+                fac_prim2=0.5d0*sqd1/sqd2*fprimcont
+                do l=1,3
+                  g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
+                  g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
+                enddo
+                n_corr1=n_corr1+1
+cd               write (iout,*) 'sred_geom=',sred_geom,
+cd     &          ' ekont=',ekont,' fprim=',fprimcont,
+cd     &          ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
+cd               write (iout,*) "g_contij",g_contij
+cd               write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
+cd               write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
+                call calc_eello(i,jp,i+1,jp1,jj,kk)
+                if (wcorr4.gt.0.0d0) 
+     &            ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
+                  if (energy_dec.and.wcorr4.gt.0.0d0) 
+     1                 write (iout,'(a6,4i5,0pf7.3)')
+     2                'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
+c                write (iout,*) "gradcorr5 before eello5"
+c                do iii=1,nres
+c                  write (iout,'(i5,3f10.5)') 
+c     &             iii,(gradcorr5(jjj,iii),jjj=1,3)
+c                enddo
+                if (wcorr5.gt.0.0d0)
+     &            ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
+c                write (iout,*) "gradcorr5 after eello5"
+c                do iii=1,nres
+c                  write (iout,'(i5,3f10.5)') 
+c     &             iii,(gradcorr5(jjj,iii),jjj=1,3)
+c                enddo
+                  if (energy_dec.and.wcorr5.gt.0.0d0) 
+     1                 write (iout,'(a6,4i5,0pf7.3)')
+     2                'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
+cd                write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
+cd                write(2,*)'ijkl',i,jp,i+1,jp1 
+                if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
+     &               .or. wturn6.eq.0.0d0))then
+cd                  write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
+                  ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
+                  if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
+     1                'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
+cd                write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
+cd     &            'ecorr6=',ecorr6
+cd                write (iout,'(4e15.5)') sred_geom,
+cd     &          dabs(eello4(i,jp,i+1,jp1,jj,kk)),
+cd     &          dabs(eello5(i,jp,i+1,jp1,jj,kk)),
+cd     &          dabs(eello6(i,jp,i+1,jp1,jj,kk))
+                else if (wturn6.gt.0.0d0
+     &            .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
+cd                  write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
+                  eturn6=eturn6+eello_turn6(i,jj,kk)
+                  if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
+     1                 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
+cd                  write (2,*) 'multibody_eello:eturn6',eturn6
+                endif
+              ENDIF
+1111          continue
+            endif
+          enddo ! kk
+        enddo ! jj
+      enddo ! i
+      do i=1,nres
+        num_cont_hb(i)=num_cont_hb_old(i)
+      enddo
+c                write (iout,*) "gradcorr5 in eello5"
+c                do iii=1,nres
+c                  write (iout,'(i5,3f10.5)') 
+c     &             iii,(gradcorr5(jjj,iii),jjj=1,3)
+c                enddo
+      return
+      end
+c------------------------------------------------------------------------------
+      subroutine add_hb_contact_eello(ii,jj,itask)
+      implicit real*8 (a-h,o-z)
+      include "DIMENSIONS"
+      include "COMMON.IOUNITS"
+      integer max_cont
+      integer max_dim
+      parameter (max_cont=maxconts)
+      parameter (max_dim=70)
+      include "COMMON.CONTACTS"
+      double precision zapas(max_dim,maxconts,max_fg_procs),
+     &  zapas_recv(max_dim,maxconts,max_fg_procs)
+      common /przechowalnia/ zapas
+      integer i,j,ii,jj,iproc,itask(4),nn
+c      write (iout,*) "itask",itask
+      do i=1,2
+        iproc=itask(i)
+        if (iproc.gt.0) then
+          do j=1,num_cont_hb(ii)
+            jjc=jcont_hb(j,ii)
+c            write (iout,*) "send turns i",ii," j",jj," jjc",jjc
+            if (jjc.eq.jj) then
+              ncont_sent(iproc)=ncont_sent(iproc)+1
+              nn=ncont_sent(iproc)
+              zapas(1,nn,iproc)=ii
+              zapas(2,nn,iproc)=jjc
+              zapas(3,nn,iproc)=d_cont(j,ii)
+              ind=3
+              do kk=1,3
+                ind=ind+1
+                zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
+              enddo
+              do kk=1,2
+                do ll=1,2
+                  ind=ind+1
+                  zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
+                enddo
+              enddo
+              do jj=1,5
+                do kk=1,3
+                  do ll=1,2
+                    do mm=1,2
+                      ind=ind+1
+                      zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
+                    enddo
+                  enddo
+                enddo
+              enddo
+              exit
+            endif
+          enddo
+        endif
+      enddo
+      return
+      end
+c------------------------------------------------------------------------------
+      double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      double precision gx(3),gx1(3)
+      logical lprn
+      lprn=.false.
+      eij=facont_hb(jj,i)
+      ekl=facont_hb(kk,k)
+      ees0pij=ees0p(jj,i)
+      ees0pkl=ees0p(kk,k)
+      ees0mij=ees0m(jj,i)
+      ees0mkl=ees0m(kk,k)
+      ekont=eij*ekl
+      ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
+cd    ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
+C Following 4 lines for diagnostics.
+cd    ees0pkl=0.0D0
+cd    ees0pij=1.0D0
+cd    ees0mkl=0.0D0
+cd    ees0mij=1.0D0
+c      write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
+c     & 'Contacts ',i,j,
+c     & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
+c     & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
+c     & 'gradcorr_long'
+C Calculate the multi-body contribution to energy.
+c      ecorr=ecorr+ekont*ees
+C Calculate multi-body contributions to the gradient.
+      coeffpees0pij=coeffp*ees0pij
+      coeffmees0mij=coeffm*ees0mij
+      coeffpees0pkl=coeffp*ees0pkl
+      coeffmees0mkl=coeffm*ees0mkl
+      do ll=1,3
+cgrad        ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
+        gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
+     &  -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
+     &  coeffmees0mkl*gacontm_hb1(ll,jj,i))
+        gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
+     &  -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
+     &  coeffmees0mkl*gacontm_hb2(ll,jj,i))
+cgrad        ghalfk=ees*eij*gacont_hbr(ll,kk,k)
+        gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
+     &  -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
+     &  coeffmees0mij*gacontm_hb1(ll,kk,k))
+        gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
+     &  -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
+     &  coeffmees0mij*gacontm_hb2(ll,kk,k))
+        gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
+     &     ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
+     &     coeffmees0mkl*gacontm_hb3(ll,jj,i))
+        gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
+        gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
+        gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
+     &     ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
+     &     coeffmees0mij*gacontm_hb3(ll,kk,k))
+        gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
+        gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
+c        write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
+      enddo
+c      write (iout,*)
+cgrad      do m=i+1,j-1
+cgrad        do ll=1,3
+cgrad          gradcorr(ll,m)=gradcorr(ll,m)+
+cgrad     &     ees*ekl*gacont_hbr(ll,jj,i)-
+cgrad     &     ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
+cgrad     &     coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+1,l-1
+cgrad        do ll=1,3
+cgrad          gradcorr(ll,m)=gradcorr(ll,m)+
+cgrad     &     ees*eij*gacont_hbr(ll,kk,k)-
+cgrad     &     ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
+cgrad     &     coeffm*ees0mij*gacontm_hb3(ll,kk,k))
+cgrad        enddo
+cgrad      enddo 
+c      write (iout,*) "ehbcorr",ekont*ees
+      ehbcorr=ekont*ees
+      return
+      end
+#ifdef MOMENT
+C---------------------------------------------------------------------------
+      subroutine dipole(i,j,jj)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.FFIELD'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
+     &  auxmat(2,2)
+      iti1 = itortyp(itype(i+1))
+      if (j.lt.nres-1) then
+        itj1 = itortyp(itype(j+1))
+      else
+        itj1=ntortyp+1
+      endif
+      do iii=1,2
+        dipi(iii,1)=Ub2(iii,i)
+        dipderi(iii)=Ub2der(iii,i)
+        dipi(iii,2)=b1(iii,i+1)
+        dipj(iii,1)=Ub2(iii,j)
+        dipderj(iii)=Ub2der(iii,j)
+        dipj(iii,2)=b1(iii,j+1)
+      enddo
+      kkk=0
+      do iii=1,2
+        call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) 
+        do jjj=1,2
+          kkk=kkk+1
+          dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
+        enddo
+      enddo
+      do kkk=1,5
+        do lll=1,3
+          mmm=0
+          do iii=1,2
+            call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
+     &        auxvec(1))
+            do jjj=1,2
+              mmm=mmm+1
+              dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
+            enddo
+          enddo
+        enddo
+      enddo
+      call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
+      call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
+      do iii=1,2
+        dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
+      enddo
+      call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
+      do iii=1,2
+        dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
+      enddo
+      return
+      end
+#endif
+C---------------------------------------------------------------------------
+      subroutine calc_eello(i,j,k,l,jj,kk)
+C 
+C This subroutine computes matrices and vectors needed to calculate 
+C the fourth-, fifth-, and sixth-order local-electrostatic terms.
+C
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      include 'COMMON.FFIELD'
+      double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
+     &  aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
+      logical lprn
+      common /kutas/ lprn
+cd      write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
+cd     & ' jj=',jj,' kk=',kk
+cd      if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
+cd      write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
+cd      write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
+      do iii=1,2
+        do jjj=1,2
+          aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
+          aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
+        enddo
+      enddo
+      call transpose2(aa1(1,1),aa1t(1,1))
+      call transpose2(aa2(1,1),aa2t(1,1))
+      do kkk=1,5
+        do lll=1,3
+          call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
+     &      aa1tder(1,1,lll,kkk))
+          call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
+     &      aa2tder(1,1,lll,kkk))
+        enddo
+      enddo 
+      if (l.eq.j+1) then
+C parallel orientation of the two CA-CA-CA frames.
+        if (i.gt.1) then
+          iti=itortyp(itype(i))
+        else
+          iti=ntortyp+1
+        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
+        endif
+C A1 kernel(j+1) A2T
+cd        do iii=1,2
+cd          write (iout,'(3f10.5,5x,3f10.5)') 
+cd     &     (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
+cd        enddo
+        call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
+     &   aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
+     &   AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
+C Following matrices are needed only for 6-th order cumulants
+        IF (wcorr6.gt.0.0d0) THEN
+        call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
+     &   aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
+     &   AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
+        call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
+     &   aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
+     &   Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
+     &   ADtEAderx(1,1,1,1,1,1))
+        lprn=.false.
+        call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
+     &   aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
+     &   DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
+     &   ADtEA1derx(1,1,1,1,1,1))
+        ENDIF
+C End 6-th order cumulants
+cd        lprn=.false.
+cd        if (lprn) then
+cd        write (2,*) 'In calc_eello6'
+cd        do iii=1,2
+cd          write (2,*) 'iii=',iii
+cd          do kkk=1,5
+cd            write (2,*) 'kkk=',kkk
+cd            do jjj=1,2
+cd              write (2,'(3(2f10.5),5x)') 
+cd     &        ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
+cd            enddo
+cd          enddo
+cd        enddo
+cd        endif
+        call transpose2(EUgder(1,1,k),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
+        call transpose2(EUg(1,1,k),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
+        call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
+     &          EAEAderx(1,1,lll,kkk,iii,1))
+            enddo
+          enddo
+        enddo
+C A1T kernel(i+1) A2
+        call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
+     &   a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
+     &   AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
+C Following matrices are needed only for 6-th order cumulants
+        IF (wcorr6.gt.0.0d0) THEN
+        call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
+     &   a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
+     &   AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
+        call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
+     &   a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
+     &   Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
+     &   ADtEAderx(1,1,1,1,1,2))
+        call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
+     &   a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
+     &   DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
+     &   ADtEA1derx(1,1,1,1,1,2))
+        ENDIF
+C End 6-th order cumulants
+        call transpose2(EUgder(1,1,l),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
+        call transpose2(EUg(1,1,l),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
+        call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
+     &          EAEAderx(1,1,lll,kkk,iii,2))
+            enddo
+          enddo
+        enddo
+C AEAb1 and AEAb2
+C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
+C They are needed only when the fifth- or the sixth-order cumulants are
+C indluded.
+        IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
+        call transpose2(AEA(1,1,1),auxmat(1,1))
+        call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
+        call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
+        call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
+        call transpose2(AEAderg(1,1,1),auxmat(1,1))
+        call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
+        call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
+        call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
+        call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
+        call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
+        call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
+        call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
+        call transpose2(AEA(1,1,2),auxmat(1,1))
+        call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
+        call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
+        call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
+        call transpose2(AEAderg(1,1,2),auxmat(1,1))
+        call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
+        call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
+        call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
+        call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
+        call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
+        call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
+        call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
+C Calculate the Cartesian derivatives of the vectors.
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
+              call matvec2(auxmat(1,1),b1(1,i),
+     &          AEAb1derx(1,lll,kkk,iii,1,1))
+              call matvec2(auxmat(1,1),Ub2(1,i),
+     &          AEAb2derx(1,lll,kkk,iii,1,1))
+              call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
+     &          AEAb1derx(1,lll,kkk,iii,2,1))
+              call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
+     &          AEAb2derx(1,lll,kkk,iii,2,1))
+              call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
+              call matvec2(auxmat(1,1),b1(1,j),
+     &          AEAb1derx(1,lll,kkk,iii,1,2))
+              call matvec2(auxmat(1,1),Ub2(1,j),
+     &          AEAb2derx(1,lll,kkk,iii,1,2))
+              call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
+     &          AEAb1derx(1,lll,kkk,iii,2,2))
+              call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
+     &          AEAb2derx(1,lll,kkk,iii,2,2))
+            enddo
+          enddo
+        enddo
+        ENDIF
+C End vectors
+      else
+C Antiparallel orientation of the two CA-CA-CA frames.
+        if (i.gt.1) then
+          iti=itortyp(itype(i))
+        else
+          iti=ntortyp+1
+        endif
+        itk1=itortyp(itype(k+1))
+        itl=itortyp(itype(l))
+        itj=itortyp(itype(j))
+        if (j.lt.nres-1) then
+          itj1=itortyp(itype(j+1))
+        else 
+          itj1=ntortyp+1
+        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),
+     &   aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
+     &   AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
+C Following matrices are needed only for 6-th order cumulants
+        IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
+     &     j.eq.i+4 .and. l.eq.i+3)) THEN
+        call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
+     &   aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
+     &   AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
+        call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
+     &   aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
+     &   Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
+     &   ADtEAderx(1,1,1,1,1,1))
+        call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
+     &   aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
+     &   DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
+     &   ADtEA1derx(1,1,1,1,1,1))
+        ENDIF
+C End 6-th order cumulants
+        call transpose2(EUgder(1,1,k),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
+        call transpose2(EUg(1,1,k),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
+        call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
+     &          EAEAderx(1,1,lll,kkk,iii,1))
+            enddo
+          enddo
+        enddo
+C A2T kernel(i+1)T A1
+        call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
+     &   a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
+     &   AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
+C Following matrices are needed only for 6-th order cumulants
+        IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
+     &     j.eq.i+4 .and. l.eq.i+3)) THEN
+        call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
+     &   a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
+     &   AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
+        call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
+     &   a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
+     &   Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
+     &   ADtEAderx(1,1,1,1,1,2))
+        call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
+     &   a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
+     &   DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
+     &   ADtEA1derx(1,1,1,1,1,2))
+        ENDIF
+C End 6-th order cumulants
+        call transpose2(EUgder(1,1,j),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
+        call transpose2(EUg(1,1,j),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
+        call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
+     &          EAEAderx(1,1,lll,kkk,iii,2))
+            enddo
+          enddo
+        enddo
+C AEAb1 and AEAb2
+C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
+C They are needed only when the fifth- or the sixth-order cumulants are
+C indluded.
+        IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
+     &    (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
+        call transpose2(AEA(1,1,1),auxmat(1,1))
+        call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
+        call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
+        call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
+        call transpose2(AEAderg(1,1,1),auxmat(1,1))
+        call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
+        call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
+        call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
+        call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
+        call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
+        call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
+        call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
+        call transpose2(AEA(1,1,2),auxmat(1,1))
+        call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
+        call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
+        call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
+        call transpose2(AEAderg(1,1,2),auxmat(1,1))
+        call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
+        call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
+        call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
+        call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
+        call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
+        call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
+        call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
+C Calculate the Cartesian derivatives of the vectors.
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
+              call matvec2(auxmat(1,1),b1(1,i),
+     &          AEAb1derx(1,lll,kkk,iii,1,1))
+              call matvec2(auxmat(1,1),Ub2(1,i),
+     &          AEAb2derx(1,lll,kkk,iii,1,1))
+              call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
+     &          AEAb1derx(1,lll,kkk,iii,2,1))
+              call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
+     &          AEAb2derx(1,lll,kkk,iii,2,1))
+              call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
+              call matvec2(auxmat(1,1),b1(1,l),
+     &          AEAb1derx(1,lll,kkk,iii,1,2))
+              call matvec2(auxmat(1,1),Ub2(1,l),
+     &          AEAb2derx(1,lll,kkk,iii,1,2))
+              call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
+     &          AEAb1derx(1,lll,kkk,iii,2,2))
+              call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
+     &          AEAb2derx(1,lll,kkk,iii,2,2))
+            enddo
+          enddo
+        enddo
+        ENDIF
+C End vectors
+      endif
+      return
+      end
+C---------------------------------------------------------------------------
+      subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
+     &  KK,KKderg,AKA,AKAderg,AKAderx)
+      implicit none
+      integer nderg
+      logical transp
+      double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
+     &  aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
+     &  AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
+      integer iii,kkk,lll
+      integer jjj,mmm
+      logical lprn
+      common /kutas/ lprn
+      call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
+      do iii=1,nderg 
+        call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
+     &    AKAderg(1,1,iii))
+      enddo
+cd      if (lprn) write (2,*) 'In kernel'
+      do kkk=1,5
+cd        if (lprn) write (2,*) 'kkk=',kkk
+        do lll=1,3
+          call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
+     &      KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
+cd          if (lprn) then
+cd            write (2,*) 'lll=',lll
+cd            write (2,*) 'iii=1'
+cd            do jjj=1,2
+cd              write (2,'(3(2f10.5),5x)') 
+cd     &        (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
+cd            enddo
+cd          endif
+          call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
+     &      KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
+cd          if (lprn) then
+cd            write (2,*) 'lll=',lll
+cd            write (2,*) 'iii=2'
+cd            do jjj=1,2
+cd              write (2,'(3(2f10.5),5x)') 
+cd     &        (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
+cd            enddo
+cd          endif
+        enddo
+      enddo
+      return
+      end
+C---------------------------------------------------------------------------
+      double precision function eello4(i,j,k,l,jj,kk)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      double precision pizda(2,2),ggg1(3),ggg2(3)
+cd      if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
+cd        eello4=0.0d0
+cd        return
+cd      endif
+cd      print *,'eello4:',i,j,k,l,jj,kk
+cd      write (2,*) 'i',i,' j',j,' k',k,' l',l
+cd      call checkint4(i,j,k,l,jj,kk,eel4_num)
+cold      eij=facont_hb(jj,i)
+cold      ekl=facont_hb(kk,k)
+cold      ekont=eij*ekl
+      eel4=-EAEA(1,1,1)-EAEA(2,2,1)
+cd      eel41=-EAEA(1,1,2)-EAEA(2,2,2)
+      gcorr_loc(k-1)=gcorr_loc(k-1)
+     &   -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
+      if (l.eq.j+1) then
+        gcorr_loc(l-1)=gcorr_loc(l-1)
+     &     -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
+      else
+        gcorr_loc(j-1)=gcorr_loc(j-1)
+     &     -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
+      endif
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+            derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
+     &                        -EAEAderx(2,2,lll,kkk,iii,1)
+cd            derx(lll,kkk,iii)=0.0d0
+          enddo
+        enddo
+      enddo
+cd      gcorr_loc(l-1)=0.0d0
+cd      gcorr_loc(j-1)=0.0d0
+cd      gcorr_loc(k-1)=0.0d0
+cd      eel4=1.0d0
+cd      write (iout,*)'Contacts have occurred for peptide groups',
+cd     &  i,j,' fcont:',eij,' eij',' and ',k,l,
+cd     &  ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
+      if (j.lt.nres-1) then
+        j1=j+1
+        j2=j-1
+      else
+        j1=j-1
+        j2=j-2
+      endif
+      if (l.lt.nres-1) then
+        l1=l+1
+        l2=l-1
+      else
+        l1=l-1
+        l2=l-2
+      endif
+      do ll=1,3
+cgrad        ggg1(ll)=eel4*g_contij(ll,1)
+cgrad        ggg2(ll)=eel4*g_contij(ll,2)
+        glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
+        glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
+cgrad        ghalf=0.5d0*ggg1(ll)
+        gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
+        gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
+        gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
+        gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
+        gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
+        gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
+cgrad        ghalf=0.5d0*ggg2(ll)
+        gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
+        gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
+        gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
+        gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
+        gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
+        gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
+      enddo
+cgrad      do m=i+1,j-1
+cgrad        do ll=1,3
+cgrad          gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+1,l-1
+cgrad        do ll=1,3
+cgrad          gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=i+2,j2
+cgrad        do ll=1,3
+cgrad          gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+2,l2
+cgrad        do ll=1,3
+cgrad          gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
+cgrad        enddo
+cgrad      enddo 
+cd      do iii=1,nres-3
+cd        write (2,*) iii,gcorr_loc(iii)
+cd      enddo
+      eello4=ekont*eel4
+cd      write (2,*) 'ekont',ekont
+cd      write (iout,*) 'eello4',ekont*eel4
+      return
+      end
+C---------------------------------------------------------------------------
+      double precision function eello5(i,j,k,l,jj,kk)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
+      double precision ggg1(3),ggg2(3)
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C                                                                              C
+C                            Parallel chains                                   C
+C                                                                              C
+C          o             o                   o             o                   C
+C         /l\           / \             \   / \           / \   /              C
+C        /   \         /   \             \ /   \         /   \ /               C
+C       j| o |l1       | o |	          o| o |         | o |o                C
+C     \  |/k\|         |/ \|  /            |/ \|         |/ \|                 C
+C      \i/   \         /   \ /             /   \         /   \                 C
+C       o    k1             o                                                  C
+C         (I)          (II)                (III)          (IV)                 C
+C                                                                              C
+C      eello5_1        eello5_2            eello5_3       eello5_4             C
+C                                                                              C
+C                            Antiparallel chains                               C
+C                                                                              C
+C          o             o                   o             o                   C
+C         /j\           / \             \   / \           / \   /              C
+C        /   \         /   \             \ /   \         /   \ /               C
+C      j1| o |l        | o |	          o| o |         | o |o                C
+C     \  |/k\|         |/ \|  /            |/ \|         |/ \|                 C
+C      \i/   \         /   \ /             /   \         /   \                 C
+C       o     k1            o                                                  C
+C         (I)          (II)                (III)          (IV)                 C
+C                                                                              C
+C      eello5_1        eello5_2            eello5_3       eello5_4             C
+C                                                                              C
+C o denotes a local interaction, vertical lines an electrostatic interaction.  C
+C                                                                              C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+cd      if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
+cd        eello5=0.0d0
+cd        return
+cd      endif
+cd      write (iout,*)
+cd     &   'EELLO5: Contacts have occurred for peptide groups',i,j,
+cd     &   ' and',k,l
+      itk=itortyp(itype(k))
+      itl=itortyp(itype(l))
+      itj=itortyp(itype(j))
+      eello5_1=0.0d0
+      eello5_2=0.0d0
+      eello5_3=0.0d0
+      eello5_4=0.0d0
+cd      call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
+cd     &   eel5_3_num,eel5_4_num)
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+            derx(lll,kkk,iii)=0.0d0
+          enddo
+        enddo
+      enddo
+cd      eij=facont_hb(jj,i)
+cd      ekl=facont_hb(kk,k)
+cd      ekont=eij*ekl
+cd      write (iout,*)'Contacts have occurred for peptide groups',
+cd     &  i,j,' fcont:',eij,' eij',' and ',k,l
+cd      goto 1111
+C Contribution from the graph I.
+cd      write (2,*) 'AEA  ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
+cd      write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
+      call transpose2(EUg(1,1,k),auxmat(1,1))
+      call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
+      vv(1)=pizda(1,1)-pizda(2,2)
+      vv(2)=pizda(1,2)+pizda(2,1)
+      eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
+     & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
+C Explicit gradient in virtual-dihedral angles.
+      if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
+     & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
+     & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
+      call transpose2(EUgder(1,1,k),auxmat1(1,1))
+      call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
+      vv(1)=pizda(1,1)-pizda(2,2)
+      vv(2)=pizda(1,2)+pizda(2,1)
+      g_corr5_loc(k-1)=g_corr5_loc(k-1)
+     & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
+     & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+      call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
+      vv(1)=pizda(1,1)-pizda(2,2)
+      vv(2)=pizda(1,2)+pizda(2,1)
+      if (l.eq.j+1) then
+        if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
+     &   +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
+     &   +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+      else
+        if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
+     &   +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
+     &   +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
+      endif 
+C Cartesian gradient
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+            call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
+     &        pizda(1,1))
+            vv(1)=pizda(1,1)-pizda(2,2)
+            vv(2)=pizda(1,2)+pizda(2,1)
+            derx(lll,kkk,iii)=derx(lll,kkk,iii)
+     &       +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
+     &       +0.5d0*scalar2(vv(1),Dtobr2(1,i))
+          enddo
+        enddo
+      enddo
+c      goto 1112
+c1111  continue
+C Contribution from graph II 
+      call transpose2(EE(1,1,itk),auxmat(1,1))
+      call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
+      vv(1)=pizda(1,1)+pizda(2,2)
+      vv(2)=pizda(2,1)-pizda(1,2)
+      eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
+     & -0.5d0*scalar2(vv(1),Ctobr(1,k))
+C Explicit gradient in virtual-dihedral angles.
+      g_corr5_loc(k-1)=g_corr5_loc(k-1)
+     & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
+      call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
+      vv(1)=pizda(1,1)+pizda(2,2)
+      vv(2)=pizda(2,1)-pizda(1,2)
+      if (l.eq.j+1) then
+        g_corr5_loc(l-1)=g_corr5_loc(l-1)
+     &   +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
+     &   -0.5d0*scalar2(vv(1),Ctobr(1,k)))
+      else
+        g_corr5_loc(j-1)=g_corr5_loc(j-1)
+     &   +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
+     &   -0.5d0*scalar2(vv(1),Ctobr(1,k)))
+      endif
+C Cartesian gradient
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+            call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
+     &        pizda(1,1))
+            vv(1)=pizda(1,1)+pizda(2,2)
+            vv(2)=pizda(2,1)-pizda(1,2)
+            derx(lll,kkk,iii)=derx(lll,kkk,iii)
+     &       +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
+     &       -0.5d0*scalar2(vv(1),Ctobr(1,k))
+          enddo
+        enddo
+      enddo
+cd      goto 1112
+cd1111  continue
+      if (l.eq.j+1) then
+cd        goto 1110
+C Parallel orientation
+C Contribution from graph III
+        call transpose2(EUg(1,1,l),auxmat(1,1))
+        call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(1,2)+pizda(2,1)
+        eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
+     &   +0.5d0*scalar2(vv(1),Dtobr2(1,j))
+C Explicit gradient in virtual-dihedral angles.
+        g_corr5_loc(j-1)=g_corr5_loc(j-1)
+     &   +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
+     &   +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
+        call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(1,2)+pizda(2,1)
+        g_corr5_loc(k-1)=g_corr5_loc(k-1)
+     &   +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
+     &   +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
+        call transpose2(EUgder(1,1,l),auxmat1(1,1))
+        call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(1,2)+pizda(2,1)
+        g_corr5_loc(l-1)=g_corr5_loc(l-1)
+     &   +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
+     &   +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
+C Cartesian gradient
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
+     &          pizda(1,1))
+              vv(1)=pizda(1,1)-pizda(2,2)
+              vv(2)=pizda(1,2)+pizda(2,1)
+              derx(lll,kkk,iii)=derx(lll,kkk,iii)
+     &         +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
+     &         +0.5d0*scalar2(vv(1),Dtobr2(1,j))
+            enddo
+          enddo
+        enddo
+cd        goto 1112
+C Contribution from graph IV
+cd1110    continue
+        call transpose2(EE(1,1,itl),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
+        vv(1)=pizda(1,1)+pizda(2,2)
+        vv(2)=pizda(2,1)-pizda(1,2)
+        eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
+     &   -0.5d0*scalar2(vv(1),Ctobr(1,l))
+C Explicit gradient in virtual-dihedral angles.
+        g_corr5_loc(l-1)=g_corr5_loc(l-1)
+     &   -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
+        call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
+        vv(1)=pizda(1,1)+pizda(2,2)
+        vv(2)=pizda(2,1)-pizda(1,2)
+        g_corr5_loc(k-1)=g_corr5_loc(k-1)
+     &   +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
+     &   -0.5d0*scalar2(vv(1),Ctobr(1,l)))
+C Cartesian gradient
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
+     &          pizda(1,1))
+              vv(1)=pizda(1,1)+pizda(2,2)
+              vv(2)=pizda(2,1)-pizda(1,2)
+              derx(lll,kkk,iii)=derx(lll,kkk,iii)
+     &         +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
+     &         -0.5d0*scalar2(vv(1),Ctobr(1,l))
+            enddo
+          enddo
+        enddo
+      else
+C Antiparallel orientation
+C Contribution from graph III
+c        goto 1110
+        call transpose2(EUg(1,1,j),auxmat(1,1))
+        call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(1,2)+pizda(2,1)
+        eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
+     &   +0.5d0*scalar2(vv(1),Dtobr2(1,l))
+C Explicit gradient in virtual-dihedral angles.
+        g_corr5_loc(l-1)=g_corr5_loc(l-1)
+     &   +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
+     &   +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
+        call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(1,2)+pizda(2,1)
+        g_corr5_loc(k-1)=g_corr5_loc(k-1)
+     &   +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
+     &   +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
+        call transpose2(EUgder(1,1,j),auxmat1(1,1))
+        call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(1,2)+pizda(2,1)
+        g_corr5_loc(j-1)=g_corr5_loc(j-1)
+     &   +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
+     &   +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
+C Cartesian gradient
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
+     &          pizda(1,1))
+              vv(1)=pizda(1,1)-pizda(2,2)
+              vv(2)=pizda(1,2)+pizda(2,1)
+              derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
+     &         +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
+     &         +0.5d0*scalar2(vv(1),Dtobr2(1,l))
+            enddo
+          enddo
+        enddo
+cd        goto 1112
+C Contribution from graph IV
+1110    continue
+        call transpose2(EE(1,1,itj),auxmat(1,1))
+        call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
+        vv(1)=pizda(1,1)+pizda(2,2)
+        vv(2)=pizda(2,1)-pizda(1,2)
+        eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
+     &   -0.5d0*scalar2(vv(1),Ctobr(1,j))
+C Explicit gradient in virtual-dihedral angles.
+        g_corr5_loc(j-1)=g_corr5_loc(j-1)
+     &   -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
+        call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
+        vv(1)=pizda(1,1)+pizda(2,2)
+        vv(2)=pizda(2,1)-pizda(1,2)
+        g_corr5_loc(k-1)=g_corr5_loc(k-1)
+     &   +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
+     &   -0.5d0*scalar2(vv(1),Ctobr(1,j)))
+C Cartesian gradient
+        do iii=1,2
+          do kkk=1,5
+            do lll=1,3
+              call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
+     &          pizda(1,1))
+              vv(1)=pizda(1,1)+pizda(2,2)
+              vv(2)=pizda(2,1)-pizda(1,2)
+              derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
+     &         +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
+     &         -0.5d0*scalar2(vv(1),Ctobr(1,j))
+            enddo
+          enddo
+        enddo
+      endif
+1112  continue
+      eel5=eello5_1+eello5_2+eello5_3+eello5_4
+cd      if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
+cd        write (2,*) 'ijkl',i,j,k,l
+cd        write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
+cd     &     ' eello5_3',eello5_3,' eello5_4',eello5_4
+cd      endif
+cd      write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
+cd      write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
+cd      write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
+cd      write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
+      if (j.lt.nres-1) then
+        j1=j+1
+        j2=j-1
+      else
+        j1=j-1
+        j2=j-2
+      endif
+      if (l.lt.nres-1) then
+        l1=l+1
+        l2=l-1
+      else
+        l1=l-1
+        l2=l-2
+      endif
+cd      eij=1.0d0
+cd      ekl=1.0d0
+cd      ekont=1.0d0
+cd      write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
+C 2/11/08 AL Gradients over DC's connecting interacting sites will be
+C        summed up outside the subrouine as for the other subroutines 
+C        handling long-range interactions. The old code is commented out
+C        with "cgrad" to keep track of changes.
+      do ll=1,3
+cgrad        ggg1(ll)=eel5*g_contij(ll,1)
+cgrad        ggg2(ll)=eel5*g_contij(ll,2)
+        gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
+        gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
+c        write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') 
+c     &   "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
+c     &   derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
+c     &   derx(ll,4,2),derx(ll,5,2)," ekont",ekont
+c        write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') 
+c     &   "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
+c     &   gradcorr5ij,
+c     &   k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
+cold        ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
+cgrad        ghalf=0.5d0*ggg1(ll)
+cd        ghalf=0.0d0
+        gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
+        gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
+        gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
+        gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
+        gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
+        gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
+cold        ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
+cgrad        ghalf=0.5d0*ggg2(ll)
+cd        ghalf=0.0d0
+        gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
+        gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
+        gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
+        gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
+        gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
+        gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
+      enddo
+cd      goto 1112
+cgrad      do m=i+1,j-1
+cgrad        do ll=1,3
+cold          gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
+cgrad          gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+1,l-1
+cgrad        do ll=1,3
+cold          gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
+cgrad          gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
+cgrad        enddo
+cgrad      enddo
+c1112  continue
+cgrad      do m=i+2,j2
+cgrad        do ll=1,3
+cgrad          gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+2,l2
+cgrad        do ll=1,3
+cgrad          gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
+cgrad        enddo
+cgrad      enddo 
+cd      do iii=1,nres-3
+cd        write (2,*) iii,g_corr5_loc(iii)
+cd      enddo
+      eello5=ekont*eel5
+cd      write (2,*) 'ekont',ekont
+cd      write (iout,*) 'eello5',ekont*eel5
+      return
+      end
+c--------------------------------------------------------------------------
+      double precision function eello6(i,j,k,l,jj,kk)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      include 'COMMON.FFIELD'
+      double precision ggg1(3),ggg2(3)
+cd      if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
+cd        eello6=0.0d0
+cd        return
+cd      endif
+cd      write (iout,*)
+cd     &   'EELLO6: Contacts have occurred for peptide groups',i,j,
+cd     &   ' and',k,l
+      eello6_1=0.0d0
+      eello6_2=0.0d0
+      eello6_3=0.0d0
+      eello6_4=0.0d0
+      eello6_5=0.0d0
+      eello6_6=0.0d0
+cd      call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
+cd     &   eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+            derx(lll,kkk,iii)=0.0d0
+          enddo
+        enddo
+      enddo
+cd      eij=facont_hb(jj,i)
+cd      ekl=facont_hb(kk,k)
+cd      ekont=eij*ekl
+cd      eij=1.0d0
+cd      ekl=1.0d0
+cd      ekont=1.0d0
+      if (l.eq.j+1) then
+        eello6_1=eello6_graph1(i,j,k,l,1,.false.)
+        eello6_2=eello6_graph1(j,i,l,k,2,.false.)
+        eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
+        eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
+        eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
+        eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
+      else
+        eello6_1=eello6_graph1(i,j,k,l,1,.false.)
+        eello6_2=eello6_graph1(l,k,j,i,2,.true.)
+        eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
+        eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
+        if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
+          eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
+        else
+          eello6_5=0.0d0
+        endif
+        eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
+      endif
+C If turn contributions are considered, they will be handled separately.
+      eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
+cd      write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
+cd      write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
+cd      write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
+cd      write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
+cd      write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
+cd      write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
+cd      goto 1112
+      if (j.lt.nres-1) then
+        j1=j+1
+        j2=j-1
+      else
+        j1=j-1
+        j2=j-2
+      endif
+      if (l.lt.nres-1) then
+        l1=l+1
+        l2=l-1
+      else
+        l1=l-1
+        l2=l-2
+      endif
+      do ll=1,3
+cgrad        ggg1(ll)=eel6*g_contij(ll,1)
+cgrad        ggg2(ll)=eel6*g_contij(ll,2)
+cold        ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
+cgrad        ghalf=0.5d0*ggg1(ll)
+cd        ghalf=0.0d0
+        gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
+        gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
+        gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
+        gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
+        gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
+        gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
+        gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
+        gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
+cgrad        ghalf=0.5d0*ggg2(ll)
+cold        ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
+cd        ghalf=0.0d0
+        gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
+        gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
+        gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
+        gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
+        gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
+        gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
+      enddo
+cd      goto 1112
+cgrad      do m=i+1,j-1
+cgrad        do ll=1,3
+cold          gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
+cgrad          gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+1,l-1
+cgrad        do ll=1,3
+cold          gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
+cgrad          gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
+cgrad        enddo
+cgrad      enddo
+cgrad1112  continue
+cgrad      do m=i+2,j2
+cgrad        do ll=1,3
+cgrad          gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+2,l2
+cgrad        do ll=1,3
+cgrad          gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
+cgrad        enddo
+cgrad      enddo 
+cd      do iii=1,nres-3
+cd        write (2,*) iii,g_corr6_loc(iii)
+cd      enddo
+      eello6=ekont*eel6
+cd      write (2,*) 'ekont',ekont
+cd      write (iout,*) 'eello6',ekont*eel6
+      return
+      end
+c--------------------------------------------------------------------------
+      double precision function eello6_graph1(i,j,k,l,imat,swap)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
+      logical swap
+      logical lprn
+      common /kutas/ lprn
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C                                                                              C
+C      Parallel       Antiparallel                                             C
+C                                                                              C
+C          o             o                                                     C
+C         /l\           /j\                                                    C
+C        /   \         /   \                                                   C
+C       /| o |         | o |\                                                  C
+C     \ j|/k\|  /   \  |/k\|l /                                                C
+C      \ /   \ /     \ /   \ /                                                 C
+C       o     o       o     o                                                  C
+C       i             i                                                        C
+C                                                                              C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+      itk=itortyp(itype(k))
+      s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
+      s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
+      s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
+      call transpose2(EUgC(1,1,k),auxmat(1,1))
+      call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
+      vv1(1)=pizda1(1,1)-pizda1(2,2)
+      vv1(2)=pizda1(1,2)+pizda1(2,1)
+      s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
+      vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
+      vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
+      s5=scalar2(vv(1),Dtobr2(1,i))
+cd      write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
+      eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
+      if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
+     & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
+     & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
+     & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
+     & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
+     & +scalar2(vv(1),Dtobr2der(1,i)))
+      call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
+      vv1(1)=pizda1(1,1)-pizda1(2,2)
+      vv1(2)=pizda1(1,2)+pizda1(2,1)
+      vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
+      vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
+      if (l.eq.j+1) then
+        g_corr6_loc(l-1)=g_corr6_loc(l-1)
+     & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
+     & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
+     & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
+     & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
+      else
+        g_corr6_loc(j-1)=g_corr6_loc(j-1)
+     & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
+     & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
+     & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
+     & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
+      endif
+      call transpose2(EUgCder(1,1,k),auxmat(1,1))
+      call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
+      vv1(1)=pizda1(1,1)-pizda1(2,2)
+      vv1(2)=pizda1(1,2)+pizda1(2,1)
+      if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
+     & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
+     & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
+     & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
+      do iii=1,2
+        if (swap) then
+          ind=3-iii
+        else
+          ind=iii
+        endif
+        do kkk=1,5
+          do lll=1,3
+            s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
+            s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
+            s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
+            call transpose2(EUgC(1,1,k),auxmat(1,1))
+            call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
+     &        pizda1(1,1))
+            vv1(1)=pizda1(1,1)-pizda1(2,2)
+            vv1(2)=pizda1(1,2)+pizda1(2,1)
+            s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
+            vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
+     &       -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
+            vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
+     &       +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
+            s5=scalar2(vv(1),Dtobr2(1,i))
+            derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
+          enddo
+        enddo
+      enddo
+      return
+      end
+c----------------------------------------------------------------------------
+      double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      logical swap
+      double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
+     & auxvec1(2),auxvec2(2),auxmat1(2,2)
+      logical lprn
+      common /kutas/ lprn
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C                                                                              C
+C      Parallel       Antiparallel                                             C
+C                                                                              C
+C          o             o                                                     C
+C     \   /l\           /j\   /                                                C
+C      \ /   \         /   \ /                                                 C
+C       o| o |         | o |o                                                  C
+C     \ j|/k\|      \  |/k\|l                                                  C
+C      \ /   \       \ /   \                                                   C
+C       o             o                                                        C
+C       i             i                                                        C
+C                                                                              C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+cd      write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
+C AL 7/4/01 s1 would occur in the sixth-order moment, 
+C           but not in a cluster cumulant
+#ifdef MOMENT
+      s1=dip(1,jj,i)*dip(1,kk,k)
+#endif
+      call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
+      s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
+      call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
+      s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
+      call transpose2(EUg(1,1,k),auxmat(1,1))
+      call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
+      vv(1)=pizda(1,1)-pizda(2,2)
+      vv(2)=pizda(1,2)+pizda(2,1)
+      s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+cd      write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
+#ifdef MOMENT
+      eello6_graph2=-(s1+s2+s3+s4)
+#else
+      eello6_graph2=-(s2+s3+s4)
+#endif
+c      eello6_graph2=-s3
+C Derivatives in gamma(i-1)
+      if (i.gt.1) then
+#ifdef MOMENT
+        s1=dipderg(1,jj,i)*dip(1,kk,k)
+#endif
+        s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
+        call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
+        s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+        s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
+#ifdef MOMENT
+        g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
+#else
+        g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
+#endif
+c        g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
+      endif
+C Derivatives in gamma(k-1)
+#ifdef MOMENT
+      s1=dip(1,jj,i)*dipderg(1,kk,k)
+#endif
+      call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
+      s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+      call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
+      s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+      call transpose2(EUgder(1,1,k),auxmat1(1,1))
+      call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
+      vv(1)=pizda(1,1)-pizda(2,2)
+      vv(2)=pizda(1,2)+pizda(2,1)
+      s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+#ifdef MOMENT
+      g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
+#else
+      g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
+#endif
+c      g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
+C Derivatives in gamma(j-1) or gamma(l-1)
+      if (j.gt.1) then
+#ifdef MOMENT
+        s1=dipderg(3,jj,i)*dip(1,kk,k) 
+#endif
+        call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
+        s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+        s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
+        call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(1,2)+pizda(2,1)
+        s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+#ifdef MOMENT
+        if (swap) then
+          g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
+        else
+          g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
+        endif
+#endif
+        g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
+c        g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
+      endif
+C Derivatives in gamma(l-1) or gamma(j-1)
+      if (l.gt.1) then 
+#ifdef MOMENT
+        s1=dip(1,jj,i)*dipderg(3,kk,k)
+#endif
+        call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
+        s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
+        call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
+        s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
+        call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(1,2)+pizda(2,1)
+        s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+#ifdef MOMENT
+        if (swap) then
+          g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
+        else
+          g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
+        endif
+#endif
+        g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
+c        g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
+      endif
+C Cartesian derivatives.
+      if (lprn) then
+        write (2,*) 'In eello6_graph2'
+        do iii=1,2
+          write (2,*) 'iii=',iii
+          do kkk=1,5
+            write (2,*) 'kkk=',kkk
+            do jjj=1,2
+              write (2,'(3(2f10.5),5x)') 
+     &        ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
+            enddo
+          enddo
+        enddo
+      endif
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+#ifdef MOMENT
+            if (iii.eq.1) then
+              s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
+            else
+              s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
+            endif
+#endif
+            call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
+     &        auxvec(1))
+            s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
+            call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
+     &        auxvec(1))
+            s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
+            call transpose2(EUg(1,1,k),auxmat(1,1))
+            call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
+     &        pizda(1,1))
+            vv(1)=pizda(1,1)-pizda(2,2)
+            vv(2)=pizda(1,2)+pizda(2,1)
+            s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
+cd            write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
+#ifdef MOMENT
+            derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
+#else
+            derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
+#endif
+            if (swap) then
+              derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
+            else
+              derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+            endif
+          enddo
+        enddo
+      enddo
+      return
+      end
+c----------------------------------------------------------------------------
+      double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
+      logical swap
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C                                                                              C
+C      Parallel       Antiparallel                                             C
+C                                                                              C
+C          o             o                                                     C
+C         /l\   /   \   /j\                                                    C 
+C        /   \ /     \ /   \                                                   C
+C       /| o |o       o| o |\                                                  C
+C       j|/k\|  /      |/k\|l /                                                C
+C        /   \ /       /   \ /                                                 C
+C       /     o       /     o                                                  C
+C       i             i                                                        C
+C                                                                              C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C 4/7/01 AL Component s1 was removed, because it pertains to the respective 
+C           energy moment and not to the cluster cumulant.
+      iti=itortyp(itype(i))
+      if (j.lt.nres-1) then
+        itj1=itortyp(itype(j+1))
+      else
+        itj1=ntortyp+1
+      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
+      endif
+#ifdef MOMENT
+      s1=dip(4,jj,i)*dip(4,kk,k)
+#endif
+      call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
+      s2=0.5d0*scalar2(b1(1,k),auxvec(1))
+      call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
+      s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
+      call transpose2(EE(1,1,itk),auxmat(1,1))
+      call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
+      vv(1)=pizda(1,1)+pizda(2,2)
+      vv(2)=pizda(2,1)-pizda(1,2)
+      s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
+cd      write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
+cd     & "sum",-(s2+s3+s4)
+#ifdef MOMENT
+      eello6_graph3=-(s1+s2+s3+s4)
+#else
+      eello6_graph3=-(s2+s3+s4)
+#endif
+c      eello6_graph3=-s4
+C Derivatives in gamma(k-1)
+      call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
+      s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
+      s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
+      g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
+C Derivatives in gamma(l-1)
+      call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
+      s2=0.5d0*scalar2(b1(1,k),auxvec(1))
+      call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
+      vv(1)=pizda(1,1)+pizda(2,2)
+      vv(2)=pizda(2,1)-pizda(1,2)
+      s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
+      g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) 
+C Cartesian derivatives.
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+#ifdef MOMENT
+            if (iii.eq.1) then
+              s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
+            else
+              s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
+            endif
+#endif
+            call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
+     &        auxvec(1))
+            s2=0.5d0*scalar2(b1(1,k),auxvec(1))
+            call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
+     &        auxvec(1))
+            s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
+            call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
+     &        pizda(1,1))
+            vv(1)=pizda(1,1)+pizda(2,2)
+            vv(2)=pizda(2,1)-pizda(1,2)
+            s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
+#ifdef MOMENT
+            derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
+#else
+            derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
+#endif
+            if (swap) then
+              derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
+            else
+              derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+            endif
+c            derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
+          enddo
+        enddo
+      enddo
+      return
+      end
+c----------------------------------------------------------------------------
+      double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      include 'COMMON.FFIELD'
+      double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
+     & auxvec1(2),auxmat1(2,2)
+      logical swap
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C                                                                              C
+C      Parallel       Antiparallel                                             C
+C                                                                              C
+C          o             o                                                     C
+C         /l\   /   \   /j\                                                    C
+C        /   \ /     \ /   \                                                   C
+C       /| o |o       o| o |\                                                  C
+C     \ j|/k\|      \  |/k\|l                                                  C
+C      \ /   \       \ /   \                                                   C
+C       o     \       o     \                                                  C
+C       i             i                                                        C
+C                                                                              C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C 4/7/01 AL Component s1 was removed, because it pertains to the respective 
+C           energy moment and not to the cluster cumulant.
+cd      write (2,*) 'eello_graph4: wturn6',wturn6
+      iti=itortyp(itype(i))
+      itj=itortyp(itype(j))
+      if (j.lt.nres-1) then
+        itj1=itortyp(itype(j+1))
+      else
+        itj1=ntortyp+1
+      endif
+      itk=itortyp(itype(k))
+      if (k.lt.nres-1) then
+        itk1=itortyp(itype(k+1))
+      else
+        itk1=ntortyp+1
+      endif
+      itl=itortyp(itype(l))
+      if (l.lt.nres-1) then
+        itl1=itortyp(itype(l+1))
+      else
+        itl1=ntortyp+1
+      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,
+cd     & ' itl',itl,' itl1',itl1
+#ifdef MOMENT
+      if (imat.eq.1) then
+        s1=dip(3,jj,i)*dip(3,kk,k)
+      else
+        s1=dip(2,jj,j)*dip(2,kk,l)
+      endif
+#endif
+      call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
+      s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+      if (j.eq.l+1) then
+        call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
+        s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
+      else
+        call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
+        s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
+      endif
+      call transpose2(EUg(1,1,k),auxmat(1,1))
+      call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
+      vv(1)=pizda(1,1)-pizda(2,2)
+      vv(2)=pizda(2,1)+pizda(1,2)
+      s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+cd      write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
+#ifdef MOMENT
+      eello6_graph4=-(s1+s2+s3+s4)
+#else
+      eello6_graph4=-(s2+s3+s4)
+#endif
+C Derivatives in gamma(i-1)
+      if (i.gt.1) then
+#ifdef MOMENT
+        if (imat.eq.1) then
+          s1=dipderg(2,jj,i)*dip(3,kk,k)
+        else
+          s1=dipderg(4,jj,j)*dip(2,kk,l)
+        endif
+#endif
+        s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
+        if (j.eq.l+1) then
+          call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
+          s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
+        else
+          call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
+          s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
+        endif
+        s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
+        if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+cd          write (2,*) 'turn6 derivatives'
+#ifdef MOMENT
+          gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
+#else
+          gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
+#endif
+        else
+#ifdef MOMENT
+          g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
+#else
+          g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
+#endif
+        endif
+      endif
+C Derivatives in gamma(k-1)
+#ifdef MOMENT
+      if (imat.eq.1) then
+        s1=dip(3,jj,i)*dipderg(2,kk,k)
+      else
+        s1=dip(2,jj,j)*dipderg(4,kk,l)
+      endif
+#endif
+      call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
+      s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
+      if (j.eq.l+1) then
+        call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
+        s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
+      else
+        call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
+        s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
+      endif
+      call transpose2(EUgder(1,1,k),auxmat1(1,1))
+      call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
+      vv(1)=pizda(1,1)-pizda(2,2)
+      vv(2)=pizda(2,1)+pizda(1,2)
+      s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+      if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+#ifdef MOMENT
+        gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
+#else
+        gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
+#endif
+      else
+#ifdef MOMENT
+        g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
+#else
+        g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
+#endif
+      endif
+C Derivatives in gamma(j-1) or gamma(l-1)
+      if (l.eq.j+1 .and. l.gt.1) then
+        call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
+        s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+        call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(2,1)+pizda(1,2)
+        s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+        g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
+      else if (j.gt.1) then
+        call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
+        s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+        call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
+        vv(1)=pizda(1,1)-pizda(2,2)
+        vv(2)=pizda(2,1)+pizda(1,2)
+        s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+        if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+          gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
+        else
+          g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
+        endif
+      endif
+C Cartesian derivatives.
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+#ifdef MOMENT
+            if (iii.eq.1) then
+              if (imat.eq.1) then
+                s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
+              else
+                s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
+              endif
+            else
+              if (imat.eq.1) then
+                s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
+              else
+                s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
+              endif
+            endif
+#endif
+            call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
+     &        auxvec(1))
+            s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
+            if (j.eq.l+1) then
+              call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
+     &          b1(1,j+1),auxvec(1))
+              s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
+            else
+              call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
+     &          b1(1,l+1),auxvec(1))
+              s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
+            endif
+            call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
+     &        pizda(1,1))
+            vv(1)=pizda(1,1)-pizda(2,2)
+            vv(2)=pizda(2,1)+pizda(1,2)
+            s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
+            if (swap) then
+              if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
+#ifdef MOMENT
+                derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
+     &             -(s1+s2+s4)
+#else
+                derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
+     &             -(s2+s4)
+#endif
+                derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
+              else
+#ifdef MOMENT
+                derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
+#else
+                derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
+#endif
+                derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+              endif
+            else
+#ifdef MOMENT
+              derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
+#else
+              derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
+#endif
+              if (l.eq.j+1) then
+                derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
+              else 
+                derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
+              endif
+            endif 
+          enddo
+        enddo
+      enddo
+      return
+      end
+c----------------------------------------------------------------------------
+      double precision function eello_turn6(i,jj,kk)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.DERIV'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CONTACTS'
+      include 'COMMON.TORSION'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
+     &  atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
+     &  ggg1(3),ggg2(3)
+      double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
+     &  atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
+C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
+C           the respective energy moment and not to the cluster cumulant.
+      s1=0.0d0
+      s8=0.0d0
+      s13=0.0d0
+c
+      eello_turn6=0.0d0
+      j=i+4
+      k=i+1
+      l=i+3
+      iti=itortyp(itype(i))
+      itk=itortyp(itype(k))
+      itk1=itortyp(itype(k+1))
+      itl=itortyp(itype(l))
+      itj=itortyp(itype(j))
+cd      write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
+cd      write (2,*) 'i',i,' k',k,' j',j,' l',l
+cd      if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
+cd        eello6=0.0d0
+cd        return
+cd      endif
+cd      write (iout,*)
+cd     &   'EELLO6: Contacts have occurred for peptide groups',i,j,
+cd     &   ' and',k,l
+cd      call checkint_turn6(i,jj,kk,eel_turn6_num)
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+            derx_turn(lll,kkk,iii)=0.0d0
+          enddo
+        enddo
+      enddo
+cd      eij=1.0d0
+cd      ekl=1.0d0
+cd      ekont=1.0d0
+      eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
+cd      eello6_5=0.0d0
+cd      write (2,*) 'eello6_5',eello6_5
+#ifdef MOMENT
+      call transpose2(AEA(1,1,1),auxmat(1,1))
+      call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
+      ss1=scalar2(Ub2(1,i+2),b1(1,l))
+      s1 = (auxmat(1,1)+auxmat(2,2))*ss1
+#endif
+      call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
+      call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
+      s2 = scalar2(b1(1,k),vtemp1(1))
+#ifdef MOMENT
+      call transpose2(AEA(1,1,2),atemp(1,1))
+      call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
+      call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
+      s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
+#endif
+      call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
+      call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
+      s12 = scalar2(Ub2(1,i+2),vtemp3(1))
+#ifdef MOMENT
+      call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
+      call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
+      call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) 
+      call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) 
+      ss13 = scalar2(b1(1,k),vtemp4(1))
+      s13 = (gtemp(1,1)+gtemp(2,2))*ss13
+#endif
+c      write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
+c      s1=0.0d0
+c      s2=0.0d0
+c      s8=0.0d0
+c      s12=0.0d0
+c      s13=0.0d0
+      eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
+C Derivatives in gamma(i+2)
+      s1d =0.0d0
+      s8d =0.0d0
+#ifdef MOMENT
+      call transpose2(AEA(1,1,1),auxmatd(1,1))
+      call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+      s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+      call transpose2(AEAderg(1,1,2),atempd(1,1))
+      call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
+      s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
+#endif
+      call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
+      call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+      s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+c      s1d=0.0d0
+c      s2d=0.0d0
+c      s8d=0.0d0
+c      s12d=0.0d0
+c      s13d=0.0d0
+      gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
+C Derivatives in gamma(i+3)
+#ifdef MOMENT
+      call transpose2(AEA(1,1,1),auxmatd(1,1))
+      call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+      ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
+      s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
+#endif
+      call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
+      call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
+      s2d = scalar2(b1(1,k),vtemp1d(1))
+#ifdef MOMENT
+      call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
+      s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
+#endif
+      s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
+#ifdef MOMENT
+      call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
+      call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) 
+      s13d = (gtempd(1,1)+gtempd(2,2))*ss13
+#endif
+c      s1d=0.0d0
+c      s2d=0.0d0
+c      s8d=0.0d0
+c      s12d=0.0d0
+c      s13d=0.0d0
+#ifdef MOMENT
+      gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
+     &               -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
+#else
+      gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
+     &               -0.5d0*ekont*(s2d+s12d)
+#endif
+C Derivatives in gamma(i+4)
+      call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
+      call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+      s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+#ifdef MOMENT
+      call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
+      call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) 
+      s13d = (gtempd(1,1)+gtempd(2,2))*ss13
+#endif
+c      s1d=0.0d0
+c      s2d=0.0d0
+c      s8d=0.0d0
+C      s12d=0.0d0
+c      s13d=0.0d0
+#ifdef MOMENT
+      gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
+#else
+      gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
+#endif
+C Derivatives in gamma(i+5)
+#ifdef MOMENT
+      call transpose2(AEAderg(1,1,1),auxmatd(1,1))
+      call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+      s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+#endif
+      call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
+      call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
+      s2d = scalar2(b1(1,k),vtemp1d(1))
+#ifdef MOMENT
+      call transpose2(AEA(1,1,2),atempd(1,1))
+      call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
+      s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
+#endif
+      call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
+      s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+#ifdef MOMENT
+      call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) 
+      ss13d = scalar2(b1(1,k),vtemp4d(1))
+      s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
+#endif
+c      s1d=0.0d0
+c      s2d=0.0d0
+c      s8d=0.0d0
+c      s12d=0.0d0
+c      s13d=0.0d0
+#ifdef MOMENT
+      gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
+     &               -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
+#else
+      gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
+     &               -0.5d0*ekont*(s2d+s12d)
+#endif
+C Cartesian derivatives
+      do iii=1,2
+        do kkk=1,5
+          do lll=1,3
+#ifdef MOMENT
+            call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
+            call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
+            s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
+#endif
+            call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
+            call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
+     &          vtemp1d(1))
+            s2d = scalar2(b1(1,k),vtemp1d(1))
+#ifdef MOMENT
+            call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
+            call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
+            s8d = -(atempd(1,1)+atempd(2,2))*
+     &           scalar2(cc(1,1,itl),vtemp2(1))
+#endif
+            call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
+     &           auxmatd(1,1))
+            call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
+            s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
+c      s1d=0.0d0
+c      s2d=0.0d0
+c      s8d=0.0d0
+c      s12d=0.0d0
+c      s13d=0.0d0
+#ifdef MOMENT
+            derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) 
+     &        - 0.5d0*(s1d+s2d)
+#else
+            derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) 
+     &        - 0.5d0*s2d
+#endif
+#ifdef MOMENT
+            derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) 
+     &        - 0.5d0*(s8d+s12d)
+#else
+            derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) 
+     &        - 0.5d0*s12d
+#endif
+          enddo
+        enddo
+      enddo
+#ifdef MOMENT
+      do kkk=1,5
+        do lll=1,3
+          call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
+     &      achuj_tempd(1,1))
+          call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
+          call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) 
+          s13d=(gtempd(1,1)+gtempd(2,2))*ss13
+          derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
+          call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
+     &      vtemp4d(1)) 
+          ss13d = scalar2(b1(1,k),vtemp4d(1))
+          s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
+          derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
+        enddo
+      enddo
+#endif
+cd      write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
+cd     &  16*eel_turn6_num
+cd      goto 1112
+      if (j.lt.nres-1) then
+        j1=j+1
+        j2=j-1
+      else
+        j1=j-1
+        j2=j-2
+      endif
+      if (l.lt.nres-1) then
+        l1=l+1
+        l2=l-1
+      else
+        l1=l-1
+        l2=l-2
+      endif
+      do ll=1,3
+cgrad        ggg1(ll)=eel_turn6*g_contij(ll,1)
+cgrad        ggg2(ll)=eel_turn6*g_contij(ll,2)
+cgrad        ghalf=0.5d0*ggg1(ll)
+cd        ghalf=0.0d0
+        gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
+        gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
+        gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
+     &    +ekont*derx_turn(ll,2,1)
+        gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
+        gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
+     &    +ekont*derx_turn(ll,4,1)
+        gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
+        gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
+        gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
+cgrad        ghalf=0.5d0*ggg2(ll)
+cd        ghalf=0.0d0
+        gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
+     &    +ekont*derx_turn(ll,2,2)
+        gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
+        gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
+     &    +ekont*derx_turn(ll,4,2)
+        gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
+        gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
+        gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
+      enddo
+cd      goto 1112
+cgrad      do m=i+1,j-1
+cgrad        do ll=1,3
+cgrad          gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+1,l-1
+cgrad        do ll=1,3
+cgrad          gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
+cgrad        enddo
+cgrad      enddo
+cgrad1112  continue
+cgrad      do m=i+2,j2
+cgrad        do ll=1,3
+cgrad          gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
+cgrad        enddo
+cgrad      enddo
+cgrad      do m=k+2,l2
+cgrad        do ll=1,3
+cgrad          gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
+cgrad        enddo
+cgrad      enddo 
+cd      do iii=1,nres-3
+cd        write (2,*) iii,g_corr6_loc(iii)
+cd      enddo
+      eello_turn6=ekont*eel_turn6
+cd      write (2,*) 'ekont',ekont
+cd      write (2,*) 'eel_turn6',ekont*eel_turn6
+      return
+      end
+
+C-----------------------------------------------------------------------------
+      double precision function scalar(u,v)
+!DIR$ INLINEALWAYS scalar
+#ifndef OSF
+cDEC$ ATTRIBUTES FORCEINLINE::scalar
+#endif
+      implicit none
+      double precision u(3),v(3)
+cd      double precision sc
+cd      integer i
+cd      sc=0.0d0
+cd      do i=1,3
+cd        sc=sc+u(i)*v(i)
+cd      enddo
+cd      scalar=sc
+
+      scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
+      return
+      end
+crc-------------------------------------------------
+      SUBROUTINE MATVEC2(A1,V1,V2)
+!DIR$ INLINEALWAYS MATVEC2
+#ifndef OSF
+cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
+#endif
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      DIMENSION A1(2,2),V1(2),V2(2)
+c      DO 1 I=1,2
+c        VI=0.0
+c        DO 3 K=1,2
+c    3     VI=VI+A1(I,K)*V1(K)
+c        Vaux(I)=VI
+c    1 CONTINUE
+
+      vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
+      vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
+
+      v2(1)=vaux1
+      v2(2)=vaux2
+      END
+C---------------------------------------
+      SUBROUTINE MATMAT2(A1,A2,A3)
+#ifndef OSF
+cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2  
+#endif
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      DIMENSION A1(2,2),A2(2,2),A3(2,2)
+c      DIMENSION AI3(2,2)
+c        DO  J=1,2
+c          A3IJ=0.0
+c          DO K=1,2
+c           A3IJ=A3IJ+A1(I,K)*A2(K,J)
+c          enddo
+c          A3(I,J)=A3IJ
+c       enddo
+c      enddo
+
+      ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
+      ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
+      ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
+      ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
+
+      A3(1,1)=AI3_11
+      A3(2,1)=AI3_21
+      A3(1,2)=AI3_12
+      A3(2,2)=AI3_22
+      END
+
+c-------------------------------------------------------------------------
+      double precision function scalar2(u,v)
+!DIR$ INLINEALWAYS scalar2
+      implicit none
+      double precision u(2),v(2)
+      double precision sc
+      integer i
+      scalar2=u(1)*v(1)+u(2)*v(2)
+      return
+      end
+
+C-----------------------------------------------------------------------------
+
+      subroutine transpose2(a,at)
+!DIR$ INLINEALWAYS transpose2
+#ifndef OSF
+cDEC$ ATTRIBUTES FORCEINLINE::transpose2
+#endif
+      implicit none
+      double precision a(2,2),at(2,2)
+      at(1,1)=a(1,1)
+      at(1,2)=a(2,1)
+      at(2,1)=a(1,2)
+      at(2,2)=a(2,2)
+      return
+      end
+c--------------------------------------------------------------------------
+      subroutine transpose(n,a,at)
+      implicit none
+      integer n,i,j
+      double precision a(n,n),at(n,n)
+      do i=1,n
+        do j=1,n
+          at(j,i)=a(i,j)
+        enddo
+      enddo
+      return
+      end
+C---------------------------------------------------------------------------
+      subroutine prodmat3(a1,a2,kk,transp,prod)
+!DIR$ INLINEALWAYS prodmat3
+#ifndef OSF
+cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
+#endif
+      implicit none
+      integer i,j
+      double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
+      logical transp
+crc      double precision auxmat(2,2),prod_(2,2)
+
+      if (transp) then
+crc        call transpose2(kk(1,1),auxmat(1,1))
+crc        call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
+crc        call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) 
+        
+           prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
+     & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
+           prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
+     & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
+           prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
+     & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
+           prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
+     & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
+
+      else
+crc        call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
+crc        call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
+
+           prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
+     &  +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
+           prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
+     &  +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
+           prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
+     &  +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
+           prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
+     &  +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
+
+      endif
+c      call transpose2(a2(1,1),a2t(1,1))
+
+crc      print *,transp
+crc      print *,((prod_(i,j),i=1,2),j=1,2)
+crc      print *,((prod(i,j),i=1,2),j=1,2)
+
+      return
+      end
+