c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine hesss  --  Hessian matrix                      ##
c     ##                                                            ##
c     ################################################################
c
c
c     "testhess" computes and compares the analytical and numerical
c     Hessian matrices of the potential energy function with respect
c     to Cartesian coordinates
c
c
      subroutine hesss(transx,ic12tn,atnmtn,itptn,itgtn,mcmkey,
     *                 intn,nattom,mcmatm,mcmcar,tnky,tranky,
     *                 ftk)
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'couple.i'
      include 'atoms.i'
      include 'potent.i'
      include 'files.i'
      include 'hescut.i'
      include 'iounit.i'
      include 'usage.i'
      include 'keys.i'
      integer maxnum,mcmkey
      parameter (maxnum=120)
      integer nattom,mcmatm,mcmcar
      integer ic12tn(mcmatm,mcmatm),itptn(mcmatm),itgtn(mcmatm)
      integer intn(mcmatm)
      character*3 atnmtn(mcmatm)
      real*8 transx(mcmcar)
      real*8 ftk(mcmcar,mcmcar)
      integer tnky
      character*80 tranky(mcmkey)
      integer i,j,k,m,ii,jj,index,freeunit
      integer hinit(3,maxatm),hstop(3,maxatm)
      integer hindex(maxhess)
      real*8 h(maxhess),hdiag(3,maxatm)
      real*8 g(3,maxatm),g0(3,maxatm)
      real*8 energy,e,old,eps,eps0,delta,sum
      real*8 nhess(3,maxnum,3,maxnum)
      character*1 answer,axis(3)
      character*60 hessfile
      character*80 string
      logical doanalyt,donumer,dograd,dofull
      logical exist,query,identical
      external energy
      data axis  / 'X','Y','Z' /
c
c
c     set up the structure and mechanics calculation
c
      do i=1,mcmcar
         do j=1,mcmcar
            ftk(i,j)=0.0
         enddo
      enddo
cOTs
      use_angle=.true.
cOTe
      call initial
c     call getxyz
      n=nattom
      do i=1,nattom
         tag(i)=itgtn(i)
         type(i)=itptn(i)
         name(i)=atnmtn(i)
         do j=1,nattom
            i12(i,j)=ic12tn(i,j)
         enddo
         x(i)=transx((i-1)*3+1)
         y(i)=transx((i-1)*3+2)
         z(i)=transx((i-1)*3+3)
      enddo
      do i=1,nattom
         n12(i) = intn(i)
      enddo
      nkey=tnky
      if (nkey.gt.0) then
         do i=1,nkey
            keyline(i)=tranky(i)
         enddo
      endif
      call mechanic
c
      doanalyt = .true.
      donumer = .false.
c
c     decide whether to output results by Hessian component
c
      dofull = .true. 
c
      identical = .true.
      hesscut = 0.0
      call hessian (h,hinit,hstop,hindex,hdiag)
c
c     write out the full matrix of analytical Hessian elements
c     I commented the printing of the information. It is not useful.
c     TVA 01/24/02
c
c         write (iout,210)
c  210    format (/,' Diagonal Hessian Elements  (3 per Atom)',/)
c         write (iout,220)  ((hdiag(j,i),j=1,3),i=1,n)
c  220    format (6f12.4)
c         do i = 1, n
c            do j = 1, 3
c               if (hinit(j,i) .le. hstop(j,i)) then
c                  write (iout,230)  i,axis(j)
c  230             format (/,' Off-diagonal Hessian Elements for Atom',
c     &                       i6,1x,a1,/)
c                  write (iout,240)  (h(k),k=hinit(j,i),hstop(j,i))
c  240             format (6f12.4)
c               end if
c            end do
c         end do
c         close (unit=iout)
c
c     put the diagonal elements in tkf
c
      do i=1,n
        do j=1,3
           k=(i-1)*3+j
           ftk(k,k)=hdiag(j,i)
        enddo
      enddo
c
c     put the off-diagonal elements in tkf
c
      do i=1,n
       do j=1,3
          if (hinit(j,i) .le. hstop(j,i)) then
             do k=hinit(j,i),hstop(j,i)
                ii=k-hinit(j,i)+((i-1)*3+j)+1
                jj=((i-1)*3+j)
                ftk(ii,jj)=h(k)
                ftk(jj,ii)=h(k)
             enddo
          endif
        enddo    
      enddo    
      return
      end
