more flexible and user friendly
This commit is contained in:
parent
af28e9cdd9
commit
87f3e3f621
71
src/math.f90
71
src/math.f90
|
@ -354,20 +354,38 @@ end subroutine math_check
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief Quicksort algorithm for two-dimensional integer arrays
|
!> @brief Quicksort algorithm for two-dimensional integer arrays
|
||||||
! Sorting is done with respect to array(1,:)
|
! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it.
|
||||||
! and keeps array(2:N,:) linked to it.
|
! default: sort=1
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
recursive subroutine math_qsort(a, istart, iend)
|
recursive subroutine math_qsort(a, istart, iend, sortDim)
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer(pInt), dimension(:,:), intent(inout) :: a
|
integer(pInt), dimension(:,:), intent(inout) :: a
|
||||||
integer(pInt), intent(in) :: istart,iend
|
integer(pInt), intent(in),optional :: istart,iend, sortDim
|
||||||
integer(pInt) :: ipivot
|
integer(pInt) :: ipivot,s,e,d
|
||||||
|
|
||||||
if (istart < iend) then
|
if(present(istart)) then
|
||||||
ipivot = qsort_partition(a,istart, iend)
|
s = istart
|
||||||
call math_qsort(a, istart, ipivot-1_pInt)
|
else
|
||||||
call math_qsort(a, ipivot+1_pInt, iend)
|
s = lbound(a,2)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(present(iend)) then
|
||||||
|
e = iend
|
||||||
|
else
|
||||||
|
e = ubound(a,2)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if(present(sortDim)) then
|
||||||
|
d = sortDim
|
||||||
|
else
|
||||||
|
d = 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (s < e) then
|
||||||
|
ipivot = qsort_partition(a,s, e, d)
|
||||||
|
call math_qsort(a, s, ipivot-1_pInt, d)
|
||||||
|
call math_qsort(a, ipivot+1_pInt, e, d)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -376,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend)
|
||||||
!-------------------------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------------------------
|
||||||
!> @brief Partitioning required for quicksort
|
!> @brief Partitioning required for quicksort
|
||||||
!-------------------------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------------------------
|
||||||
integer(pInt) function qsort_partition(a, istart, iend)
|
integer(pInt) function qsort_partition(a, istart, iend, sort)
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer(pInt), dimension(:,:), intent(inout) :: a
|
integer(pInt), dimension(:,:), intent(inout) :: a
|
||||||
integer(pInt), intent(in) :: istart,iend
|
integer(pInt), intent(in) :: istart,iend,sort
|
||||||
integer(pInt) :: i,j,k,tmp
|
integer(pInt), dimension(size(a,1)) :: tmp
|
||||||
|
integer(pInt) :: i,j
|
||||||
|
|
||||||
do
|
do
|
||||||
! find the first element on the right side less than or equal to the pivot point
|
! find the first element on the right side less than or equal to the pivot point
|
||||||
do j = iend, istart, -1_pInt
|
do j = iend, istart, -1_pInt
|
||||||
if (a(1,j) <= a(1,istart)) exit
|
if (a(sort,j) <= a(sort,istart)) exit
|
||||||
enddo
|
enddo
|
||||||
! find the first element on the left side greater than the pivot point
|
! find the first element on the left side greater than the pivot point
|
||||||
do i = istart, iend
|
do i = istart, iend
|
||||||
if (a(1,i) > a(1,istart)) exit
|
if (a(sort,i) > a(sort,istart)) exit
|
||||||
enddo
|
|
||||||
if (i < j) then ! if the indexes do not cross, exchange values
|
|
||||||
do k = 1_pInt, int(size(a,1_pInt), pInt)
|
|
||||||
tmp = a(k,i)
|
|
||||||
a(k,i) = a(k,j)
|
|
||||||
a(k,j) = tmp
|
|
||||||
enddo
|
|
||||||
else ! if they do cross, exchange left value with pivot and return with the partition index
|
|
||||||
do k = 1_pInt, int(size(a,1_pInt), pInt)
|
|
||||||
tmp = a(k,istart)
|
|
||||||
a(k,istart) = a(k,j)
|
|
||||||
a(k,j) = tmp
|
|
||||||
enddo
|
enddo
|
||||||
|
cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index
|
||||||
|
tmp = a(:,istart)
|
||||||
|
a(:,istart) = a(:,j)
|
||||||
|
a(:,j) = tmp
|
||||||
qsort_partition = j
|
qsort_partition = j
|
||||||
return
|
return
|
||||||
endif
|
else cross ! if they do not cross, exchange values
|
||||||
|
tmp = a(:,i)
|
||||||
|
a(:,i) = a(:,j)
|
||||||
|
a(:,j) = tmp
|
||||||
|
endif cross
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
end function qsort_partition
|
end function qsort_partition
|
||||||
|
@ -2713,7 +2728,7 @@ end function math_clip
|
||||||
|
|
||||||
#if defined(__PGI)
|
#if defined(__PGI)
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief substitute for the norm2 intrinsic which is not available when using PGI 18.10
|
!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
real(pReal) pure function norm2(v)
|
real(pReal) pure function norm2(v)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue