      SUBROUTINE smalldeglast(maxd,mind)
      include 'irreg.h'
      integer i,j,todo,passes,removed,setsize,v,w,mind,maxd,max
      integer used(0:105),weight(0:npm),dstar(0:nm),offset
      integer neighbour,deltadstar(0:nm)
      integer end_flag,stop_flag, yet_colored
      common /dstar/ dstar,deltadstar
      external mysum, mymax
      integer mysum, mymax

      offset=np*procnum

c$$$      print*,"Parallel Node Ordering Algorithm"
C     First calculate weights
      do i=0,npm
         dstar(i+offset)=proc_n(i)
         weight(i)=0
      enddo

      color_count=0
      removed=0
      w=1
      v=mind
      end_flag=0
      stop_flag=0
      do while ((removed .lt. np) .or. (stop_flag .eq. 0))
         setsize=0
         do i=0,npm
            if ((dstar(i+offset) .le. v) .and. (weight(i) .eq. 0)) then
               weight(i)=w
               setsize=setsize+1
            endif
         enddo
         if (setsize .eq. 0) then
            v=v+1
         else 
            do i=0,npm
               if (weight(i) .eq. w) then
                  do j=0,proc_n(i)-1
                     neighbour=neigh(i,j)
                     deltadstar(neighbour)=deltadstar(neighbour)+1
                  enddo
               endif
            enddo
            removed=removed+setsize
         endif
         call update_dstar
         if (removed .ge. np) then
            end_flag=1
         else
            end_flag=0
         endif
         status=kxcomb(end_flag,MYSUM,4,1,IALNOD,0,101)
         if (end_flag .eq. nprocs) stop_flag=1
         w=w+1
      enddo
      do i=0,npm
         if (dstar(i+offset) .ne. 0) then
            print *,"Error : dstar[",i+offset,dstar(i+offset),procnum
         endif
      enddo
c$$$      print *,"Bound on number of colours =", v+1, procnum
c$$$      print *,"First level passes taken =", w-1, procnum
      color_count=(w-1)

C     /* Now do the colouring */
      call assign_rand_labels(TwoTo25)
      do i=0,npm
         temp_color(i)=0
         temp_label(i)=abs(temp_label(i)+ (TwoTo26*weight(i)))
         temp_queue(i)=i
      enddo
      do i=0,nm
         color(i)=0
      enddo
      call pack_and_send
C------Do the colouring using subroutine doextjonespass-----------
      color_index = 0
      color_count = 1
      yet_colored = np

      end_flag = 0
      stop_flag = 0
      j = 0
      do while ((yet_colored .ge. 0) .and. (stop_flag .eq. 0))
         call doextjonespass(yet_colored)
         if (yet_colored .eq. 0) then
            end_flag=1
         else
            end_flag=0
         endif
         status=kxcomb(end_flag,MYSUM,4,1,IALNOD,0,101)
         if (end_flag .eq. nprocs) then
           stop_flag=1
         else
           stop_flag = 0
         endif
         if (j .ge. 100) then
            stop_flag = 1
            if (procnum .eq. 0) Print *, 
     &                  "SDL emergency stop, can't color it."
         endif
         j = j + 1

      enddo
      status=kxcomb(color_count, mymax, 4, 1, IALNOD, 0, 101)
c$$$      print *,"Passes taken =", passes, procnum
      return
      end

C__________________________________________________________________

      subroutine update_dstar

      include 'irreg.h'

      external mysum
      integer dstar(0:nm),deltadstar(0:nm),mysum,i
      common /dstar/ dstar,deltadstar

      status=kxcomb(deltadstar,mysum,4,n,IALNOD,0,102)

      do i=0,nm
         dstar(i)=dstar(i)-deltadstar(i)
         deltadstar(i)=0
      enddo

      return
      end

      
