c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1996  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##################################################################
c     ##                                                              ##
c     ##  program anneal  --  molecular dynamics simulated annealing  ##
c     ##                                                              ##
c     ##################################################################
c
c
c     "anneal" performs a simulated annealing protocol by means of
c     variable temperature molecular dynamics using either linear,
c     exponential or sigmoidal cooling schedules
c
c
      program anneal
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bath.i'
      include 'bond.i'
      include 'bound.i'
      include 'inform.i'
      include 'iounit.i'
      include 'keys.i'
      include 'potent.i'
      include 'solute.i'
      include 'usage.i'
      integer i,ndump,nequil,nstep,istep
      integer period,next,modstep
      real*8 logmass,factor
      real*8 ratio,sigmoid
      real*8 dt,dt_dump,dt2,dt_2
      real*8 dt_8,dt2_2,dt2_8
      real*8 temp_start,temp_stop
      real*8 tau_start,tau_stop
      character*1 answer
      character*6 integrate
      character*8 cooltyp
      character*20 keyword
      character*80 record,string
      logical exist
c
c
c     set up the structure and mechanics calculation
c
      call initial
      call getxyz
      call mechanic
c
c     get choice of statistical ensemble for periodic system
c
      temp_start = -1.0d0
      temp_stop = -1.0d0
      call nextarg (string,exist)
      if (exist)  read (string,*,err=10,end=10)  temp_start
      call nextarg (string,exist)
      if (exist)  read (string,*,err=10,end=10)  temp_stop
   10 continue
      if (temp_start.lt.0.0d0 .or. temp_stop.lt.0.0d0) then
         temp_start = -1.0d0
         temp_stop = -1.0d0
         write (iout,20)
   20    format (/,' Enter the Initial and Final Temperatures in',
     &              ' Degrees K [1000,0] :  ',$)
         read (input,30)  record
   30    format (a80)
         read (record,*,err=40,end=40)  temp_start,temp_stop
   40    continue
      end if
      if (temp_start .le. 0.0d0)  temp_start = 1000.0d0
      if (temp_stop .le. 0.0d0)  temp_stop = 0.0d0
c
c     set the number of steps of initial equilibration
c
      nequil = -1
      call nextarg (string,exist)
      if (exist)  read (string,*,err=50,end=50)  nequil
   50 continue
      if (nequil .lt. 0) then
         write (iout,60)
   60    format (/,' Enter the Number of Equilibration Steps [0] :  ',$)
         read (input,70)  nequil
   70    format (i10)
      end if
      if (nequil .le. 0)  nequil = 0
c
c     set the number of dynamics steps for the cooling protocol
c
      nstep = -1
      call nextarg (string,exist)
      if (exist)  read (string,*,err=80,end=80)  nstep
   80 continue
      if (nstep .lt. 0) then
         write (iout,90)
   90    format (/,' Enter the Number of Cooling Protocol Steps',
     &              ' [2000] :  ',$)
         read (input,100)  nstep
  100    format (i10)
      end if
      if (nstep .le. 0)  nstep = 2000
c
c     decide which annealing cooling protocol to use
c
      cooltyp = 'linear'
      call nextarg (answer,exist)
      if (.not. exist) then
         write (iout,110)
  110    format (/,' Use Linear, Sigmoidal or Exponential Cooling',
     &              ' Protocol ([L], S or E) :  ',$)
         read (input,120)  answer
  120    format (a1)
      end if
      call upcase (answer)
      if (answer .eq. 'S')  cooltyp = 'sigmoid'
      if (answer .eq. 'E')  cooltyp = 'exponent'
c
c     get size of time steps for MD simulated annealing
c     and time between coordinate dumps
c
      dt = -1.0d0
      call nextarg (string,exist)
      if (exist)  read (string,*,err=130,end=130)  dt
  130 continue
      if (dt .le. 0.0d0) then
         write (iout,140)
  140    format (/,' Enter the Time Step value in Femtoseconds',
     &              ' [1.0] :  ',$)
         read (input,150)  dt
  150    format (f20.0)
      end if
      if (dt .le. 0.0d0)  dt = 1.0d0
      dt = 1.0d-15 * dt
c
c     set the time between trajectory snapshot coordinate dumps
c
      dt_dump = -1.0d0
      call nextarg (string,exist)
      if (exist)  read (string,*,err=160,end=160)  dt_dump
  160 continue
      if (dt_dump .lt. 0.0d0) then
         write (iout,170)
  170    format (/,' Enter Time between Dumps in Picoseconds',
     &              ' [0.1] :  ',$)
         read (input,180)  dt_dump
  180    format (f20.0)
      end if
      if (dt_dump .le. 0.0d0)  dt_dump = 0.1d0
      dt_dump = 1.0d-12 * dt_dump
c
c     get factor by which atomic weights are to be increased
c
      logmass = -1.0d0
      call nextarg (string,exist)
      if (exist)  read (string,*,err=190,end=190)  logmass
  190 continue
      if (logmass .lt. 0.0d0) then
         write (iout,200)
  200    format (/,' Increase Atomic Weights by a Factor of',
     &              ' 10^x [x=0.0] :  ',$)
         read (input,210)  logmass
  210    format (f20.0)
      end if
      if (logmass .le. 0.0d0) then
         logmass = 0.0d0
      else
         factor = 10.0d0**(logmass)
         do i = 1, n
            mass(i) = mass(i) * factor
         end do
      end if
c
c     set some default parameters for the annealing run
c
      isothermal = .true.
      isobaric = .false.
      atmsph = 1.0d0
      tau_start = 100.0d0 * dt
      tau_stop = 10.0d0 * dt
      integrate = 'BEEMAN'
      kelvin = temp_start
      tautemp = tau_start
c
c     check for keywords containing any altered parameters
c
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:10) .eq. 'INTEGRATE ') then
            call getword (record,integrate,next)
            call upcase (integrate)
         end if
      end do
c
c     set time constants for the dynamics integration
c
      dt2 = dt * dt
      dt_2 = dt / 2.0d0
      dt_8 = dt / 8.0d0
      dt2_2 = dt2 / 2.0d0
      dt2_8 = dt2 / 8.0d0
      ndump = nint(dt_dump/dt)
c
c     make sure all atoms have a mass of at least one
c
      do i = 1, n
         if (use(i)) then
            mass(i) = max(mass(i),1.0d0)
         end if
      end do
c
c     set initial velocities or restart from previous trajectory
c
      call mdinit
c
c     initialize any constraints for the rattle algorithm
c
      call shakeup
c
c     set Born radii update frequency for GB/SA solvation
c
      if (use_gbsa) then
         if (reborn .eq. 1) then
            call born
            reborn = 100
         end if
      end if
c
c     print out a header lines for the equilibration phase
c
      if (nequil .ne. 0) then
         write (iout,220)
  220    format (/,' Simulated Annealing Equilibration Phase')
         write (iout,230)  nequil,1.0d12*dt,logmass,
     &                     temp_start,temp_start
  230    format (/,' Steps:',i6,3x,'Time/Step:',f6.3,' ps',3x,
     &              'LogMass:',f5.2,3x,'Temp:',f7.1,' to',f7.1)
      end if
c
c     take the dynamics steps for the equilibration phase
c
      period = 100
      do istep = 1, nequil
         modstep = mod(istep,period)
         if (verbose .and. modstep.eq.1) then
            if (isobaric) then
               write (iout,240)
  240          format (/,'    MD Step      E Total   E Potential',
     &                   '   E Kinetic       Temp       Pres',/)
            else
               write (iout,250)
  250          format (/,'    MD Step      E Total   E Potential',
     &                   '   E Kinetic       Temp',/)
            end if
         end if
         if (integrate .eq. 'VERLET') then
            call verlet (istep,dt,dt_2,dt2_2,ndump)
         else
            call beeman (istep,dt,dt_8,dt2_8,ndump)
         end if
         if (nuse.eq.n .and. modstep.eq.0)  call mdrest
      end do
c
c     start the cooling phase from the end of equilibration phase
c
      if (nequil .ne. 0)  call mdinit
c
c     print out a header lines for the cooling protocol
c
      write (iout,260)
  260 format (/,' Simulated Annealing Cooling Protocol')
      write (iout,270)  nstep,1.0d12*dt,logmass,temp_start,temp_stop
  270 format (/,' Steps:',i6,3x,'Time/Step:',f6.3,' ps',3x,
     &           'LogMass:',f5.2,3x,'Temp:',f7.1,' to',f7.1)
c
c     take the desired number of molecular dynamics steps
c
      period = 100
      do istep = 1, nstep
         modstep = mod(istep,period)
         if (verbose .and. modstep.eq.1) then
            if (isobaric) then
               write (iout,280)
  280          format (/,'    MD Step      E Total   E Potential',
     &                   '   E Kinetic       Temp       Pres',/)
            else
               write (iout,290)
  290          format (/,'    MD Step      E Total   E Potential',
     &                   '   E Kinetic       Temp',/)
            end if
         end if
c
c     set target temperature using the desired cooling protocol
c
         ratio = dble(istep) / dble(nstep)
         if (cooltyp .eq. 'sigmoid') then
            ratio = sigmoid (3.5d0,ratio)
         else if (cooltyp .eq. 'exponent') then
            ratio = 1.0d0 - exp(-5.0d0*ratio)
         end if
         kelvin = temp_start*(1.0d0-ratio) + temp_stop*ratio
         tautemp = tau_start*(1.0d0-ratio) + tau_stop*ratio
c
c     integrate equations of motion to take a time step
c
         if (integrate .eq. 'VERLET') then
            call verlet (istep,dt,dt_2,dt2_2,ndump)
         else
            call beeman (istep,dt,dt_8,dt2_8,ndump)
         end if
         if (nuse.eq.n .and. modstep.eq.0)  call mdrest
      end do
      end
