c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###########################################################
c     ##                                                       ##
c     ##  program intedit  --  edit and display Z-matrix file  ##
c     ##                                                       ##
c     ###########################################################
c
c
c     "intedit" allows the user to extract information from
c     or alter the values within an internal coordinates file
c
c
      program intedit
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'files.i'
      include 'iounit.i'
      include 'katoms.i'
      include 'zcoord.i'
      integer i,j,k,l,m
      integer izmt,space
      integer freeunit
      integer trimtext
      integer numrow,numcol
      integer next,number(4)
      real*8 value,geometry
      logical changed,error
      character*4 word
      character*120 coordfile
      character*120 record
c
c
c     read coordinate file and force field definition
c
      call initial
      call getint
      call field
c
c     print out the instructions for the program
c
      next = 1
      changed = .false.
      error = .false.
   10 continue
      call zhelp
c
c     start of main loop, examine or change Z-matrix elements
c
   20 continue
      m = 0
      write (iout,30)
   30 format (/,' INTEDIT>  ',$)
      read (input,40)  record
   40 format (a120)
c
c     interpret any user entered text command
c
      space = 1
      call getword (record,word,space)
      call upcase (word)
      if (word .eq. 'EXIT') then
         if (changed) then
            izmt = freeunit ()
            coordfile = filename(1:leng)//'.int'
            call version (coordfile,'new')
            open (unit=izmt,file=coordfile,status='new')
            call prtint (izmt)
            close (unit=izmt)
            write (iout,50)  coordfile(1:trimtext(coordfile))
   50       format (/,' Z-Matrix Internal Coordinates written to :  ',a)
         else
            write (iout,60)
   60       format (/,' The Z-Matrix was not Changed;',
     &                 ' No File was Written')
         end if
         goto 410
      else if (word .eq. 'QUIT') then
         goto 410
      else if (word .eq. 'SHOW') then
         write (iout,70)
   70    format ()
         call prtint (iout)
c
c     get the number of atoms entered by the user
c
      else
         do i = 1, 4
            number(i) = 0
         end do
         read (record,*,err=10,end=80)  (number(i),i=1,4)
   80    continue
         do i = 1, 4
            if (number(i) .ne. 0)  m = i
            if (number(i) .gt. n) then
               write (iout,90)  n
   90          format (/,' Warning; Only',i6,' Atoms are Present',
     &                     ' in the Z-matrix')
               goto 20
            end if
         end do
         if (m .eq. 0) then
            m = 1
            number(1) = next
         end if
      end if
c
c     get information about a single specified atom
c
      if (m .eq. 1) then
         i = number(1)
         write (iout,100)  i
  100    format (/,' Atom Number :',i8)
         write (iout,110)  name(i)
  110    format (' Atom Name :',6x,a4)
         write (iout,120)  describe(type(i))
  120    format (' Atom Type :',5x,a20)
         write (iout,130)  type(i)
  130    format (' Type Number :',i8)
         if (i .eq. 1) then
            write (iout,140)
  140       format (/,' Atom 1 is at the Coordinate System Origin')
         else
            write (iout,150)
  150       format (/,' Internal Coordinate Structural Definition :',/)
            write (iout,160)  iz(1,i),-i,zbond(i)
  160       format (1x,2i6,17x,'Distance Value :',f14.4)
            if (i .gt. 2) then
               write (iout,170)  iz(2,i),-iz(1,i),-i,zang(i)
  170          format (1x,3i6,11x,'Bond Angle Value :',f12.4)
               if (i .gt. 3) then
                  if (iz(4,i) .eq. 0) then
                     write (iout,180) iz(3,i),-iz(2,i),
     &                                -iz(1,i),-i,ztors(i)
  180                format (1x,4i6,5x,'Dihedral Angle :',f14.4)
                  else
                     write (iout,190)  iz(3,i),-iz(1,i),-i,ztors(i)
  190                format (1x,3i6,11x,'Bond Angle Value :',f12.4)
                     write (iout,200)  iz(4,i)
  200                format (30x,'Chirality Flag :',6x,i6)
                  end if
               end if
            end if
         end if
         next = i + 1
         if (next .gt. n)  next = 1
c
c     chirality change for an atom was requested
c
      else if (m.eq.2 .and. number(2).lt.0) then
         do i = 1, n
            if (iz(4,i).ne.0 .and. iz(1,i).eq.number(1)) then
               changed = .true.
               write (iout,210)  i
  210          format (/,' Inverting Chirality of Atom : ',i6)
               iz(4,i) = -iz(4,i)
            end if
         end do
         next = number(1)
         call makexyz
c
c     information about a specified bond or distance
c
      else if (m .eq. 2) then
         i = max(number(1),number(2))
         j = min(number(1),number(2))
         if (min(i,j).le.0 .and. max(i,j).gt.n) then
            write (iout,250)
  250       format (/,' Invalid Atom Number')
            error = .true.
         else
            if (j .ne. iz(1,i)) then
               value = geometry (i,j,0,0)
               write (iout,220)  value
  220          format (/,' The Current Distance is : ',f9.4)
               write (iout,230)
  230          format (' That Bond is not in the Z-matrix')
            else
               write (iout,240)  zbond(i)
  240          format (/,' The Current Distance is : ',f9.4)
               call zvalue ('Bond Length',zbond(i),changed)
               next = i
            end if
         end if
c
c     an atom type change was requested
c
      else if (m.eq.3 .and. number(2).lt.0) then
         if (number(3).gt.0 .and. number(3).le.maxtyp) then
            changed = .true.
            write (iout,260)  describe(type(number(1)))
  260       format (/,' Old Atom Type is :  ',a20)
            type(number(1)) = number(3)
            write (iout,270)  describe(type(number(1)))
  270       format (' New Atom Type is :  ',a20)
         else
            write (iout,280)
  280       format (/,' Invalid Atom Type; Valid Types are :',/)
            numrow = (maxtyp+2) / 3
            numcol = 2
            do i = 1, numrow
               if (i .gt. numrow-2+mod(maxtyp-1,3))  numcol = 1
               write (iout,290)  (j*numrow+i,describe(j*numrow+i),
     &                                      j=0,numcol)
  290          format (1x,3(i3,1x,a20,2x))
            end do
         end if
c
c     information about a specified bond angle
c
      else if (m .eq. 3) then
         i = max(number(1),number(3))
         j = number(2)
         k = min(number(1),number(3))
         if (min(i,j,k).le.0 .or. max(i,j,k).gt.n) then
            write (iout,300)
  300       format (/,' Invalid Atom Number')
            error = .true.
         else
            if (iz(1,i) .ne. j) then
               value = geometry (i,j,k,0)
               write (iout,310)  value
  310          format (/,' The Bond Angle Value is :  ',f9.4)
               write (iout,320)
  320          format (' That Bond Angle is not in the Z-matrix')
            else if (iz(2,i) .eq. k) then
               write (iout,330)  zang(i)
  330          format (/,' The Bond Angle Value is :  ',f9.4)
               call zvalue ('Bond Angle',zang(i),changed)
               next = i
            else if (iz(3,i).eq.k .and. iz(4,i).ne.0) then
               write (iout,340)  ztors(i)
  340          format (/,' The Bond Angle Value is :  ',f9.4)
               call zvalue ('Bond Angle',ztors(i),changed)
               next = i
            else
               value = geometry (i,j,k,0)
               write (iout,350)  value
  350          format (/,' The Bond Angle Value is :  ',f9.4)
               write (iout,360)
  360          format (' That Bond Angle is not in the Z-matrix')
            end if
         end if
c
c    information about a specified dihedral angle
c
      else if (m .eq. 4) then
         if (number(1) .gt. number(4)) then
            i = number(1)
            j = number(2)
            k = number(3)
            l = number(4)
         else
            i = number(4)
            j = number(3)
            k = number(2)
            l = number(1)
         end if
         if (min(i,j,k,l).le.0 .or. max(i,j,k,l).gt.n) then
            write (iout,370)
  370       format (/,' Invalid Atom Number')
            error = .true.
         else
            if (iz(1,i).ne.j .or. iz(2,i).ne.k .or.
     &          iz(3,i).ne.l .or. iz(4,i).ne.0) then
               value = geometry (i,j,k,l)
               write (iout,380)  value
  380          format (/,' The Dihedral Angle Value is :  ',f9.4)
               write (iout,390)
  390          format (' That Dihedral Angle is not in the Z-matrix')
            else
               write (iout,400)  ztors(i)
  400          format (/,' The Dihedral Angle Value is :  ',f9.4)
               call zvalue ('Dihedral Angle',ztors(i),changed)
               next = i
            end if
         end if
      end if
c
c     print instructions for the program if needed
c
      if (error) then
         error = .false.
         call zhelp
      end if
      goto 20
c
c     perform any final tasks before program exit
c
  410 continue
      call final
      end
c
c
c     #################################################################
c     ##                                                             ##
c     ##  subroutine zhelp  --  print Z-matrix editing instructions  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "zhelp" prints the general information and instructions
c     for the Z-matrix editing program
c
c
      subroutine zhelp
      implicit none
      include 'iounit.i'
c
c
c     print the help and information message for Z-matrix editing
c
      write (iout,10)
   10 format (/,' If a single atom number is entered, the',
     &           ' current definition of',
     &        /,' the atom will be displayed.',
     &        //,' If two atom numbers are entered, the output',
     &           ' gives the distance',
     &        /,' between the atoms, and asks for a new bond',
     &           ' length if applicable;',
     &        /,' Entry of three atoms shows the angle, and',
     &           ' entry of four atoms',
     &        /,' will display the corresponding dihedral angle.',
     &        //,' To change the chirality at an atom, enter',
     &           ' its number and -1.',
     &        /,' To change the type of an atom, enter its',
     &           ' number, -1, and the',
     &        /,' new atom type number.')
      write (iout,20)
   20 format (/,' A carriage return at the prompt will display',
     &           ' the atom last',
     &        /,' changed or the next atom after the one just',
     &           ' examined.',
     &        //,' Typing SHOW will display the contents of the',
     &           ' current Z-matrix.',
     &        //,' Entering EXIT writes a new file then stops,',
     &           ' while QUIT aborts.')
      return
      end
c
c
c     #############################################################
c     ##                                                         ##
c     ##  subroutine zvalue  --  gets user input Z-matrix value  ##
c     ##                                                         ##
c     #############################################################
c
c
c     "zvalue" gets user supplied values for selected coordinates
c     as needed by the internal coordinate editing program
c
c
      subroutine zvalue (text,x,changed)
      implicit none
      include 'iounit.i'
      integer length
      integer trimtext
      real*8 x,xnew
      logical changed
      character*120 record
      character*(*) text
c
c
c     ask the user for the new internal coordinate value
c
      xnew = x
      write (iout,10)  text
   10 format (/,' Enter the New ',a,' :  ',$)
      read (input,20)  record
   20 format (a120)
      length = trimtext (record)
      if (length .ne. 0) then
         read (record,*,end=30,err=30)  xnew
   30    continue
      end if
c
c     return with the altered value and recompute coordinates
c
      if (xnew .ne. x) then
         changed = .true.
         x = xnew
         call makexyz
      end if
      return
      end
