Changeset 10027 for utils/tools/NESTING/src/agrif_modutil.f90

Timestamp:

2018-08-02T17:08:17+02:00 (3 years ago)

Author:

clem

Message:

solve issues with median averages (greatly increase speed and sort out land issues)

File:

• utils/tools/NESTING/src/agrif_modutil.f90 (modified) (1 diff)

utils/tools/NESTING/src/agrif_modutil.f90

@@ -49 +49 @@
   END SUBROUTINE ssort
   !
+  !***********************************************************
+  !                    --- quicksort ---
+  ! Author: t-nissie
+  ! License: GPLv3
+  ! Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
+  !***********************************************************
+  RECURSIVE SUBROUTINE quicksort(var, first, last)
+     IMPLICIT NONE
+
+     REAL*8, DIMENSION(:), INTENT(inout) :: var
+     INTEGER,              INTENT(in)    :: first, last
+     REAL*8  :: x, t
+     INTEGER :: ji, jj
+     
+     x = var( (first+last) / 2 )
+     ji = first
+     jj = last
+     DO
+        DO WHILE (var(ji) < x)
+           ji=ji+1
+        END DO
+        DO WHILE (x < var(jj))
+           jj=jj-1
+        END DO
+        IF (ji >= jj) EXIT
+        t = var(ji);  var(ji) = var(jj);  var(jj) = t
+        ji=ji+1
+        jj=jj-1
+     END DO
+     IF (first < ji-1) CALL quicksort(var, first, ji-1)
+     IF (jj+1 < last)  CALL quicksort(var, jj+1, last)
+  END SUBROUTINE quicksort
+  
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   !************************************************************************