Merge pull request #390 from golasa97/main

Replacing bubblesort in PURR with quicksort

Author: whaeck

src/purr.f90

@@ -1910,7 +1910,7 @@ subroutine unrest(bkg,sig0,sigf,tabl,tval,er,gnr,gfr,ggr,gxr,gt,&
          els(itemp,ie)=spot
       enddo
    enddo
-   call fsort(es,xs,ne,1)
+   call fsort(es,ne)
 
    !--loop over sequences
    do 170 k=1,nseq0
@@ -2277,7 +2277,7 @@ subroutine unrest(bkg,sig0,sigf,tabl,tval,er,gnr,gfr,ggr,gxr,gt,&
       do ie=1,ne
          es(ie)=els(itemp,ie)+fis(itemp,ie)+cap(itemp,ie)+bkg(1)
       enddo
-      call fsort(es,xs,ne,1)
+      call fsort(es,ne)
       tmin(itemp)=es(1)
       tmax(itemp)=es(ne)
       nebin=int(nsamp/(nbin-10+1.76))
@@ -2780,7 +2780,7 @@ subroutine uw2(rez,aim1,rew,aimw)
    return
    end subroutine uw2
 
-   subroutine fsort(x,y,n,i)
+   subroutine fsort(x,n)
    !-------------------------------------------------------------------
    ! Floating-point sort routine.
    ! Sort x and y into increasing x order.
@@ -2792,21 +2792,46 @@ subroutine fsort(x,y,n,i)
    integer::k,j
    real(kr)::xt,yt
 
-   do  k=1,n-1
-      do j=k+1,n
-         if (x(k).gt.x(j)) then
-            xt=x(k)
-            yt=y(k)
-            x(k)=x(j)
-            y(k)=y(j)
-            x(j)=xt
-            y(j)=yt
-         endif
-      enddo
-   enddo
+   if (n <= 1) return
+   call quicksort(x,1,n)
+     
    return
    end subroutine fsort
 
+   recursive subroutine quicksort(a,l,r)
+    real(kr), intent(inout) :: a(:)
+    integer, intent(in) :: l, r
+    integer :: i, j
+    real(kr) :: pivot, ta
+
+    i = l
+    j = r
+    pivot = a((l+r)/2)
+
+    do
+        do while (a(i) < pivot)
+            i = i + 1
+        end do
+        do while (a(j) > pivot)
+            j = j - 1
+        end do
+
+        if (i <= j) then
+            ta = a(i)
+            a(i) = a(j)
+            a(j) = ta
+
+            i = i + 1
+            j = j - 1
+        end if
+
+        if (i > j) exit
+     end do
+
+     if (l < j) call quicksort(a,l,j)
+     if (i < r) call quicksort(a,i,r)
+   end subroutine quicksort
+
    subroutine fsrch(x,xarray,n,i,k)
    !-------------------------------------------------------------------
    ! Floating-point search routine.