cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c-- Interface to the parallel RSB partitioner
c
c     once runtime data graph (RDG)is formed this subroutine can be
c     called to partition the RDG. This subroutine returns the
c     processor assignments list (the mapping) in the form of a 
c     translation table
c     
c     The  parallel version of the RSB is based on the sequential
c     version developed by Horst Simon and Stephen T. Barnard
c
ccccccccccccccccccc------- Ravi -------ccccccccccccccccccccccccccc

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c  index - list of local node numbers in global numbering
c  xadjs - RDG : list of pointers into the array adjs
c  adjs  - RDG : list of adjacent nodes for local nodes (index)
c  ttable - new distribution returned  as a translation table
c  work   - work array
c  nwork  - work array size
c  msglvl - message level (= 0 for silent running)
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      subroutine par_partitioner(index, xadjs, adjs, neqns,
     .              ttable, work, nwork, msglvl)

c      implicit none
#if defined CM5
#include "../include/machine/cm5.fort.h"
#elif defined INTEL
#include "../include/machine/intel.fort.h"
#elif defined SP1
#include "../include/machine/sp1.fort.h"
#endif

      integer MAXLAN
C     common /rsb/ MAXLAN  
      integer neqns,  nwork,  msglvl, ttable
      integer index(*), xadjs(*), adjs(*)
      integer work(nwork)
      data maxlan/400/

c     --------------
c     local variables
c     ---------------

      integer inwork, rnwork, npart, myproc, type, ninds, pfac
      integer init_ttable_with_proc, nnodes, my_log2

c      print *, 'NEQNS', neqns, ' nwork', nwork
      myproc = iPARTI_mynode()
      nnodes = iPARTI_numnodes()
      pfac   = my_log2(nnodes)
      ninds  = xadjs(neqns+1) - 1
      npart  = 2**pfac
c
c     --------------
c     approx memory required
c     --------------
c
      inwork = 6*neqns+4*npart+3*ninds
      rnwork = 6*neqns+5*(npart*maxlan)

      if (nwork .lt. (inwork+rnwork)) then
        print *, 'Not enough memory'
        print *, 'Required memory', rnwork+inwork
        print *, 'Allocated memory', nwork
      end if

      msglvl = 3
      if (msglvl .gt. 3) print *, myproc, 
     .  ' Approx. memory requirement: ', rnwork+inwork

      inwork = nwork/2
      rnwork = nwork-inwork


      print *, 'neqns', neqns, ' ninds', ninds, ' pfac ', pfac

      call rsb_partitioner(index, xadjs, adjs, neqns, ninds, pfac,
     .     work(1), inwork, work(inwork+1), rnwork, msglvl)


      type   = 1
      ttable = init_ttable_with_proc(type, work, neqns)
      return
      end 



      subroutine rsb_partitioner(index,xadjs,adjs,neqns,ninds,pfac,
     .        iwork, iworksiz, rwork, rworksiz, msglvl)

      implicit none

      integer rworksiz, iworksiz
      real    rwork(rworksiz)
      integer iwork(iworksiz)

      integer neqns, ninds, nwork, pfac,  msglvl
      integer index(*), xadjs(*), adjs(*)


c     --------------
c     local variables
c     ---------------
      integer sched, noffproc
      common /parti/sched, noffproc
      integer MAXLAN
C     common /rsb/ MAXLAN  
          data maxlan/400/

      integer color, i
      integer ncolor, mask, key
      integer new_rnwork, new_inwork, inwork, rnwork, local

      integer npart

      integer build_translation_table, itable , mynode

c      msglvl  = 4

      MAXLAN = 600
      npart = 2**pfac
c      print *, 'neqns', neqns, 'ninds', ninds, 'npart', npart

c     -------------------------
c     ... storage allocation
c     -------------------------


      key    = 1
      local  = key +  neqns
      mask   = local + ninds 
      

      itable = build_translation_table(1, index, neqns)
      call localize(itable,sched,adjs,iwork(local),ninds,
     . noffproc,neqns, 1)

      call free_table(itable)
c      print *, 'table', itable, 'sched', sched, 'noffproc', noffproc

      color   = mask + ninds
      inwork  = color + ninds + noffproc

      if (inwork .ge. iworksiz) then
        print *, 'Not enuf memory'
        print *, 'Required memory', inwork
        print *, 'Allocated memory', iworksiz
      end if
    
      new_inwork = iworksiz - inwork
      
      call partition (neqns,
     .                xadjs, iwork(local),iwork(key), 
     .                rwork(1), rworksiz,
     .                iwork(inwork), new_inwork, iwork(color),
     .                iwork(mask), pfac, npart,  msglvl)


      do i = 1, neqns
c	write(30+mynode(), *) iwork(color+i-1)
        iwork(i) = iwork(color+i-1)
      end do
      
      call free_sched(sched)
      end


c
c 
c
      function my_log2(np)

      integer i

      i = 0
      
  10  continue
      if (2**i .lt. np) then
         i = i+1
         go to 10
      end if
      my_log2 = i
      end 

      subroutine par_partitioner_color(index, xadjs, adjs, neqns,
     .              color, work, nwork, msglvl)

c      implicit none
#if defined CM5
#include "../include/machine/cm5.fort.h"
#elif defined INTEL
#include "../include/machine/intel.fort.h"
#elif defined SP1
#include "../include/machine/sp1.fort.h"
#endif

      integer MAXLAN
C     common /rsb/ MAXLAN  
      integer neqns,  nwork,  msglvl, ttable
      integer index(*), xadjs(*), adjs(*), color(*)
      integer work(nwork)
          data maxlan/400/

c     --------------
c     local variables
c     ---------------

      integer inwork, rnwork, npart, mynode, type, ninds, pfac
      integer init_ttable_with_proc, numnodes, my_log2
      integer i

c      print *, 'NEQNS', neqns, ' nwork', nwork
      pfac   = my_log2(iPARTI_numnodes())
      ninds  = xadjs(neqns+1) - 1
      npart  = 2**pfac
c
c     --------------
c     approx memory required
c     --------------
c
      inwork = 6*neqns+4*npart+3*ninds
      rnwork = 6*neqns+5*(npart*maxlan)

      if (nwork .lt. (inwork+rnwork)) then
        print *, 'Not enough memory'
        print *, 'Required memory', rnwork+inwork
        print *, 'Allocated memory', nwork
      end if

      if (msglvl .gt. 3) print *, iPARTI_mynode(), 
     .  ' Approx. memory requirement: ', rnwork+inwork

      inwork = nwork/2
      rnwork = nwork-inwork


      print *, 'neqns', neqns, ' ninds', ninds, ' pfac ', pfac

      call rsb_partitioner(index, xadjs, adjs, neqns, ninds, pfac,
     .     work(1), inwork, work(inwork+1), rnwork, msglvl)


      do i = 1, neqns
       color(i) = work(i)
      end do
      return
      end 
