628 lines
23 KiB
FortranFixed
628 lines
23 KiB
FortranFixed
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
|