Initial commit
This commit is contained in:
@@ -0,0 +1,627 @@
|
||||
subroutine LeafGasFit_Stom(unitparamsout,unitwuecicacomp,
|
||||
&unitstomcomp,curveno,curvename,npoints0,aPPFDlf0,templeaf0,
|
||||
&tempair0,co2i_pa,co2a_pa,pres_air0,yAnet0,gswmeas0,vpdl0,trmmol0,
|
||||
&abspt_lf_par,co2c_pa,co2recycleratio,stargamma25,ha_stargamma,
|
||||
!
|
||||
& siteID,Latitude,Longitude,Elevation,yearsampled,
|
||||
& sampledoy,GrowingSeasonStart,GrowingSeasonEnd,
|
||||
& standage,CanopyHeight,LeafAreaIndex,species,
|
||||
& avetimeresolution,avetimesampled,SampleHeight,
|
||||
& Needleage,specificLAI,nitrogencontent,carboncontent,
|
||||
& phoscontent,woodporosity,sapwooddensity,leafratio)
|
||||
implicit none
|
||||
!
|
||||
!----------Inputs-------------------------------------------
|
||||
integer npoints0,unitparamsout,unitwuecicacomp,unitstomcomp,
|
||||
&curveno
|
||||
double precision aPPFDlf0(npoints0),templeaf0(npoints0),
|
||||
&tempair0(npoints0),co2i_pa(npoints0),co2a_pa(npoints0),
|
||||
&pres_air0(npoints0),yAnet0(npoints0),gswmeas0(npoints0),
|
||||
&vpdl0(npoints0),trmmol0(npoints0),abspt_lf_par,
|
||||
&co2c_pa(4,npoints0),co2recycleratio0(6,npoints0),
|
||||
&stargamma25(6),ha_stargamma
|
||||
|
||||
character*100 curvename
|
||||
character siteID*(*),species*(*),woodporosity*(*)
|
||||
double precision Latitude,Longitude,Elevation,yearsampled,
|
||||
&sampledoy,GrowingSeasonStart,GrowingSeasonEnd,standage,
|
||||
&CanopyHeight,LeafAreaIndex,avetimeresolution,avetimesampled,
|
||||
&SampleHeight,Needleage,specificLAI,nitrogencontent,
|
||||
&carboncontent,phoscontent,sapwooddensity,leafratio
|
||||
!----------Internal variables-------------------------------
|
||||
integer npoints_stom,i,j,k,numparams,INFO,istommodel,malfit,
|
||||
&imodel,iwrong,idostom,idocica,idowue,npoints
|
||||
double precision co2threshold,co2current,vpdl_ref,gascon,
|
||||
&templeaf_stom(npoints0),gswmeas_stom(npoints0),
|
||||
&pres_air_stom(npoints0),xpco2i_stom(npoints0),
|
||||
&yAnet_stom(npoints0),trmmol_stom(npoints0),stargamma(npoints0),
|
||||
&pco2s(npoints0),rehulfsurf(npoints0),pvapordef_s(npoints0),
|
||||
&combined1(npoints0),combined2(npoints0),wue(npoints0),
|
||||
&wuemod(npoints0),wue_intrin(npoints0),wue_intrinmod(npoints0),
|
||||
&cicameas(npoints0),cicamod(npoints0),gswmodcp(npoints0),
|
||||
&gswmod1(npoints0),gswmod2(npoints0),gswmod(4,npoints0),
|
||||
&sig(npoints0),ballintersurf,ballslopesurf,ballrsqsurf,
|
||||
&ballinterinside,ballslopeinside,
|
||||
&ballrsqinside,ballinter,ballslope,ballrsqgsw,esat,raysurfinter,
|
||||
&raysurfslope,raysurfd0,raysurfrsqgsw,belindainter,belindaslope,
|
||||
&belindad0,belindarsqgsw,dewarinter,dewarslope,deward0,dewarrsqgsw,
|
||||
&wueref,der_wueref,rsqwue,alfit(10),der_alfit(10),wueref_intrin,
|
||||
&der_wueref_intrin,rsqwue_intrin,blfit(10),der_blfit(10),cicaref,
|
||||
&der_cicaref,rsqcica,avetleaf,avetair,avevpdl,avepari,term,
|
||||
&ballrmsgsw,ballagrindgsw,raysurfrmsgsw,raysurfagrindgsw,
|
||||
&belindarmsgsw,belindaagrindgsw,dewarrmsgsw,dewaragrindgsw,rmswue,
|
||||
&agrindwue,rmswue_intrin,agrindwue_intrin,stomintercept,stomslope,
|
||||
&rayDzero,rsqgsw,rmsgsw,agrindgsw,rmscica,agrindcica,cicafit(10),
|
||||
&der_cicafit(10),bmin(10),bmax(10),rsqccci(4),rmsccci(4),
|
||||
&agrindccci(4),cccifit(4,10),der_cccifit(4,10),ccciref(4),
|
||||
&der_ccciref(4),co2iref,cccimeas(4,npoints0),cccimod(4,npoints0),
|
||||
&avepres_air,rsqrecyc(6),rmsrecyc(6),agrindrecyc(6),recycfit(6,10),
|
||||
&der_recycfit(6,10),recycref(6),der_recycref(6),
|
||||
&recycmod(6,npoints0),aPPFDlf(npoints0),templeaf(npoints0),
|
||||
&tempair(npoints0),co2i_ppm(npoints0),co2a_ppm(npoints0),
|
||||
&pres_air(npoints0),yAnet(npoints0),gswmeas(npoints0),
|
||||
&vpdl(npoints0),trmmol(npoints0),co2c_ppm(4,npoints0),
|
||||
&co2recycleratio(6,npoints0)
|
||||
|
||||
parameter(gascon=8.314472d0,co2threshold=0.0d0,co2current=400.0d0,
|
||||
&vpdl_ref=1600.0d0)
|
||||
!if ambient co2 is too low, the ball-berry stomatal conductance model does not apply so we need to
|
||||
!set up a threshold here
|
||||
!this ambient CO2 threshold (250ppm) is taken from Gutschick and Simmonneau (2002)
|
||||
!WUE are standardized for VPD at 50% relative humidity at 25 oC.
|
||||
|
||||
external lfitbasisfuncs
|
||||
!-------------------------------------------------------------------------------------------
|
||||
idostom=1
|
||||
idowue=1
|
||||
idocica=1
|
||||
npoints=0
|
||||
do j=1,npoints0
|
||||
if(gswmeas0(j).gt.0.0d0.and.co2i_pa(j).gt.0.0d0.and.
|
||||
&trmmol0(j).gt.0.0d0)then
|
||||
npoints=npoints+1
|
||||
aPPFDlf(npoints)=aPPFDlf0(j)
|
||||
templeaf(npoints)=templeaf0(j)
|
||||
tempair(npoints)=tempair0(j)
|
||||
yAnet(npoints)=yAnet0(j)
|
||||
co2i_ppm(npoints)=co2i_pa(j)*1.0d+6/pres_air0(j)
|
||||
if(co2a_pa(j).gt.0.0d0)then
|
||||
co2a_ppm(npoints)=co2a_pa(j)*1.0d+6/pres_air0(j)
|
||||
else
|
||||
co2a_ppm(npoints)=-9999.0d0
|
||||
idocica=0
|
||||
endif
|
||||
pres_air(npoints)=pres_air0(j)
|
||||
gswmeas(npoints)=gswmeas0(j)
|
||||
trmmol(npoints)=trmmol0(j)
|
||||
vpdl(npoints)=vpdl0(j)
|
||||
do k=1,4
|
||||
if(dabs(co2c_pa(k,j)+9999.0d0).gt.1.0d-5)then
|
||||
co2c_ppm(k,npoints)=co2c_pa(k,j)*1.0d+6/pres_air0(j)
|
||||
else
|
||||
co2c_ppm(k,npoints)=-9999.0d0
|
||||
endif
|
||||
enddo
|
||||
do k=1,6
|
||||
co2recycleratio(k,npoints)=co2recycleratio0(k,j)
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
if(npoints.le.3)return
|
||||
avevpdl=0.0d0
|
||||
avetleaf=0.0d0
|
||||
avetair=0.0d0
|
||||
avepari=0.0d0
|
||||
avepres_air=0.0d0
|
||||
do j=1,npoints
|
||||
avevpdl=avevpdl+vpdl(j)
|
||||
avetleaf=avetleaf+templeaf(j)
|
||||
avetair=avetair+tempair(j)
|
||||
avepari=avepari+aPPFDlf(j)/abspt_lf_par
|
||||
avepres_air=avepres_air+pres_air(j)
|
||||
enddo
|
||||
avevpdl=avevpdl/dble(npoints)
|
||||
avetleaf=avetleaf/dble(npoints)-273.15d0
|
||||
avetair=avetair/dble(npoints)-273.15d0
|
||||
avepari=avepari/dble(npoints)
|
||||
avepres_air=avepres_air/dble(npoints)
|
||||
if(avepres_air.lt.0.0d0)avepres_air=98000.0d0
|
||||
!$$$$$$$$$$$$ Fitting stomatal conductance models $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
||||
!Now fit the stomatal conductance models
|
||||
npoints_stom=-9999
|
||||
if(idostom.eq.1)then
|
||||
npoints_stom=0
|
||||
do j=1,npoints
|
||||
if(co2a_ppm(j).gt.co2threshold.and.yAnet(j).gt.0.0d0)then
|
||||
npoints_stom=npoints_stom+1
|
||||
templeaf_stom(npoints_stom)=templeaf(j)
|
||||
pres_air_stom(npoints_stom)=pres_air(j)
|
||||
xpco2i_stom(npoints_stom)=co2i_ppm(j)
|
||||
yAnet_stom(npoints_stom)=yAnet(j)
|
||||
trmmol_stom(npoints_stom)=trmmol(j)
|
||||
gswmeas_stom(npoints_stom)=gswmeas(j)
|
||||
endif
|
||||
enddo
|
||||
if(npoints_stom.le.3)then
|
||||
idostom=0
|
||||
endif
|
||||
endif
|
||||
if(idostom.eq.1)then
|
||||
do j=1,npoints_stom
|
||||
call co2compens(templeaf_stom(j),stargamma25(5),ha_stargamma,
|
||||
& gascon,stargamma(j))
|
||||
!stargamma is in Pa, so convert it to ppm
|
||||
term=esat(templeaf_stom(j),pres_air_stom(j))
|
||||
stargamma(j)=1.0d+6*stargamma(j)/pres_air_stom(j)
|
||||
pco2s(j)=xpco2i_stom(j)+1.6d0*yAnet_stom(j)/gswmeas_stom(j)
|
||||
!mole fraction
|
||||
pvapordef_s(j)=term/pres_air_stom(j)-
|
||||
& 0.001d0*trmmol_stom(j)/gswmeas_stom(j)
|
||||
!partial pressure
|
||||
pvapordef_s(j)=pres_air_stom(j)*pvapordef_s(j)
|
||||
!partial pressure deficit
|
||||
pvapordef_s(j)=term-pvapordef_s(j)
|
||||
pvapordef_s(j)=dmax1(0.0d0,pvapordef_s(j))
|
||||
pvapordef_s(j)=dmin1(term,pvapordef_s(j))
|
||||
rehulfsurf(j)=1.0d0-pvapordef_s(j)/term
|
||||
combined1(j)=yAnet_stom(j)*rehulfsurf(j)/pco2s(j)
|
||||
combined2(j)=yAnet_stom(j)*rehulfsurf(j)/xpco2i_stom(j)
|
||||
enddo
|
||||
malfit=2
|
||||
do j=1,npoints_stom
|
||||
sig(j)=1.0d0
|
||||
enddo
|
||||
call lfit(combined1,gswmeas_stom,sig,npoints_stom,alfit,
|
||||
& malfit,malfit,lfitbasisfuncs,INFO)
|
||||
do j=1,npoints_stom
|
||||
gswmod1(j)=alfit(1)+alfit(2)*combined1(j)
|
||||
enddo
|
||||
call rsq_rms(gswmeas_stom,gswmod1,npoints_stom,rsqgsw,
|
||||
& rmsgsw,agrindgsw)
|
||||
ballintersurf=alfit(1)
|
||||
ballslopesurf=alfit(2)
|
||||
ballrsqsurf=rsqgsw
|
||||
malfit=2
|
||||
do j=1,npoints_stom
|
||||
sig(j)=1.0d0
|
||||
enddo
|
||||
call lfit(combined2,gswmeas_stom,sig,npoints_stom,alfit,
|
||||
& malfit,malfit,lfitbasisfuncs,INFO)
|
||||
do j=1,npoints_stom
|
||||
gswmod2(j)=alfit(1)+alfit(2)*combined2(j)
|
||||
enddo
|
||||
call rsq_rms(gswmeas_stom,gswmod2,npoints_stom,rsqgsw,
|
||||
& rmsgsw,agrindgsw)
|
||||
ballinterinside=alfit(1)
|
||||
ballslopeinside=alfit(2)
|
||||
ballrsqinside=rsqgsw
|
||||
do istommodel=1,4
|
||||
stomintercept=0.0001d0
|
||||
stomslope=10.0d0
|
||||
rayDzero=2000.0d0
|
||||
if(istommodel.le.3)then
|
||||
call StomRegression(npoints_stom,istommodel,pco2s,
|
||||
& rehulfsurf,stargamma,yAnet_stom,gswmeas_stom,
|
||||
& stomintercept,stomslope,pvapordef_s,rayDzero)
|
||||
call stomoptimization(npoints_stom,istommodel,pco2s,
|
||||
& rehulfsurf,stargamma,yAnet_stom,gswmeas_stom,
|
||||
& stomintercept,stomslope,pvapordef_s,rayDzero)
|
||||
do j=1,npoints_stom
|
||||
call StomatalConductance(pco2s(j),rehulfsurf(j),
|
||||
&stargamma(j),pvapordef_s(j),rayDzero,yAnet_stom(j),istommodel,
|
||||
&stomintercept,stomslope,term)
|
||||
gswmod(istommodel,j)=term
|
||||
gswmodcp(j)=term
|
||||
enddo
|
||||
endif
|
||||
if(istommodel.eq.4)then
|
||||
!We experiment using internal CO2 to fit the dewar model
|
||||
call StomRegression(npoints_stom,istommodel,xpco2i_stom,
|
||||
& rehulfsurf,stargamma,yAnet_stom,gswmeas_stom,
|
||||
& stomintercept,stomslope,pvapordef_s,rayDzero)
|
||||
call stomoptimization(npoints_stom,istommodel,xpco2i_stom,
|
||||
& rehulfsurf,stargamma,yAnet_stom,gswmeas_stom,
|
||||
& stomintercept,stomslope,pvapordef_s,rayDzero)
|
||||
do j=1,npoints_stom
|
||||
call StomatalConductance(xpco2i_stom(j),
|
||||
& rehulfsurf(j),stargamma(j),pvapordef_s(j),rayDzero,
|
||||
& yAnet_stom(j),istommodel,
|
||||
& stomintercept,stomslope,term)
|
||||
gswmod(istommodel,j)=term
|
||||
gswmodcp(j)=term
|
||||
enddo
|
||||
endif
|
||||
call rsq_rms(gswmeas_stom,gswmodcp,
|
||||
& npoints_stom,rsqgsw,rmsgsw,agrindgsw)
|
||||
if(istommodel.eq.1)then
|
||||
ballinter=stomintercept
|
||||
ballslope=stomslope
|
||||
ballrsqgsw=rsqgsw
|
||||
ballrmsgsw=rmsgsw
|
||||
ballagrindgsw=agrindgsw
|
||||
endif
|
||||
if(istommodel.eq.2)then
|
||||
raysurfinter=stomintercept
|
||||
raysurfslope=stomslope
|
||||
raysurfd0=rayDzero
|
||||
raysurfrsqgsw=rsqgsw
|
||||
raysurfrmsgsw=rmsgsw
|
||||
raysurfagrindgsw=agrindgsw
|
||||
endif
|
||||
if(istommodel.eq.3)then
|
||||
belindainter=stomintercept
|
||||
belindaslope=stomslope
|
||||
belindad0=-9999.0d0
|
||||
belindarsqgsw=rsqgsw
|
||||
belindarmsgsw=rmsgsw
|
||||
belindaagrindgsw=agrindgsw
|
||||
endif
|
||||
if(istommodel.eq.4)then
|
||||
dewarinter=stomintercept
|
||||
dewarslope=stomslope
|
||||
deward0=rayDzero
|
||||
dewarrsqgsw=rsqgsw
|
||||
dewarrmsgsw=rmsgsw
|
||||
dewaragrindgsw=agrindgsw
|
||||
endif
|
||||
enddo
|
||||
do j=1,npoints_stom
|
||||
write(unitstomcomp,370)curveno,trim(curvename),
|
||||
& gswmeas_stom(j),gswmod1(j),gswmod2(j),gswmod(1,j),
|
||||
& gswmod(2,j),gswmod(3,j),gswmod(4,j),xpco2i_stom(j),
|
||||
& pco2s(j),rehulfsurf(j),stargamma(j),pvapordef_s(j),
|
||||
& pres_air_stom(j),yAnet_stom(j)
|
||||
enddo
|
||||
else
|
||||
ballintersurf=-9999.0d0
|
||||
ballslopesurf=-9999.0d0
|
||||
ballrsqsurf=-9999.0d0
|
||||
ballinterinside=-9999.0d0
|
||||
ballslopeinside=-9999.0d0
|
||||
ballrsqinside=-9999.0d0
|
||||
ballinter=-9999.0d0
|
||||
ballslope=-9999.0d0
|
||||
ballrsqgsw=-9999.0d0
|
||||
ballrmsgsw=-9999.0d0
|
||||
ballagrindgsw=-9999.0d0
|
||||
raysurfinter=-9999.0d0
|
||||
raysurfslope=-9999.0d0
|
||||
raysurfd0=-9999.0d0
|
||||
raysurfrsqgsw=-9999.0d0
|
||||
raysurfrmsgsw=-9999.0d0
|
||||
raysurfagrindgsw=-9999.0d0
|
||||
belindainter=-9999.0d0
|
||||
belindaslope=-9999.0d0
|
||||
belindad0=-9999.0d0
|
||||
belindarsqgsw=-9999.0d0
|
||||
belindarmsgsw=-9999.0d0
|
||||
belindaagrindgsw=-9999.0d0
|
||||
dewarinter=-9999.0d0
|
||||
dewarslope=-9999.0d0
|
||||
deward0=-9999.0d0
|
||||
dewarrsqgsw=-9999.0d0
|
||||
dewarrmsgsw=-9999.0d0
|
||||
dewaragrindgsw=-9999.0d0
|
||||
endif
|
||||
!$$$$$$$$$$$$ End of Stomatal Conductance Fit $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
||||
!Now analyze the relationship of water use efficiency with ambient CO2
|
||||
if(idowue.eq.1)then
|
||||
do j=1,npoints
|
||||
wue(j)=yAnet(j)/trmmol(j)
|
||||
sig(j)=1.0d0
|
||||
enddo
|
||||
! malfit=3
|
||||
! do j=1,npoints
|
||||
! sig(j)=1.0d0
|
||||
! enddo
|
||||
! call lfit(co2a_ppm,wue,sig,npoints,alfit,malfit,malfit,
|
||||
! & lfitbasisfuncs,INFO)
|
||||
! do j=1,npoints
|
||||
! wuemod(j)=alfit(1)+alfit(2)*co2a_ppm(j)+alfit(3)*
|
||||
! & co2a_ppm(j)*co2a_ppm(j)/1000.0d0
|
||||
! enddo
|
||||
! call rsq_rms(wue,wuemod,npoints,rsqwue,rmswue,agrindwue)
|
||||
! wueref=alfit(1)+alfit(2)*co2current+alfit(3)*
|
||||
! & co2current*co2current/1000.0d0
|
||||
! der_wueref=alfit(2)+2.0d0*alfit(3)*co2current/1000.0d0
|
||||
|
||||
alfit(1)=1.0d0
|
||||
alfit(2)=0.1d0
|
||||
alfit(3)=-20.0d0
|
||||
alfit(4)=0.1d0
|
||||
alfit(5)=100.0d0
|
||||
bmin(1)=-1.0d+3
|
||||
bmax(1)=1.0d+4
|
||||
bmin(2)=-1.0d+4
|
||||
bmax(2)=1.0d+5
|
||||
bmin(3)=-1.0d+5
|
||||
bmax(3)=1.0d+5
|
||||
bmin(4)=-1.0d+5
|
||||
bmax(4)=1.0d+5
|
||||
bmin(5)=-1.0d+5
|
||||
bmax(5)=1.0d+5
|
||||
imodel=1
|
||||
numparams=5
|
||||
call cica_Regression5(npoints,wue,co2a_ppm,alfit,numparams,
|
||||
&imodel,bmin,bmax)
|
||||
call cicaoptimization5(npoints,wue,co2a_ppm,alfit,numparams,
|
||||
&imodel,bmin,bmax)
|
||||
do j=1,npoints
|
||||
call cica_ca5(imodel,numparams,alfit,co2a_ppm(j),wuemod(j),
|
||||
&der_wueref,der_alfit)
|
||||
enddo
|
||||
call cica_ca5(imodel,numparams,alfit,co2current,wueref,
|
||||
&der_wueref,der_alfit)
|
||||
call rsq_rms(wue,wuemod,npoints,rsqwue,rmswue,agrindwue)
|
||||
!------------------------------------------------------------------------------
|
||||
do j=1,npoints
|
||||
wue_intrin(j)=yAnet(j)/gswmeas(j)
|
||||
enddo
|
||||
! call lfit(co2a_ppm,wue_intrin,sig,npoints,blfit,malfit,
|
||||
! & malfit,lfitbasisfuncs,INFO)
|
||||
! do j=1,npoints
|
||||
! wue_intrinmod(j)=blfit(1)+blfit(2)*co2a_ppm(j)+
|
||||
! & blfit(3)*co2a_ppm(j)*co2a_ppm(j)/1000.0d0
|
||||
! enddo
|
||||
! call rsq_rms(wue_intrin,wue_intrinmod,npoints,rsqwue_intrin,
|
||||
! & rmswue,agrindwue)
|
||||
! wueref_intrin=blfit(1)+blfit(2)*co2current+blfit(3)*
|
||||
! & co2current*co2current/1000.0d0
|
||||
! der_wueref_intrin=blfit(2)+2.0d0*blfit(3)*co2current/1000.0d0
|
||||
|
||||
blfit(1)=1.0d0
|
||||
blfit(2)=0.10
|
||||
blfit(3)=-20.0d0
|
||||
blfit(4)=0.1d0
|
||||
blfit(5)=100.0d0
|
||||
|
||||
bmin(1)=-1.0d+5
|
||||
bmax(1)=1.0d+5
|
||||
bmin(2)=-1.0d+5
|
||||
bmax(2)=1.0d+5
|
||||
bmin(3)=-1.0d+5
|
||||
bmax(3)=1.0d+5
|
||||
bmin(4)=-1.0d+5
|
||||
bmax(4)=1.0d+5
|
||||
bmin(5)=-1.0d+5
|
||||
bmax(5)=1.0d+5
|
||||
numparams=5
|
||||
imodel=1
|
||||
call cica_Regression5(npoints,wue_intrin,co2a_ppm,
|
||||
&blfit,numparams,imodel,bmin,bmax)
|
||||
call cicaoptimization5(npoints,wue_intrin,co2a_ppm,
|
||||
&blfit,numparams,imodel,bmin,bmax)
|
||||
do j=1,npoints
|
||||
call cica_ca5(imodel,numparams,blfit,co2a_ppm(j),
|
||||
&wue_intrinmod(j),der_wueref_intrin,der_blfit)
|
||||
enddo
|
||||
call cica_ca5(imodel,numparams,blfit,co2current,
|
||||
&wueref_intrin,der_wueref_intrin,der_blfit)
|
||||
call rsq_rms(wue_intrin,wue_intrinmod,npoints,rsqwue_intrin,
|
||||
&rmswue,agrindwue)
|
||||
else
|
||||
rsqwue=-9999.0d0
|
||||
rmswue=-9999.0d0
|
||||
agrindwue=-9999.d0
|
||||
wueref=-9999.0d0
|
||||
der_wueref=-9999.0d0
|
||||
avevpdl=-9999.0d0
|
||||
avetleaf=-9999.0d0
|
||||
avetair=-9999.0d0
|
||||
do j=1,npoints
|
||||
wue(j)=-9999.0d0
|
||||
wuemod(j)=-9999.0d0
|
||||
wue_intrin(j)=-9999.0d0
|
||||
wue_intrinmod(j)=-9999.0d0
|
||||
enddo
|
||||
rsqwue_intrin=-9999.0d0
|
||||
wueref_intrin=-9999.0d0
|
||||
der_wueref_intrin=-9999.0d0
|
||||
do j=1,numparams
|
||||
alfit(j)=-9999.0d0
|
||||
blfit(j)=-9999.0d0
|
||||
enddo
|
||||
endif
|
||||
|
||||
!----------------------------------------------------------------------------
|
||||
!Now analyze the relationship of Ci/Ca ratio with ambient CO2 and Cc/Ci with Ci
|
||||
100 term=co2a_ppm(1)
|
||||
do j=2,npoints
|
||||
if(co2a_ppm(j).gt.term)then
|
||||
term=co2a_ppm(j)
|
||||
endif
|
||||
enddo
|
||||
bmin(1)=-1.0d+2
|
||||
bmax(1)=1.0d+2
|
||||
bmin(2)=-300.0d0/term
|
||||
bmax(2)=1.0d+6
|
||||
|
||||
if(idocica.eq.1)then
|
||||
do j=1,npoints
|
||||
cicameas(j)=co2i_ppm(j)/co2a_ppm(j)
|
||||
enddo
|
||||
|
||||
!Ci/Ca=a*exp(-b*Ca)+c+d*ln(co2a)+e*(ln(co2))**2
|
||||
|
||||
cicafit(1)=1.5874d0
|
||||
cicafit(2)=2.0343d0
|
||||
cicafit(3)=0.8779d0
|
||||
cicafit(4)=0.1d0
|
||||
cicafit(5)=0.01d0
|
||||
|
||||
bmin(3)=-1.0d+2
|
||||
bmax(3)=1.0d+2
|
||||
bmin(4)=-1.0d+2
|
||||
bmax(4)=1.0d+2
|
||||
bmin(5)=-1.0d+2
|
||||
bmax(5)=1.0d+2
|
||||
|
||||
numparams=5
|
||||
imodel=3
|
||||
call cica_Regression5(npoints,cicameas,co2a_ppm,
|
||||
&cicafit,numparams,imodel,bmin,bmax)
|
||||
call cicaoptimization5(npoints,cicameas,co2a_ppm,
|
||||
&cicafit,numparams,imodel,bmin,bmax)
|
||||
do j=1,npoints
|
||||
call cica_ca5(imodel,numparams,cicafit,co2a_ppm(j),
|
||||
&cicamod(j),der_cicaref,der_cicafit)
|
||||
enddo
|
||||
call cica_ca5(imodel,numparams,cicafit,co2current,
|
||||
&cicaref,der_cicaref,der_cicafit)
|
||||
call rsq_rms(cicameas,cicamod,npoints,rsqcica,rmscica,
|
||||
& agrindcica)
|
||||
else
|
||||
do j=1,npoints
|
||||
cicamod(j)=-9999.0d0
|
||||
enddo
|
||||
rsqcica=-9999.0d0
|
||||
rmscica=-9999.0d0
|
||||
agrindcica=-9999.0d0
|
||||
cicaref=-9999.0d0
|
||||
der_cicaref=-9999.0d0
|
||||
do j=1,numparams
|
||||
cicafit(j)=-9999.0d0
|
||||
der_cicafit(j)=-9999.0d0
|
||||
enddo
|
||||
endif
|
||||
!--------------------------------------------------------------------------
|
||||
!below we fit Cc/Ci
|
||||
110 do i=1,4
|
||||
do j=1,npoints
|
||||
cccimeas(i,j)=co2c_ppm(i,j)/co2i_ppm(j)
|
||||
enddo
|
||||
if(co2c_ppm(i,1).ge.0.0d0)then
|
||||
cccifit(i,1)=2.5874d0
|
||||
cccifit(i,2)=2.0343d0
|
||||
cccifit(i,3)=0.8779d0
|
||||
cccifit(i,4)=0.1d0
|
||||
cccifit(i,5)=0.01d0
|
||||
cccifit(i,6)=0.001d0
|
||||
|
||||
bmin(3)=-1.0d+2
|
||||
bmax(3)=1.0d+2
|
||||
bmin(4)=-1.0d+2
|
||||
bmax(4)=1.0d+2
|
||||
bmin(5)=-1.0d+2
|
||||
bmax(5)=1.0d+2
|
||||
bmin(6)=-1.0d+2
|
||||
bmax(6)=1.0d+2
|
||||
|
||||
numparams=6
|
||||
imodel=3
|
||||
call cica_Regression5(npoints,cccimeas(i:i,1:npoints),
|
||||
&co2i_ppm,cccifit(i:i,1:numparams),numparams,imodel,bmin,bmax)
|
||||
call cicaoptimization5(npoints,cccimeas(i:i,1:npoints),
|
||||
&co2i_ppm,cccifit(i:i,1:numparams),numparams,imodel,bmin,bmax)
|
||||
do j=1,npoints
|
||||
call cica_ca5(imodel,numparams,cccifit(i:i,1:numparams),
|
||||
&co2i_ppm(j),cccimod(i,j),der_ccciref(i),der_cccifit)
|
||||
enddo
|
||||
if(dabs(cicaref+9999.0d0).gt.1.0d-5)then
|
||||
co2iref=cicaref*co2current
|
||||
else
|
||||
co2iref=0.75d0*co2current
|
||||
endif
|
||||
call cica_ca5(imodel,numparams,cccifit(i:i,1:numparams),
|
||||
&co2iref,ccciref(i),der_ccciref(i),der_cccifit)
|
||||
call rsq_rms(cccimeas(i:i,1:npoints),cccimod(i:i,1:npoints),
|
||||
&npoints,rsqccci(i),rmsccci(i),agrindccci(i))
|
||||
else
|
||||
do j=1,npoints
|
||||
cccimod(i,j)=-9999.0d0
|
||||
enddo
|
||||
rsqccci(i)=-9999.0d0
|
||||
rmsccci(i)=-9999.0d0
|
||||
agrindccci(i)=-9999.0d0
|
||||
ccciref(i)=-9999.0d0
|
||||
der_ccciref(i)=-9999.0d0
|
||||
do j=1,numparams
|
||||
cccifit(i,j)=-9999.0d0
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
!-----------------------------------------------------------------------
|
||||
!now we fit CO2 recycling ratio
|
||||
do i=1,6
|
||||
if(co2recycleratio(i,1).ge.0.0d0)then
|
||||
recycfit(i,1)=2.5874d0
|
||||
recycfit(i,2)=2.0343d0
|
||||
recycfit(i,3)=0.8779d0
|
||||
recycfit(i,4)=0.1d0
|
||||
recycfit(i,5)=0.01d0
|
||||
recycfit(i,6)=0.001d0
|
||||
bmin(3)=-1.0d+2
|
||||
bmax(3)=1.0d+2
|
||||
bmin(4)=-1.0d+2
|
||||
bmax(4)=1.0d+2
|
||||
bmin(5)=-1.0d+2
|
||||
bmax(5)=1.0d+2
|
||||
bmin(6)=-1.0d+2
|
||||
bmax(6)=1.0d+2
|
||||
numparams=5
|
||||
imodel=3
|
||||
call cica_Regression5(npoints,co2recycleratio(i:i,1:npoints),
|
||||
&co2i_ppm,recycfit(i:i,1:numparams),numparams,imodel,bmin,bmax)
|
||||
call cicaoptimization5(npoints,co2recycleratio(i:i,1:npoints),
|
||||
&co2i_ppm,recycfit(i:i,1:numparams),numparams,imodel,bmin,bmax)
|
||||
do j=1,npoints
|
||||
call cica_ca5(imodel,numparams,recycfit(i:i,1:numparams),
|
||||
&co2i_ppm(j),recycmod(i,j),der_recycref(i),der_recycfit)
|
||||
enddo
|
||||
if(dabs(cicaref+9999.0d0).gt.1.0d-5)then
|
||||
co2iref=cicaref*co2current
|
||||
else
|
||||
co2iref=0.75d0*co2current
|
||||
endif
|
||||
call cica_ca5(imodel,numparams,recycfit(i:i,1:numparams),
|
||||
&co2iref,recycref(i),der_recycref(i),der_recycfit)
|
||||
call rsq_rms(co2recycleratio(i:i,1:npoints),
|
||||
&recycmod(i:i,1:npoints),npoints,rsqrecyc(i),rmsrecyc(i),
|
||||
&agrindrecyc(i))
|
||||
else
|
||||
do j=1,npoints
|
||||
recycmod(i,j)=-9999.0d0
|
||||
enddo
|
||||
rsqrecyc(i)=-9999.0d0
|
||||
rmsrecyc(i)=-9999.0d0
|
||||
agrindrecyc(i)=-9999.0d0
|
||||
recycref(i)=-9999.0d0
|
||||
der_recycref(i)=-9999.0d0
|
||||
do j=1,numparams
|
||||
recycfit(i,j)=-9999.0d0
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
!-----------------------------------------------------------------------
|
||||
do j=1,npoints
|
||||
write(unitwuecicacomp,380)curveno,trim(curvename),co2a_ppm(j),
|
||||
&vpdl(j),wue(j),wuemod(j),cicameas(j),cicamod(j),wue_intrin(j),
|
||||
&wue_intrinmod(j),((cccimeas(k,j),cccimod(k,j)),k=1,4),
|
||||
&((co2recycleratio(k,j),recycmod(k,j)),k=1,6)
|
||||
enddo
|
||||
write(unitparamsout,390)curveno,trim(curvename),npoints_stom,
|
||||
&co2threshold,co2current,vpdl_ref,ballintersurf,ballslopesurf,
|
||||
&ballrsqsurf,ballinterinside,ballslopeinside,ballrsqinside,
|
||||
&ballinter,ballslope,ballrsqgsw,raysurfinter,raysurfslope,
|
||||
&raysurfd0,raysurfrsqgsw,belindainter,belindaslope,
|
||||
&belindad0,belindarsqgsw,dewarinter,dewarslope,deward0,
|
||||
&dewarrsqgsw,wueref,der_wueref,rsqwue,(alfit(i),i=1,5),
|
||||
&wueref_intrin,der_wueref_intrin,rsqwue_intrin,(blfit(i),i=1,5),
|
||||
&cicaref,der_cicaref,rsqcica,(cicafit(i),i=1,5),
|
||||
&avetleaf,avetair,avevpdl,avepari,((ccciref(i),der_ccciref(i),
|
||||
&rsqccci(i),(cccifit(i,j),j=1,6)),i=1,4),
|
||||
&((recycref(i),der_recycref(i),
|
||||
&rsqrecyc(i),(recycfit(i,j),j=1,5)),i=1,6),
|
||||
!
|
||||
&trim(siteID),Latitude,Longitude,Elevation,yearsampled,
|
||||
&sampledoy,GrowingSeasonStart,GrowingSeasonEnd,
|
||||
&standage,CanopyHeight,LeafAreaIndex,trim(species),
|
||||
&avetimeresolution,avetimesampled,SampleHeight,
|
||||
&Needleage,specificLAI,nitrogencontent,carboncontent,
|
||||
&phoscontent,trim(woodporosity),sapwooddensity,leafratio
|
||||
370 format(i0,',',a,',',13(f0.8,','),f0.8)
|
||||
380 format(i0,',',a,',',27(f0.8,','),f0.8)
|
||||
390 format(i0,',',a,',',i0,',',136(f0.8,','),a,',',10(f0.8,','),
|
||||
&a,',',8(f0.8,','),a,',',f0.8,',',f0.8)
|
||||
return
|
||||
end subroutine LeafGasFit_Stom
|
||||
Reference in New Issue
Block a user