1!
2!     CalculiX - A 3-dimensional finite element program
3!              Copyright (C) 1998-2021 Guido Dhondt
4!
5!     This program is free software; you can redistribute it and/or
6!     modify it under the terms of the GNU General Public License as
7!     published by the Free Software Foundation(version 2);
8!
9!
10!     This program 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 General Public License for more details.
14!
15!     You should have received a copy of the GNU General Public License
16!     along with this program; if not, write to the Free Software
17!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18!
19!     S.W. Sloan, Adv.Eng.Software,1987,9(1),34-55.
20!     Permission for use with the GPL license granted by Prof. Scott
21!     Sloan on 17. Nov. 2013
22!
23      subroutine qsorti(n,list,key)
24!
25      implicit none
26!
27      integer list(*),key(*),n,ll,lr,lm,nl,nr,ltemp,stktop,maxstk,guess
28!
29      parameter(maxstk=32)
30!
31      integer lstack(maxstk),rstack(maxstk)
32!
33      ll= 1
34      lr=n
35      stktop=0
36 10   if(ll.lt.lr) then
37         nl=ll
38         nr=lr
39         lm=(ll+lr)/2
40         guess=key(list(lm))
41 20      if (key(list(nl)).lt.guess) then
42            nl=nl+1
43            goto 20
44         end if
45 30      if (guess.lt.key(list(nr))) then
46            nr=nr-1
47            goto 30
48         end if
49         if(nl.lt.(nr-1)) then
50            ltemp=list(nl)
51            list(nl)=list(nr)
52            list(nr)=ltemp
53            nl=nl+1
54            nr=nr-1
55            goto 20
56         end if
57         if(nl.le.nr) then
58            if(nl.lt.nr) then
59               ltemp=list(nl)
60               list(nl)=list(nr)
61               list(nr)=ltemp
62            end if
63            nl=nl+1
64            nr=nr-1
65         end if
66         stktop=stktop+1
67         if(nr.lt.lm) then
68            lstack(stktop)=nl
69            rstack(stktop)=lr
70            lr=nr
71         else
72            lstack(stktop)=ll
73            rstack(stktop)=nr
74            ll=nl
75         end if
76         goto 10
77      end if
78      if (stktop.ne.0) then
79         ll=lstack(stktop)
80         lr=rstack(stktop)
81         stktop=stktop-1
82         goto 10
83      end if
84      end
85
86