V3FIT
r8zonfind.f
1  subroutine r8zonfind(x,nx,zxget,i)
2 c
3 !============
4 ! idecl: explicitize implicit INTEGER declarations:
5  IMPLICIT NONE
6  INTEGER, PARAMETER :: R8=selected_real_kind(12,100)
7  INTEGER nx,nxm,i1,i2,ij,ii
8 !============
9 ! idecl: explicitize implicit REAL declarations:
10  real*8 dx
11 !============
12  real*8 x(nx),zxget
13  integer i
14 c
15 c find index i such that x(i).le.zxget.le.x(i+1)
16 c
17 c x(1...nx) is strict increasing and x(1).le.zxget.le.x(nx)
18 c (this is assumed to already have been checked -- no check here!)
19 c
20  nxm=nx-1
21  if((i.lt.1).or.(i.gt.nxm)) then
22  i1=1
23  i2=nx-1
24  go to 10
25  endif
26 c
27  if(x(i).gt.zxget) then
28 c look down
29  dx=x(i+1)-x(i)
30  if((x(i)-zxget).gt.4*dx) then
31  i1=1
32  i2=i-1
33  go to 10
34  else
35  i2=i-1
36  do ij=i2,1,-1
37  if((x(ij).le.zxget).and.(zxget.le.x(ij+1))) then
38  i=ij
39  return
40  endif
41  enddo
42  i=1
43  return
44  endif
45  else if(x(i+1).lt.zxget) then
46 c look up
47  dx=x(i+1)-x(i)
48  if((zxget-x(i+1)).gt.4*dx) then
49  i1=i+1
50  i2=nxm
51  go to 10
52  else
53  i2=i+1
54  do ij=i2,nxm
55  if((x(ij).le.zxget).and.(zxget.le.x(ij+1))) then
56  i=ij
57  return
58  endif
59  enddo
60  ij=nxm
61  return
62  endif
63  else
64 c already there...
65  return
66  endif
67 c
68 c---------------------------
69 c binary search
70 c
71  10 continue
72 c
73  if(i1.eq.i2) then
74 c found by proc. of elimination
75  i=i1
76  return
77  endif
78 c
79  ii=(i1+i2)/2
80 c
81  if(zxget.lt.x(ii)) then
82  i2=ii-1
83  else if(zxget.gt.x(ii+1)) then
84  i1=ii+1
85  else
86 c found
87  i=ii
88  return
89  endif
90 c
91  go to 10
92 c
93  end
94