Initial commit
This commit is contained in:
@@ -0,0 +1,258 @@
|
||||
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
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
|
||||
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
Reference in New Issue
Block a user