Initial commit
This commit is contained in:
@@ -0,0 +1,209 @@
|
||||
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
||||
subroutine fluorescencejmax()
|
||||
implicit none
|
||||
include '../testarea/LeafGasParams.h'
|
||||
include '../testarea/LeafGasHybridFit.h'
|
||||
integer i,ndim,k,j,iderivative,iwrong
|
||||
double precision beta(4),sumsquare0,beta0(4),sumsquarecp,
|
||||
&betacp(4),ftol,xtol,shortx(maxobs,2),shorty(maxobs),
|
||||
&xvar(maxobs,2),weitx(maxobs,2),weity(maxobs),ran2,
|
||||
&templflights0(maxobs),aparlights0(maxobs),termmin,termmax
|
||||
parameter(ftol=1.0d-7,xtol=1.0d-7)
|
||||
external funkmin_flujmax,f1dim_flujmax,FCN_flujmax,flujmax_pikaia
|
||||
!beta(1)=fjmax25
|
||||
beta(1)=univparams(8)
|
||||
betamin(1)=univparamsmin(8)
|
||||
betamax(1)=univparamsmax(8)
|
||||
!beta(2)=phifactor
|
||||
beta(2)=univparams(11)
|
||||
betamin(2)=univparamsmin(11)
|
||||
betamax(2)=univparamsmax(11)
|
||||
!beta(3)=thetafactor
|
||||
beta(3)=univparams(12)
|
||||
betamin(3)=univparamsmin(12)
|
||||
betamax(3)=univparamsmax(12)
|
||||
ndim=3
|
||||
ntotlights=0
|
||||
termmax=-1.0d+9
|
||||
termmin=1.0d+9
|
||||
do i=1,numALightcurves
|
||||
do j=1,nALightPoints(i)
|
||||
if(ALightchlflphips2(j,i).gt.0.0d0.and.
|
||||
&j.le.nstartalight(i))then
|
||||
!Only points before nstartalight are used because these points are apparently limited by RuBP regeneration and therefore
|
||||
!the electron transport equation applies.
|
||||
ntotlights=ntotlights+1
|
||||
templflights(ntotlights)=ALighttempleaf(j,i)
|
||||
if(templflights(ntotlights).lt.termmin)
|
||||
&termmin=templflights(ntotlights)
|
||||
if(templflights(ntotlights).gt.termmax)
|
||||
&termmax=templflights(ntotlights)
|
||||
aparlights(ntotlights)=ALightaPPFDlf(j,i)
|
||||
flphips2lights(ntotlights)=ALightchlflphips2(j,i)
|
||||
xvar(ntotlights,1)=aparlights(ntotlights)
|
||||
xvar(ntotlights,2)=templflights(ntotlights)
|
||||
weitx(ntotlights,1)=1.0d0
|
||||
weitx(ntotlights,2)=1.0d0
|
||||
weity(ntotlights)=1.0d0
|
||||
templflights0(ntotlights)=templflights(ntotlights)
|
||||
aparlights0(ntotlights)=aparlights(ntotlights)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
if((termmax-termmin).gt.2.0d0)then
|
||||
ndim=4
|
||||
!beta(4)=ha_jmax
|
||||
beta(4)=univparams(17)
|
||||
betamin(4)=univparamsmin(17)
|
||||
betamax(4)=univparamsmax(17)
|
||||
endif
|
||||
if(ntotlights.lt.ndim)then
|
||||
ntotlights=0
|
||||
return
|
||||
endif
|
||||
isitbounded=1
|
||||
call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
do i=1,ndim
|
||||
beta0(i)=beta(i)
|
||||
enddo
|
||||
sumsquare0=flujmaxfval
|
||||
j=0
|
||||
k=0
|
||||
30 call nongradopt(ndim,funkmin_flujmax,
|
||||
&f1dim_flujmax,beta,betamin,betamax,ftol,flujmaxfval)
|
||||
call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
if((flujmaxfval+1.0d0).eq.flujmaxfval)then
|
||||
do i=1,ndim
|
||||
beta(i)=beta0(i)
|
||||
enddo
|
||||
flujmaxfval=sumsquare0
|
||||
else
|
||||
if(dabs(flujmaxfval-sumsquare0).lt.ftol)k=k+1
|
||||
if(flujmaxfval.gt.sumsquare0)then
|
||||
do i=1,ndim
|
||||
beta(i)=beta0(i)
|
||||
enddo
|
||||
flujmaxfval=sumsquare0
|
||||
else
|
||||
if((sumsquare0-flujmaxfval).gt.ftol)k=0
|
||||
!reset the counter of revisiting a minimum if a new minimum is found
|
||||
endif
|
||||
endif
|
||||
j=j+1
|
||||
!try different initial guesses
|
||||
if(j.lt.200.and.k.lt.50)then
|
||||
do i=1,ndim
|
||||
beta0(i)=beta(i)
|
||||
beta(i)=betamin(i)+ran2()*(betamax(i)-betamin(i))
|
||||
enddo
|
||||
sumsquare0=flujmaxfval
|
||||
call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
goto 30
|
||||
endif
|
||||
call RepeatCompassSearch(ndim,beta,flujmaxfval,betamin,
|
||||
&betamax,funkmin_flujmax,f1dim_flujmax,xtol)
|
||||
do i=1,ndim
|
||||
betacp(i)=(beta(i)-betamin(i))/(betamax(i)-betamin(i))
|
||||
enddo
|
||||
isitbounded=0
|
||||
call pikaia(flujmax_pikaia,ndim,gacontrol,betacp,flujmaxfval,i)
|
||||
do i=1,ndim
|
||||
beta(i)=betamin(i)+betacp(i)*(betamax(i)-betamin(i))
|
||||
enddo
|
||||
isitbounded=1
|
||||
call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
call RepeatCompassSearch(ndim,beta,flujmaxfval,betamin,
|
||||
&betamax,funkmin_flujmax,f1dim_flujmax,xtol)
|
||||
isitbounded=1
|
||||
call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
do i=1,ndim
|
||||
beta0(i)=beta(i)
|
||||
enddo
|
||||
sumsquare0=flujmaxfval
|
||||
iderivative=0
|
||||
iwrong=0
|
||||
call odr_leastsquare(ndim,FCN_flujmax,beta,ntotlights,
|
||||
&xvar(1:ntotlights,1:2),2,flphips2lights,1,weitx(1:ntotlights,1:2),
|
||||
&weity,iderivative,shortx(1:ntotlights,1:2),shorty(1:ntotlights),
|
||||
&flujmaxfval,iwrong)
|
||||
isitbounded=1
|
||||
!after odr_leastsquare, forcing variables are destroyed. restore to the origninals
|
||||
do i=1,ntotlights
|
||||
templflights(i)=templflights0(i)
|
||||
aparlights(i)=aparlights0(i)
|
||||
enddo
|
||||
call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
if(dabs(flujmaxfval).le.dabs(sumsquare0))then
|
||||
else
|
||||
if(dabs(flujmaxfval).gt.1.0d+20)then
|
||||
!in case of infinity (division by zero)
|
||||
do i=1,ndim
|
||||
beta(i)=beta0(i)
|
||||
enddo
|
||||
flujmaxfval=sumsquare0
|
||||
else
|
||||
!designed this way to avoid flujmaxfval='NAN'
|
||||
do i=1,ndim
|
||||
beta(i)=beta0(i)
|
||||
enddo
|
||||
flujmaxfval=sumsquare0
|
||||
endif
|
||||
endif
|
||||
j=0
|
||||
100 if(j.ge.10)then
|
||||
do i=1,ndim
|
||||
betacp(i)=(beta(i)-betamin(i))/(betamax(i)-betamin(i))
|
||||
enddo
|
||||
isitbounded=0
|
||||
call pikaia(flujmax_pikaia,ndim,gacontrol,betacp,flujmaxfval,i)
|
||||
do i=1,ndim
|
||||
beta(i)=betamin(i)+betacp(i)*(betamax(i)-betamin(i))
|
||||
enddo
|
||||
isitbounded=1
|
||||
call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
endif
|
||||
sumsquare0=flujmaxfval
|
||||
do i=1,ndim
|
||||
beta0(i)=beta(i)
|
||||
enddo
|
||||
call nongradopt(ndim,funkmin_flujmax,f1dim_flujmax,
|
||||
&beta,betamin,betamax,ftol,flujmaxfval)
|
||||
call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
if(flujmaxfval.eq.sumsquare0)return
|
||||
if(dabs(flujmaxfval).le.dabs(sumsquare0))then
|
||||
else
|
||||
if(dabs(flujmaxfval).gt.1.0d+20)then
|
||||
!in case of infinity (division by zero)
|
||||
do i=1,ndim
|
||||
beta(i)=beta0(i)
|
||||
enddo
|
||||
flujmaxfval=sumsquare0
|
||||
else
|
||||
!designed this way to avoid flujmaxfval='NAN'
|
||||
do i=1,ndim
|
||||
beta(i)=beta0(i)
|
||||
enddo
|
||||
flujmaxfval=sumsquare0
|
||||
endif
|
||||
endif
|
||||
sumsquarecp=flujmaxfval
|
||||
do i=1,ndim
|
||||
betacp(i)=beta(i)
|
||||
enddo
|
||||
call RepeatCompassSearch(ndim,betacp,sumsquarecp,betamin,
|
||||
&betamax,funkmin_flujmax,f1dim_flujmax,xtol)
|
||||
call funkmin_flujmax(ndim,betacp,sumsquarecp)
|
||||
if(flujmaxfval.eq.sumsquarecp)return
|
||||
if(dabs(sumsquarecp).lt.dabs(flujmaxfval))then
|
||||
do i=1,ndim
|
||||
beta(i)=betacp(i)
|
||||
enddo
|
||||
flujmaxfval=sumsquarecp
|
||||
endif
|
||||
j=j+1
|
||||
if(j.le.2.and.dabs(flujmaxfval-sumsquare0).gt.ftol)goto 100
|
||||
!
|
||||
!------------------------------------------------------
|
||||
110 call funkmin_flujmax(ndim,beta,flujmaxfval)
|
||||
return
|
||||
END subroutine fluorescencejmax
|
||||
Reference in New Issue
Block a user