NADCON5-ng  0.0.1
NADCON5 Next Generation
iselect2.for
Go to the documentation of this file.
1 c> \ingroup core
2 c> Function to select an element of a partially filled, but packed multi dimensional array, `integer*2`
3 c>
4 c> Finds the "kth" element of an array, "arr", which
5 c> is dimensioned to be "nmax" values long, but which
6 c> only has data in the first "n" cells.
7 c>
8 c> ## Changelog
9 c>
10 c> ### 1/14/2016:
11 c>
12 c> Like "select2" but modified by D. Smith
13 c> to allow an "nmax" array given, but which only
14 c> has values in elements 1-n, and to have "arr"
15 c> be Integer*2
16 c>
17  FUNCTION iselect2(k,n,arr,nmax)
18 
19 c - Like "select2" but modified by D. Smith on 1/14/2016
20 c - to allow an "nmax" array given, but which only
21 c - has values in elements 1-n, and to have "arr"
22 c - be Integer*2
23 
24  INTEGER k,n,nmax
25 c REAL*8 select,arr(nmax)
26  integer*2 iselect2,arr(nmax)
27  INTEGER i,ir,j,l,mid
28 c REAL*8 a,temp
29  integer*2 a,temp
30  l=1
31  ir=n
32 1 if(ir-l.le.1)then
33  if(ir-l.eq.1)then
34  if(arr(ir).lt.arr(l))then
35  temp=arr(l)
36  arr(l)=arr(ir)
37  arr(ir)=temp
38  endif
39  endif
40  iselect2=arr(k)
41  return
42  else
43  mid=(l+ir)/2
44  temp=arr(mid)
45  arr(mid)=arr(l+1)
46  arr(l+1)=temp
47  if(arr(l+1).gt.arr(ir))then
48  temp=arr(l+1)
49  arr(l+1)=arr(ir)
50  arr(ir)=temp
51  endif
52  if(arr(l).gt.arr(ir))then
53  temp=arr(l)
54  arr(l)=arr(ir)
55  arr(ir)=temp
56  endif
57  if(arr(l+1).gt.arr(l))then
58  temp=arr(l+1)
59  arr(l+1)=arr(l)
60  arr(l)=temp
61  endif
62  i=l+1
63  j=ir
64  a=arr(l)
65 3 continue
66  i=i+1
67  if(arr(i).lt.a)goto 3
68 4 continue
69  j=j-1
70  if(arr(j).gt.a)goto 4
71  if(j.lt.i)goto 5
72  temp=arr(i)
73  arr(i)=arr(j)
74  arr(j)=temp
75  goto 3
76 5 arr(l)=arr(j)
77  arr(j)=a
78  if(j.ge.k)ir=j-1
79  if(j.le.k)l=i
80  endif
81  goto 1
82  END
integer *2 function iselect2(k, n, arr, nmax)
Function to select an element of a partially filled, but packed multi dimensional array...
Definition: iselect2.for:18