NADCON5-ng  0.0.2
NADCON5 Next Generation Documentation
indexxi.for
Go to the documentation of this file.
1 c> \ingroup core
2 c> \if MANPAGE
3 c> \page indexxi
4 c> \endif
5 c>
6 c> Subroutine to perform ?? indexing on integer data
7 c>
8 c> \param[in] n number of iterations (rows?)
9 c> \param[in] nd array and index dimensions
10 c> \param[in] arr input data array
11 c> \param[out] indx index out
12 c>
13 c> ## Changelog
14 c>
15 c> ### 2/5/2013:
16 c> Modified by D. Smith. Arr has been
17 c> changed to integer*4. And like other versions
18 c> of "indexx" which I've modified,
19 c> I allow indx and arr to
20 c> be DIMENSIONED differently than the number of good
21 c> values they contain
22 c>
23  SUBROUTINE indexxi(n,nd,arr,indx)
24 
25 c> Modified by D. Smith, 2/5/2013 . Arr has been
26 c> changed to integer*4. And like other versions
27 c> of "indexx" which I've modified,
28 c> I allow indx and arr to
29 c> be DIMENSIONED differently than the number of good
30 c> values they contain
31 
32  integer nd
33  INTEGER n,indx(nd),M,NSTACK
34 cDAS REAL*4 arr(nd)
35  integer*4 arr(nd)
36  parameter(m=7,nstack=50)
37  INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(nstack)
38 cDAS REAL*4 a
39  integer*4 a
40 
41  do 11 j=1,n
42  indx(j)=j
43 11 continue
44  jstack=0
45  l=1
46  ir=n
47 1 if(ir-l.lt.m)then
48  do 13 j=l+1,ir
49  indxt=indx(j)
50  a=arr(indxt)
51  do 12 i=j-1,1,-1
52  if(arr(indx(i)).le.a)goto 2
53  indx(i+1)=indx(i)
54 12 continue
55  i=0
56 2 indx(i+1)=indxt
57 13 continue
58  if(jstack.eq.0)return
59  ir=istack(jstack)
60  l=istack(jstack-1)
61  jstack=jstack-2
62  else
63  k=(l+ir)/2
64  itemp=indx(k)
65  indx(k)=indx(l+1)
66  indx(l+1)=itemp
67  if(arr(indx(l+1)).gt.arr(indx(ir)))then
68  itemp=indx(l+1)
69  indx(l+1)=indx(ir)
70  indx(ir)=itemp
71  endif
72  if(arr(indx(l)).gt.arr(indx(ir)))then
73  itemp=indx(l)
74  indx(l)=indx(ir)
75  indx(ir)=itemp
76  endif
77  if(arr(indx(l+1)).gt.arr(indx(l)))then
78  itemp=indx(l+1)
79  indx(l+1)=indx(l)
80  indx(l)=itemp
81  endif
82  i=l+1
83  j=ir
84  indxt=indx(l)
85  a=arr(indxt)
86 3 continue
87  i=i+1
88  if(arr(indx(i)).lt.a)goto 3
89 4 continue
90  j=j-1
91  if(arr(indx(j)).gt.a)goto 4
92  if(j.lt.i)goto 5
93  itemp=indx(i)
94  indx(i)=indx(j)
95  indx(j)=itemp
96  goto 3
97 5 indx(l)=indx(j)
98  indx(j)=indxt
99  jstack=jstack+2
100  if(jstack.gt.nstack)pause 'NSTACK too small in indexx'
101  if(ir-i+1.ge.j-l)then
102  istack(jstack)=ir
103  istack(jstack-1)=i
104  ir=j-1
105  else
106  istack(jstack)=j-1
107  istack(jstack-1)=l
108  l=i
109  endif
110  endif
111  goto 1
112  END
subroutine indexxi(n, nd, arr, indx)
Subroutine to perform ?? indexing on integer data.
Definition: indexxi.for:24