28 integer(I4B),
dimension(:),
intent(inout) :: indx
29 integer(I4B),
dimension(:),
intent(inout) :: v
30 logical,
intent(in),
optional :: reverse
33 integer(I4B),
parameter :: nn = 15
34 integer(I4B),
parameter :: nstack = 50
39 integer(I4B) :: jstack
41 integer(I4B) :: iright
42 integer(I4B),
dimension(nstack) :: istack
50 if (
present(reverse))
then
64 if (iright - ileft < nn)
then
65 do j = (ileft + 1), iright
68 do i = (j - 1), ileft, -1
76 if (jstack == 0)
return
77 iright = istack(jstack)
78 ileft = istack(jstack - 1)
81 k = (ileft + iright) / 2
82 call iswap(v(k), v(ileft + 1))
83 call iswap(indx(k), indx(ileft + 1))
84 if (v(ileft) > v(iright))
then
85 call iswap(v(ileft), v(iright))
86 call iswap(indx(ileft), indx(iright))
88 if (v(ileft + 1) > v(iright))
then
89 call iswap(v(ileft + 1), v(iright))
90 call iswap(indx(ileft + 1), indx(iright))
92 if (v(ileft) > v(ileft + 1))
then
93 call iswap(v(ileft), v(ileft + 1))
94 call iswap(indx(ileft), indx(ileft + 1))
116 call iswap(v(i), v(j))
117 call iswap(indx(i), indx(j))
120 indx(ileft + 1) = indx(j)
124 if (jstack > nstack)
then
125 write (
errmsg,
'(a,3(1x,a))') &
126 'JSTACK > NSTACK IN SortModule::qsort'
129 if ((iright - i + 1) >= (j - 1))
then
130 istack(jstack) = iright
131 istack(jstack - 1) = i
134 istack(jstack) = j - 1
135 istack(jstack - 1) = ileft
145 call iswap(v(i), v(j))
146 call iswap(indx(i), indx(j))
163 integer(I4B),
dimension(:),
intent(inout) :: indx
164 real(DP),
dimension(:),
intent(inout) :: v
165 logical,
intent(in),
optional :: reverse
168 integer(I4B),
parameter :: nn = 15
169 integer(I4B),
parameter :: nstack = 50
170 integer(I4B) :: nsize
174 integer(I4B) :: jstack
175 integer(I4B) :: ileft
176 integer(I4B) :: iright
177 integer(I4B),
dimension(nstack) :: istack
185 if (
present(reverse))
then
199 if (iright - ileft < nn)
then
200 do j = (ileft + 1), iright
203 do i = (j - 1), ileft, -1
206 indx(i + 1) = indx(i)
211 if (jstack == 0)
return
212 iright = istack(jstack)
213 ileft = istack(jstack - 1)
216 k = (ileft + iright) / 2
217 call rswap(v(k), v(ileft + 1))
218 call iswap(indx(k), indx(ileft + 1))
219 if (v(ileft) > v(iright))
then
220 call rswap(v(ileft), v(iright))
221 call iswap(indx(ileft), indx(iright))
223 if (v(ileft + 1) > v(iright))
then
224 call rswap(v(ileft + 1), v(iright))
225 call iswap(indx(ileft + 1), indx(iright))
227 if (v(ileft) > v(ileft + 1))
then
228 call rswap(v(ileft), v(ileft + 1))
229 call iswap(indx(ileft), indx(ileft + 1))
251 call rswap(v(i), v(j))
252 call iswap(indx(i), indx(j))
255 indx(ileft + 1) = indx(j)
259 if (jstack > nstack)
then
260 write (
errmsg,
'(a,3(1x,a))') &
261 'JSTACK > NSTACK IN SortModule::qsort'
264 if ((iright - i + 1) >= (j - 1))
then
265 istack(jstack) = iright
266 istack(jstack - 1) = i
269 istack(jstack) = j - 1
270 istack(jstack - 1) = ileft
280 call rswap(v(i), v(j))
281 call iswap(indx(i), indx(j))
292 integer(I4B),
dimension(:),
allocatable,
intent(in) :: a
293 integer(I4B),
dimension(:),
allocatable,
intent(inout) :: b
295 integer(I4B) :: count
297 integer(I4B),
dimension(:),
allocatable :: indxarr
298 integer(I4B),
dimension(:),
allocatable :: tarr
303 allocate (tarr(
size(a)))
304 allocate (indxarr(
size(a)))
313 call qsort(indxarr, tarr, reverse=.true.)
318 if (tarr(n) > tarr(n - 1)) count = count + 1
322 if (
allocated(b))
then
331 if (tarr(n) > b(count))
then
347 real(DP),
dimension(:),
allocatable,
intent(in) :: a
348 real(DP),
dimension(:),
allocatable,
intent(inout) :: b
350 integer(I4B) :: count
352 integer(I4B),
dimension(:),
allocatable :: indxarr
353 real(DP),
dimension(:),
allocatable :: tarr
358 allocate (tarr(
size(a)))
359 allocate (indxarr(
size(a)))
368 call qsort(indxarr, tarr, reverse=.true.)
373 if (tarr(n) > tarr(n - 1)) count = count + 1
377 if (
allocated(b))
then
386 if (tarr(n) > b(count))
then
408 integer(I4B),
dimension(:),
intent(inout) :: indx
409 real(dp),
dimension(:),
intent(inout) :: v
410 logical,
intent(in),
optional :: reverse
413 integer(I4B) :: nsizei
414 integer(I4B) :: nsizev
420 real(dp),
dimension(:),
allocatable :: vv
425 if (
present(reverse))
then
433 nsizei = min(nsizev,
size(indx))
434 allocate (vv(nsizei))
446 do i = nsizei + 1, nsizev
449 if (v(i) > vv(1))
then
458 if (k /= nsizei)
then
459 if (vv(k) > vv(k + 1))
then
463 if (vv(j) <= vv(k))
then
466 call rswap(vv(k), vv(j))
467 call iswap(indx(k), indx(j))
480 call iswap(indx(i), indx(j))
491 real(DP),
intent(inout) :: a
492 real(DP),
intent(inout) :: b
507 integer(I4B),
intent(inout) :: ia
508 integer(I4B),
intent(inout) :: ib
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
This module defines variable data types.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
subroutine unique_values_int1d(a, b)
subroutine qsort_dbl1d(indx, v, reverse)
subroutine, public selectn(indx, v, reverse)
subroutine unique_values_dbl1d(a, b)
subroutine qsort_int1d(indx, v, reverse)