!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
      subroutine phenoindices(ivexcave,ndim,beta,phenofunc,step,
     &nmaxextre,tstart,tend,nphenocycl,timemark,ishape,gpprefsp,
     &gppreffl,gpprefspday,gpprefflday,spinitday,gppatspinitday,psdlin,
     &gppatpsdlin,pddlin,gppatpddlin,fltermday,gppatfltermday,centerday,
     &effgrowleng,assimpotindex,effmaxgpp,spmaxder,spmaxderday,
     &spmaxdergpp,flmaxder,flmaxderday,flmaxdergpp,extremegpp,
     &extremegppday,paramskewness,paramkurtosis,gppphase1,gppphase2,
     &gppphase3,gppphase4,gppphase5,bellarea,gppmin,gppmax,timegppmin,
     &timegppmax,nmingpp,nmaxgpp,offcenterday,offeffgrowleng,
     &offassimpotindex,offeffmaxgpp,offparamskewness,offparamkurtosis,
     &offgppphase1,offgppphase2,offgppphase3,offgppphase4,offgppphase5)
      implicit none
!ivexcave =0, timemark provided for each pheno cycle, let the program determines the shape of each cycle 
!         =1, do convex indices, use minuma as timemark
!         =2, do concave indices, use maxima as timemark
      integer ivexcave,ndim,nmaxextre,nmingpp,nmaxgpp,i,nphenocycl,
     &ishape(nmaxextre)
      double precision beta(ndim),tstart,tend,step,
     &timemark(nphenocycl+1),gpprefsp(nmaxextre),gppreffl(nmaxextre),
     &gpprefspday(nmaxextre),gpprefflday(nmaxextre),
     &spinitday(nmaxextre),gppatspinitday(nmaxextre),psdlin(nmaxextre),
     &gppatpsdlin(nmaxextre),pddlin(nmaxextre),gppatpddlin(nmaxextre),
     &fltermday(nmaxextre),gppatfltermday(nmaxextre),
     &centerday(nmaxextre),effgrowleng(nmaxextre),
     &assimpotindex(nmaxextre),effmaxgpp(nmaxextre),spmaxder(nmaxextre),
     &spmaxderday(nmaxextre),spmaxdergpp(nmaxextre),flmaxder(nmaxextre),
     &flmaxderday(nmaxextre),flmaxdergpp(nmaxextre),
     &extremegpp(nmaxextre),extremegppday(nmaxextre),
     &paramskewness(nmaxextre),paramkurtosis(nmaxextre),
     &gppphase1(nmaxextre),gppphase2(nmaxextre),gppphase3(nmaxextre),
     &gppphase4(nmaxextre),gppphase5(nmaxextre),bellarea(nmaxextre),
     &gppmin(nmaxextre),gppmax(nmaxextre),timegppmin(nmaxextre),
     &timegppmax(nmaxextre),offcenterday(nmaxextre),
     &offeffgrowleng(nmaxextre),offassimpotindex(nmaxextre),
     &offeffmaxgpp(nmaxextre),offparamskewness(nmaxextre),
     &offparamkurtosis(nmaxextre),offgppphase1(nmaxextre),
     &offgppphase2(nmaxextre),offgppphase3(nmaxextre),
     &offgppphase4(nmaxextre),offgppphase5(nmaxextre)
      external phenofunc
      call extremaviader(ndim,beta,phenofunc,step,nmaxextre,
     &tstart,tend,gppmin,gppmax,timegppmin,timegppmax,nmingpp,
     &nmaxgpp)
      if(ivexcave.eq.1.or.ivexcave.eq.2)then
        if(ivexcave.eq.1)then
          nphenocycl=nmingpp-1
          do i=1,nmingpp-1
            call bellindices(ndim,beta,phenofunc,timegppmin(i),
     &timegppmin(i+1),step,ishape(i),gpprefsp(i),gppreffl(i),
     &gpprefspday(i),gpprefflday(i),spinitday(i),
     &gppatspinitday(i),psdlin(i),gppatpsdlin(i),pddlin(i),
     &gppatpddlin(i),fltermday(i),gppatfltermday(i),centerday(i),
     &effgrowleng(i),assimpotindex(i),effmaxgpp(i),spmaxder(i),
     &spmaxderday(i),spmaxdergpp(i),flmaxder(i),flmaxderday(i),
     &flmaxdergpp(i),extremegpp(i),extremegppday(i),paramskewness(i),
     &paramkurtosis(i),gppphase1(i),gppphase2(i),gppphase3(i),
     &gppphase4(i),gppphase5(i),bellarea(i),offcenterday(i),
     &offeffgrowleng(i),offassimpotindex(i),offeffmaxgpp(i),
     &offparamskewness(i),offparamkurtosis(i),offgppphase1(i),
     &offgppphase2(i),offgppphase3(i),offgppphase4(i),offgppphase5(i))
          enddo
        endif
        if(ivexcave.eq.2)then
          nphenocycl=nmaxgpp-1
          do i=1,nmaxgpp-1
            call bellindices(ndim,beta,phenofunc,timegppmax(i),
     &timegppmax(i+1),step,ishape(i),gpprefsp(i),gppreffl(i),
     &gpprefspday(i),gpprefflday(i),spinitday(i),
     &gppatspinitday(i),psdlin(i),gppatpsdlin(i),pddlin(i),
     &gppatpddlin(i),fltermday(i),gppatfltermday(i),centerday(i),
     &effgrowleng(i),assimpotindex(i),effmaxgpp(i),spmaxder(i),
     &spmaxderday(i),spmaxdergpp(i),flmaxder(i),flmaxderday(i),
     &flmaxdergpp(i),extremegpp(i),extremegppday(i),paramskewness(i),
     &paramkurtosis(i),gppphase1(i),gppphase2(i),gppphase3(i),
     &gppphase4(i),gppphase5(i),bellarea(i),offcenterday(i),
     &offeffgrowleng(i),offassimpotindex(i),offeffmaxgpp(i),
     &offparamskewness(i),offparamkurtosis(i),offgppphase1(i),
     &offgppphase2(i),offgppphase3(i),offgppphase4(i),offgppphase5(i))
          enddo
        endif
      else
        do i=1,nphenocycl
          call bellindices(ndim,beta,phenofunc,timemark(i),
     &timemark(i+1),step,ishape(i),gpprefsp(i),gppreffl(i),
     &gpprefspday(i),gpprefflday(i),spinitday(i),
     &gppatspinitday(i),psdlin(i),gppatpsdlin(i),pddlin(i),
     &gppatpddlin(i),fltermday(i),gppatfltermday(i),centerday(i),
     &effgrowleng(i),assimpotindex(i),effmaxgpp(i),spmaxder(i),
     &spmaxderday(i),spmaxdergpp(i),flmaxder(i),flmaxderday(i),
     &flmaxdergpp(i),extremegpp(i),extremegppday(i),paramskewness(i),
     &paramkurtosis(i),gppphase1(i),gppphase2(i),gppphase3(i),
     &gppphase4(i),gppphase5(i),bellarea(i),offcenterday(i),
     &offeffgrowleng(i),offassimpotindex(i),offeffmaxgpp(i),
     &offparamskewness(i),offparamkurtosis(i),offgppphase1(i),
     &offgppphase2(i),offgppphase3(i),offgppphase4(i),offgppphase5(i))
        enddo
      endif
      return
      end
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
      subroutine bellindices(ndim,beta,phenofunc,firstday,lastday,
     &step,ishape,gpprefsp,gppreffl,gpprefspday,gpprefflday,
     &spinitday,gppatspinitday,psdlin,gppatpsdlin,pddlin,gppatpddlin,
     &fltermday,gppatfltermday,centerday,effgrowleng,assimpotindex,
     &effmaxgpp,spmaxder,spmaxderday,spmaxdergpp,flmaxder,flmaxderday,
     &flmaxdergpp,extremegpp,extremegppday,paramskewness,paramkurtosis,
     &gppphase1,gppphase2,gppphase3,gppphase4,gppphase5,bellarea,
     &offcenterday,offeffgrowleng,offassimpotindex,offeffmaxgpp,
     &offparamskewness,offparamkurtosis,offgppphase1,offgppphase2,
     &offgppphase3,offgppphase4,offgppphase5)
      implicit none
      integer ishape,ndim,nmaxextre
      parameter(nmaxextre=500)
      double precision beta(ndim),step,firstday,lastday,
     &gpprefsp,gppreffl,gpprefspday,gpprefflday,
     &spinitday,gppatspinitday,psdlin,gppatpsdlin,
     &pddlin,gppatpddlin,fltermday,gppatfltermday,centerday,
     &effgrowleng,assimpotindex,effmaxgpp,spmaxder,spmaxderday,
     &spmaxdergpp,flmaxder,flmaxderday,flmaxdergpp,extremegpp,
     &extremegppday,paramskewness,paramkurtosis,gppphase1,gppphase2,
     &gppphase3,gppphase4,gppphase5,bellarea,dydxp(ndim+1),
     &offcenterday,offeffgrowleng,offassimpotindex,offeffmaxgpp,
     &offparamskewness,offparamkurtosis,offgppphase1,offgppphase2,
     &offgppphase3,offgppphase4,offgppphase5
      double precision p1int,p2int,p3int,day,term,funcint,tfuncint,
     &sqtcentfunc,skewness,fkurtosis,fintercept,sigma,gppmin(nmaxextre),
     &gppmax(nmaxextre),timegppmin(nmaxextre),timegppmax(nmaxextre),
     &gppmin_der(nmaxextre),gppmax_der(nmaxextre),offset,
     &timegppmin_der(nmaxextre),timegppmax_der(nmaxextre)
      integer n,i,nmingpp,nmaxgpp,nmingpp_der,nmaxgpp_der
      external phenofunc
!
      call extremaviader(ndim,beta,phenofunc,step,nmaxextre,
     &firstday,lastday,gppmin,gppmax,timegppmin,timegppmax,nmingpp,
     &nmaxgpp)
      call findextrema(1,ndim,beta,phenofunc,step,nmaxextre,
     &firstday,lastday,gppmin_der,gppmax_der,timegppmin_der,
     &timegppmax_der,nmingpp_der,nmaxgpp_der)
!determine whether it is a convex (bell) shape or a concave (reverse-bess) shape.
!A convex shape has the largest function value located between the sharpest ascend and the sharpest descend (ascend first).
!A concave shape has the smallest fuction value located between the sharpest descend and the sharpest ascend (descend first).
!largest function value
      extremegpp=gppmax(1)
      extremegppday=timegppmax(1)
      do i=2,nmaxgpp
        if(gppmax(i).gt.extremegpp)then
          extremegpp=gppmax(i)
          extremegppday=timegppmax(i)
        endif
      enddo
!most positive derivative
      spmaxder=gppmax_der(1)
      spmaxderday=timegppmax_der(1)
      do i=2,nmaxgpp_der
        if(gppmax_der(i).gt.spmaxder)then
          spmaxder=gppmax_der(i)
          spmaxderday=timegppmax_der(i)
        endif
      enddo
      call phenofunc(1,spmaxdergpp,1,spmaxderday,ndim,beta,dydxp,0)
!most negative derivative
      flmaxder=gppmin_der(1)
      flmaxderday=timegppmin_der(1)
      do i=2,nmingpp_der
        if(gppmin_der(i).lt.flmaxder)then
          flmaxder=gppmin_der(i)
          flmaxderday=timegppmin_der(i)
        endif
      enddo
      call phenofunc(1,flmaxdergpp,1,flmaxderday,ndim,beta,dydxp,0)
      if(flmaxderday.ge.extremegppday.and.
     &extremegppday.ge.spmaxderday)then
!it is a convex
        ishape=1
      else
!try concave
!smallest function value
        extremegpp=gppmin(1)
        extremegppday=timegppmin(1)
        do i=2,nmingpp
          if(gppmin(i).lt.extremegpp)then
            extremegpp=gppmin(i)
            extremegppday=timegppmin(i)
          endif
        enddo
        call fortranswap(1,spmaxder,flmaxder)
        call fortranswap(1,spmaxderday,flmaxderday)
        call fortranswap(1,spmaxdergpp,flmaxdergpp)
!now flmaxder is most positive and spmaxder is most negative
        if(flmaxderday.ge.extremegppday.and.
     &extremegppday.ge.spmaxderday)then
!it is a concave
          ishape=2
        else
!the general shape is unrecognized. use the local shape
          if(flmaxderday.lt.spmaxderday)then
            call fortranswap(1,spmaxder,flmaxder)
            call fortranswap(1,spmaxderday,flmaxderday)
            call fortranswap(1,spmaxdergpp,flmaxdergpp)
!now spmaxder is most positive and flmaxder is most negative
!a small bell
            ishape=-1
          else
!a small revese-bell
            ishape=-2           
          endif
          call extremaviader(ndim,beta,phenofunc,step,nmaxextre,
     &spmaxderday,flmaxderday,gppmin,gppmax,timegppmin,timegppmax,
     &nmingpp,nmaxgpp)
          if(ishape.eq.-1)then
            extremegpp=gppmax(1)
            extremegppday=timegppmax(1)
            do i=2,nmaxgpp
              if(gppmax(i).gt.extremegpp)then
                extremegpp=gppmax(i)
                extremegppday=timegppmax(i)
              endif
            enddo
          else
            extremegpp=gppmin(1)
            extremegppday=timegppmin(1)
            do i=2,nmingpp
              if(gppmin(i).lt.extremegpp)then
                extremegpp=gppmin(i)
                extremegppday=timegppmin(i)
              endif
            enddo
          endif
        endif
      endif
!find reference gpp
      call extremaviader(ndim,beta,phenofunc,step,nmaxextre,firstday,
     &spmaxderday,gppmin,gppmax,timegppmin,timegppmax,nmingpp,nmaxgpp)
      if(ishape.eq.1.or.ishape.eq.-1)then
        gpprefsp=gppmin(1)
        gpprefspday=timegppmin(1)
        do i=2,nmingpp
          if(gppmin(i).lt.gpprefsp)then
            gpprefsp=gppmin(i)
            gpprefspday=timegppmin(i)
          endif
        enddo
      else
        gpprefsp=gppmax(1)
        gpprefspday=timegppmax(1)
        do i=2,nmaxgpp
          if(gppmax(i).lt.gpprefsp)then
            gpprefsp=gppmax(i)
            gpprefspday=timegppmax(i)
          endif
        enddo
      endif
      call extremaviader(ndim,beta,phenofunc,step,nmaxextre,flmaxderday,
     &lastday,gppmin,gppmax,timegppmin,timegppmax,nmingpp,nmaxgpp)
      if(ishape.eq.1.or.ishape.eq.-1)then
        gppreffl=gppmin(1)
        gpprefflday=timegppmin(1)
        do i=2,nmingpp
          if(gppmin(i).lt.gppreffl)then
            gppreffl=gppmin(i)
            gpprefflday=timegppmin(i)
          endif
        enddo
      else
        gppreffl=gppmax(1)
        gpprefflday=timegppmax(1)
        do i=2,nmaxgpp
          if(gppmax(i).lt.gppreffl)then
            gppreffl=gppmax(i)
            gpprefflday=timegppmax(i)
          endif
        enddo
      endif
! spring
180   fintercept=spmaxdergpp-spmaxder*spmaxderday
      spinitday=(gpprefsp-fintercept)/spmaxder
      call phenofunc(1,gppatspinitday,1,spinitday,ndim,beta,dydxp,0)
      psdlin=(extremegpp-fintercept)/spmaxder
      call phenofunc(1,gppatpsdlin,1,psdlin,ndim,beta,dydxp,0)
! fall
      fintercept=flmaxdergpp-flmaxder*flmaxderday
      fltermday=(gppreffl-fintercept)/flmaxder
      call phenofunc(1,gppatfltermday,1,fltermday,ndim,beta,dydxp,0)
      pddlin=(extremegpp-fintercept)/flmaxder
      call phenofunc(1,gppatpddlin,1,pddlin,ndim,beta,dydxp,0)
!
!first no offset
      offset=0.0d0
      assimpotindex=funcint(ndim,beta,phenofunc,firstday,lastday,offset)
      p2int=tfuncint(ndim,beta,phenofunc,firstday,lastday,offset)
      centerday=p2int/assimpotindex
      p3int=sqtcentfunc(ndim,beta,phenofunc,firstday,lastday,centerday,
     &offset)
      sigma=dsqrt(p3int/assimpotindex)
      effgrowleng=2.0d0*dsqrt(3.0d0)*sigma
      effmaxgpp=assimpotindex/effgrowleng
      paramskewness=
     &skewness(ndim,beta,phenofunc,firstday,lastday,centerday,offset)
      paramskewness=paramskewness/
     &              (assimpotindex*sigma*sigma*sigma)
      paramkurtosis=
     &fkurtosis(ndim,beta,phenofunc,firstday,lastday,centerday,offset)
      paramkurtosis=paramkurtosis/
     &         (assimpotindex*sigma*sigma*sigma*sigma)
      paramkurtosis=paramkurtosis-3.0d0
      gppphase1=funcint(ndim,beta,phenofunc,firstday,spinitday,offset)
      gppphase2=funcint(ndim,beta,phenofunc,spinitday,psdlin,offset)
      gppphase3=funcint(ndim,beta,phenofunc,psdlin,pddlin,offset)
      gppphase4=funcint(ndim,beta,phenofunc,pddlin,fltermday,offset)
      gppphase5=funcint(ndim,beta,phenofunc,fltermday,lastday,offset)
      bellarea=funcint(ndim,beta,phenofunc,gpprefspday,gpprefflday,
     &offset)
      bellarea=bellarea-0.5d0*(gpprefsp+gppreffl)*
     &(gpprefflday-gpprefspday)
!
!with offset
      offset=0.5d0*(gpprefsp+gppreffl)
      offassimpotindex=funcint(ndim,beta,phenofunc,gpprefspday,
     &gpprefflday,offset)
      p2int=tfuncint(ndim,beta,phenofunc,gpprefspday,gpprefflday,offset)
      offcenterday=p2int/offassimpotindex
      p3int=sqtcentfunc(ndim,beta,phenofunc,gpprefspday,gpprefflday,
     &offcenterday,offset)
      sigma=dsqrt(p3int/offassimpotindex)
      offeffgrowleng=2.0d0*dsqrt(3.0d0)*sigma
      offeffmaxgpp=offassimpotindex/offeffgrowleng
      offparamskewness=
     &skewness(ndim,beta,phenofunc,gpprefspday,gpprefflday,
     &offcenterday,offset)
      offparamskewness=offparamskewness/
     &(offassimpotindex*sigma*sigma*sigma)
      offparamkurtosis=fkurtosis(ndim,beta,phenofunc,gpprefspday,
     &gpprefflday,offcenterday,offset)/
     &(offassimpotindex*sigma*sigma*sigma*sigma)-3.0d0
      offgppphase1=
     &funcint(ndim,beta,phenofunc,gpprefspday,spinitday,offset)
      offgppphase2=
     &funcint(ndim,beta,phenofunc,spinitday,psdlin,offset)
      offgppphase3=funcint(ndim,beta,phenofunc,psdlin,pddlin,offset)
      offgppphase4=funcint(ndim,beta,phenofunc,pddlin,fltermday,offset)
      offgppphase5=funcint(ndim,beta,phenofunc,fltermday,
     &gpprefflday,offset)
      return
      end
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
      double precision function sqfuncint(ndim,beta,phenofunc,
     &day1st,dayend,offset)
      implicit double precision(a-h,l,o-z)
      dimension dayquad(8),weit(8),beta(ndim),dydxp(ndim+1)
      parameter(nside=10000)
      external phenofunc
c      
      cell=(dayend-day1st)/dble(nside)
      sum = 0.0d0
      do 30 m = 1, nside
        day0 = day1st+dble(m-1)*cell
        day1 = day1st+dble(m)*cell
        call quadrat(day0, day1, dayquad, weit, fact1)
        do 40 n = 1, 8
          call phenofunc(1,func,1,dayquad(n),ndim,beta,dydxp,0)
          func=func-offset
          sum = sum+func*func*weit(n)*fact1
40      continue
30    continue
      sqfuncint=sum
      return
      end
c       
      double precision function tsqfuncint(ndim,beta,phenofunc,
     &day1st,dayend,offset)
      implicit double precision(a-h,l,o-z)
      dimension dayquad(8),weit(8),beta(ndim),dydxp(ndim+1)
      parameter(nside=10000)
      external phenofunc
c      
      cell=(dayend-day1st)/dble(nside)
      sum = 0.0d0
      do 30 m = 1, nside
        day0 = day1st+dble(m-1)*cell
        day1 = day1st+dble(m)*cell
        call quadrat(day0, day1, dayquad, weit, fact1)
        do 40 n = 1, 8
          call phenofunc(1,func,1,dayquad(n),ndim,beta,dydxp,0)
          func=func-offset
          sum = sum+dayquad(n)*func*func*weit(n)*fact1
40      continue
30    continue
      tsqfuncint=sum
      return
      end
      
      double precision function tfuncint(ndim,beta,phenofunc,
     &day1st,dayend,offset)
      implicit double precision(a-h,l,o-z)
      dimension dayquad(8),weit(8),beta(ndim),dydxp(ndim+1)
      parameter(nside=10000)
      external phenofunc
c      
      cell=(dayend-day1st)/dble(nside)
      sum = 0.0d0
      do 30 m = 1, nside
        day0 = day1st+dble(m-1)*cell
        day1 = day1st+dble(m)*cell
        call quadrat(day0, day1, dayquad, weit, fact1)
        do 40 n = 1, 8
          call phenofunc(1,func,1,dayquad(n),ndim,beta,dydxp,0)
          func=func-offset
          sum = sum+dayquad(n)*func*weit(n)*fact1
40      continue
30    continue
      tfuncint=sum
      return
      end           
c
      double precision function sqtcentsqfunc(ndim,beta,phenofunc,
     &day1st,dayend,daymid,offset)
      implicit double precision(a-h,l,o-z)
      dimension dayquad(8),weit(8),beta(ndim),dydxp(ndim+1)
      parameter(nside=10000)
      external phenofunc
c      
      cell=(dayend-day1st)/dble(nside)
      sum = 0.0d0
      do 30 m = 1, nside
        day0 = day1st+dble(m-1)*cell
        day1 = day1st+dble(m)*cell
        call quadrat(day0, day1, dayquad, weit, fact1)
        do 40 n = 1, 8
          call phenofunc(1,func,1,dayquad(n),ndim,beta,dydxp,0)
          func=func-offset
          sum = sum+(dayquad(n)-daymid)*(dayquad(n)-daymid)*
     &func*func*weit(n)*fact1
40      continue
30    continue
      sqtcentsqfunc=sum
      return
      end
      
      double precision function sqtcentfunc(ndim,beta,phenofunc,
     &day1st,dayend,daymid,offset)
      implicit double precision(a-h,l,o-z)
      dimension dayquad(8),weit(8),beta(ndim),dydxp(ndim+1)
      parameter(nside=10000)
      external phenofunc
c      
      cell=(dayend-day1st)/dble(nside)
      sum = 0.0d0
      do 30 m = 1, nside
        day0 = day1st+dble(m-1)*cell
        day1 = day1st+dble(m)*cell
        call quadrat(day0, day1, dayquad, weit, fact1)
        do 40 n = 1, 8
          call phenofunc(1,func,1,dayquad(n),ndim,beta,dydxp,0)
          func=func-offset
          sum = sum+(dayquad(n)-daymid)*(dayquad(n)-daymid)*
     &func*weit(n)*fact1
40      continue
30    continue
      sqtcentfunc=sum
      return
      end
      
      double precision function skewness(ndim,beta,phenofunc,
     &day1st,dayend,daymid,offset)
      implicit double precision(a-h,l,o-z)
      dimension dayquad(8),weit(8),beta(ndim),dydxp(ndim+1)
      parameter(nside=10000)
      external phenofunc
c      
      cell=(dayend-day1st)/dble(nside)
      sum = 0.0d0
      do 30 m = 1, nside
        day0 = day1st+dble(m-1)*cell
        day1 = day1st+dble(m)*cell
        call quadrat(day0, day1, dayquad, weit, fact1)
        do 40 n = 1, 8
          call phenofunc(1,func,1,dayquad(n),ndim,beta,dydxp,0)
          func=func-offset
          sum = sum+(dayquad(n)-daymid)*(dayquad(n)-daymid)*
     &          (dayquad(n)-daymid)*func*weit(n)*fact1
40      continue
30    continue
      skewness=sum
      return
      end 
c
      double precision function fkurtosis(ndim,beta,phenofunc,
     &day1st,dayend,daymid,offset)
      implicit double precision(a-h,l,o-z)
      dimension dayquad(8),weit(8),beta(ndim),dydxp(ndim+1)
      parameter(nside=10000)
      external phenofunc
c      
      cell=(dayend-day1st)/dble(nside)
      sum = 0.0d0
      do 30 m = 1, nside
        day0 = day1st+dble(m-1)*cell
        day1 = day1st+dble(m)*cell
        call quadrat(day0, day1, dayquad, weit, fact1)
        do 40 n = 1, 8
          call phenofunc(1,func,1,dayquad(n),ndim,beta,dydxp,0)
          func=func-offset
          sum = sum+(dayquad(n)-daymid)*(dayquad(n)-daymid)*
     &          (dayquad(n)-daymid)*(dayquad(n)-daymid)*
     &          func*weit(n)*fact1
40      continue
30    continue
      fkurtosis=sum
      return
      end 

      double precision function funcint(ndim,beta,phenofunc,
     &day1st,dayend,offset)
      implicit double precision(a-h,l,o-z)
      dimension dayquad(8),weit(8),beta(ndim),dydxp(ndim+1)
      parameter(nside=10000)
      external phenofunc
c      
      cell=(dayend-day1st)/dble(nside)
      sum = 0.0d0
      do 30 m = 1, nside
        day0 = day1st+dble(m-1)*cell
        day1 = day1st+dble(m)*cell
        call quadrat(day0, day1, dayquad, weit, fact1)
        do 40 n = 1, 8
          call phenofunc(1,func,1,dayquad(n),ndim,beta,dydxp,0)
          func=func-offset
          sum = sum+func*weit(n)*fact1
40      continue
30    continue
      funcint=sum
      return
      end
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
      subroutine findextrema(idowhat,ndim,beta,phenofunc,step,
     &nmaxextre,tstart,tend,gppmin,gppmax,timegppmin,timegppmax,
     &nmingpp,nmaxgpp)
      implicit none
!idowhat=0, function value extremes
!idowhat=1, function devatives extrems
      integer idowhat,ndim,nmaxextre,nmingpp,nmaxgpp
      double precision beta(ndim),tstart,tend,step,gppmin(nmaxextre),
     &gppmax(nmaxextre),timegppmin(nmaxextre),timegppmax(nmaxextre),
     &gpp0,time,gpp1,t0,dydxp(ndim+1)
      integer istatus,iup,idn,iuptoflat,idntoflat
      parameter(iup=1,idn=2,iuptoflat=4,idntoflat=5)
      external phenofunc
!------------------------------------------------------------------
! find maxima and minima in gpp
      t0=tstart
      nmaxgpp=0
      nmingpp=0
      call phenofunc(1,gpp0,1,t0,ndim,beta,dydxp,idowhat)
      if(idowhat.eq.1)gpp0=dydxp(1)
      time=t0+step
      call phenofunc(1,gpp1,1,time,ndim,beta,dydxp,idowhat)
      if(idowhat.eq.1)gpp1=dydxp(1)
      if(gpp1.gt.gpp0)then
! gpp increases so gpp0 must be a minimum
        nmingpp=1
        gppmin(1)=gpp0
        timegppmin(1)=t0
        istatus=iup
      else
        if(gpp1.lt.gpp0)then
! gpp decreases so gpp0 must be a maximum
          nmaxgpp=1
          gppmax(1)=gpp0
          timegppmax(1)=t0
          istatus=idn
        else
! gpp flat
          istatus=-9999
        endif
      endif
50    gpp0=gpp1
      time=time+step
      call phenofunc(1,gpp1,1,time,ndim,beta,dydxp,idowhat)
      if(idowhat.eq.1)gpp1=dydxp(1)
      if(gpp1.gt.gpp0)then
! increase
        if(istatus.eq.iup)then
! still increase
          if(time.ge.tend)then
            nmaxgpp=nmaxgpp+1
            call
     &phenofunc(1,gppmax(nmaxgpp),1,tend,ndim,beta,dydxp,idowhat)
            if(idowhat.eq.1)gppmax(nmaxgpp)=dydxp(1)
            timegppmax(nmaxgpp)=tend
            goto 1000
          else
            goto 50
          endif
        endif
        if(istatus.eq.idn)then
! previous down but now up so a minimum is reached
          nmingpp=nmingpp+1
          gppmin(nmingpp)=gpp0
          timegppmin(nmingpp)=time-step
          if(time.ge.tend)then
            timegppmin(nmingpp)=tend
            call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,idowhat)
            if(idowhat.eq.1)gppmin(nmingpp)=dydxp(1)
            goto 1000
          endif
          istatus=iup
          goto 50
        endif
!previous step flat
        if(istatus.eq.iuptoflat)then
!going up to flat and then going up again. ignore this staircase.
          istatus=iup
          goto 50
        endif
        if(istatus.eq.idntoflat)then
!going down to flat and then going up so the flat represents a minimum. set the time
!stamp at the center of the flat. t0 is when the flat starts
          nmingpp=nmingpp+1
          timegppmin(nmingpp)=(t0+time-step)/2.0d0
          call phenofunc(1,gppmin(nmingpp),1,timegppmin(nmingpp),
     &ndim,beta,dydxp,idowhat)
          if(idowhat.eq.1)gppmin(nmingpp)=dydxp(1)
          if(time.ge.tend)then
            timegppmin(nmingpp)=tend
            call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,idowhat)
            if(idowhat.eq.1)gppmin(nmingpp)=dydxp(1)
            goto 1000
          endif
          istatus=iup
          goto 50
        else
!flat begining of the curve and then going up so the begining is a minimum
          nmingpp=nmingpp+1
          timegppmin(nmingpp)=t0
          call phenofunc(1,gppmin(nmingpp),1,t0,ndim,beta,dydxp,idowhat)
          if(idowhat.eq.1)gppmin(nmingpp)=dydxp(1)
          istatus=iup
          goto 50
        endif
      else
        if(gpp1.lt.gpp0)then
! decrease
          if(istatus.eq.idn)then
! still decrease
            if(time.ge.tend)then
              nmingpp=nmingpp+1
              call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,idowhat)
              if(idowhat.eq.1)gppmin(nmingpp)=dydxp(1)
              timegppmin(nmingpp)=tend
              goto 1000
            else
              goto 50
            endif
          endif
          if(istatus.eq.iup)then
! previous up but now down so a maximum is reached
            nmaxgpp=nmaxgpp+1
            gppmax(nmaxgpp)=gpp0
            timegppmax(nmaxgpp)=time-step
            if(time.ge.tend)then
              timegppmax(nmaxgpp)=tend
              call
     &phenofunc(1,gppmax(nmaxgpp),1,tend,ndim,beta,dydxp,idowhat)
              if(idowhat.eq.1)gppmax(nmaxgpp)=dydxp(1)
              goto 1000
            endif
            istatus=idn
            goto 50
          endif
! previous flat
          if(istatus.eq.idntoflat)then
!going down to flat and then going down again. ignore this staircase
            istatus=idn
            goto 50
          endif
          if(istatus.eq.iuptoflat)then
!going up to flat and then going down so the flat represents a maximum
            nmaxgpp=nmaxgpp+1
            timegppmax(nmaxgpp)=(t0+time-step)/2.0d0
            call phenofunc(1,gppmax(nmaxgpp),1,timegppmax(nmaxgpp),
     &ndim,beta,dydxp,idowhat)
            if(idowhat.eq.1)gppmax(nmaxgpp)=dydxp(1)
            if(time.ge.tend)then
              timegppmax(nmaxgpp)=tend
              call phenofunc(1,gppmax(nmaxgpp),1,timegppmax(nmaxgpp),
     &ndim,beta,dydxp,idowhat)
              if(idowhat.eq.1)gppmax(nmaxgpp)=dydxp(1)
              goto 1000
            endif
            istatus=idn
            goto 50
          else
!flat begining of the curve and then going down so the begining is a maximum
            nmaxgpp=nmaxgpp+1
            timegppmax(nmaxgpp)=t0
            call phenofunc(1,gppmax(nmaxgpp),1,timegppmax(nmaxgpp),
     &ndim,beta,dydxp,idowhat)
            if(idowhat.eq.1)gppmax(nmaxgpp)=dydxp(1)
            istatus=idn
            goto 50
          endif
        else
! a flat place
          if(istatus.eq.iup)then
! up to flat
            if(time.ge.tend)then
              nmaxgpp=nmaxgpp+1
              timegppmax(nmaxgpp)=tend
              call
     &phenofunc(1,gppmax(nmaxgpp),1,tend,ndim,beta,dydxp,idowhat)
              if(idowhat.eq.1)gppmax(nmaxgpp)=dydxp(1)
              goto 1000
            endif
            istatus=iuptoflat
            t0=time-step
            goto 50
          endif
          if(istatus.eq.idn)then
! down to flat
            if(time.ge.tend)then
              nmingpp=nmingpp+1
              timegppmin(nmingpp)=tend
              call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,idowhat)
              if(idowhat.eq.1)gppmin(nmingpp)=dydxp(1)
              goto 1000
            endif
            istatus=idntoflat
            t0=time-step
            goto 50
          endif
! remain on a flat. no information is recorded unless at the end.
          if(time.ge.tend)then
            if(istatus.eq.iuptoflat)then       
              nmaxgpp=nmaxgpp+1
              timegppmax(nmaxgpp)=tend
              call
     &phenofunc(1,gppmax(nmaxgpp),1,tend,ndim,beta,dydxp,idowhat)
              if(idowhat.eq.1)gppmax(nmaxgpp)=dydxp(1)
            else
              if(istatus.eq.idntoflat)then
                nmingpp=nmingpp+1
                timegppmin(nmingpp)=tend
                call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,idowhat)
                if(idowhat.eq.1)gppmin(nmingpp)=dydxp(1)
              else
!a horizontal line
                return
              endif      
            endif
            goto 1000
          endif
          goto 50
        endif
      endif
1000  return
      end
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
      subroutine extremaviader(ndim,beta,phenofunc,step,nmaxextre,
     &tstart,tend,gppmin,gppmax,timegppmin,timegppmax,nmingpp,nmaxgpp)
      implicit none
!find function value extremes only via changes in derivatives.
!Do not use this subroutine to find extremes of derivatives. use findextrema instead
      integer ndim,nmaxextre,nmingpp,nmaxgpp
      double precision beta(ndim),tstart,tend,step,gppmin(nmaxextre),
     &gppmax(nmaxextre),timegppmin(nmaxextre),timegppmax(nmaxextre),
     &gpp0,time,t0,dydxp(ndim+1)
      integer istatus,iup,idn,iuptoflat,idntoflat
      parameter(iup=1,idn=2,iuptoflat=4,idntoflat=5)
      external phenofunc
!------------------------------------------------------------------
! find maxima and minima in gpp
      time=tstart
      nmaxgpp=0
      nmingpp=0
      call phenofunc(1,gpp0,1,time,ndim,beta,dydxp,1)
      if(dydxp(1).gt.0.0d0)then
! gpp increases so gpp0 must be a minimum
        nmingpp=1
        gppmin(1)=gpp0
        timegppmin(1)=time
        istatus=iup
      else
        if(dydxp(1).lt.0.0d0)then
! gpp decreases so gpp0 must be a maximum
          nmaxgpp=1
          gppmax(1)=gpp0
          timegppmax(1)=time
          istatus=idn
        else
! gpp flat in the begining
          istatus=-9999
        endif
      endif
50    time=time+step
      call phenofunc(1,gpp0,1,time,ndim,beta,dydxp,1)
      if(dydxp(1).gt.0.0d0)then
! increase
        if(istatus.eq.iup)then
! still increase
          if(time.ge.tend)then
            nmaxgpp=nmaxgpp+1
            call
     &phenofunc(1,gppmax(nmaxgpp),1,tend,ndim,beta,dydxp,0)
            timegppmax(nmaxgpp)=tend
            goto 1000
          else
            goto 50
          endif
        endif
        if(istatus.eq.idn)then
! previous down but now up so a minimum is reached
          nmingpp=nmingpp+1
          if(time.ge.tend)then
            timegppmin(nmingpp)=tend
            call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,0)
            goto 1000
          endif
          time=time-step/2.0d0
          timegppmin(nmingpp)=time
          call
     &phenofunc(1,gppmin(nmingpp),1,time,ndim,beta,dydxp,0)
          istatus=iup
          goto 50
        endif
!previous step flat
        if(istatus.eq.iuptoflat)then
!going up to flat and then going up again. ignore this staircase.
          istatus=iup
          goto 50
        endif
        if(istatus.eq.idntoflat)then
!going down to flat and then going up so the flat represents a minimum. set the time
!stamp at the center of the flat. t0 is when the flat starts
          nmingpp=nmingpp+1
          timegppmin(nmingpp)=(t0+time-step)/2.0d0
          call phenofunc(1,gppmin(nmingpp),1,timegppmin(nmingpp),
     &ndim,beta,dydxp,0)
          if(time.ge.tend)then
            timegppmin(nmingpp)=tend
            call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,0)
            goto 1000
          endif
          istatus=iup
          goto 50
        else
!flat begining of the curve and then going up so the begining is a minimum
          nmingpp=nmingpp+1
          timegppmin(nmingpp)=tstart
          call phenofunc(1,gppmin(nmingpp),1,tstart,ndim,beta,dydxp,0)
          istatus=iup
          goto 50
        endif
      else
        if(dydxp(1).lt.0.0d0)then
! decrease
          if(istatus.eq.idn)then
! still decrease
            if(time.ge.tend)then
              nmingpp=nmingpp+1
              call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,0)
              timegppmin(nmingpp)=tend
              goto 1000
            else
              goto 50
            endif
          endif
          if(istatus.eq.iup)then
! previous up but now down so a maximum is reached
            nmaxgpp=nmaxgpp+1
            if(time.ge.tend)then
              timegppmax(nmaxgpp)=tend
              call
     &phenofunc(1,gppmax(nmaxgpp),1,tend,ndim,beta,dydxp,0)
              goto 1000
            endif
            time=time-step/2.0d0
            timegppmax(nmaxgpp)=time
            call
     &phenofunc(1,gppmax(nmaxgpp),1,time,ndim,beta,dydxp,0)
            istatus=idn
            goto 50
          endif
! previous flat
          if(istatus.eq.idntoflat)then
!going down to flat and then going down again. ignore this staircase
            istatus=idn
            goto 50
          endif
          if(istatus.eq.iuptoflat)then
!going up to flat and then going down so the flat represents a maximum
            nmaxgpp=nmaxgpp+1
            timegppmax(nmaxgpp)=(t0+time-step)/2.0d0
            call phenofunc(1,gppmax(nmaxgpp),1,timegppmax(nmaxgpp),
     &ndim,beta,dydxp,0)
            if(time.ge.tend)then
              timegppmax(nmaxgpp)=tend
              call phenofunc(1,gppmax(nmaxgpp),1,timegppmax(nmaxgpp),
     &ndim,beta,dydxp,0)
              goto 1000
            endif
            istatus=idn
            goto 50
          else
!flat begining of the curve and then going down so the begining is a maximum
            nmaxgpp=nmaxgpp+1
            timegppmax(nmaxgpp)=tstart
            call phenofunc(1,gppmax(nmaxgpp),1,timegppmax(nmaxgpp),
     &ndim,beta,dydxp,0)
            istatus=idn
            goto 50
          endif
        else
! a flat place
          if(istatus.eq.iup)then
! up to flat
            if(time.ge.tend)then
              nmaxgpp=nmaxgpp+1
              timegppmax(nmaxgpp)=tend
              call
     &phenofunc(1,gppmax(nmaxgpp),1,tend,ndim,beta,dydxp,0)
              goto 1000
            endif
            istatus=iuptoflat
            t0=time-step
            goto 50
          endif
          if(istatus.eq.idn)then
! down to flat
            if(time.ge.tend)then
              nmingpp=nmingpp+1
              timegppmin(nmingpp)=tend
              call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,0)
              goto 1000
            endif
            istatus=idntoflat
            t0=time-step
            goto 50
          endif
! remain on a flat. no information is recorded unless at the end.
          if(time.ge.tend)then
            if(istatus.eq.iuptoflat)then       
              nmaxgpp=nmaxgpp+1
              timegppmax(nmaxgpp)=tend
              call
     &phenofunc(1,gppmax(nmaxgpp),1,tend,ndim,beta,dydxp,0)
            else
              if(istatus.eq.idntoflat)then
                nmingpp=nmingpp+1
                timegppmin(nmingpp)=tend
                call
     &phenofunc(1,gppmin(nmingpp),1,tend,ndim,beta,dydxp,0)
              else
!a horizontal line
                return
              endif
            endif
            goto 1000
          endif
          goto 50
        endif
      endif
1000  return
      end
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$