c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine     grads  --  first derivatives               ##   
c     ##                                                            ##
c     ################################################################
c
c
c     "testgrad" computes and compares the analytical and numerical
c     gradient vectors of the potential energy function with respect
c     to Cartesian coordinates
c
c
      subroutine grads(transx,ic12tn,atnmtn,itptn,itgtn,mcmkey,
     *                 intn,nattom,mcmatm,mcmcar,tnky,tranky,
     *                 dxtk,etot)
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'couple.i'
      include 'files.i'
      include 'potent.i'
      include 'iounit.i'
      include 'titles.i'
      include 'atoms.i'
      include 'deriv.i'
      include 'energi.i'
      include 'usage.i'
      include 'keys.i'
      integer i,j

      integer nattom,mcmatm,mcmcar,mcmkey
      integer ic12tn(mcmatm,mcmatm),itptn(mcmatm),itgtn(mcmatm)
      integer intn(mcmatm)
      character*3 atnmtn(mcmatm)
      integer tnky
      character*80 tranky(mcmkey)
      real*8 transx(mcmcar)
      real*8 dxtk(mcmcar)
      real*8 etot,f,f0,eps,eps0,old,energy
      real*8 eb0,ea0,eba0,eub0,eaa0,eopb0,eid0
      real*8 eit0,et0,ebt0,ett0,ev0,e140,ec0
      real*8 ecd0,ed0,em0,ep0,er0,es0,eg0,ex0
      real*8 ndeb(3,maxatm),ndea(3,maxatm)
      real*8 ndeba(3,maxatm),ndeub(3,maxatm)
      real*8 ndeaa(3,maxatm),ndeopb(3,maxatm)
      real*8 ndeid(3,maxatm),ndeit(3,maxatm)
      real*8 ndet(3,maxatm),ndebt(3,maxatm)
      real*8 ndett(3,maxatm),ndev(3,maxatm)
      real*8 nde14(3,maxatm),ndec(3,maxatm)
      real*8 ndecd(3,maxatm),nded(3,maxatm)
      real*8 ndem(3,maxatm),ndep(3,maxatm)
      real*8 nder(3,maxatm),ndes(3,maxatm)
      real*8 ndeg(3,maxatm),ndex(3,maxatm)
      real*8 detot(3,maxatm),ndetot(3,maxatm)
      real*8 denorm(maxatm),ndenorm(maxatm)
      real*8 totnorm,ntotnorm,rms,nrms
      character*1 answer,axis(3)
      character*80 string
      logical exist,query,doanalyt,donumer,dofull
      data axis  / 'X','Y','Z' /
c
c
c     set up the structure and mechanics calculation
c
      do i=1,mcmcar
         dxtk(i)=0.
      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
c     decide whether to do an analytical gradient calculation
c
      doanalyt = .true.
c
c     decide whether to do a numerical gradient calculation
c
      donumer = .false.
c
c     decide whether to output results by gradient component
c
      dofull = .true.
c
c     compute the analytical gradient components
c
      call gradient (etot,detot)
c
c     print total energy
c     I commented the printing of the information. It is not useful.
c     TVA 01/24/02
c
c      write (iout,100)  etot
c  100 format (/,' Total Potential Energy :',6x,f16.4,' Kcal/mole')
c
c     print out the gradient components for each atom
c
c      write (iout,180)
c  180 format (/,' Energy Derivative Breakdown over Individual Atoms :')
c      write (iout,190)
c  190 format (/,2x,'Type',6x,'Atom',12x,'dE/dX',
c     &          7x,'dE/dY',7x,'dE/dZ',10x,'Norm',/)
c
c      totnorm = 0.0d0
c      ntotnorm = 0.0d0
c      do i = 1, n
c            denorm(i) = detot(1,i)**2 + detot(2,i)**2 +
c     &                       detot(3,i)**2
c            totnorm = totnorm + denorm(i)
c            denorm(i) = sqrt(denorm(i))
c            write (iout,200)  i,(detot(j,i),j=1,3),denorm(i)
c  200       format (' Anlyt',5x,i5,5x,3f12.4,2x,f12.4)
c      end do
c      close (unit=iout)
      do i=1,n
        do j=1,3
             dxtk((i-1)*3+j)=detot(j,i)
        enddo
      enddo
      return
      end
