drivesort.f

Go to the documentation of this file.

c
c -------------------------------------------------------------
c
       subroutine drivesort(npts,badpts,level,index,mbuff)

      use amr_module
      implicit  double precision (a-h,o-z)
      dimension badpts(2,npts)
      dimension iflags(npts), ixarray(npts)
      logical db/.false./
 
      iadd(i,j) = (i+mbuff)  + (isize+2*mbuff)*(j+mbuff)
c
c  convert using one dimensional ordering of badpts array as if
c  it covered entire domain(xprob by yprob) on this level
c
      isize = iregsz(level)
      jsize = jregsz(level)

      do k = 1, npts
        i = badpts(1,k)-.5  ! remember was shifted when put  into array
        j = badpts(2,k)-.5  
        intequiv = iadd(i,j)
c        write(*,*)i,j," has equivalent integer ",intequiv
        iflags(k) = intequiv
      end do

      call qsorti(ixarray, npts, iflags)

c copy back to badpts, in sorted order, removing duplicates      
      k = 1
      index = 0
      do while (k .le. npts) 
         intequiv = iflags(ixarray(k))
         index = index + 1
         badpts(2,index) = intequiv/(isize+2*mbuff) + .5 -mbuff
         badpts(1,index) = mod(intequiv,(isize+2*mbuff)) + .5 -mbuff
        if (db) write(outunit,101) badpts(1,index),badpts(2,index)
 101    format(2f6.1)
         k = k + 1
         do while ( k.le. npts)    ! skip over duplicates
            if (iflags(ixarray(k)) .eq. iflags(ixarray(k-1))) then
c           write(*,*)" duplicate in sorted array loc ",ixarray(k)
               k = k+1
            else
               exit   ! back to outer loop
            endif
         end do
       if (k .gt. npts) exit !did we stop because we ran off end or pts not equal
      end do

      if (gprint) then
          write(outunit,929) index
 929      format(i5," flagged pts after removing duplicates and ",
     &           " non-nested flags")
      endif

      return
      end