!Identifying the flat portion of a curve by computing the mean slope of !all possible pairs. Data must be ranked with xvar from low to high subroutine findplateau(npoints,xvar,yvar,iflat, & flatmean,radius) implicit none integer npoints,iflat(npoints),isoutlier_1side double precision xvar(npoints),yvar(npoints), & flatmean,radius,t0,ymax integer i,j,k,m,n,nstart,nend,isslopezero,no1,no2, & no3,nset double precision der(npoints*(npoints-1)/2),std,term, & student_t,slopemin,Sign_Level,coeffvar,coeffvarmin, & xx(npoints),yy(npoints),ainter,bslope,r,eps parameter(Sign_Level=0.90d0,eps=1.0d-6,nset=3) do i=1,npoints iflat(i)=1 enddo nend=-9999 nstart=0 slopemin=1.0d+9 coeffvarmin=1.0d+9 flatmean=-9999.0d0 radius=-9999.0d0 ymax=0.0d0 do i=1,nset ymax=ymax+yvar(i) enddo ymax=ymax/dble(nset) nstart=1 do i=2,npoints-nset+1 term=0.0d0 do j=i,i+nset-1 term=term+yvar(j) enddo term=term/dble(nset) if(term.ge.ymax)then ymax=term nstart=i endif enddo no1=nstart do i=nstart+1,nstart+nset-1 if(yvar(i).ge.yvar(no1))then no1=i endif enddo nstart=1 500 k=no1-nstart+1 if(k.lt.3)then nstart=no1 goto 510 endif do i=nstart,no1 xx(i-nstart+1)=xvar(i) yy(i-nstart+1)=yvar(i) enddo call linregres(k,xx,yy,Sign_Level,ainter, & bslope,r,radius,isslopezero) if(isslopezero.eq.-1)then nstart=nstart+1 goto 500 endif 510 nend=no1 if((nend-nstart+1).le.4)then k=nstart do i=1,k-1 do j=k,nend if(yvar(j).lt.yvar(i))then nstart=no1 endif enddo enddo endif nend=npoints 600 k=nend-no1+1 if(k.lt.3)then nend=no1 goto 610 endif do i=no1,nend xx(i-no1+1)=xvar(i) yy(i-no1+1)=yvar(i) enddo call linregres(k,xx,yy,Sign_Level,ainter, & bslope,r,radius,isslopezero) if(isslopezero.eq.-1)then nend=nend-1 goto 600 endif 610 if((nend-no1+1).le.4)then k=nend do i=k+1,npoints do j=no1,k if(yvar(j).lt.yvar(i))then nend=no1 endif enddo enddo endif if((nend-nstart).eq.0)then if(no1.eq.npoints)return if(no1.eq.1)then do i=1,npoints iflat(i)=3 enddo return endif nstart=no1-1 nend=no1 endif goto 100 !find the three largest value in yvar if(yvar(1).lt.yvar(2))then no1=2 no2=1 else no1=1 no2=2 endif if(yvar(3).ge.yvar(no1))then no3=no2 no2=no1 no1=3 else if(yvar(3).lt.yvar(no2))then no3=3 else no3=no2 no2=3 endif endif do i=4,npoints if(yvar(i).ge.yvar(no1))then no3=no2 no2=no1 no1=i else if(yvar(i).ge.yvar(no2))then no3=no2 no2=i else if(yvar(i).ge.yvar(no3))then no3=i endif endif endif enddo If(no1.gt.no2.and.no1.gt.no3)then nend=no1 if(no2.gt.no3)then nstart=no3 else nstart=no2 endif endif If(no2.gt.no1.and.no2.gt.no3)then nend=no2 if(no1.gt.no3)then nstart=no3 else nstart=no1 endif endif If(no3.gt.no1.and.no3.gt.no2)then nend=no3 if(no1.gt.no2)then nstart=no2 else nstart=no1 endif endif if(nstart.gt.1)then i=1 2 if(dabs(yvar(i)-yvar(no1)).lt.eps.or. & dabs(yvar(i)-yvar(no2)).lt.eps.or. & dabs(yvar(i)-yvar(no3)).lt.eps)then nstart=i goto 1 endif i=i+1 if(i.eq.nstart)goto 1 goto 2 endif 1 if(nend.lt.npoints)then i=nend+1 3 if(dabs(yvar(i)-yvar(no1)).lt.eps.or. & dabs(yvar(i)-yvar(no2)).lt.eps.or. & dabs(yvar(i)-yvar(no3)).lt.eps)then nend=i endif if(i.eq.npoints)goto 4 i=i+1 goto 3 endif 4 do i=nstart,nend xx(i-nstart+1)=xvar(i) yy(i-nstart+1)=yvar(i) enddo k=nend-nstart+1 call linregres(k,xx,yy,Sign_Level,ainter, & bslope,r,radius,isslopezero) if(isslopezero.eq.-1)then if(no1.eq.npoints)return if(no1.eq.nstart)then nstart=no1 nend=no1 goto 100 endif if(no1.gt.no2)then nstart=no2 nend=no1 else nstart=no1 nend=no2 endif goto 100 endif slopemin=dabs(bslope) call stdmean(k,yy,std,flatmean) coeffvarmin=std/flatmean 10 if(nend.eq.npoints)goto 50 if(no1.eq.nend)then if(dabs(yvar(nend+1)-yvar(no1)).lt.eps.or. & dabs(yvar(nend+1)-yvar(no2)).lt.eps.or. & dabs(yvar(nend+1)-yvar(no3)).lt.eps)then nend=nend+1 goto 10 else goto 50 endif endif do k=no1,nend+1 xx(k-no1+1)=xvar(k) yy(k-no1+1)=yvar(k) enddo k=nend+1-no1+1 call linregres(k,xx,yy,Sign_Level,ainter,bslope, & r,radius,isslopezero) if(isslopezero.eq.-1)goto 50 call stdmean(k,yy,std,flatmean) coeffvar=std/flatmean nend=nend+1 goto 10 50 if(nstart.eq.1)goto 100 if(no1.eq.nstart)then if(dabs(yvar(nstart-1)-yvar(no1)).lt.eps.or. & dabs(yvar(nstart-1)-yvar(no2)).lt.eps.or. & dabs(yvar(nstart-1)-yvar(no3)).lt.eps)then nstart=nstart-1 goto 50 else goto 100 endif endif do k=nstart-1,no1 xx(k-nstart+1+1)=xvar(k) yy(k-nstart+1+1)=yvar(k) enddo k=no1-(nstart-1)+1 call linregres(k,xx,yy,Sign_Level,ainter,bslope, & r,radius,isslopezero) if(isslopezero.eq.-1)goto 100 call stdmean(k,yy,std,flatmean) coeffvar=std/flatmean nstart=nstart-1 goto 50 100 if(nstart.le.nend)then n=0 do i=nstart,nend n=n+1 der(n)=yvar(i) enddo if(n.gt.1)then call stdmean(n,der,std,flatmean) t0=student_t(n-1,Sign_Level) radius=t0*std/dsqrt(dble(n)) else flatmean=der(1) radius=-9999.0d0 endif do i=1,nstart-1 iflat(i)=1 enddo do i=nstart,nend iflat(i)=2 enddo do i=nend+1,npoints iflat(i)=3 enddo if(n.gt.2)then k=isoutlier_1side(n,der,-1) if(k.eq.1)then iflat(nstart)=1 endif if(k.eq.n)then iflat(nend)=3 endif endif endif return end