126 lines
3.8 KiB
FortranFixed
126 lines
3.8 KiB
FortranFixed
subroutine VariabilityIndicies(nsamp,xvar,nthresh,threshold,
|
|
&shannon,coefvar,xmean,total,unevenness,standunevenness,
|
|
&arearatio,pvindex,meaninterval,maxinterval,xintensity)
|
|
implicit none
|
|
integer nsamp,i,nthresh,j,k
|
|
double precision xvar(nsamp),shannon,coefvar,xmean,total,
|
|
&unevenness,standunevenness,arearatio,cumline(nsamp),
|
|
&evenline(nsamp),areacum,areaeven,trans(nsamp),avetrans,
|
|
&pvindex,meaninterval(nthresh),maxinterval(nthresh),
|
|
&finterval(nsamp),fstart,threshold(nthresh),recumline(nsamp),
|
|
&repvi,retrans(nsamp),averetrans,xintensity
|
|
!
|
|
cumline(1)=xvar(1)
|
|
recumline(1)=xvar(nsamp)
|
|
k=0
|
|
if(xvar(1).gt.0.0d0)k=1
|
|
do i=2,nsamp
|
|
cumline(i)=cumline(i-1)+xvar(i)
|
|
recumline(i)=recumline(i-1)+xvar(nsamp-i+1)
|
|
if(xvar(i).gt.0.0d0)k=k+1
|
|
enddo
|
|
total=cumline(nsamp)
|
|
xmean=total/dble(nsamp)
|
|
if(k.gt.0)then
|
|
xintensity=total/dble(k)
|
|
else
|
|
xintensity=-9999.0d0
|
|
endif
|
|
if(nsamp.eq.1.or.total.le.0.0d0)then
|
|
shannon=-9999.0d0
|
|
coefvar=-9999.0d0
|
|
unevenness=-9999.0d0
|
|
standunevenness=-9999.0d0
|
|
arearatio=-9999.0d0
|
|
pvindex=-9999.0d0
|
|
repvi=-9999.0d0
|
|
do i=1,nthresh
|
|
meaninterval(i)=-9999.0d0
|
|
maxinterval(i)=-9999.0d0
|
|
enddo
|
|
return
|
|
endif
|
|
do i=1,nsamp
|
|
evenline(i)=xmean*dble(i)
|
|
enddo
|
|
unevenness=0.0d0
|
|
shannon=0.0d0
|
|
coefvar=0.0d0
|
|
avetrans=0.0d0
|
|
averetrans=0.0d0
|
|
do i=1,nsamp
|
|
unevenness=unevenness+(cumline(i)-evenline(i))*
|
|
&(cumline(i)-evenline(i))
|
|
trans(i)=(cumline(i)-evenline(i))/evenline(i)
|
|
! trans(i)=2.0d0*(cumline(i)-evenline(i))/(xmean*dble((nsamp+1)))
|
|
retrans(i)=(recumline(i)-evenline(i))/evenline(i)
|
|
avetrans=avetrans+trans(i)
|
|
averetrans=averetrans+retrans(i)
|
|
if(dabs(xvar(i)).gt.1.0d-10)then
|
|
shannon=shannon+(xvar(i)/total)*dlog(xvar(i)/total)
|
|
endif
|
|
coefvar=coefvar+(xvar(i)-xmean)*(xvar(i)-xmean)
|
|
enddo
|
|
|
|
! avetrans=0.0d0
|
|
! do i=1,nsamp
|
|
! trans(i)=trans(i)*retrans(nsamp-i+1)
|
|
! if(trans(i).lt.0.0d0)then
|
|
! trans(i)=-dsqrt(-trans(i))
|
|
! else
|
|
! trans(i)=dsqrt(trans(i))
|
|
! endif
|
|
! avetrans=avetrans+trans(i)
|
|
! enddo
|
|
|
|
coefvar=dsqrt(coefvar/dble(nsamp-1))/xmean
|
|
unevenness=dsqrt(unevenness/dble(nsamp))
|
|
standunevenness=unevenness/xmean
|
|
shannon=-shannon/dlog(dble(nsamp))
|
|
avetrans=avetrans/dble(nsamp)
|
|
averetrans=averetrans/dble(nsamp)
|
|
pvindex=0.0d0
|
|
repvi=0.0d0
|
|
do i=1,nsamp
|
|
pvindex=pvindex+(trans(i)-avetrans)*(trans(i)-avetrans)
|
|
repvi=repvi+(retrans(i)-averetrans)*(retrans(i)-averetrans)
|
|
enddo
|
|
pvindex=dsqrt(pvindex/dble(nsamp))
|
|
repvi=dsqrt(repvi/dble(nsamp))
|
|
|
|
! pvindex=(pvindex+repvi)/2.0d0
|
|
|
|
areacum=0.0d0
|
|
areaeven=0.0d0
|
|
do i=2,nsamp
|
|
areacum=areacum+(cumline(i)+cumline(i-1))*0.5d0
|
|
areaeven=areaeven+(evenline(i)+evenline(i-1))*0.5d0
|
|
enddo
|
|
arearatio=areacum/areaeven
|
|
!intervals
|
|
do i=1,nthresh
|
|
fstart=0.0d0
|
|
k=1
|
|
do j=1,nsamp
|
|
if(xvar(j).ge.threshold(i))then
|
|
finterval(k)=dble(j)-fstart-1.0d0
|
|
fstart=dble(j)
|
|
k=k+1
|
|
endif
|
|
enddo
|
|
if((dble(nsamp)-fstart).gt.0.5d0)then
|
|
finterval(k)=dble(nsamp)-fstart
|
|
else
|
|
k=k-1
|
|
endif
|
|
maxinterval(i)=finterval(1)
|
|
meaninterval(i)=finterval(1)
|
|
do j=2,k
|
|
if(finterval(j).gt.maxinterval(i))maxinterval(i)=finterval(j)
|
|
meaninterval(i)=meaninterval(i)+finterval(j)
|
|
enddo
|
|
meaninterval(i)=meaninterval(i)/dble(k)
|
|
enddo
|
|
return
|
|
end subroutine VariabilityIndicies
|