Initial commit
This commit is contained in:
@@ -0,0 +1,973 @@
|
||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
||||
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),
|
||||
¢erday(nmaxextre),effgrowleng(nmaxextre),
|
||||
&assimpotindex(nmaxextre),effmaxgpp(nmaxextre),spmaxder(nmaxextre),
|
||||
&spmaxderday(nmaxextre),spmaxdergpp(nmaxextre),flmaxder(nmaxextre),
|
||||
&flmaxderday(nmaxextre),flmaxdergpp(nmaxextre),
|
||||
&extremegpp(nmaxextre),extremegppday(nmaxextre),
|
||||
¶mskewness(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),
|
||||
¶mkurtosis(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),
|
||||
¶mkurtosis(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),
|
||||
¶mkurtosis(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
|
||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
||||
Reference in New Issue
Block a user