c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ##############################################################
c     ##                                                          ##
c     ##  subroutine orbital  --  setup for pisystem calculation  ##
c     ##                                                          ##
c     ##############################################################
c
c
c     "orbital" finds and organizes lists of atoms in a pisystem,
c     bonds connecting pisystem atoms and torsions whose two
c     central atoms are both pisystem atoms
c
c
      subroutine orbital
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'bond.i'
      include 'couple.i'
      include 'iounit.i'
      include 'keys.i'
      include 'pistuf.i'
      include 'potent.i'
      include 'tors.i'
      integer i,j,k,m,ib,ic
      integer iorb,jorb,next
      integer piatoms(maxpi)
      character*20 keyword
      character*80 record,string
c
c
c     set the default values for the pisystem variables
c
      do i = 1, maxpi
         piatoms(i) = 0
      end do
c
c     check the keywords for any lists of pisystem atoms
c
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:9) .eq. 'PISYSTEM ') then
            string = record(next:80)
            read (string,*,err=10,end=10)  (piatoms(k),k=1,maxpi)
         end if
   10    continue
      end do
c
c     quit if no pisystem was found for consideration
c
      if (piatoms(1) .eq. 0) then
         use_orbit = .false.
         return
      else
         use_orbit = .true.
      end if
c
c     organize and make lists of the pisystem atoms
c
      do i = 1, n
         listpi(i) = .false.
      end do
      i = 1
      dowhile (piatoms(i) .ne. 0)
         if (piatoms(i) .gt. 0) then
            listpi(piatoms(i)) = .true.
            i = i + 1
         else
            do j = -piatoms(i), piatoms(i+1)
               listpi(j) = .true.
            end do
            i = i + 2
         end if
      end do
      norbit = 0
      do i = 1, n
         if (listpi(i)) then
            norbit = norbit + 1
            iorbit(norbit) = i
         end if
      end do
c
c     quit if the molecule contains too many piorbitals
c
      if (norbit .gt. maxpi) then
         write (iout,20)
   20    format (' ORBITAL  --  Too many Pi-Orbitals;',
     &           ' Increase MAXPI')
         call fatal
      end if
c
c     find three atoms which define a plane
c     perpendicular to each orbital
c
      call piplane
c
c     find and store the pisystem bonds
c
      npibond = 0
      do i = 1, norbit-1
         iorb = iorbit(i)
         do j = i, norbit
            jorb = iorbit(j)
            do k = 1, n12(iorb)
               if (i12(k,iorb) .eq. jorb) then
                  npibond = npibond + 1
                  do m = 1, nbond
                     if (iorb.eq.ibnd(1,m) .and.
     &                   jorb.eq.ibnd(2,m)) then
                        pibond(1,npibond) = m
                        pibond(2,npibond) = i
                        pibond(3,npibond) = j
                        goto 30
                     end if
                  end do
   30             continue
               end if
            end do
         end do
      end do
c
c     find and store the pisystem torsions
c
      npitors = 0
      do i = 1, ntors
         ib = itors(2,i)
         ic = itors(3,i)
         if (listpi(ib) .and. listpi(ic)) then
            do j = 1, npibond
               k = pibond(1,j)
               if (ib.eq.ibnd(1,k).and.ic.eq.ibnd(2,k) .or.
     &             ib.eq.ibnd(2,k).and.ic.eq.ibnd(1,k)) then
                  npitors = npitors + 1
                  pitors(1,npitors) = i
                  pitors(2,npitors) = j
                  goto 40
               end if
            end do
   40       continue
         end if
      end do
      return
      end
