Files
piscal/dataassim/math/othersupmath/grouping.f
2016-02-03 18:52:05 +00:00

75 lines
2.3 KiB
FortranFixed

! optimally group a gappy order time series into different sections with an average
! length
subroutine grouping(numpoints,time,windowsize,minnum,
&timestart,timeend,nsections,nrange,confirmvar,rangemin)
implicit none
integer numpoints,nsections,minnum,n,i,ipass,j,nrange
double precision time(numpoints),timestart(numpoints),
& timeend(numpoints),gap,windowsize,diff,fmin(nrange),
& fmax(nrange),confirmvar(nrange,numpoints),rangemin(nrange)
! the first mark is always time(1)-1.0d-9*time(1). time must be ordered from
! low to high
! rangemin is the minimum range of a variable in a section
nsections=1
n=0
timestart(nsections)=time(1)-1.0d-9*time(1)
do j=1,nrange
fmin(j)=confirmvar(j,1)
fmax(j)=confirmvar(j,1)
enddo
do i=2,numpoints
gap=time(i)-time(i-1)
if(gap.ge.windowsize.and.nsections.gt.1)then
! there is a large gap. Put all members in the current section into the previous
! section and start the current section from time(i)
timeend(nsections-1)=time(i-1)
timestart(nsections)=time(i)
n=0
do j=1,nrange
fmin(j)=confirmvar(j,i)
fmax(j)=confirmvar(j,i)
enddo
else
diff=time(i)-timestart(nsections)
do j=1,nrange
if(fmin(j).gt.confirmvar(j,i))then
fmin(j)=confirmvar(j,i)
endif
if(fmax(j).lt.confirmvar(j,i))then
fmax(j)=confirmvar(j,i)
endif
enddo
ipass=1
if(diff.lt.windowsize)then
ipass=0
endif
do j=1,nrange
if((fmax(j)-fmin(j)).lt.rangemin(j))then
ipass=0
endif
enddo
if(ipass.eq.0)then
n=n+1
else
if(n.ge.minnum)then
timeend(nsections)=time(i)
nsections=nsections+1
timestart(nsections)=time(i)
n=0
do j=1,nrange
fmin(j)=confirmvar(j,i)
fmax(j)=confirmvar(j,i)
enddo
else
n=n+1
endif
endif
endif
enddo
nsections=nsections-1
timeend(nsections)=time(numpoints)
return
end