# source:trunk/src/sort2.f90

Last change on this file was 4, checked in by mlanger, 10 years ago
File size: 3.3 KB
Line
1!**********************************************************************
3! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
4! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
5!                                                                     *
6! This file is part of FLEXPART.                                      *
7!                                                                     *
8! FLEXPART is free software: you can redistribute it and/or modify    *
10! the Free Software Foundation, either version 3 of the License, or   *
11! (at your option) any later version.                                 *
12!                                                                     *
13! FLEXPART is distributed in the hope that it will be useful,         *
14! but WITHOUT ANY WARRANTY; without even the implied warranty of      *
15! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
16! GNU General Public License for more details.                        *
17!                                                                     *
18! You should have received a copy of the GNU General Public License   *
19! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
20!**********************************************************************
21
22! From numerical recipes
23! Change by A. Stohl: Use of integer instead of real values
24
25subroutine sort2(n,arr,brr)
26
27  implicit none
28
29  integer :: n
30  integer :: arr(n),brr(n)
31  integer,parameter :: m=7,nstack=50
32  integer :: i,ir,j,jstack,k,l,istack(nstack)
33  integer :: a,b,temp
34  jstack=0
35  l=1
36  ir=n
371   if(ir-l.lt.m)then
38    do j=l+1,ir
39      a=arr(j)
40      b=brr(j)
41      do i=j-1,1,-1
42        if(arr(i).le.a)goto 2
43        arr(i+1)=arr(i)
44        brr(i+1)=brr(i)
45      end do
46      i=0
472     arr(i+1)=a
48      brr(i+1)=b
49    end do
50    if(jstack.eq.0)return
51    ir=istack(jstack)
52    l=istack(jstack-1)
53    jstack=jstack-2
54  else
55    k=(l+ir)/2
56    temp=arr(k)
57    arr(k)=arr(l+1)
58    arr(l+1)=temp
59    temp=brr(k)
60    brr(k)=brr(l+1)
61    brr(l+1)=temp
62    if(arr(l+1).gt.arr(ir))then
63      temp=arr(l+1)
64      arr(l+1)=arr(ir)
65      arr(ir)=temp
66      temp=brr(l+1)
67      brr(l+1)=brr(ir)
68      brr(ir)=temp
69    endif
70    if(arr(l).gt.arr(ir))then
71      temp=arr(l)
72      arr(l)=arr(ir)
73      arr(ir)=temp
74      temp=brr(l)
75      brr(l)=brr(ir)
76      brr(ir)=temp
77    endif
78    if(arr(l+1).gt.arr(l))then
79      temp=arr(l+1)
80      arr(l+1)=arr(l)
81      arr(l)=temp
82      temp=brr(l+1)
83      brr(l+1)=brr(l)
84      brr(l)=temp
85    endif
86    i=l+1
87    j=ir
88    a=arr(l)
89    b=brr(l)
903   continue
91      i=i+1
92    if(arr(i).lt.a)goto 3
934   continue
94      j=j-1
95    if(arr(j).gt.a)goto 4
96    if(j.lt.i)goto 5
97    temp=arr(i)
98    arr(i)=arr(j)
99    arr(j)=temp
100    temp=brr(i)
101    brr(i)=brr(j)
102    brr(j)=temp
103    goto 3
1045   arr(l)=arr(j)
105    arr(j)=a
106    brr(l)=brr(j)
107    brr(j)=b
108    jstack=jstack+2
109    if(jstack.gt.nstack) then
110       print*, 'nstack too small in sort2'
111       stop
112    end if
113    if(ir-i+1.ge.j-l)then
114      istack(jstack)=ir
115      istack(jstack-1)=i
116      ir=j-1
117    else
118      istack(jstack)=j-1
119      istack(jstack-1)=l
120      l=i
121    endif
122  endif
123  goto 1
124end subroutine sort2
125!  (C) Copr. 1986-92 Numerical Recipes Software us.
Note: See TracBrowser for help on using the repository browser.