974 lines
35 KiB
FortranFixed
974 lines
35 KiB
FortranFixed
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
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
|
|
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|