more flexible and user friendly

src/math.f90

@@ -119,7 +119,7 @@ module math
 
  public :: &
 #if defined(__PGI)
-  norm2, &
+   norm2, &
 #endif
    math_init, &
    math_qsort, &
@@ -354,20 +354,38 @@ end subroutine math_check
 
 !--------------------------------------------------------------------------------------------------
 !> @brief Quicksort algorithm for two-dimensional integer arrays
-! Sorting is done with respect to array(1,:)
-! and keeps array(2:N,:) linked to it.
+! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it.
+! default: sort=1
 !--------------------------------------------------------------------------------------------------
-recursive subroutine math_qsort(a, istart, iend)
+recursive subroutine math_qsort(a, istart, iend, sortDim)
 
  implicit none
  integer(pInt), dimension(:,:), intent(inout) :: a
- integer(pInt), intent(in) :: istart,iend
- integer(pInt) :: ipivot
-
- if (istart < iend) then
-   ipivot = qsort_partition(a,istart, iend)
-   call math_qsort(a, istart, ipivot-1_pInt)
-   call math_qsort(a, ipivot+1_pInt, iend)
+ integer(pInt), intent(in),optional :: istart,iend, sortDim
+ integer(pInt) :: ipivot,s,e,d
+ 
+ if(present(istart)) then
+   s = istart
+ else
+   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
 
 !--------------------------------------------------------------------------------------------------
@@ -376,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend)
  !-------------------------------------------------------------------------------------------------
  !> @brief Partitioning required for quicksort
  !-------------------------------------------------------------------------------------------------
- integer(pInt) function qsort_partition(a, istart, iend)
+ integer(pInt) function qsort_partition(a, istart, iend, sort)
  
    implicit none
    integer(pInt), dimension(:,:), intent(inout) :: a
-   integer(pInt), intent(in) :: istart,iend
-   integer(pInt) :: i,j,k,tmp
+   integer(pInt),                 intent(in)    :: istart,iend,sort
+   integer(pInt), dimension(size(a,1))          :: tmp
+   integer(pInt) :: i,j
   
    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
-       if (a(1,j) <= a(1,istart)) exit
+       if (a(sort,j) <= a(sort,istart)) exit
      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
-       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
+     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
        return
-     endif
+     else cross ! if they do not cross, exchange values
+       tmp    = a(:,i)
+       a(:,i) = a(:,j)
+       a(:,j) = tmp
+     endif cross
    enddo
  
  end function qsort_partition
@@ -2713,7 +2728,7 @@ end function math_clip
 
 #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)