c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1997  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine cluster  --  set user-defined groups of atoms  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "cluster" gets the partitioning of the system into groups
c     and stores a list of the group to which each atom belongs
c
c
      subroutine cluster
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'group.i'
      include 'inform.i'
      include 'iounit.i'
      include 'keys.i'
      integer i,j,k
      integer inum,jnum
      integer last,next
      integer gnum,ga,gb
      integer nlist,list(maxatm)
      real*8 wg
      character*20 keyword
      character*80 record,string
      logical header,selected
c
c
c     set defaults for the group atom list and weights
c
      use_group = .false.
      selected = .false.
      do i = 1, n
         grplist(i) = 0
      end do
      do i = 1, maxgrp
         igrp(1,i) = 1
         igrp(2,i) = 0
      end do
      do i = 0, maxgrp
         do j = 0, maxgrp
            wgrp(j,i) = 0.0d0
         end do
      end do
c
c     get any keywords containing atom group definitions
c
      do j = 1, nkey
         next = 1
         record = keyline(j)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:6) .eq. 'GROUP ') then
            use_group = .true.
            gnum = 0
            do i = 1, n
               list(i) = 0
            end do
            call getnumb (record,gnum,next)
            if (gnum .gt. maxgrp) then
               write (iout,10)  maxgrp
   10          format (/,' CLUSTER  --  The Maximum Group Number of',
     &                    i6,' has been Exceeded')
               call fatal
            end if
            string = record(next:80)
            read (string,*,err=20,end=20)  (list(i),i=1,n)
   20       continue
            i = 1
            dowhile (list(i) .ne. 0)
               if (list(i) .gt. 0) then
                  grplist(list(i)) = gnum
                  i = i + 1
               else
                  do k = abs(list(i)), abs(list(i+1))
                     grplist(k) = gnum
                  end do
                  i = i + 2
               end if
            end do
c
c     get any keywords with weights for group interactions
c
         else if (keyword(1:13) .eq. 'SELECT-GROUP ') then
            selected = .true.
            ga = 0
            gb = 0
            wg = 0.0d0
            string = record(next:80)
            read (string,*,err=30,end=30)  ga,gb,wg
   30       continue
            if (gb .eq. 0)  gb = ga
            if (wg .eq. 0.0d0)  wg = 1.0d0
            wgrp(ga,gb) = wg
            wgrp(gb,ga) = wg
         end if
      end do
c
c     pack atoms of each group into a contiguous indexed list
c
      do i = 1, n
         list(i) = grplist(i)
      end do
      call sort3 (n,list,kgrp)
c
c     find the first and last atom in each nonempty group
c
      ngrp = 0
      igrp(1,ngrp) = 1
      do i = 1, n
         j = list(i)
         if (j .ne. last) then
            igrp(2,ngrp) = i - 1
            ngrp = ngrp + 1
            igrp(1,ngrp) = i
            grpnum(ngrp) = j
            last = j
         end if
      end do
      igrp(2,ngrp) = n
c
c     sort the list of atoms in each group by atom number
c
      do i = 0, maxgrp
         j = igrp(2,i) - igrp(1,i) + 1
         call sort (j,kgrp(igrp(1,i)))
      end do
c
c     renumber the group list and weights to remove empty groups
c
      do i = 1, ngrp
         do j = igrp(1,i), igrp(2,i)
            grplist(kgrp(j)) = i
         end do
      end do
      do i = 1, ngrp
         inum = grpnum(i)
         wgrp(0,i) = wgrp(0,inum)
         wgrp(i,0) = wgrp(inum,0)
         do j = 1, ngrp
            jnum = grpnum(j)
            wgrp(j,i) = wgrp(jnum,inum)
            if (jnum.ne.j .or. inum.ne.i)  wgrp(jnum,inum) = 0.0d0
         end do
      end do
c
c     use only intergroup if no group interactions were selected
c
      if (.not.selected) then
         do i = 0, ngrp
            do j = 0, ngrp
               wgrp(j,i) = 1.0d0
            end do
            wgrp(i,i) = 0.0d0
         end do
      end if
c
c     output the final list of atoms in each group
c
      if (debug .and. use_group) then
         do i = 1, ngrp
            nlist = 0
            do j = igrp(1,i), igrp(2,i)
               nlist = nlist + 1
               list(nlist) = kgrp(j)
            end do
            if (nlist .ne. 0) then
               write (iout,40)  grpnum(i)
   40          format (/,' List of Atoms Contained in Group',i3,' :',/)
               write (iout,50)  (list(j),j=1,nlist)
   50          format (3x,10i7)
            end if
         end do
      end if
c
c     output the weights for intragroup and intergroup interactions
c
      if (verbose .and. use_group) then
         header = .true.
         do i = 1, ngrp
            do j = i, ngrp
               if (wgrp(j,i) .ne. 0.0d0) then
                  if (header) then
                     header = .false.
                     write (iout,60)
   60                format (/,' Active Sets of Intra- and InterGroup',
     &                          ' Interactions :',
     &                       //,11x,'Groups',15x,'Type',14x,'Weight',/)
                  end if
                  if (i .eq. j) then
                     write (iout,70)  grpnum(i),grpnum(j),wgrp(j,i)
   70                format (5x,2i6,12x,'IntraGroup',5x,f12.4)
                  else
                     write (iout,80)  grpnum(i),grpnum(j),wgrp(j,i)
   80                format (5x,2i6,12x,'InterGroup',5x,f12.4)
                  end if
               end if
            end do
         end do
      end if
      return
      end
