259 lines
10 KiB
FortranFixed
259 lines
10 KiB
FortranFixed
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
subroutine leafunivphotosyn(Currentiknowlimit0,ilimittype0,
|
|
&ifitmode0,aPPFDlf,templeaf,pco2i_obs0,po2i,chlflphips20,anet_obs0,
|
|
&weitpco2i0,weitanet0,weitphips20,weitfjelect0,pco2i_pred0,
|
|
&anet_pred0,iphotolimit0,pco2c0,PhiPSII_pred,anet_pred_flu0,
|
|
&pco2i_pred_flu0,pco2c_anet_flu0,pco2c_pco2i_flu0,fvalue)
|
|
implicit none
|
|
include '../testarea/LeafGasParams.h'
|
|
include '../testarea/pco2ianetfunc.h'
|
|
!------------ Inputs -------------------
|
|
!ilimittype=1: Rubisco,RuBp and TPU limitations
|
|
! =2: Rubisco and RuBp limitations only
|
|
! =3: Rubisco and TPU limitations only
|
|
! =4: RuBp and TPU limitations only
|
|
! =5: Rubisco limitation only
|
|
! =6: RuBp limitation only
|
|
! =7: TPU limitation only
|
|
!aPPFDlf: absorbed photosynthetic photon flux density by leaf (umol m-2 s-1)
|
|
!templeaf: leaf temperature [K]
|
|
!pco2i_obs: measured intercellular CO2 partial pressure (Pa).
|
|
!po2i: intercellular O2 partial pressure (Pa, often taking the ambient value).
|
|
!chlflphips2: photochemical efficiency of photosynthesis (NA), if provided
|
|
!anet_obs: meausred net rate of CO2 uptake per unit leaf area [umol m-2 s-1]
|
|
!ifitmode: =-2, ordinary fitting with pco2i calculated as a function of anet
|
|
!ifitmode: =-1, ordinary fitting with anet calculated as a function of pco2i
|
|
!ifitmode: =1, orthogonal fitting with anet calculated as a function of pco2i
|
|
!ifitmode: =2, orthogonal fitting with pco2i calculated as a function of anet
|
|
!------------ Outputs -------------------
|
|
!anet_pred: net rate of CO2 uptake per unit leaf area calculated from pco2i_obs and photosynthetic parameters [umol m-2 s-1]
|
|
!iphotolimit_anet: the limitation state of the photosynthesis determined with anet as the response variable and pco2i as one independent variable
|
|
!pco2c_anet: chloroplastic CO2 partial pressure calculated with anet as a response
|
|
!fjelect_anet: the realized electron transport rate <= jrubp (=when RuBP regeneration limits photosynthesis) determined with anet as the response
|
|
! variable and pco2i as one independent variable.
|
|
!anet_pred_flu: if chlflphips2 is provided, net rate of CO2 uptake per unit leaf area calculated from photochemical efficiency. anet is a response. [umol m-2 s-1],
|
|
!pco2c_anet_flu: chloroplastic CO2 partial pressure calculated from fluorescence data with anet as a response (Pa)
|
|
!
|
|
!pco2i_pred: intercellular CO2 partial pressure calculated from anet_obs and photosynthetic parameters [Pa]
|
|
!iphotolimit_pco2i: the limitation state of the photosynthesis determined with pco2i as the response variable and anet as one independent variable
|
|
!pco2c_pco2i: chloroplastic CO2 partial pressure calculated with pco2i as a response
|
|
!fjelect_pco2i: the realized electron transport rate <= jrubp (=when RuBP regeneration limits photosynthesis) determined with pco2i as the response
|
|
! variable and anet as one independent variable.
|
|
!pco2i_pred_flu: if chlflphips2 is provided, intercellular CO2 partial pressure calculated from photochemical efficiency. pco2i is a response. [Pa]
|
|
!pco2c_pco2i_flu: chloroplastic CO2 partial pressure calculated from fluorescence data with pco2i as a response (Pa)
|
|
!Note: when alpha25 = 0, pco2i cannot be solved from anet because anet is independent of pco2i and pco2c. so when TPU is limitting, we always treat
|
|
! anet as a response and pco2i as an independent.
|
|
integer Currentiknowlimit0,ilimittype0,ifitmode0,iphotolimit0
|
|
double precision aPPFDlf,templeaf,pco2i_obs0,po2i,chlflphips20,
|
|
&anet_obs0,weitpco2i0,weitanet0,weitphips20,weitfjelect0,
|
|
&pco2i_pred0,anet_pred0,pco2c0,PhiPSII_pred,anet_pred_flu0,
|
|
&pco2i_pred_flu0,pco2c_anet_flu0,pco2c_pco2i_flu0,fvalue
|
|
!------------ Local variables -----------
|
|
integer ierr,n
|
|
double precision fkc,fko,ax,bx,cx,fa,fb,fc,lowerbound,upperbound,
|
|
&pco2ianetfunc,term,x_pred,deltafract,step,TOL,leafbrent,dum,
|
|
&thetaPSII
|
|
parameter(TOL=1.0d-7,deltafract=0.2d0)
|
|
|
|
Currentiknowlimit=Currentiknowlimit0
|
|
ilimittype=ilimittype0
|
|
ifitmode=ifitmode0
|
|
pco2i_obs=pco2i_obs0
|
|
chlflphips2=chlflphips20
|
|
anet_obs=anet_obs0
|
|
weitpco2i=weitpco2i0
|
|
weitanet=weitanet0
|
|
weitphips2=weitphips20
|
|
weitfjelect=weitfjelect0
|
|
alpha=alpha25
|
|
if(Currentiknowlimit.ne.-1)then
|
|
call vcmaxontemp(templeaf,vcmax25,gascon,ha_vcmax,hd_vcmax,
|
|
&sv_vcmax,vcmax)
|
|
call jontemp(aPPFDlf,templeaf,fjelect,fjmax25,ha_jmax,
|
|
&hd_jmax,sv_jmax,gascon,phifactor,thetafactor,betaPSII)
|
|
call tpuontemp(templeaf,gascon,tpu25,ha_tpu,hd_tpu,sv_tpu,tpu)
|
|
if(chlflphips2.gt.0.0d0)then
|
|
chlflfjelect=betaPSII*chlflphips2*aPPFDlf
|
|
if(aPPFDlf.lt.0.0d0)then
|
|
call thetaphipsii(templeaf,PhiPSIImax,thetaPSII)
|
|
PhiPSIImax=PhiPSIImax*phifactor
|
|
endif
|
|
endif
|
|
else
|
|
if(chlflphips2.gt.0.0d0)then
|
|
fjelect=betaPSII*chlflphips2*aPPFDlf
|
|
else
|
|
fvalue=0.0d0
|
|
return
|
|
endif
|
|
endif
|
|
call gmesoontemp(templeaf,1.0d0,gascon,ha_gmeso,hd_gmeso,
|
|
&sv_gmeso,term)
|
|
resistwp=resistwp25/term
|
|
resistch=resistch25/term
|
|
call resp_mitocho(templeaf,rdlight25,ha_darkresp,gascon,rdlight)
|
|
call co2compens(templeaf,stargamma25,ha_stargamma,gascon,
|
|
&stargamma)
|
|
call MichaelisCO2(templeaf,fkc25,ha_kc,gascon,fkc)
|
|
call MichaelisO2(templeaf,fko25,ha_ko,gascon,fko)
|
|
fkco=fkc*(1.0d0+po2i/fko)
|
|
if(ifitmode.eq.-1)then
|
|
ifitmode=1
|
|
fvalue=pco2ianetfunc(pco2i_obs)
|
|
goto 100
|
|
endif
|
|
if(ifitmode.eq.-2)then
|
|
ifitmode=2
|
|
fvalue=pco2ianetfunc(anet_obs)
|
|
goto 100
|
|
endif
|
|
if(ifitmode.eq.1)then
|
|
term=pco2i_obs
|
|
upperbound=term*(1.0d0+deltafract)
|
|
lowerbound=term*(1.0d0-deltafract)
|
|
ax=term*(1.0d0-deltafract/5.0d0)
|
|
bx=term
|
|
endif
|
|
if(ifitmode.eq.2)then
|
|
term=dmax1(2.0d0,dabs(anet_obs))
|
|
upperbound=anet_obs+term*deltafract
|
|
lowerbound=anet_obs-term*deltafract
|
|
ax=anet_obs-term*deltafract/5.0d0
|
|
bx=anet_obs
|
|
endif
|
|
n=0
|
|
10 call leafmnbrak(ax,bx,cx,fa,fb,fc,lowerbound,upperbound,
|
|
&ierr,pco2ianetfunc)
|
|
if(ierr.ne.0)then
|
|
if(n.le.50)then
|
|
if(fb.gt.fa)then
|
|
dum=ax
|
|
ax=bx
|
|
bx=dum
|
|
dum=fa
|
|
fa=fb
|
|
fb=dum
|
|
!from ax to bx, f decreases
|
|
endif
|
|
if(fc.gt.fb)then
|
|
if(fc.lt.fa)then
|
|
dum=bx
|
|
bx=cx
|
|
cx=dum
|
|
dum=fc
|
|
fc=fb
|
|
fb=dum
|
|
else
|
|
dum=ax
|
|
ax=cx
|
|
cx=dum
|
|
dum=fc
|
|
fc=fa
|
|
fa=dum
|
|
endif
|
|
endif
|
|
!from ax to bx to cx, f decreases
|
|
if(dabs(cx-bx).lt.dabs(cx-ax))then
|
|
if(ax.gt.cx)then
|
|
lowerbound=lowerbound-term*deltafract
|
|
else
|
|
upperbound=upperbound+term*deltafract
|
|
endif
|
|
ax=lowerbound+(upperbound-lowerbound)*0.5d0
|
|
bx=lowerbound+(upperbound-lowerbound)*0.51d0
|
|
n=n+1
|
|
goto 10
|
|
else
|
|
if(ifitmode.eq.1)x_pred=pco2i_obs
|
|
if(ifitmode.eq.2)x_pred=anet_obs
|
|
endif
|
|
else
|
|
if(ifitmode.eq.1)x_pred=pco2i_obs
|
|
if(ifitmode.eq.2)x_pred=anet_obs
|
|
endif
|
|
endif
|
|
fvalue=leafbrent(ax,bx,cx,pco2ianetfunc,TOL,x_pred)
|
|
fvalue=pco2ianetfunc(x_pred)
|
|
100 pco2i_pred0=pco2i_pred
|
|
anet_pred0=anet_pred
|
|
if(aPPFDlf.gt.0.0d0)then
|
|
PhiPSII_pred=realizedfjelect/(betaPSII*aPPFDlf)
|
|
else
|
|
PhiPSII_pred=PhiPSIImax
|
|
endif
|
|
iphotolimit0=iphotolimit
|
|
pco2c0=pco2c
|
|
anet_pred_flu0=anet_pred_flu
|
|
pco2i_pred_flu0=pco2i_pred_flu
|
|
pco2c_anet_flu0=pco2c_anet_flu
|
|
pco2c_pco2i_flu0=pco2c_pco2i_flu
|
|
return
|
|
end
|
|
|
|
double precision function pco2ianetfunc(x)
|
|
implicit none
|
|
include '../testarea/pco2ianetfunc.h'
|
|
!local variables
|
|
integer iph
|
|
double precision x,term,term1,term2,term3,pco2c_wp,anet_wp
|
|
if(ifitmode.eq.1)then
|
|
!anet as a function of pco2i
|
|
pco2i_pred=x
|
|
call Anet_Final(vcmax,fjelect,tpu,resistwp,resistch,stargamma,
|
|
&fkco,pco2i_pred,alpha,rdlight,ilimittype,iphotolimit,anet_pred,
|
|
&pco2c,realizedfjelect)
|
|
pco2ianetfunc=(weitpco2i*(pco2i_obs-pco2i_pred))**2+
|
|
&(weitanet*(anet_obs-anet_pred))**2
|
|
endif
|
|
if(ifitmode.eq.2)then
|
|
!pco2i as a function of anet
|
|
anet_pred=x
|
|
call CO2i_Final(vcmax,fjelect,tpu,resistwp,resistch,stargamma,
|
|
&fkco,pco2i_pred,alpha,rdlight,ilimittype,iphotolimit,
|
|
&anet_pred,pco2c,realizedfjelect,pco2i_obs,pco2c_wp,anet_wp)
|
|
if(iphotolimit.eq.3.and.alpha.le.0.0d0)then
|
|
!anet is independent of pco2i. assume no error in pco2i. ensure the optimized x = 3*tpu-rd. Vc for tpu
|
|
!is computed from the forward mode, i.e. the same as in ifitmode=1
|
|
pco2i_pred=pco2i_obs
|
|
anet_pred=anet_wp
|
|
pco2c=pco2c_wp
|
|
pco2ianetfunc=(weitanet**2)*
|
|
&((anet_obs-anet_pred)**2+(x-anet_pred)**2)
|
|
else
|
|
pco2ianetfunc=(weitpco2i*(pco2i_obs-pco2i_pred))**2+
|
|
&(weitanet*(anet_obs-anet_pred))**2
|
|
endif
|
|
endif
|
|
if(Currentiknowlimit.ne.-1.and.chlflphips2.gt.0.0d0)then
|
|
!use either option 1 or option 2 or option 3
|
|
!option 1
|
|
if(chlflfjelect.gt.0.0d0)then
|
|
pco2ianetfunc=pco2ianetfunc+(weitphips2*
|
|
&chlflphips2*(1.0d0-realizedfjelect/chlflfjelect))**2
|
|
else
|
|
pco2ianetfunc=pco2ianetfunc+
|
|
&(weitphips2*(chlflphips2-PhiPSIImax))**2
|
|
endif
|
|
!option 2
|
|
pco2ianetfunc=pco2ianetfunc+
|
|
&(weitfjelect*(chlflfjelect-realizedfjelect))**2
|
|
!option 3
|
|
if(ifitmode.eq.1)then
|
|
call Anet_Final(vcmax,chlflfjelect,tpu,resistwp,resistch,
|
|
&stargamma,fkco,pco2i_pred,alpha,rdlight,6,iph,anet_pred_flu,
|
|
&pco2c_anet_flu,term)
|
|
pco2ianetfunc=pco2ianetfunc+
|
|
&(weitanet*(anet_pred-anet_pred_flu))**2
|
|
endif
|
|
if(ifitmode.eq.2)then
|
|
call CO2i_Final(vcmax,chlflfjelect,tpu,resistwp,resistch,
|
|
&stargamma,fkco,pco2i_pred_flu,alpha,rdlight,6,iph,anet_pred,
|
|
&pco2c_pco2i_flu,term,term1,term2,term3)
|
|
pco2ianetfunc=pco2ianetfunc+
|
|
&(weitpco2i*(pco2i_pred-pco2i_pred_flu))**2
|
|
endif
|
|
endif
|
|
return
|
|
end
|
|
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|