      SUBROUTINE PATHK
      implicit double precision (A-H,O-Z)
      include 'SIZES'
      include 'MOP6FILE'
************************************************************************
*
*               Written by Manyin Yi, Aug 1989.
*       Restartable reaction_path calulation.
*       The number of path_step and step value are read in through
*       keyword POINT and STEP.
*       The reaction profile is archived.
*
************************************************************************
      common /GEOM  / GEO(3,NUMATM)
      common /GEOVAR/ NVAR,LOC(2,MAXPAR), IDUMY, XPARAM(MAXPAR)
      common /GRADNT/ GRAD(MAXPAR),GNORM
      common /GRAVEC/ COSINE
      common /PATH  / LATOM, LPARAM, REACT(200)
      common /PPARAM/ CURRT
      common /KLOOP / KLOOP
      common /PROFIL/ PROFIL
      common /KEYWRD/ KEYWRD
      dimension GD(MAXPAR),XLAST(MAXPAR),MDFP(20),XDFP(20)
      dimension PROFIL(200)
      character KEYWRD*241, GETNAM*80
      STEP = READA(KEYWRD,INDEX(KEYWRD,'STEP')+5)
      NPTS = READA(KEYWRD,INDEX(KEYWRD,'POINT')+6)
C
C  THE SMALLEST VALUE IN THE PATH IS
C      REACT(1) DEGREE OR GEO(LPARAM,LATOM) RADIANS
C
      DEGREE=180.D0/3.14159265359D0
      if (LPARAM.NE.1) STEP=STEP/DEGREE
C
C  NOW TO SWEEP THROUGH THE PATH
C
      if (LPARAM.NE.1) then
         C1=DEGREE
      else
         C1=1.D0
      end if
C
      KLOOP=1
      CPUTOT=0.0
      CURRT=GEO(LPARAM,LATOM)
      PROFIL(1)=0.D0
      if (INDEX(KEYWRD,'RESTART').NE.0) then
         MDFP(9)=0
         call DFPSAV(CPUTOT,XPARAM,GD,XLAST,ESCF,MDFP,XDFP)
         write(MIOB,'(//10X,'' RESTARTING AT POINT '',I3)') KLOOP
      end if
C
      GEO(LPARAM,LATOM)=CURRT
      do 10 ILOOP=KLOOP,NPTS
         CPU1=SECOND()
         CURRT=GEO(LPARAM,LATOM)
         call FLEPO(XPARAM, NVAR, ESCF)
         KLOOP=KLOOP+1
         CPU2=SECOND()
         CPU3=CPU2-CPU1
         CPUTOT=CPUTOT+CPU3
         PROFIL(ILOOP)=ESCF
         write(MIOB,'(/''          VARIABLE        function'')')
         write(MIOB,'('' :'',F16.5,F16.6)') GEO(LPARAM,LATOM)*C1,ESCF
         call GEOUT(MIOB)
         GEO(LPARAM,LATOM)=GEO(LPARAM,LATOM)+STEP
   10 continue
      REACT(1)=REACT(1)*C1
      do 20 I=2,NPTS
   20 REACT(I)=REACT(I-1)+STEP*C1
      write(MIOB,'(/16X,''POINTS ON REACTION PATH '',
     1          /16X,''AND CORRESPONDING HEATS'',//)')
      open(unit=MIOF,file=GETNAM('FOR012'),status='UNKNOWN')
      write(MIOF,30)
      call WRTTXT(MIOF)
   30 format(' ARCHIVE FILE FOR PATH CALCULATION'/
     1 'A PROFIL OF COORDINATES - HEATS'/)
      write(MIOF,'(/'' TOTAL CPU TIME IN FLEPO : '',F10.3/)') CPUTOT
C
      L=NPTS/8
      M=NPTS - L*8
      if (L.LT.1) go to 50
      do 40 K=0,L-1
         write(MIOB,'(8F7.2)')   (REACT(I),I=K*8+1,K*8+8)
         write(MIOB,'(8F7.2,/)') (PROFIL(I),I=K*8+1,K*8+8)
         write(MIOF,'(8F7.2)')  (REACT(I),I=K*8+1,K*8+8)
   40 write(MIOF,'(8F7.2,/)') (PROFIL(I),I=K*8+1,K*8+8)
   50 if (M.GT.0) then
         write(MIOB,'(8F7.2)')    (REACT(I),I=L*8+1,L*8+M)
         write(MIOB,'(8F7.2,/)') (PROFIL(I),I=L*8+1,L*8+M)
         write(MIOF,'(8F7.2)')   (REACT(I),I=L*8+1,L*8+M)
         write(MIOF,'(8F7.2,/)') (PROFIL(I),I=L*8+1,L*8+M)
      end if
      return
      end
