MODFLOW 6  version 6.5.0.dev2
MODFLOW 6 Code Documentation
Private Member Functions | List of all members
sortmodule::qsort Interface Reference
Collaboration diagram for sortmodule::qsort:
Collaboration graph

Private Member Functions

subroutine qsort_int1d (indx, v, reverse)
 
subroutine qsort_dbl1d (indx, v, reverse)
 

Detailed Description

Definition at line 11 of file sort.f90.

Member Function/Subroutine Documentation

◆ qsort_dbl1d()

subroutine sortmodule::qsort::qsort_dbl1d ( integer(i4b), dimension(:), intent(inout)  indx,
real(dp), dimension(:), intent(inout)  v,
logical, intent(in), optional  reverse 
)
private

Definition at line 155 of file sort.f90.

156 ! **************************************************************************
157 ! qsort -- quick sort that also includes an index number
158 ! **************************************************************************
159 !
160 ! SPECIFICATIONS:
161 ! --------------------------------------------------------------------------
162  ! -- dummy arguments
163  integer(I4B), dimension(:), intent(inout) :: indx
164  real(DP), dimension(:), intent(inout) :: v
165  logical, intent(in), optional :: reverse
166  ! -- local variables
167  logical :: lrev
168  integer(I4B), parameter :: nn = 15
169  integer(I4B), parameter :: nstack = 50
170  integer(I4B) :: nsize
171  integer(I4B) :: k
172  integer(I4B) :: i
173  integer(I4B) :: j
174  integer(I4B) :: jstack
175  integer(I4B) :: ileft
176  integer(I4B) :: iright
177  integer(I4B), dimension(nstack) :: istack
178  integer(I4B) :: iidx
179  integer(I4B) :: ia
180  real(DP) :: a
181  ! -- functions
182  ! -- code
183  !
184  ! -- process optional dummy variables
185  if (present(reverse)) then
186  lrev = reverse
187  else
188  lrev = .false.
189  end if
190  !
191  ! -- initialize variables
192  nsize = size(v)
193  jstack = 0
194  ileft = 1
195  iright = nsize
196  !
197  ! -- perform quicksort
198  do
199  if (iright - ileft < nn) then
200  do j = (ileft + 1), iright
201  a = v(j)
202  iidx = indx(j)
203  do i = (j - 1), ileft, -1
204  if (v(i) <= a) exit
205  v(i + 1) = v(i)
206  indx(i + 1) = indx(i)
207  end do
208  v(i + 1) = a
209  indx(i + 1) = iidx
210  end do
211  if (jstack == 0) return
212  iright = istack(jstack)
213  ileft = istack(jstack - 1)
214  jstack = jstack - 2
215  else
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))
222  end if
223  if (v(ileft + 1) > v(iright)) then
224  call rswap(v(ileft + 1), v(iright))
225  call iswap(indx(ileft + 1), indx(iright))
226  end if
227  if (v(ileft) > v(ileft + 1)) then
228  call rswap(v(ileft), v(ileft + 1))
229  call iswap(indx(ileft), indx(ileft + 1))
230  end if
231  i = ileft + 1
232  j = iright
233  a = v(ileft + 1)
234  ia = indx(ileft + 1)
235  do
236  do
237  i = i + 1
238  if (v(i) >= a) then
239  exit
240  end if
241  end do
242  do
243  j = j - 1
244  if (v(j) <= a) then
245  exit
246  end if
247  end do
248  if (j < i) then
249  exit
250  end if
251  call rswap(v(i), v(j))
252  call iswap(indx(i), indx(j))
253  end do
254  v(ileft + 1) = v(j)
255  indx(ileft + 1) = indx(j)
256  v(j) = a
257  indx(j) = ia
258  jstack = jstack + 2
259  if (jstack > nstack) then
260  write (errmsg, '(a,3(1x,a))') &
261  'JSTACK > NSTACK IN SortModule::qsort'
262  call store_error(errmsg, terminate=.true.)
263  end if
264  if ((iright - i + 1) >= (j - 1)) then
265  istack(jstack) = iright
266  istack(jstack - 1) = i
267  iright = j - 1
268  else
269  istack(jstack) = j - 1
270  istack(jstack - 1) = ileft
271  ileft = i
272  end if
273  end if
274  end do
275  !
276  ! -- reverse order of the heap index
277  if (lrev) then
278  j = nsize
279  do i = 1, nsize / 2
280  call rswap(v(i), v(j))
281  call iswap(indx(i), indx(j))
282  j = j - 1
283  end do
284  end if
285  !
286  ! -- return
287  return
Here is the call graph for this function:

◆ qsort_int1d()

subroutine sortmodule::qsort::qsort_int1d ( integer(i4b), dimension(:), intent(inout)  indx,
integer(i4b), dimension(:), intent(inout)  v,
logical, intent(in), optional  reverse 
)
private

Definition at line 20 of file sort.f90.

21 ! **************************************************************************
22 ! qsort -- quick sort that also includes an index number
23 ! **************************************************************************
24 !
25 ! SPECIFICATIONS:
26 ! --------------------------------------------------------------------------
27  ! -- dummy arguments
28  integer(I4B), dimension(:), intent(inout) :: indx
29  integer(I4B), dimension(:), intent(inout) :: v
30  logical, intent(in), optional :: reverse
31  ! -- local variables
32  logical :: lrev
33  integer(I4B), parameter :: nn = 15
34  integer(I4B), parameter :: nstack = 50
35  integer(I4B) :: nsize
36  integer(I4B) :: k
37  integer(I4B) :: i
38  integer(I4B) :: j
39  integer(I4B) :: jstack
40  integer(I4B) :: ileft
41  integer(I4B) :: iright
42  integer(I4B), dimension(nstack) :: istack
43  integer(I4B) :: iidx
44  integer(I4B) :: ia
45  integer(I4B) :: a
46  ! -- functions
47  ! -- code
48  !
49  ! -- process optional dummy variables
50  if (present(reverse)) then
51  lrev = reverse
52  else
53  lrev = .false.
54  end if
55  !
56  ! -- initialize variables
57  nsize = size(v)
58  jstack = 0
59  ileft = 1
60  iright = nsize
61  !
62  ! -- perform quicksort
63  do
64  if (iright - ileft < nn) then
65  do j = (ileft + 1), iright
66  a = v(j)
67  iidx = indx(j)
68  do i = (j - 1), ileft, -1
69  if (v(i) <= a) exit
70  v(i + 1) = v(i)
71  indx(i + 1) = indx(i)
72  end do
73  v(i + 1) = a
74  indx(i + 1) = iidx
75  end do
76  if (jstack == 0) return
77  iright = istack(jstack)
78  ileft = istack(jstack - 1)
79  jstack = jstack - 2
80  else
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))
87  end if
88  if (v(ileft + 1) > v(iright)) then
89  call iswap(v(ileft + 1), v(iright))
90  call iswap(indx(ileft + 1), indx(iright))
91  end if
92  if (v(ileft) > v(ileft + 1)) then
93  call iswap(v(ileft), v(ileft + 1))
94  call iswap(indx(ileft), indx(ileft + 1))
95  end if
96  i = ileft + 1
97  j = iright
98  a = v(ileft + 1)
99  ia = indx(ileft + 1)
100  do
101  do
102  i = i + 1
103  if (v(i) >= a) then
104  exit
105  end if
106  end do
107  do
108  j = j - 1
109  if (v(j) <= a) then
110  exit
111  end if
112  end do
113  if (j < i) then
114  exit
115  end if
116  call iswap(v(i), v(j))
117  call iswap(indx(i), indx(j))
118  end do
119  v(ileft + 1) = v(j)
120  indx(ileft + 1) = indx(j)
121  v(j) = a
122  indx(j) = ia
123  jstack = jstack + 2
124  if (jstack > nstack) then
125  write (errmsg, '(a,3(1x,a))') &
126  'JSTACK > NSTACK IN SortModule::qsort'
127  call store_error(errmsg, terminate=.true.)
128  end if
129  if ((iright - i + 1) >= (j - 1)) then
130  istack(jstack) = iright
131  istack(jstack - 1) = i
132  iright = j - 1
133  else
134  istack(jstack) = j - 1
135  istack(jstack - 1) = ileft
136  ileft = i
137  end if
138  end if
139  end do
140  !
141  ! -- reverse order of the heap index
142  if (lrev) then
143  j = nsize
144  do i = 1, nsize / 2
145  call iswap(v(i), v(j))
146  call iswap(indx(i), indx(j))
147  j = j - 1
148  end do
149  end if
150  !
151  ! -- return
152  return
Here is the call graph for this function:
The documentation for this interface was generated from the following file: