m_partition3way.f90 Source File

This File Depends On

sourcefile~~m_partition3way.f90~~EfferentGraph sourcefile~m_partition3way.f90 m_partition3way.f90 sourcefile~m_swap.f90 m_swap.f90 sourcefile~m_swap.f90->sourcefile~m_partition3way.f90 sourcefile~m_variablekind.f90 m_variableKind.f90 sourcefile~m_variablekind.f90->sourcefile~m_partition3way.f90 sourcefile~m_variablekind.f90->sourcefile~m_swap.f90 sourcefile~m_compare.f90 m_compare.f90 sourcefile~m_variablekind.f90->sourcefile~m_compare.f90 sourcefile~m_compare.f90->sourcefile~m_partition3way.f90
Help

Source Code


Source Code

module m_partition3way
  !! Contains Hoare's style partitioning algorithms used for quicksorting routines
  use variableKind
  use m_swap, only: swap
  use m_compare, only: compare
  implicit none

  interface partition3way
    !! Partitioning used for quicksort routines
!    module procedure :: partition_r1D,
    module procedure :: partition3way_d1D!, partition_i1D, partition_id1D

  end interface

!  interface argPartition
!    !! Partitioning used for argQuicksort routines
!    module procedure :: argPartition_r1D, argPartition_d1D, argPartition_i1D, argPartition_id1D
!  end interface
  contains
!  !====================================================================!
!  subroutine partition_r1D(this,left,right,iPivot)
!    !! Interfaced with partition()
!  !====================================================================!
!  real(r32), intent(inout) :: this(:) !! 1D array
!  integer(i32), intent(inout) :: left !! Left index
!  integer(i32), intent(inout) :: right !! Right index
!  integer(i32), intent(inout) :: iPivot !! Pivoting index
!  integer(i32) :: n
!  integer(i32) :: lo,hi
!  real(r32) :: pivot
!  n=(right+left)/2
!  call swap(this(left),this(n))
!  pivot=this(left)
!  lo=left;hi=right
!  do while (lo <= hi)
!    do while (this(hi) > pivot)
!      hi=hi-1
!    end do
!
!    do while (lo <= hi .and. this(lo) <= pivot)
!      lo=lo+1
!    end do
!    if (lo <= hi) then
!      call swap(this(lo),this(hi))
!      lo=lo+1;hi=hi-1
!    end if
!  end do
!  call swap(this(left),this(hi))
!  iPivot=hi
!  end subroutine
!  !====================================================================!
  !====================================================================!
  subroutine partition3way_d1D(this,left,right,iPivot1, iPivot2)
    !! Interfaced with partition()
  !====================================================================!
  real(r64), intent(inout) :: this(:) !! 1D array
  integer(i32), intent(inout) :: left !! Left index
  integer(i32), intent(inout) :: right !! Right index
  integer(i32), intent(inout) :: iPivot1 !! Pivoting index
  integer(i32), intent(inout) :: iPivot2 !! Pivoting index
  integer(i32) :: i,j
  integer(i32) :: c
  real(r64) :: pivot

  iPivot1 = left
  iPivot2 = right
  pivot = this(left)
  i = left
  do while (i <= iPivot2)
    c = compare(this(i), pivot)
    select case(c)
      case(-1)
        call swap(this(iPivot1), this(i))
        iPivot1 = iPivot1 + 1
        i = i + 1
      case(1)
        call swap(this(i), this(iPivot2))
        iPivot2 = iPivot2 - 1
      case(0)
        i = i + 1
    end select
  end do
  end subroutine
  !====================================================================!
!  !====================================================================!
!  subroutine partition_i1D(this,left,right,iPivot)
!    !! Interfaced with partition()
!  !====================================================================!
!  integer(i32), intent(inout) :: this(:)
!  integer(i32), intent(inout) :: left
!  integer(i32), intent(inout) :: right
!  integer(i32), intent(inout) :: iPivot
!  integer(i32) :: n
!  integer(i32) :: lo,hi
!  integer(i32) :: pivot
!  n=(right+left)/2
!  call swap(this(left),this(n))
!  pivot=this(left)
!  lo=left;hi=right
!  do while (lo <= hi)
!    do while (this(hi) > pivot)
!      hi=hi-1
!    end do
!
!    do while (lo <= hi .and. this(lo) <= pivot)
!      lo=lo+1
!    end do
!    if (lo <= hi) then
!      call swap(this(lo),this(hi))
!      lo=lo+1;hi=hi-1
!    end if
!  end do
!  call swap(this(left),this(hi))
!  iPivot=hi
!  end subroutine
!  !====================================================================!
!  !====================================================================!
!  subroutine partition_id1D(this,left,right,iPivot)
!    !! Interfaced with partition()
!  !====================================================================!
!  integer(i64), intent(inout) :: this(:)
!  integer(i32), intent(inout) :: left
!  integer(i32), intent(inout) :: right
!  integer(i32), intent(inout) :: iPivot
!  integer(i32) :: n
!  integer(i32) :: lo,hi
!  integer(i64) :: pivot
!  n=(right+left)/2
!  call swap(this(left),this(n))
!  pivot=this(left)
!  lo=left;hi=right
!  do while (lo <= hi)
!    do while (this(hi) > pivot)
!      hi=hi-1
!    end do
!
!    do while (lo <= hi .and. this(lo) <= pivot)
!      lo=lo+1
!    end do
!    if (lo <= hi) then
!      call swap(this(lo),this(hi))
!      lo=lo+1;hi=hi-1
!    end if
!  end do
!  call swap(this(left),this(hi))
!  iPivot=hi
!  end subroutine
!  !====================================================================!
!  !====================================================================!
!  subroutine argPartition_r1D(this,idx,left,right,i)
!    !! Interfaced with argPartition()
!  !====================================================================!
!  real(r32) :: this(:)
!  integer(i32) :: idx(:)
!  integer(i32) :: left,right,i
!  integer(i32) :: n
!  integer(i32) :: lo,hi
!  real(r32) :: pivot
!  n=(right+left)/2
!  call swap(idx(left),idx(n))
!  pivot=this(idx(left))
!  lo=left+1;hi=right
!  do while (lo <= hi)
!    do while (this(idx(hi)) > pivot)
!      hi=hi-1
!    end do
!    do while (lo <= hi .and. this(idx(lo)) <= pivot)
!      lo=lo+1
!    end do
!    if (lo <= hi) then
!      call swap(idx(lo),idx(hi))
!      lo=lo+1;hi=hi-1
!    end if
!  end do
!  call swap(idx(left),idx(hi))
!  i=hi
!  end subroutine
!  !====================================================================!
!  !====================================================================!
!  subroutine argPartition_d1D(this,idx,left,right,i)
!    !! Interfaced with argPartition()
!  !====================================================================!
!  real(r64) :: this(:)
!  integer(i32) :: idx(:)
!  integer(i32) :: left,right,i
!  integer(i32) :: n
!  integer(i32) :: lo,hi
!  real(r64) :: pivot
!!  n=(right+left)/2
!!  call swap(idx(left),idx(n))
!  pivot=this(idx(left))
!  lo=left+1;hi=right
!  do while (lo <= hi)
!    do while (this(idx(hi)) > pivot)
!      hi=hi-1
!    end do
!    do while (lo <= hi .and. (this(idx(lo)) - pivot) <= 1.d-12  )
!      lo=lo+1
!    end do
!    if (lo <= hi) then
!      call swap(idx(lo),idx(hi))
!      lo=lo+1;hi=hi-1
!    end if
!  end do
!  call swap(idx(left),idx(hi))
!  i=hi
!  end subroutine
!  !====================================================================!
!  !====================================================================!
!  subroutine argPartition_i1D(this,idx,left,right,i)
!    !! Interfaced with argPartition()
!  !====================================================================!
!  integer(i32) :: this(:)
!  integer(i32) :: idx(:)
!  integer(i32) :: left,right,i
!  integer(i32) :: n
!  integer(i32) :: lo,hi
!  integer(i32) :: pivot
!  n=(right+left)/2
!  call swap(idx(left),idx(n))
!  pivot=this(idx(left))
!  lo=left+1;hi=right
!  do while (lo <= hi)
!    do while (this(idx(hi)) > pivot)
!      hi=hi-1
!    end do
!    do while (lo <= hi .and. this(idx(lo)) <= pivot)
!      lo=lo+1
!    end do
!    if (lo <= hi) then
!      call swap(idx(lo),idx(hi))
!      lo=lo+1;hi=hi-1
!    end if
!  end do
!  call swap(idx(left),idx(hi))
!  i=hi
!  end subroutine
!  !====================================================================!
!  !====================================================================!
!  subroutine argPartition_id1D(this,idx,left,right,i)
!    !! Interfaced with argPartition()
!  !====================================================================!
!  integer(i64) :: this(:)
!  integer(i32) :: idx(:)
!  integer(i32) :: left,right,i
!  integer(i32) :: n
!  integer(i32) :: lo,hi
!  integer(i64) :: pivot
!  n=(right+left)/2
!  call swap(idx(left),idx(n))
!  pivot=this(idx(left))
!  lo=left+1;hi=right
!  do while (lo <= hi)
!    do while (this(idx(hi)) > pivot)
!      hi=hi-1
!    end do
!    do while (lo <= hi .and. this(idx(lo)) <= pivot)
!      lo=lo+1
!    end do
!    if (lo <= hi) then
!      call swap(idx(lo),idx(hi))
!      lo=lo+1;hi=hi-1
!    end if
!  end do
!  call swap(idx(left),idx(hi))
!  i=hi
!  end subroutine
!  !====================================================================!
end module