c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  program testgrad  --  derivative test; Cartesian version  ##
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
      program testgrad
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'deriv.i'
      include 'energi.i'
      include 'iounit.i'
      include 'usage.i'
      integer i,j
      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
      call initial
      call getxyz
      call mechanic
c
c     decide whether to do an analytical gradient calculation
c
      doanalyt = .true.
      call nextarg (answer,exist)
      if (.not. exist) then
         write (iout,10)
   10    format (/,' Compute the Analytical Gradient Vector [Y] :  ',$)
         read (input,20)  answer
   20    format (a1)
      end if
      call upcase (answer)
      if (answer .eq. 'N')  doanalyt = .false.
c
c     decide whether to do a numerical gradient calculation
c
      donumer = .true.
      call nextarg (answer,exist)
      if (.not. exist) then
         write (iout,30)
   30    format (/,' Compute the Numerical Gradient Vector [Y] :   ',$)
         read (input,40)  answer
   40    format (a1)
      end if
      call upcase (answer)
      if (answer .eq. 'N')  donumer = .false.
c
c     get the stepsize for numerical gradient calculation
c
      if (donumer) then
         eps = -1.0d0
         eps0 = 1.0d-4
         query = .true.
         call nextarg (string,exist)
         if (exist) then
            read (string,*,err=50,end=50)  eps
            query = .false.
         end if
   50    continue
         if (query) then
            write (iout,60)  eps0
   60       format (/,' Enter a Numerical Stepsize [',d7.1,
     &                 ' Ang] :  ',$)
            read (input,70)  eps
   70       format (f20.0)
         end if
         if (eps .le. 0.0d0)  eps = eps0
      end if
c
c     decide whether to output results by gradient component
c
      dofull = .true.
      if (n .gt. 100) then
         dofull = .false.
         call nextarg (answer,exist)
         if (.not. exist) then
            write (iout,80)
   80       format (/,' Output breakdown by Gradient Component',
     &                 ' [N] :  ',$)
            read (input,90)  answer
   90       format (a1)
         end if
         call upcase (answer)
         if (answer .eq. 'Y')  dofull = .true.
      end if
c
c     compute the analytical gradient components
c
      if (doanalyt) then
         call gradient (etot,detot)
      end if
c
c     print total energy and breakdown over energy components
c
      if (doanalyt) then
         write (iout,100)  etot
  100    format (/,' Total Potential Energy :',6x,f16.4,' Kcal/mole')
         write (iout,110)
  110    format (/,' Potential Energy Breakdown by Individual',
     &              ' Components :')
         write (iout,120)
  120    format (/,15x,'EB',10x,'EA',9x,'EBA',9x,'EUB',
     &              9x,'EAA',8x,'EOPB',
     &           /,14x,'EID',9x,'EIT',10x,'ET',9x,'EBT',
     &              9x,'ETT',9x,'E14',
     &           /,15x,'EV',10x,'EC',9x,'ECD',10x,'ED',
     &              10x,'EM',10x,'EP',
     &           /,15x,'ER',10x,'ES',10x,'EG',10x,'EX')
         write (iout,130)  eb,ea,eba,eub,eaa,eopb,eid,eit,et,ebt,
     &                     ett,e14,ev,ec,ecd,ed,em,ep,er,es,eg,ex
  130    format (/,6x,6f12.4,/,6x,6f12.4,/,6x,6f12.4,/,6x,4f12.4)
      end if
c
c     print a header for the gradients of individual potentials
c
      write (iout,140)
  140 format (/,' Energy Derivative Breakdown by Individual',
     &              ' Components :')
      if (dofull) then
         write (iout,150)
  150    format (/,2x,'Atom',8x,'d EB',8x,'d EA',7x,'d EBA',
     &              7x,'d EUB',7x,'d EAA',6x,'d EOPB',
     &           /,2x,'Axis',7x,'d EID',7x,'d EIT',8x,'d ET',
     &              7x,'d EBT',7x,'d ETT',7x,'d E14',
     &           /,2x,'Type',8x,'d EV',8x,'d EC',7x,'d ECD',
     &              8x,'d ED',8x,'d EM',8x,'d EP',
     &           /,14x,'d ER',8x,'d ES',8x,'d EG',8x,'d EX')
      end if
c
c     get the x-component two-sided numerical gradient
c
      do i = 1, n
         if (donumer .and. use(i)) then
            old = x(i)
            x(i) = x(i) - 0.5d0*eps
            f0 = energy ()
            eb0 = eb
            ea0 = ea
            eba0 = eba
            eub0 = eub
            eaa0 = eaa
            eopb0 = eopb
            eid0 = eid
            eit0 = eit
            et0 = et
            ebt0 = ebt
            ett0 = ett
            e140 = e14
            ev0 = ev
            ec0 = ec
            ecd0 = ecd
            ed0 = ed
            em0 = em
            ep0 = ep
            er0 = er
            es0 = es
            eg0 = eg
            ex0 = ex
            x(i) = x(i) + eps
            f = energy ()
            x(i) = old
            ndeb(1,i) = (eb - eb0) / eps
            ndea(1,i) = (ea - ea0) / eps
            ndeba(1,i) = (eba - eba0) / eps
            ndeub(1,i) = (eub - eub0) / eps
            ndeaa(1,i) = (eaa - eaa0) / eps
            ndeopb(1,i) = (eopb - eopb0) / eps
            ndeid(1,i) = (eid - eid0) / eps
            ndeit(1,i) = (eit - eit0) / eps
            ndet(1,i) = (et - et0) / eps
            ndebt(1,i) = (ebt - ebt0) / eps
            ndett(1,i) = (ett - ett0) / eps
            nde14(1,i) = (e14 - e140) / eps
            ndev(1,i) = (ev - ev0) / eps
            ndec(1,i) = (ec - ec0) / eps
            ndecd(1,i) = (ecd - ecd0) / eps
            nded(1,i) = (ed - ed0) / eps
            ndem(1,i) = (em - em0) / eps
            ndep(1,i) = (ep - ep0) / eps
            nder(1,i) = (er - er0) / eps
            ndes(1,i) = (es - es0) / eps
            ndeg(1,i) = (eg - eg0) / eps
            ndex(1,i) = (ex - ex0) / eps
            ndetot(1,i) = (f - f0) / eps
c
c     get the y-component two-sided numerical gradient
c
            old = y(i)
            y(i) = y(i) - 0.5d0*eps
            f0 = energy ()
            eb0 = eb
            ea0 = ea
            eba0 = eba
            eub0 = eub
            eaa0 = eaa
            eopb0 = eopb
            eid0 = eid
            eit0 = eit
            et0 = et
            ebt0 = ebt
            ett0 = ett
            e140 = e14
            ev0 = ev
            ec0 = ec
            ecd0 = ecd
            ed0 = ed
            em0 = em
            ep0 = ep
            er0 = er
            es0 = es
            eg0 = eg
            ex0 = ex
            y(i) = y(i) + eps
            f = energy ()
            y(i) = old
            ndeb(2,i) = (eb - eb0) / eps
            ndea(2,i) = (ea - ea0) / eps
            ndeba(2,i) = (eba - eba0) / eps
            ndeub(2,i) = (eub - eub0) / eps
            ndeaa(2,i) = (eaa - eaa0) / eps
            ndeopb(2,i) = (eopb - eopb0) / eps
            ndeid(2,i) = (eid - eid0) / eps
            ndeit(2,i) = (eit - eit0) / eps
            ndet(2,i) = (et - et0) / eps
            ndebt(2,i) = (ebt - ebt0) / eps
            ndett(2,i) = (ett - ett0) / eps
            nde14(2,i) = (e14 - e140) / eps
            ndev(2,i) = (ev - ev0) / eps
            ndec(2,i) = (ec - ec0) / eps
            ndecd(2,i) = (ecd - ecd0) / eps
            nded(2,i) = (ed - ed0) / eps
            ndem(2,i) = (em - em0) / eps
            ndep(2,i) = (ep - ep0) / eps
            nder(2,i) = (er - er0) / eps
            ndes(2,i) = (es - es0) / eps
            ndeg(2,i) = (eg - eg0) / eps
            ndex(2,i) = (ex - ex0) / eps
            ndetot(2,i) = (f - f0) / eps
c
c     get the z-component two-sided numerical gradient
c
            old = z(i)
            z(i) = z(i) - 0.5d0*eps
            f0 = energy ()
            eb0 = eb
            ea0 = ea
            eba0 = eba
            eub0 = eub
            eaa0 = eaa
            eopb0 = eopb
            eid0 = eid
            eit0 = eit
            et0 = et
            ebt0 = ebt
            ett0 = ett
            e140 = e14
            ev0 = ev
            ec0 = ec
            ecd0 = ecd
            ed0 = ed
            em0 = em
            ep0 = ep
            er0 = er
            es0 = es
            eg0 = eg
            ex0 = ex
            z(i) = z(i) + eps
            f = energy ()
            z(i) = old
            ndeb(3,i) = (eb - eb0) / eps
            ndea(3,i) = (ea - ea0) / eps
            ndeba(3,i) = (eba - eba0) / eps
            ndeub(3,i) = (eub - eub0) / eps
            ndeaa(3,i) = (eaa - eaa0) / eps
            ndeopb(3,i) = (eopb - eopb0) / eps
            ndeid(3,i) = (eid - eid0) / eps
            ndeit(3,i) = (eit - eit0) / eps
            ndet(3,i) = (et - et0) / eps
            ndebt(3,i) = (ebt - ebt0) / eps
            ndett(3,i) = (ett - ett0) / eps
            nde14(3,i) = (e14 - e140) / eps
            ndev(3,i) = (ev - ev0) / eps
            ndec(3,i) = (ec - ec0) / eps
            ndecd(3,i) = (ecd - ecd0) / eps
            nded(3,i) = (ed - ed0) / eps
            ndem(3,i) = (em - em0) / eps
            ndep(3,i) = (ep - ep0) / eps
            nder(3,i) = (er - er0) / eps
            ndes(3,i) = (es - es0) / eps
            ndeg(3,i) = (eg - eg0) / eps
            ndex(3,i) = (ex - ex0) / eps
            ndetot(3,i) = (f - f0) / eps
         end if
c
c     print out gradient of each energy term for each
c     of the three coordinate components of each atom
c
         if (dofull .and. use(i)) then
            do j = 1, 3
               if (doanalyt) then
                  write (iout,160)  i,deb(j,i),dea(j,i),deba(j,i),
     &                              deub(j,i),deaa(j,i),deopb(j,i),
     &                              axis(j),deid(j,i),deit(j,i),
     &                              det(j,i),debt(j,i),dett(j,i),
     &                              de14(j,i),dev(j,i),dec(j,i),
     &                              decd(j,i),ded(j,i),dem(j,i),
     &                              dep(j,i),der(j,i),des(j,i),
     &                              deg(j,i),dex(j,i)
  160             format (/,i6,6f12.4,/,5x,a1,6f12.4,
     &                    /,' Anlyt',6f12.4,/,6x,4f12.4)
               end if
               if (donumer) then
                  write (iout,170)  i,ndeb(j,i),ndea(j,i),ndeba(j,i),
     &                              ndeub(j,i),ndeaa(j,i),ndeopb(j,i),
     &                              axis(j),ndeid(j,i),ndeit(j,i),
     &                              ndet(j,i),ndebt(j,i),ndett(j,i),
     &                              nde14(j,i),ndev(j,i),ndec(j,i),
     &                              ndecd(j,i),nded(j,i),ndem(j,i),
     &                              ndep(j,i),nder(j,i),ndes(j,i),
     &                              ndeg(j,i),ndex(j,i)
  170             format (/,i6,6f12.4,/,5x,a1,6f12.4,
     &                    /,' Numer',6f12.4,/,6x,4f12.4)
               end if
            end do
         end if
      end do
c
c     print out the gradient components for each atom
c
      write (iout,180)
  180 format (/,' Energy Derivative Breakdown over Individual Atoms :')
      write (iout,190)
  190 format (/,2x,'Type',6x,'Atom',12x,'dE/dX',
     &          7x,'dE/dY',7x,'dE/dZ',10x,'Norm',/)
      totnorm = 0.0d0
      ntotnorm = 0.0d0
      do i = 1, n
         if (doanalyt .and. use(i)) then
            denorm(i) = detot(1,i)**2 + detot(2,i)**2 +
     &                       detot(3,i)**2
            totnorm = totnorm + denorm(i)
            denorm(i) = sqrt(denorm(i))
            write (iout,200)  i,(detot(j,i),j=1,3),denorm(i)
  200       format (' Anlyt',5x,i5,5x,3f12.4,2x,f12.4)
         end if
         if (donumer .and. use(i)) then
            ndenorm(i) = ndetot(1,i)**2 + ndetot(2,i)**2 +
     &                        ndetot(3,i)**2
            ntotnorm = ntotnorm + ndenorm(i)
            ndenorm(i) = sqrt(ndenorm(i))
            write (iout,210)  i,(ndetot(j,i),j=1,3),ndenorm(i)
  210       format (' Numer',5x,i5,5x,3f12.4,2x,f12.4)
         end if
      end do
c
c     print out the total gradient norm for the system
c
      write (iout,220)
  220 format (/,' Total Gradient Norm and RMS Gradient per Atom :')
      if (doanalyt) then
         totnorm = sqrt(totnorm)
         write (iout,230)  totnorm
  230    format (/,' Anlyt      Total Gradient Norm Value',4x,f16.4)
      end if
      if (donumer) then
         ntotnorm = sqrt(ntotnorm)
         write (iout,240)  ntotnorm
  240    format (' Numer      Total Gradient Norm Value',4x,f16.4)
      end if
c
c     find root mean square gradient norm over all atoms
c
      if (doanalyt) then
         rms = totnorm / sqrt(dble(nuse))
         write (iout,250)  rms
  250    format (/,' Anlyt      RMS Gradient over All Atoms',2x,f16.4)
      end if
      if (donumer) then
         nrms = ntotnorm / sqrt(dble(nuse))
         write (iout,260)  nrms
  260    format (' Numer      RMS Gradient over All Atoms',2x,f16.4)
      end if
      end
