!! Copyright (C) Stichting Deltares, 2005-2017. !! !! This file is part of iMOD. !! !! This program is free software: you can redistribute it and/or modify !! it under the terms of the GNU General Public License as published by !! the Free Software Foundation, either version 3 of the License, or !! (at your option) any later version. !! !! This program is distributed in the hope that it will be useful, !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! GNU General Public License for more details. !! !! You should have received a copy of the GNU General Public License !! along with this program. If not, see . !! !! Contact: imod.support@deltares.nl !! Stichting Deltares !! P.O. Box 177 !! 2600 MH Delft, The Netherlands. !! subroutine sortem(ib,ie,a,iperm,b,c,d,e,f,g,h) c----------------------------------------------------------------------- c c Quickersort Subroutine c ********************** c c This is a subroutine for sorting a real array in ascending order. This c is a Fortran translation of algorithm 271, quickersort, by R.S. Scowen c in collected algorithms of the ACM. c c The method used is that of continually splitting the array into parts c such that all elements of one part are less than all elements of the c other, with a third part in the middle consisting of one element. An c element with value t is chosen arbitrarily (here we choose the middle c element). i and j give the lower and upper limits of the segment being c split. After the split a value q will have been found such that c a(q)=t and a(l)<=t<=a(m) for all i<=l7 no other array is permuted. c c b,c,d,e,f,g,h arrays to be permuted according to array a. c c OUTPUT PARAMETERS: c c a = the array, a portion of which has been sorted. c c b,c,d,e,f,g,h =arrays permuted according to array a (see iperm) c c NO EXTERNAL ROUTINES REQUIRED: c c----------------------------------------------------------------------- IMPLICIT NONE REAL(KIND=DP_KIND),dimension a(*),b(*),c(*),d(*),e(*),f(*),g(*),h(*) c c The dimensions for lt and ut have to be at least log (base 2) n c integer lt(64),ut(64),i,j,k,m,p,q c c Initialize: c j = ie m = 1 i = ib iring = iperm+1 if (iperm.gt.7) iring=1 c c If this segment has more than two elements we split it c 10 if (j-i-1) 100,90,15 c c p is the position of an arbitrary element in the segment we choose the c middle element. Under certain circumstances it may be advantageous c to choose p at random. c 15 p = (j+i)/2 ta = a(p) a(p) = a(i) go to (21,19,18,17,16,161,162,163),iring 163 th = h(p) h(p) = h(i) 162 tg = g(p) g(p) = g(i) 161 tf = f(p) f(p) = f(i) 16 te = e(p) e(p) = e(i) 17 td = d(p) d(p) = d(i) 18 tc = c(p) c(p) = c(i) 19 tb = b(p) b(p) = b(i) 21 continue c c Start at the beginning of the segment, search for k such that a(k)>t c q = j k = i 20 k = k+1 if(k.gt.q) go to 60 if(a(k).le.ta) go to 20 c c Such an element has now been found now search for a q such that a(q)7 no other array is permuted. c c b,c,d,e,f,g,h arrays to be permuted according to array a. c c OUTPUT PARAMETERS: c c a = the array, a portion of which has been sorted. c c b,c,d,e,f,g,h =arrays permuted according to array a (see iperm) c c NO EXTERNAL ROUTINES REQUIRED: c c----------------------------------------------------------------------- integer a,xa,ta dimension a(*),b(*),c(*),d(*),e(*),f(*),g(*),h(*) c c The dimensions for lt and ut have to be at least log (base 2) n c integer lt(64),ut(64),i,j,k,m,p,q c c Initialize: c j = ie m = 1 i = ib iring = iperm+1 if (iperm.gt.7) iring=1 c c If this segment has more than two elements we split it c 10 if (j-i-1) 100,90,15 c c p is the position of an arbitrary element in the segment we choose the c middle element. Under certain circumstances it may be advantageous c to choose p at random. c 15 p = (j+i)/2 ta = a(p) a(p) = a(i) go to (21,19,18,17,16,161,162,163),iring 163 th = h(p) h(p) = h(i) 162 tg = g(p) g(p) = g(i) 161 tf = f(p) f(p) = f(i) 16 te = e(p) e(p) = e(i) 17 td = d(p) d(p) = d(i) 18 tc = c(p) c(p) = c(i) 19 tb = b(p) b(p) = b(i) 21 continue c c Start at the beginning of the segment, search for k such that a(k)>t c q = j k = i 20 k = k+1 if(k.gt.q) go to 60 if(a(k).le.ta) go to 20 c c Such an element has now been found now search for a q such that a(q)7 no other array is permuted. c c b,c,d,e,f,g,h arrays to be permuted according to array a. c c OUTPUT PARAMETERS: c c a = the array, a portion of which has been sorted. c c b,c,d,e,f,g,h =arrays permuted according to array a (see iperm) c c NO EXTERNAL ROUTINES REQUIRED: c c----------------------------------------------------------------------- REAL(KIND=DP_KIND) a,xa,ta dimension a(*),b(*),c(*),d(*),e(*),f(*),g(*),h(*) c c The dimensions for lt and ut have to be at least log (base 2) n c integer lt(64),ut(64),i,j,k,m,p,q c c Initialize: c j = ie m = 1 i = ib iring = iperm+1 if (iperm.gt.7) iring=1 c c If this segment has more than two elements we split it c 10 if (j-i-1) 100,90,15 c c p is the position of an arbitrary element in the segment we choose the c middle element. Under certain circumstances it may be advantageous c to choose p at random. c 15 p = (j+i)/2 ta = a(p) a(p) = a(i) go to (21,19,18,17,16,161,162,163),iring 163 th = h(p) h(p) = h(i) 162 tg = g(p) g(p) = g(i) 161 tf = f(p) f(p) = f(i) 16 te = e(p) e(p) = e(i) 17 td = d(p) d(p) = d(i) 18 tc = c(p) c(p) = c(i) 19 tb = b(p) b(p) = b(i) 21 continue c c Start at the beginning of the segment, search for k such that a(k)>t c q = j k = i 20 k = k+1 if(k.gt.q) go to 60 if(a(k).le.ta) go to 20 c c Such an element has now been found now search for a q such that a(q)