real x(100),xl(100),y(100),l,fh(100),r(100)
real xs(100),xsl(100),ys(100)
integer ir(1)
c
c specify n =series length, hmin = minimum bandwidth,
c hinc = bandwidth increment
c
n=57
hmin=0.05
hinc=0.01
c
c read x = abundance series; form y = discrete growth rate
c series; sort (x, y) by x for smoothing; form xl = log x
c
do 10 i=1,n
read(9,*)zz,x(i)
if(i.gt.1)y(i-1)=alog(x(i)/x(i-1))
10 continue
xstart=x(1)
do 21 i=1,n-2
do 22 j=i+1,n-1
if(x(i).le.x(j))goto 22
hold=x(i)
x(i)=x(j)
x(j)=hold
hold=y(i)
y(i)=y(j)
y(j)=hold
22 continue
21 continue
do 23 i=1,n-1
xl(i)=alog(x(i))
23 continue
c
c smooth with increasing bandwidth until 1 0-downcrossing;
c upon completion, h = critical bandwidth; fh = critically
c smoothed values; r = residuals for use in bootstrap; IMSL
c function anordf returns value of standard normal
c distribution function
c
h=hmin
24 h=h+hinc
do 30 i=1,n-1
xx=xl(i)
sum=0.0
do 40 j=1,n-1
if(j.gt.1)l=0.5*(xl(j-1)+xl(j))
if(j.lt.(n-1))u=0.5*(xl(j+1)+xl(j))
if(j.eq.1)w=anordf((u-xx)/h)
if(j.eq.(n-1))w=1-anordf((l-xx)/h)
if(j.gt.1.and.j.lt.(n-1))w=
1 anordf((u-xx)/h)-anordf((l-xx)/h)
sum=sum+y(j)*w
40 continue
fh(i)=sum
r(i)=y(i)-fh(i)
30 continue
ncross=0
do 50 i=2,n-1
if(fh(i-1).gt.0.0.and.fh(i).lt.0.0)ncross=ncross+1
50 continue
if(ncross.gt.1)goto 24
write(5,*)h
c
c repeatedly generate bootstrap series xs and count the number
c with critical bandwidth greater than h; IMSL subroutine
c generates discrete uniform random number
c
do 666 kkk=1,100
xs(1)=xstart
xsl(1)=alog(xs(1))
do 51 i=2,n
xx=xsl(i-1)
sum=0.0
do 60 j=1,n-1
if(j.gt.1)l=0.5*(xl(j-1)+xl(j))
if(j.lt.(n-1))u=0.5*(xl(j+1)+xl(j))
if(j.eq.1)w=anordf((u-xx)/h)
if(j.eq.(n-1))w=1-anordf((l-xx)/h)
if(j.gt.1.and.j.lt.(n-1))w=
1 anordf((u-xx)/h)-anordf((l-xx)/h)
sum=sum+y(j)*w
60 continue
61 call rnund(1,n-1,ir)
c if(r(ir(1)).gt.3.6)goto 61
xs(i)=xs(i-1)*exp(sum+r(ir(1)))
xsl(i)=alog(xs(i))
ys(i-1)=xsl(i)-xsl(i-1)
51 continue
do 70 i=1,n-2
do 80 j=i+1,n-1
if(xsl(i).le.xsl(j))goto 80
hold=xsl(i)
xsl(i)=xsl(j)
xsl(j)=hold
hold=ys(i)
ys(i)=ys(j)
ys(j)=hold
80 continue
70 continue
do 300 i=1,n-1
xx=xsl(i)
sum=0.0
do 400 j=1,n-1
if(j.gt.1)l=0.5*(xsl(j-1)+xsl(j))
if(j.lt.(n-1))u=0.5*(xsl(j+1)+xsl(j))
if(j.eq.1)w=anordf((u-xx)/h)
if(j.eq.(n-1))w=1-anordf((l-xx)/h)
if(j.gt.1.and.j.lt.(n-1))w=
1 anordf((u-xx)/h)-anordf((l-xx)/h)
sum=sum+ys(j)*w
400 continue
fh(i)=sum
300 continue
ncross=0
do 100 i=2,n-1
if(fh(i-1).gt.0.0.and.fh(i).lt.0.0)ncross=ncross+1
100 continue
if(ncross.gt.1)ic=ic+1
write(5,*)kkk,ncross,ic
666 continue
write(5,*)ic
c
c
c
stop
end