1! This file is part of xtb.
2!
3! Copyright (C) 2017-2020 Stefan Grimme
4!
5! xtb is free software: you can redistribute it and/or modify it under
6! the terms of the GNU Lesser General Public License as published by
7! the Free Software Foundation, either version 3 of the License, or
8! (at your option) any later version.
9!
10! xtb is distributed in the hope that it will be useful,
11! but WITHOUT ANY WARRANTY; without even the implied warranty of
12! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13! GNU Lesser General Public License for more details.
14!
15! You should have received a copy of the GNU Lesser General Public License
16! along with xtb.  If not, see <https://www.gnu.org/licenses/>.
17
18recursive subroutine qsort(a, first, last, ind)
19   use xtb_mctc_accuracy, only : wp
20  implicit none
21  real(wp) :: a(*), x, t
22  integer  :: ind(*)
23  integer  :: first, last
24  integer  :: i, j, ii
25
26  x = a( (first+last) / 2 )
27  i = first
28  j = last
29  do
30     do while (a(i) < x)
31        i=i+1
32     end do
33     do while (x < a(j))
34        j=j-1
35     end do
36     if (i >= j) exit
37     t = a(i);  a(i) = a(j);  a(j) = t
38     ii=ind(i); ind(i) = ind(j);  ind(j) = ii
39     i=i+1
40     j=j-1
41  end do
42  if (first < i-1) call qsort(a, first, i-1, ind)
43  if (j+1 < last)  call qsort(a, j+1, last, ind)
44end subroutine qsort
45
46recursive subroutine qqsort(a, first, last)
47   use xtb_mctc_accuracy, only : wp
48  implicit none
49  real(wp) :: a(*), x, t
50  integer  :: first, last
51  integer  :: i, j, ii
52
53  x = a( (first+last) / 2 )
54  i = first
55  j = last
56  do
57     do while (a(i) < x)
58        i=i+1
59     end do
60     do while (x < a(j))
61        j=j-1
62     end do
63     if (i >= j) exit
64     t = a(i);  a(i) = a(j);  a(j) = t
65     i=i+1
66     j=j-1
67  end do
68  if (first < i-1) call qqsort(a, first, i-1)
69  if (j+1 < last)  call qqsort(a, j+1, last)
70end subroutine qqsort
71