c***********************************************************************
c     mehook
c***********************************************************************
c
      subroutine mehook(xii,v,e1,e2,e12,mcmcar,mciord,icomplex)
c
c     This subroutine is the driver for an energy calculation.
c     (Titus V Albu January 2002)
c
      implicit double precision (a-h,o-z)
c
      dimension xii(mcmcar)
      dimension g1(mcmcar), h1(mcmcar,mcmcar)
      dimension g2(mcmcar), h2(mcmcar,mcmcar)
      dimension g12(mcmcar), h12(mcmcar,mcmcar)
c
c  Initialize the variables
c
      v=0.d0
      e1=0.d0
      e2=0.d0
      e12=0.d0
      do i=1,mcmcar
        g1(i)=0.d0
        g2(i)=0.d0
        g12(i)=0.d0
      enddo
      do i=1,mcmcar
        do j=1,mcmcar
          h1(i,j)=0.d0
          h2(i,j)=0.d0
          h12(i,j)=0.d0
        enddo
      enddo
c
c  If a SCMM1 calculation (MM calculation with configuration 1)
c
      if (mciord.eq.1) then
         call mcviic(xii,e1,g1,h1,1,1,1)
c 1106HL03s
c call it again                                                         1201HL03
c         call mcviic(xii,e1,g1,h1,1,1,1)                                  1201HL03
c 1106HL03e
	          v = e1
c
c  If a SCMM2 calculation (MM calculation with configuration 2)
c
      else if (mciord.eq.2) then
         call mcviic(xii,e2,g2,h2,1,2,1)	 
c 1106HL03s
c call it again                                                         1201HL03
c         call mcviic(xii,e2,g2,h2,1,2,1)                                  1201HL03
c 1106HL03e
         v = e2
c
c  If a MCMM calculation
c
c 1105HL03s
c  for an MCMM calculation, proper initializtion has been 
c  achieved in call of mcsesi
c 1105HL03e
c
      else if (mciord.eq.0) then
c
c  Calculate V11
c
         call mcviic(xii,e1,g1,h1,1,1,1)
c
c  Calculate V22
c
         call mcviic(xii,e2,g2,h2,1,2,1)
c
c  Calculate V12
c
         call mcv12c(xii,e12,g12,h12,1)
c
c  Combine energies
c
         call mccene(e1,e2,e12,v,icomplex)
      endif
c
      return
      end
c***********************************************************************
c     mghook
c***********************************************************************
c
      subroutine mghook(xii,v,e1,e2,e12,dxii,mcmcar,mciord,icomplex)
c
c     This subroutine is the driver for a gradient calculation.
c     (Titus V Albu January 2002)
c
      implicit double precision (a-h,o-z)
c
CAMBP#ifdef MPI
CAMBPc     =========================== AMBER/MPI ===========================
CAMBP#     ifdef MPI_DOUBLE_PRECISION
CAMBP#       undef MPI_DOUBLE_PRECISION
CAMBP#     endif
CAMBP      include 'mpif.h'
CAMBP#     ifdef CRAY_PVP
CAMBP#       define MPI_DOUBLE_PRECISION MPI_REAL8
CAMBP#     endif
CAMBPc     ========================= END AMBER/MPI =========================
CAMBPc
CAMBP#     include "parallel.h"
CAMBP#     include "extra.h"
CAMBPc
CAMBP      dimension istat(MPI_STATUS_SIZE)
CAMBP#endif
CAMBP#     include "../sander/def_time.h"
c
      dimension xii(mcmcar), dxii(mcmcar)
      dimension g1(mcmcar), h1(mcmcar,mcmcar)
      dimension g2(mcmcar), h2(mcmcar,mcmcar)
      dimension g12(mcmcar), h12(mcmcar,mcmcar)
c
c  Initialize the variables
c
      v=0.d0
      e1=0.d0
      e2=0.d0
      e12=0.d0
      do i=1,mcmcar
        g1(i)=0.d0
        g2(i)=0.d0
        g12(i)=0.d0
      enddo
      do i=1,mcmcar
        do j=1,mcmcar
          h1(j,i)=0.d0
          h2(j,i)=0.d0
          h12(j,i)=0.d0
        enddo
      enddo
c
c  If a SCMM1 calculation (MM calculation with configuration 1)
c
      if (mciord.eq.1) then
c
CAMBP         call timer_start(TIME_MCMMDIAG)
c
         call mcviic(xii,e1,g1,h1,2,1,1)
c 1106HL03s
c call it again                                                         1201HL03
c         call mcviic(xii,e1,g1,h1,2,1,1)                                  1201HL03
c 1106HL03e	 
c
         v = e1
         do i=1,mcmcar
            dxii(i) = g1(i)
         enddo
c
CAMBP         call timer_stop(TIME_MCMMDIAG)
c
c  If a SCMM2 calculation (MM calculation with configuration 2)
c
      else if (mciord.eq.2) then
c
CAMBP         call timer_start(TIME_MCMMDIAG)
c
         call mcviic(xii,e2,g2,h2,2,2,1)
c 1106HL03s
c call it again                                                         1201HL03
c         call mcviic(xii,e2,g2,h2,2,2,1)                                  1201HL03
c 1106HL03e
c
         v = e2
         do i=1,mcmcar
            dxii(i) = g2(i)
         enddo
c
CAMBP         call timer_stop(TIME_MCMMDIAG)
c
c  If a MCMM calculation
c
      else if (mciord.eq.0) then
c
CAMBP         call timer_start(TIME_MCMMDIAG)
CAMBPc
CAMBP#ifdef MPI
CAMBPc
CAMBPc     parallel job
CAMBPc
CAMBP         if(numtasks.eq.1) then
CAMBPc
CAMBPc     Calculate V11
CAMBPc
CAMBP            call mcviic(xii,e1,g1,h1,2,1,1)
CAMBPc
CAMBPc     Calculate V22
CAMBPc
CAMBP            call mcviic(xii,e2,g2,h2,2,2,1)
CAMBPc
CAMBP         else
CAMBPc
CAMBP            if(mod(mytaskid,2).eq.0) then
CAMBPc
CAMBP               call mcviic(xii,e1,g1,h1,2,1,1)
CAMBPc
CAMBP               n2=mytaskid/2
CAMBP               n2=2*n2+1
CAMBP               call mpi_send(e1,1,mpi_double_precision,n2,
CAMBP     &                       10,commsander,ier)
CAMBP               call mpi_send(g1,mcmcar,mpi_double_precision,n2,
CAMBP     &                       10,commsander,ier)
CAMBPc
CAMBP               call mpi_recv(e2,1,mpi_double_precision,n2,
CAMBP     &                       20,commsander,istat,ier)
CAMBP               call mpi_recv(g2,mcmcar,mpi_double_precision,n2,
CAMBP     &                       20,commsander,istat,ier)
CAMBPc
CAMBP            else
CAMBPc
CAMBP               call mcviic(xii,e2,g2,h2,2,2,1)
CAMBPc
CAMBP               n2=mytaskid/2
CAMBP               n2=2*n2
CAMBP               call mpi_recv(e1,1,mpi_double_precision,n2,
CAMBP     &                       10,commsander,istat,ier)
CAMBP               call mpi_recv(g1,mcmcar,mpi_double_precision,n2,
CAMBP     &                       10,commsander,istat,ier)
CAMBPc
CAMBP               call mpi_send(e2,1,mpi_double_precision,n2,
CAMBP     &                       20,commsander,ier)
CAMBP               call mpi_send(g2,mcmcar,mpi_double_precision,n2,
CAMBP     &                       20,commsander,ier)
CAMBPc
CAMBP            end if
CAMBP         end if
CAMBP#else
c
c  Calculate V11
c
         call mcviic(xii,e1,g1,h1,2,1,1)
c
c  Calculate V22
c
         call mcviic(xii,e2,g2,h2,2,2,1)
CAMBP#endif
CAMBPc
CAMBP         call timer_stop(TIME_MCMMDIAG)
c
c  Calculate V12
c
CAMBP         call timer_start(TIME_MCMMRESO)
         call mcv12c(xii,e12,g12,h12,2)
CAMBP         call timer_stop(TIME_MCMMRESO)
c
c  Combine energies
c
CAMBP         call timer_start(TIME_MCMMFORCE)
c
         call mccene(e1,e2,e12,v,icomplex)
c
c  Combine gradients
c
         call mccgra(e1,e2,e12,g1,g2,g12,dxii,mcmcar,icomplex)
c
CAMBP         call timer_stop(TIME_MCMMFORCE)
c
      endif
c
      return
      end
c***********************************************************************
c     mhhook
c***********************************************************************
c
      subroutine mhhook(xii,v,e1,e2,e12,dxii,fmat,mcmcar,
     * mciord,icomplex)
c
c     This subroutine is the driver for a Hessian calculation.
c     (Titus V Albu January 2002)
c
      implicit double precision (a-h,o-z)
c
      dimension xii(mcmcar), dxii(mcmcar), fmat(mcmcar,mcmcar)
      dimension g1(mcmcar), h1(mcmcar,mcmcar)
      dimension g2(mcmcar), h2(mcmcar,mcmcar)
      dimension g12(mcmcar), h12(mcmcar,mcmcar)
c
c  Initialize the variables
c
      v=0.d0
      e1=0.d0
      e2=0.d0
      e12=0.d0
      do i=1,mcmcar
        g1(i)=0.d0
        g2(i)=0.d0
        g12(i)=0.d0
      enddo
      do i=1,mcmcar
        do j=1,mcmcar
          h1(i,j)=0.d0
          h2(i,j)=0.d0
          h12(i,j)=0.d0
        enddo
      enddo
c
c  If a SCMM1 calculation (MM calculation with configuration 1)
c
      if (mciord.eq.1) then
         call mcviic(xii,e1,g1,h1,3,1,1)
c 1106HL03s
c call it again                                                         1201HL03
c         call mcviic(xii,e1,g1,h1,3,1,1)                                  1201HL03
c 1106HL03e
c	 
         v = e1
         do i=1,mcmcar
            dxii(i) = g1(i)
         enddo
         do i=1,mcmcar
           do j=1,mcmcar
             fmat(i,j) = h1(i,j)
           enddo
         enddo
c
c  If a SCMM2 calculation (MM calculation with configuration 2)
c
      else if (mciord.eq.2) then
         call mcviic(xii,e2,g2,h2,3,2,1)
c 1106HL03s
c call it again                                                         1201HL03
c         call mcviic(xii,e2,g2,h2,3,2,1)                                  1201HL03
c 1106HL03e
c	 
         v = e2
         do i=1,mcmcar
            dxii(i) = g2(i)
         enddo
         do i=1,mcmcar
           do j=1,mcmcar
             fmat(i,j) = h2(i,j)
           enddo
         enddo
c
c  If a MCMM calculation
c
      else if (mciord.eq.0) then
c
c  Calculate V11
c
         call mcviic(xii,e1,g1,h1,3,1,1)
c
c  Calculate V22
c
         call mcviic(xii,e2,g2,h2,3,2,1)
c
c  Calculate V12
c
         call mcv12c(xii,e12,g12,h12,3)
c
c  Combine energies
c
         call mccene(e1,e2,e12,v,icomplex)
c
c  Combine gradients
c
         call mccgra(e1,e2,e12,g1,g2,g12,dxii,mcmcar,icomplex)
       do i=1,mcmcar
       enddo
c
c  Combine hessians
c
       call mcches(e1,e2,e12,g1,g2,g12,h1,h2,h12,fmat,mcmcar,icomplex)
c
      endif
c
      return
      end
c***********************************************************************
c     mehooks
c***********************************************************************
c
      subroutine mehooks(xii,v,e1,e2,e12,mcmcar,mciord,
     * alphaV1,alphaV2,isigmav1,isigmav2,icomplex)                                 
c
c     This subroutine is analogous to mehook subroutine, but it returns a
c     symmetrized MM potential (eq 31 of JCTC, 2007, 3, 938). (O.T. October 2006)
c
      implicit double precision (a-h,o-z)
c
c
      dimension xii(mcmcar)
      dimension g1(mcmcar), h1(mcmcar,mcmcar)          
      dimension g2(mcmcar), h2(mcmcar,mcmcar)
      dimension g12(mcmcar), h12(mcmcar,mcmcar)
c
c  Initialize the variables
c
      v=0.d0
      e1=0.d0
      e1_E=0.d0                                                         
      e1_12=0.d0                                                        
      e1_23=0.d0                                                        
      e1_13=0.d0                                                        
      e1_123=0.d0                                                       
      e1_132=0.d0                                                       
      e2=0.d0
      e2_E=0.d0                                                         
      e2_12=0.d0                                                        
      e2_23=0.d0                                                        
      e2_13=0.d0                                                        
      e2_123=0.d0                                                       
      e2_132=0.d0                                                       
      e12=0.d0
      exxp1 = 0.d0                                                      
      exxp2 = 0.d0                                                      
      exxp3 = 0.d0                                                      
      exxp4 = 0.d0                                                      
      exxp5 = 0.d0                                                      
      exxp6 = 0.d0                                                      
      do i=1,mcmcar
        g1(i)=0.d0
        g2(i)=0.d0
        g12(i)=0.d0
      enddo
      do i=1,mcmcar
        do j=1,mcmcar
          h1(i,j)=0.d0
          h2(i,j)=0.d0
          h12(i,j)=0.d0
        enddo
      enddo
c
c  If a SCMM1 calculation (MM calculation with configuration 1)
c
      if (mciord.eq.1) then
         call mcviic(xii,e1,g1,h1,1,1,1)
	          v = e1
c
c  If a SCMM2 calculation (MM calculation with configuration 2)
c
      else if (mciord.eq.2) then
         call mcviic(xii,e2,g2,h2,1,2,1)	 
         v = e2
c
c  If a MCMM calculation
c
c 1105HL03s
c  for an MCMM calculation, proper initializtion has been 
c  achieved in call of mcsesi
c 1105HL03e
c
      else if (mciord.eq.0) then
c
c generate symmetrically equivalent geometries
c
c  Calculate V11
c
         call mcviic(xii,e1_E,g1,h1,1,1,1)                              
         call mcviic(xii,e1_12,g1,h1,1,1,2)                             
         call mcviic(xii,e1_23,g1,h1,1,1,3)                             
         call mcviic(xii,e1_13,g1,h1,1,1,4)                             
         call mcviic(xii,e1_123,g1,h1,1,1,5)                            
         call mcviic(xii,e1_132,g1,h1,1,1,6)                            
c
       exxp1 = dexp(-alphaV1*e1_E)                                      
       exxp2 = dexp(-alphaV1*e1_12)                                     
       exxp3 = dexp(-alphaV1*e1_23)                                     
       exxp4 = dexp(-alphaV1*e1_13)                                     
       exxp5 = dexp(-alphaV1*e1_123)                                    
       exxp6 = dexp(-alphaV1*e1_132)                                    
       e1=-(1.d0/alphaV1)*dlog(1.d0/isigmav1*(exxp1+exxp2+exxp3+exxp4+  
     & exxp5+exxp6))                                                    
c
c  Calculate V22
c
         call mcviic(xii,e2_E,g2,h2,1,2,1)
         call mcviic(xii,e2_12,g1,h1,1,2,2)                             
         call mcviic(xii,e2_23,g1,h1,1,2,3)                             
         call mcviic(xii,e2_13,g1,h1,1,2,4)                             
         call mcviic(xii,e2_123,g1,h1,1,2,5)                            
         call mcviic(xii,e2_132,g1,h1,1,2,6)                            
c
       exxp1 = 0.d0                                                     
       exxp2 = 0.d0                                                     
       exxp3 = 0.d0                                                     
       exxp4 = 0.d0                                                     
       exxp5 = 0.d0                                                     
       exxp6 = 0.d0                                                     
c
       exxp1 = dexp(-alphaV2*e2_E)                                      
       exxp2 = dexp(-alphaV2*e2_12)                                     
       exxp3 = dexp(-alphaV2*e2_23)                                     
       exxp4 = dexp(-alphaV2*e2_13)                                     
       exxp5 = dexp(-alphaV2*e2_123)                                    
       exxp6 = dexp(-alphaV2*e2_132)                                    
c
         e2=-(1.d0/alphaV2)*dlog(1.d0/isigmav2*(exxp1+exxp2+
     & exxp3+exxp4+ 
     & exxp5+exxp6))                                                    
c
c  Calculate V12
c
         call mcv12c(xii,e12,g12,h12,1)
c
c  Combine energies
c
         call mccene(e1,e2,e12,v,icomplex)
      endif
c
      return
      end
c***********************************************************************
c     mghooks
c***********************************************************************
c
       subroutine mghooks(xii,v,e1,e2,e12,dxii,mcmcar,mcncar,
     * mciord,
     * alphaV1,alphaV2,isigmav1,isigmav2,icomplex)                                 
c
c     This subroutine returns gradient of a symmetrized MM potential 
c     (eq 32 of JCTC, 2007, 3, 938). Otherwise, it is analogous to mghook 
c     subroutine. (O.T. October 2006)
c
      implicit double precision (a-h,o-z)
c
      dimension xii(mcmcar), dxii(mcmcar)
      dimension g1(mcmcar), h1(mcmcar,mcmcar)
      dimension g1a(mcmcar), g2a(mcmcar)
      dimension g1_E(mcmcar), h1_E(mcmcar,mcmcar)                       
      dimension g1_12(mcmcar), h1_12(mcmcar,mcmcar)                     
      dimension g1_23(mcmcar), h1_23(mcmcar,mcmcar)                     
      dimension g1_13(mcmcar), h1_13(mcmcar,mcmcar)                     
      dimension g1_123(mcmcar), h1_123(mcmcar,mcmcar)                   
      dimension g1_132(mcmcar), h1_132(mcmcar,mcmcar)                   
      dimension g2(mcmcar), h2(mcmcar,mcmcar)
      dimension g2_E(mcmcar), h2_E(mcmcar,mcmcar)                       
      dimension g2_12(mcmcar), h2_12(mcmcar,mcmcar)                     
      dimension g2_23(mcmcar), h2_23(mcmcar,mcmcar)                     
      dimension g2_13(mcmcar), h2_13(mcmcar,mcmcar)                     
      dimension g2_123(mcmcar), h2_123(mcmcar,mcmcar)                   
      dimension g2_132(mcmcar), h2_132(mcmcar,mcmcar)                   
      dimension d1tmp(mcmcar), d2tmp(mcmcar)                            
      dimension g12(mcmcar), h12(mcmcar,mcmcar)                         
c
c  Initialize the variables
c
      v=0.d0
      e1=0.d0 
      e1_E=0.d0                                                         
      e1_12=0.d0                                                        
      e1_23=0.d0                                                        
      e1_13=0.d0                                                        
      e1_123=0.d0                                                       
      e1_132=0.d0                                                       
      e2=0.d0
      e2_E=0.d0                                                         
      e2_12=0.d0                                                        
      e2_23=0.d0                                                        
      e2_13=0.d0                                                        
      e2_123=0.d0                                                       
      e2_132=0.d0                                                       
      e12=0.d0
      expsum=0.d0
      do i=1,mcmcar
        g1(i)=0.d0
         g1a(i)=0.d0
         g2a(i)=0.d0
        g1_E(i)=0.d0
        g1_12(i)=0.d0                                                   
        g1_23(i)=0.d0                                                   
        g1_13(i)=0.d0                                                   
        g1_123(i)=0.d0                                                  
        g1_132(i)=0.d0                                                  
        g2(i)=0.d0
        g2_E(i)=0.d0
        g2_12(i)=0.d0                                                   
        g2_23(i)=0.d0                                                   
        g2_13(i)=0.d0                                                   
        g2_123(i)=0.d0                                                  
        g2_132(i)=0.d0                                                  
        g12(i)=0.d0
        d1tmp(i)=0.d0                                                   
        d2tmp(i)=0.d0                                                   
      enddo
      do i=1,mcmcar
        do j=1,mcmcar
          h1(i,j)=0.d0
          h2(i,j)=0.d0
          h12(i,j)=0.d0
        enddo
      enddo
c
c  If a SCMM1 calculation (MM calculation with configuration 1)
c
      if (mciord.eq.1) then
         call mcviic(xii,e1,g1,h1,2,1,1)
c
         v = e1
         do i=1,mcmcar
            dxii(i) = g1(i)
         enddo
c
c  If a SCMM2 calculation (MM calculation with configuration 2)
c
      else if (mciord.eq.2) then
         call mcviic(xii,e2,g2,h2,2,2,1)
c
         v = e2
         do i=1,mcmcar
            dxii(i) = g2(i)
         enddo
c
c  If a MCMM calculation
c
      else if (mciord.eq.0) then
c
c  Calculate V11
c
       call mcviic(xii,e1_E,g1_E,h1,2,1,1)                                
       call mcviic(xii,e1_12,g1_12,h1,2,1,2)                              
       call mcviic(xii,e1_23,g1_23,h1,2,1,3)                              
       call mcviic(xii,e1_13,g1_13,h1,2,1,4)                              
       call mcviic(xii,e1_123,g1_123,h1,2,1,5)                            
       call mcviic(xii,e1_132,g1_132,h1,2,1,6)                            
c
       exxp1 = 0.d0                                                     
       exxp2 = 0.d0                                                     
       exxp3 = 0.d0                                                     
       exxp4 = 0.d0                                                     
       exxp5 = 0.d0                                                     
       exxp6 = 0.d0                                                     
c
       exxp1 = dexp(-alphaV1*e1_E)                                      
       exxp2 = dexp(-alphaV1*e1_12)                                     
       exxp3 = dexp(-alphaV1*e1_23)                                     
       exxp4 = dexp(-alphaV1*e1_13)                                     
       exxp5 = dexp(-alphaV1*e1_123)                                    
       exxp6 = dexp(-alphaV1*e1_132)                                    
       e1=-(1.d0/alphaV1)*dlog(1.d0/isigmav1*(exxp1+exxp2+exxp3+exxp4+  
     & exxp5+exxp6))                                                    
c
         expsum=exxp1+exxp2+exxp3+exxp4+exxp5+exxp6                     
c
         do i=1,mcncar
          d1tmp(i)=exxp1*g1_E(i)+exxp2*g1_12(i)+exxp3*g1_23(i)          
     *    +exxp4*g1_13(i)+exxp5*g1_123(i)+exxp6*g1_132(i)               
           g1(i)=d1tmp(i)/expsum 
         enddo 
c
c  Calculate V22
c
       expsum=0.d0
       call mcviic(xii,e2_E,g2_E,h2,2,2,1)                                
       call mcviic(xii,e2_12,g2_12,h2,2,2,2)                              
       call mcviic(xii,e2_23,g2_23,h2,2,2,3)                              
       call mcviic(xii,e2_13,g2_13,h2,2,2,4)                              
       call mcviic(xii,e2_123,g2_123,h2,2,2,5)                            
       call mcviic(xii,e2_132,g2_132,h2,2,2,6)                            
c
       exxp1_2 = 0.d0                                                     
       exxp2_2 = 0.d0                                                     
       exxp3_2 = 0.d0                                                     
       exxp4_2 = 0.d0                                                     
       exxp5_2 = 0.d0                                                     
       exxp6_2 = 0.d0                                                     
c
       exxp1_2 = dexp(-alphaV2*e2_E)                                      
       exxp2_2 = dexp(-alphaV2*e2_12)                                     
       exxp3_2 = dexp(-alphaV2*e2_23)                                     
       exxp4_2 = dexp(-alphaV2*e2_13)                                     
       exxp5_2 = dexp(-alphaV2*e2_123)                                    
       exxp6_2 = dexp(-alphaV2*e2_132)                                    
c
         e2=-(1.d0/alphaV2)*dlog(1.d0/isigmav2*(exxp1_2+
     & exxp2_2+exxp3_2+exxp4_2+
     & exxp5_2+exxp6_2))                                                   
c
         expsum=exxp1_2+exxp2_2+exxp3_2+exxp4_2+exxp5_2+exxp6_2            
c
         do i=1,mcncar
          d2tmp(i)=exxp1_2*g2_E(i)+exxp2_2*g2_12(i)+exxp3_2*g2_23(i)        
     *    +exxp4_2*g2_13(i)+exxp5_2*g2_123(i)+exxp6_2*g2_132(i)            
           g2(i)=d2tmp(i)/expsum 
         enddo                                                         
c
c  Calculate V12
c
         call mcv12c(xii,e12,g12,h12,2)
c
c  Combine energies
c
         call mccene(e1,e2,e12,v,icomplex)
c
c  Combine gradients
c
         call mccgra(e1,e2,e12,g1,g2,g12,dxii,mcmcar,icomplex)
c
      endif
c
      return
      end
c***********************************************************************
c     mhhooks
c***********************************************************************
c
       subroutine mhhooks(xii,v,e1,e2,e12,dxii,fmat,mcmcar,mcncar,
     * mciord,
     * alphaV1,alphaV2,isigmav1,isigmav2,icomplex)                                
c
c     This subroutine returns Hessian of a symmetrized MM potential
c     (eq 33 of JCTC, 2007, 3, 938). Otherwise, it is analogous to
c     mhhook subroutine (O.T. October 2006)
c
      implicit double precision (a-h,o-z)
c
      dimension xii(mcmcar), dxii(mcmcar), fmat(mcmcar,mcmcar)
      dimension g1(mcmcar), h1(mcmcar,mcmcar)
      dimension g1a(mcmcar), g2a(mcmcar)                                
      dimension g1_E(mcmcar), h1_E(mcmcar,mcmcar)                       
      dimension g1_12(mcmcar), h1_12(mcmcar,mcmcar)                     
      dimension g1_23(mcmcar), h1_23(mcmcar,mcmcar)                     
      dimension g1_13(mcmcar), h1_13(mcmcar,mcmcar)                     
      dimension g1_123(mcmcar), h1_123(mcmcar,mcmcar)                   
      dimension g1_132(mcmcar), h1_132(mcmcar,mcmcar)                   
      dimension g2(mcmcar), h2(mcmcar,mcmcar)
      dimension g2_E(mcmcar), h2_E(mcmcar,mcmcar)                       
      dimension g2_12(mcmcar), h2_12(mcmcar,mcmcar)                     
      dimension g2_23(mcmcar), h2_23(mcmcar,mcmcar)                     
      dimension g2_13(mcmcar), h2_13(mcmcar,mcmcar)                      
      dimension g2_123(mcmcar), h2_123(mcmcar,mcmcar)                   
      dimension g2_132(mcmcar), h2_132(mcmcar,mcmcar)                   
      dimension d1tmp(mcmcar), d2tmp(mcmcar)                            
      dimension g12(mcmcar), h12(mcmcar,mcmcar)
      dimension                                                         
     *                 xlooker1(mcmcar,mcmcar),                         
     *                 xlooker2(mcmcar,mcmcar),                         
     *                 xlooker3(mcmcar,mcmcar),                         
     *                 xlooker3a(mcmcar,mcmcar),                        
     *                 xlooker4(mcmcar,mcmcar),                          
     *                 xlooker5(mcmcar,mcmcar)                          
c
c  Initialize the variables
c
      v=0.d0
      e1=0.d0
      e1_E=0.d0                                                         
      e1_12=0.d0                                                        
      e1_23=0.d0                                                        
      e1_13=0.d0                                                        
      e1_123=0.d0                                                       
      e1_132=0.d0                                                       
      e2=0.d0
      e2_E=0.d0                                                         
      e2_12=0.d0                                                        
      e2_23=0.d0                                                        
      e2_13=0.d0                                                        
      e2_123=0.d0                                                       
      e2_132=0.d0                                                       
      e12=0.d0
      expsum=0.d0
      do i=1,mcmcar
        g1(i)=0.d0
        g1a(i)=0.d0
        g1_E(i)=0.d0
        g1_12(i)=0.d0                                                   
        g1_23(i)=0.d0                                                   
        g1_13(i)=0.d0                                                   
        g1_123(i)=0.d0                                                  
        g1_132(i)=0.d0                                                  
        g2(i)=0.d0
        g2a(i)=0.d0
        g2_E(i)=0.d0
        g2_12(i)=0.d0                                                   
        g2_23(i)=0.d0                                                   
        g2_13(i)=0.d0                                                   
        g2_123(i)=0.d0                                                  
        g2_132(i)=0.d0                                                  
        g12(i)=0.d0
        d1tmp(i)=0.d0                                                   
        d2tmp(i)=0.d0                                                   
      enddo
      do i=1,mcmcar
        do j=1,mcmcar
          h1(i,j)=0.d0
          h1_E(i,j)=0.d0
          h1_12(i,j)=0.d0
          h1_23(i,j)=0.d0
          h1_13(i,j)=0.d0
          h1_123(i,j)=0.d0
          h1_132(i,j)=0.d0
          h2(i,j)=0.d0
          h2_E(i,j)=0.d0
          h2_12(i,j)=0.d0
          h2_23(i,j)=0.d0
          h2_13(i,j)=0.d0
          h2_123(i,j)=0.d0
          h2_132(i,j)=0.d0
          h12(i,j)=0.d0
            xlooker1(i,j)=0.d0
            xlooker2(i,j)=0.d0
            xlooker3(i,j)=0.d0
            xlooker3a(i,j)=0.d0
            xlooker4(i,j)=0.d0
            xlooker5(i,j)=0.d0
        enddo
      enddo
c
c  If a SCMM1 calculation (MM calculation with configuration 1)
c
      if (mciord.eq.1) then
         call mcviic(xii,e1,g1,h1,3,1,1)
c	 
         v = e1
         do i=1,mcmcar
            dxii(i) = g1(i)
         enddo
         do i=1,mcmcar
           do j=1,mcmcar
             fmat(i,j) = h1(i,j)
           enddo
         enddo
c
c  If a SCMM2 calculation (MM calculation with configuration 2)
c
      else if (mciord.eq.2) then
         call mcviic(xii,e2,g2,h2,3,2,1)
c	 
         v = e2
         do i=1,mcmcar
            dxii(i) = g2(i)
         enddo
         do i=1,mcmcar
           do j=1,mcmcar
             fmat(i,j) = h2(i,j)
           enddo
         enddo
c
c  If a MCMM calculation
c
      else if (mciord.eq.0) then
c
c  Calculate V11
c
       call mcviic(xii,e1_E,g1_E,h1_E,3,1,1)                            
       call mcviic(xii,e1_12,g1_12,h1_12,3,1,2)                         
       call mcviic(xii,e1_23,g1_23,h1_23,3,1,3)                         
       call mcviic(xii,e1_13,g1_13,h1_13,3,1,4)                         
       call mcviic(xii,e1_123,g1_123,h1_123,3,1,5)                      
       call mcviic(xii,e1_132,g1_132,h1_132,3,1,6)                      
c                                                                       
       exxp1 = 0.d0                                                     
       exxp2 = 0.d0                                                     
       exxp3 = 0.d0                                                     
       exxp4 = 0.d0                                                     
       exxp5 = 0.d0                                                     
       exxp6 = 0.d0                                                     
c                                                                       
       exxp1 = dexp(-alphaV1*e1_E)                                      
       exxp2 = dexp(-alphaV1*e1_12)                                     
       exxp3 = dexp(-alphaV1*e1_23)                                     
       exxp4 = dexp(-alphaV1*e1_13)                                     
       exxp5 = dexp(-alphaV1*e1_123)                                    
       exxp6 = dexp(-alphaV1*e1_132)
c
         expsum=exxp1+exxp2+exxp3+exxp4+exxp5+exxp6
c                                    
       e1=-(1.d0/alphaV1)*dlog(1.d0/isigmav1*expsum)                                                    
c                                                                       
c                                                                       
         do i=1,mcncar
          d1tmp(i)=exxp1*g1_E(i)+exxp2*g1_12(i)+exxp3*g1_23(i)          
     *    +exxp4*g1_13(i)+exxp5*g1_123(i)+exxp6*g1_132(i)               
           g1(i)=d1tmp(i)/expsum                                        
         enddo                                                          
c
         do i=1,mcncar
           do j=1,mcncar
         xlooker1(i,j)=(h1_E(i,j)-alphaV1*g1_E(i)*g1_E(j))*exxp1+       
     *   (h1_12(i,j)-alphaV1*g1_12(i)*g1_12(j))*exxp2+                  
     *   (h1_23(i,j)-alphaV1*g1_23(i)*g1_23(j))*exxp3+                  
     *   (h1_13(i,j)-alphaV1*g1_13(i)*g1_13(j))*exxp4+                  
     * (h1_123(i,j)-alphaV1*g1_123(i)*g1_123(j))*exxp5+                 
     * (h1_132(i,j)-alphaV1*g1_132(i)*g1_132(j))*exxp6                  
            xlooker2(i,j)=xlooker1(i,j)/expsum                          
            xlooker3(i,j)=g1_E(i)*exxp1+                                
     *     g1_12(i)*exxp2+                                              
     *     g1_23(i)*exxp3+                                              
     *     g1_13(i)*exxp4+                                              
     *     g1_123(i)*exxp5+                                             
     *     g1_132(i)*exxp6                                              
           xlooker3a(i,j)=g1_E(j)*exxp1+                                
     *     g1_12(j)*exxp2+                                              
     *     g1_23(j)*exxp3+                                              
     *     g1_13(j)*exxp4+                                              
     *     g1_123(j)*exxp5+                                             
     *     g1_132(j)*exxp6                                              
           xlooker4(i,j)=alphaV1*xlooker3(i,j)*                         
     *     xlooker3a(i,j)/(expsum**2)                                   
           xlooker5(i,j)=xlooker2(i,j)+xlooker4(i,j)                    
           enddo                                                        
         enddo                                                          
           do i=1,mcncar
           do j=1,mcncar
           h1(i,j)=xlooker5(i,j)                                        
           enddo                                                        
         enddo                                                          
c  Calculate V22
c
       expsum=0.d0
c
       call mcviic(xii,e2_E,g2_E,h2_E,3,2,1)                           
       call mcviic(xii,e2_12,g2_12,h2_12,3,2,2)                        
       call mcviic(xii,e2_23,g2_23,h2_23,3,2,3)                        
       call mcviic(xii,e2_13,g2_13,h2_13,3,2,4)                        
       call mcviic(xii,e2_123,g2_123,h2_123,3,2,5)                     
       call mcviic(xii,e2_132,g2_132,h2_132,3,2,6)                     
c                                                                      
       exxp1 = 0.d0                                                    
       exxp2 = 0.d0                                                    
       exxp3 = 0.d0                                                    
       exxp4 = 0.d0                                                    
       exxp5 = 0.d0                                                    
       exxp6 = 0.d0                                                    
c                                                                      
       exxp1 = dexp(-alphaV2*e2_E)                                     
       exxp2 = dexp(-alphaV2*e2_12)                                    
       exxp3 = dexp(-alphaV2*e2_23)                                    
       exxp4 = dexp(-alphaV2*e2_13)                                    
       exxp5 = dexp(-alphaV2*e2_123)                                   
       exxp6 = dexp(-alphaV2*e2_132)                                   
c
         expsum=exxp1+exxp2+exxp3+exxp4+exxp5+exxp6                                                                      
         e2=-(1.d0/alphaV2)*dlog(1.d0/isigmav2*expsum)
c                                                                       
         do i=1,mcncar
          d2tmp(i)=exxp1*g2_E(i)+exxp2*g2_12(i)+exxp3*g2_23(i)          
     *    +exxp4*g2_13(i)+exxp5*g2_123(i)+exxp6*g2_132(i)               
           g2(i)=d2tmp(i)/expsum                                        
         enddo                                                          
c                                                                       
         do i=1,mcmcar                                                  
         do j=1,mcmcar                                                  
         xlooker1(i,j)=0.d0                                             
         xlooker2(i,j)=0.d0                                             
         xlooker3(i,j)=0.d0                                             
         xlooker3a(i,j)=0.d0                                            
         xlooker4(i,j)=0.d0                                             
         xlooker5(i,j)=0.d0                                             
        enddo                                                           
         enddo                                                          
         do i=1,mcncar
           do j=1,mcncar
         xlooker1(i,j)=(h2_E(i,j)-alphaV2*g2_E(i)*g2_E(j))*exxp1+       
     *   (h2_12(i,j)-alphaV2*g2_12(i)*g2_12(j))*exxp2+                  
     *   (h2_23(i,j)-alphaV2*g2_23(i)*g2_23(j))*exxp3+                  
     *   (h2_13(i,j)-alphaV2*g2_13(i)*g2_13(j))*exxp4+                  
     * (h2_123(i,j)-alphaV2*g2_123(i)*g2_123(j))*exxp5+                 
     * (h2_132(i,j)-alphaV2*g2_132(i)*g2_132(j))*exxp6                  
            xlooker2(i,j)=xlooker1(i,j)/expsum                          
            xlooker3(i,j)=g2_E(i)*exxp1+                                
     *     g2_12(i)*exxp2+                                              
     *     g2_23(i)*exxp3+                                              
     *     g2_13(i)*exxp4+                                              
     *     g2_123(i)*exxp5+                                             
     *     g2_132(i)*exxp6                                              
           xlooker3a(i,j)=g2_E(j)*exxp1+                                
     *     g2_12(j)*exxp2+                                              
     *     g2_23(j)*exxp3+                                              
     *     g2_13(j)*exxp4+                                              
     *     g2_123(j)*exxp5+                                             
     *     g2_132(j)*exxp6                                              
           xlooker4(i,j)=alphaV2*xlooker3(i,j)*                         
     *     xlooker3a(i,j)/(expsum**2)                                   
           xlooker5(i,j)=xlooker2(i,j)+xlooker4(i,j)                       
           enddo                                                        
         enddo                                                          
           do i=1,mcncar
           do j=1,mcncar
           h2(i,j)=xlooker5(i,j)                                        
           enddo                                                       
         enddo                                                        
c
c  Calculate V12
c
         call mcv12c(xii,e12,g12,h12,3)
c
c  Combine energies
c
         call mccene(e1,e2,e12,v,icomplex)
c
c  Combine gradients
c
         call mccgra(e1,e2,e12,g1,g2,g12,dxii,mcmcar,
     *  icomplex)
c
c  Combine hessians
c
         call mcches(e1,e2,e12,g1,g2,g12,h1,h2,h12,fmat,
     *  mcmcar,icomplex)
c
      endif
c
      return
      end
c***********************************************************************
c     mc12perm
c***********************************************************************
c
      subroutine mc12perm(a_new,a_old)
c
      implicit double precision (a-h,o-z)
c
c      include 'mcparm.inc'
c      include 'mcperc.inc'
c      include 'mccomm.inc'
c
      dimension a_old(12)
      dimension a_new(12)
c
c   Initialiization
       do i=1,12
         a_new(i)=0.d0
       enddo
c
         a_new(1)=a_old(1)
         a_new(2)=a_old(2)
         a_new(3)=a_old(3)
         a_new(4)=a_old(7)
         a_new(5)=a_old(8)
         a_new(6)=a_old(9)
         a_new(7)=a_old(4)
         a_new(8)=a_old(5)
         a_new(9)=a_old(6)
         a_new(10)=a_old(10)
         a_new(11)=a_old(11)
         a_new(12)=a_old(12)
c
      return 
      end
c***********************************************************************
c     mc23perm
c***********************************************************************
c
      subroutine mc23perm(a_new,a_old)
c
      implicit double precision (a-h,o-z)
c
c      include 'mcparm.inc'
c      include 'mcperc.inc'
c      include 'mccomm.inc'
c
      dimension a_old(12)
      dimension a_new(12)
c
c   Initialiization
       do i=1,12
         a_new(i)=0.d0
       enddo
c
         a_new(1)=a_old(1)
         a_new(2)=a_old(2)
         a_new(3)=a_old(3)
         a_new(4)=a_old(4)
         a_new(5)=a_old(5)
         a_new(6)=a_old(6)
         a_new(7)=a_old(10)
         a_new(8)=a_old(11)
         a_new(9)=a_old(12)
         a_new(10)=a_old(7)
         a_new(11)=a_old(8)
         a_new(12)=a_old(9)
c
      return
      end
c***********************************************************************
c     mc13perm
c***********************************************************************
c
      subroutine mc13perm(a_new,a_old)
c
      implicit double precision (a-h,o-z)
c
c      include 'mcparm.inc'
c      include 'mcperc.inc'
c      include 'mccomm.inc'
c
      dimension a_old(12)
      dimension a_new(12)
c
c   Initialiization
       do i=1,12
         a_new(i)=0.d0
       enddo
c
         a_new(1)=a_old(1)
         a_new(2)=a_old(2)
         a_new(3)=a_old(3)
         a_new(4)=a_old(10)
         a_new(5)=a_old(11)
         a_new(6)=a_old(12)
         a_new(7)=a_old(7)
         a_new(8)=a_old(8)
         a_new(9)=a_old(9)
         a_new(10)=a_old(4)
         a_new(11)=a_old(5)
         a_new(12)=a_old(6)
c
      return 
      end
c***********************************************************************
c     mc123perm
c***********************************************************************
c
      subroutine mc123perm(a_new,a_old)
c
      implicit double precision (a-h,o-z)
c
c      include 'mcparm.inc'
c      include 'mcperc.inc'
c      include 'mccomm.inc'
c
      dimension a_old(12)
      dimension a_new(12)
c
c   Initialiization
       do i=1,12
         a_new(i)=0.d0
       enddo
c
         a_new(1)=a_old(1)
         a_new(2)=a_old(2)
         a_new(3)=a_old(3)
         a_new(4)=a_old(10)
         a_new(5)=a_old(11)
         a_new(6)=a_old(12)
         a_new(7)=a_old(4)
         a_new(8)=a_old(5)
         a_new(9)=a_old(6)
         a_new(10)=a_old(7)
         a_new(11)=a_old(8)
         a_new(12)=a_old(9)
c
      return 
      end
c***********************************************************************
c     mc132perm
c***********************************************************************
c
      subroutine mc132perm(a_new,a_old)
c
      implicit double precision (a-h,o-z)
c
c      include 'mcparm.inc'
c      include 'mcperc.inc'
c      include 'mccomm.inc'
c
      dimension a_old(12)
      dimension a_new(12)
c
c   Initialiization
       do i=1,12
         a_new(i)=0.d0
       enddo
c
         a_new(1)=a_old(1)
         a_new(2)=a_old(2)
         a_new(3)=a_old(3)
         a_new(4)=a_old(7)
         a_new(5)=a_old(8)
         a_new(6)=a_old(9)
         a_new(7)=a_old(10)
         a_new(8)=a_old(11)
         a_new(9)=a_old(12)
         a_new(10)=a_old(4)
         a_new(11)=a_old(5)
         a_new(12)=a_old(6)
c
      return 
      end
c***********************************************************************
c     mc12perm2
c***********************************************************************
c
       subroutine mc12perm2(k_prm,k_old)
c
       implicit double precision (a-h,o-z)
c
       include 'mcparm.inc'
       include 'mcperc.inc'
       include 'mccomm.inc'
c
       double precision k_old(mcmcar,mcmcar)
       double precision k_prm(mcmcar,mcmcar)
       double precision k_prm1(mcmcar,mcmcar)
c
       do i=1,mcmcar
       do j=1,mcmcar
       k_prm(i,j)=0.d0
       k_prm1(i,j)=0.d0
       enddo
       enddo
c
         do i=1,mcmcar
         k_prm1(i,1)=k_old(i,1)
         k_prm1(i,2)=k_old(i,2)
         k_prm1(i,3)=k_old(i,3)
         k_prm1(i,4)=k_old(i,7)
         k_prm1(i,5)=k_old(i,8)
         k_prm1(i,6)=k_old(i,9)
         k_prm1(i,7)=k_old(i,4)
         k_prm1(i,8)=k_old(i,5)
         k_prm1(i,9)=k_old(i,6)
         k_prm1(i,10)=k_old(i,10)
         k_prm1(i,11)=k_old(i,11)
         k_prm1(i,12)=k_old(i,12)
         enddo
         do j=1,mcmcar
         k_prm(1,j)=k_prm1(1,j)
         k_prm(2,j)=k_prm1(2,j)
         k_prm(3,j)=k_prm1(3,j)
         k_prm(4,j)=k_prm1(7,j)
         k_prm(5,j)=k_prm1(8,j)
         k_prm(6,j)=k_prm1(9,j)
         k_prm(7,j)=k_prm1(4,j)
         k_prm(8,j)=k_prm1(5,j)
         k_prm(9,j)=k_prm1(6,j)
         k_prm(10,j)=k_prm1(10,j)
         k_prm(11,j)=k_prm1(11,j)
         k_prm(12,j)=k_prm1(12,j)
         enddo
         return
         end
c***********************************************************************
c     mc23perm2
c***********************************************************************
c
            subroutine mc23perm2(k_prm,k_old)
c
       implicit double precision (a-h,o-z)
c
       include 'mcparm.inc'
       include 'mcperc.inc'
       include 'mccomm.inc'
c
       double precision k_old(mcmcar,mcmcar)
       double precision k_prm(mcmcar,mcmcar)
       double precision k_prm1(mcmcar,mcmcar)
c
       do i=1,mcmcar
       do j=1,mcmcar
       k_prm(i,j)=0.d0
       k_prm1(i,j)=0.d0
       enddo
       enddo
c
         do i=1,mcmcar
         k_prm1(i,1)=k_old(i,1)
         k_prm1(i,2)=k_old(i,2)
         k_prm1(i,3)=k_old(i,3)
         k_prm1(i,4)=k_old(i,4)
         k_prm1(i,5)=k_old(i,5)
         k_prm1(i,6)=k_old(i,6)
         k_prm1(i,7)=k_old(i,10)
         k_prm1(i,8)=k_old(i,11)
         k_prm1(i,9)=k_old(i,12)
         k_prm1(i,10)=k_old(i,7)
         k_prm1(i,11)=k_old(i,8)
         k_prm1(i,12)=k_old(i,9)
         enddo
         do j=1,mcmcar
         k_prm(1,j)=k_prm1(1,j)
         k_prm(2,j)=k_prm1(2,j)
         k_prm(3,j)=k_prm1(3,j)
         k_prm(4,j)=k_prm1(4,j)
         k_prm(5,j)=k_prm1(5,j)
         k_prm(6,j)=k_prm1(6,j)
         k_prm(7,j)=k_prm1(10,j)
         k_prm(8,j)=k_prm1(11,j)
         k_prm(9,j)=k_prm1(12,j)
         k_prm(10,j)=k_prm1(7,j)
         k_prm(11,j)=k_prm1(8,j)
         k_prm(12,j)=k_prm1(9,j)
         enddo
         return
         end
c***********************************************************************
c     mc13perm2
c***********************************************************************
c
            subroutine mc13perm2(k_prm,k_old)
c
       implicit double precision (a-h,o-z)
c
       include 'mcparm.inc'
       include 'mcperc.inc'
       include 'mccomm.inc'
c
       double precision k_old(mcmcar,mcmcar)
       double precision k_prm(mcmcar,mcmcar)
       double precision k_prm1(mcmcar,mcmcar)
c
       do i=1,mcmcar
       do j=1,mcmcar
       k_prm(i,j)=0.d0
       k_prm1(i,j)=0.d0
       enddo
       enddo
c
         do i=1,mcmcar
         k_prm1(i,1)=k_old(i,1)
         k_prm1(i,2)=k_old(i,2)
         k_prm1(i,3)=k_old(i,3)
         k_prm1(i,4)=k_old(i,10)
         k_prm1(i,5)=k_old(i,11)
         k_prm1(i,6)=k_old(i,12)
         k_prm1(i,7)=k_old(i,7)
         k_prm1(i,8)=k_old(i,8)
         k_prm1(i,9)=k_old(i,9)
         k_prm1(i,10)=k_old(i,4)
         k_prm1(i,11)=k_old(i,5)
         k_prm1(i,12)=k_old(i,6)
         enddo
         do j=1,mcmcar
         k_prm(1,j)=k_prm1(1,j)
         k_prm(2,j)=k_prm1(2,j)
         k_prm(3,j)=k_prm1(3,j)
         k_prm(4,j)=k_prm1(10,j)
         k_prm(5,j)=k_prm1(11,j)
         k_prm(6,j)=k_prm1(12,j)
         k_prm(7,j)=k_prm1(7,j)
         k_prm(8,j)=k_prm1(8,j)
         k_prm(9,j)=k_prm1(9,j)
         k_prm(10,j)=k_prm1(4,j)
         k_prm(11,j)=k_prm1(5,j)
         k_prm(12,j)=k_prm1(6,j)
         enddo
         return
         end
