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,izmt,space
      integer next,numrow,numcol,number(4)
      integer freeunit,trimtext
      real*8 value,bndangle,dihedral
      character*4 word
      character*60 coordfile
      character*80 record
      logical changed,error
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 (a80)
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) then
               m = i
            else if (number(i) .gt. n) then
               write (iout,90)  n
   90          format (/,' Only',i6,' Atoms are 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,blen(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,alph(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,bet(i)
  180                format (1x,4i6,5x,'Dihedral Angle :',f14.4)
                  else
                     write (iout,190)  iz(3,i),-iz(1,i),-i,bet(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
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
               write (iout,210)  i
  210          format (/,' Inverting Chirality of Atom : ',i6)
               iz(4,i) = -iz(4,i)
               changed = .true.
            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 = sqrt((x(i)-x(j))**2 + (y(i)-y(j))**2
     &                            + (z(i)-z(j))**2)
               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)  blen(i)
  240          format (/,' The Current Distance is : ',f9.4)
               call zvalue ('Bond Length',blen(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
            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 = bndangle (i,j,k)
               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)  alph(i)
  330          format (/,' The Bond Angle Value is :  ',f9.4)
               call zvalue ('Bond Angle',alph(i),changed)
               next = i
            else if (iz(3,i).eq.k .and. iz(4,i).ne.0) then
               write (iout,340)  bet(i)
  340          format (/,' The Bond Angle Value is :  ',f9.4)
               call zvalue ('Bond Angle',bet(i),changed)
               next = i
            else
               value = bndangle (i,j,k)
               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 = dihedral (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)  bet(i)
  400          format (/,' The Dihedral Angle Value is :  ',f9.4)
               call zvalue ('Dihedral Angle',bet(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     exit from the program
c
  410 continue
      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 "intedit"
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 you enter a single atom number, the',
     &           ' current definition of',
     &        /,' that atom will be displayed.',
     &        //,' If you enter two atom numbers, you will be',
     &           ' asked for a new',
     &        /,' length for the bond between those atoms;',
     &           ' three atom numbers',
     &        /,' will prompt for the angle, and four will',
     &           ' prompt for 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.')
      write (iout,20)
   20 format (/,' Typing just a carriage return will examine',
     &           ' the atom last',
     &        /,' changed or the next atom after the one just',
     &           ' examined,',
     &        /,' depending on which operation was most recently',
     &           ' performed.',
     &        //,' Typing SHOW displays the full form of the',
     &           ' current Z-matrix.',
     &        //,' Typing 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 a user supplied value for an internal
c     coordinate; used only by the internal coordinate
c     editing program
c
c
      subroutine zvalue (text,x,changed)
      implicit none
      include 'iounit.i'
      real*8 x,xnew
      character*(*) text
      logical changed,done
c
c
c     ask the user for the new internal coordinate value
c
      done = .false.
      dowhile (.not. done)
         xnew = 999.0d0
         write (iout,10)  text
   10    format (/,' Enter the New ',a,' :  ',$)
         read (input,20,err=30)  xnew
   20    format (f20.0)
         done = .true.
   30    continue
c
c     return with the altered value of the coordinate
c
         if (done) then
            if (xnew .ne. 999.0d0) then
               changed = .true.
               x = xnew
            end if
c
c     second chance if initial answer was nonsense
c
         else
            write (iout,40)
   40       format (/,' Error in Input; <CR> leaves Value Unchanged')
         end if
      end do
      return
      end
