Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,125 @@
+      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