Kolpack-Software-Consulting/piscal
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

New changes from l2g

Browse Source 
w
This commit is contained in:
James Kolpack
2022-09-12 16:40:28 +00:00
parent 78eb7147d0
commit d713d4f61a
110 changed files with 87672 additions and 1098 deletions
Download Patch File Download Diff File Expand all files Collapse all files
leafres/testarea/C4PhotoFit.f
+75
View File
@@ -0,0 +1,75 @@
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
subroutine C4PhotoFit()
implicit none
include '../testarea/LeafGasParams.h'
include '../testarea/LeafGasHybridFit.h'
integer i,ndim,k,j,iderivative,iwrong,jnon,n,icompete,isame,i2,
&isitnaninf,nave
double precision beta(20),sumsquare0,beta0(20),sumsquarecp,
&betacp(20),ftol,xtol,shortx(maxobs,10),shorty(maxobs,5),
&ftol_relax,term1,term2,ran2,history(2000,25),discount,upper,lower,
&f1dim_C4Fit,ff_pikaia
parameter(ftol=1.0d-7,xtol=1.0d-7)
external funkmin_C4Fit,f1dim_C4Fit,FCN_C4Fit,ff_pikaia
ndim=3
beta(1)=vcmax25_ori
beta(2)=c4aparslope_ori
beta(3)=c4kp25_ori
betamin(1)=0.0d0
betamax(1)=500.0d0
betamin(2)=0.0d0
betamax(2)=10.0d0
betamin(3)=0.0d0
betamax(3)=200000.0d0*betamax(1)
if(idord.eq.1)then
ndim=4
beta(ndim)=rdlight25_ori
betamin(ndim)=0.0d0
betamax(ndim)=15.0d0
endif
isitbounded=1
call funkmin_C4Fit(ndim,beta,sumsquare)
do i=1,ndim
beta0(i)=beta(i)
enddo
sumsquare0=sumsquare
do i=1,ntotsamples
responses(i,1)=anet_obs(i)
forcings(i,1)=pco2i(i)
forcings(i,2)=aPPFDlf(i)
forcings(i,3)=templeaf(i)
forcings(i,4)=pres_air(i)
do j=1,4
weitforcings(i,j)=1.0d0
enddo
weitresponses(i,1)=1.0d0
enddo
j=4
i=1
iderivative=0
iwrong=0
call odr_leastsquare(ndim,FCN_C4Fit,beta,ntotsamples,
&forcings(1:ntotsamples,1:j),j,responses(1:ntotsamples,1:i),i,
&weitforcings(1:ntotsamples,1:j),weitresponses(1:ntotsamples,1:i),
&iderivative,shortx(1:ntotsamples,1:j),shorty(1:ntotsamples,1:i),
&sumsquare,iwrong)
!after odr_leastsquare, forcing variables are destroyed. restore to the origninals
do i=1,ntotsamples
pco2i(i)=pco2i_ori(i)
aPPFDlf(i)=aPPFDlf_ori(i)
templeaf(i)=templeaf_ori(i)
pres_air(i)=pres_air_ori(i)
enddo
call funkmin_C4Fit(ndim,beta,sumsquare)
do i=1,10
call nongradopt(ndim,funkmin_C4Fit,f1dim_C4Fit,beta,betamin,
&betamax,ftol,sumsquare)
call funkmin_C4Fit(ndim,beta,sumsquare)
call RepeatCompassSearch(ndim,beta,sumsquare,
&betamin,betamax,funkmin_C4Fit,f1dim_C4Fit,ftol)
call funkmin_C4Fit(ndim,beta,sumsquare)
enddo
call ilimittypestats(ntotsamples,Postiphotolimit,
&bestilimittype,bestnumrubis,bestnumrubp,bestnumtpu)
return
END subroutine C4PhotoFit
leafres/testarea/C4SetUpLeafGasFit.f
+1578
View File
File diff suppressed because it is too large Load Diff
leafres/testarea/HybridCombinatorial.f
+1 -1
View File
@@ -233,7 +233,7 @@
2001 continue
enddo
! goto 1000
goto 1000
gacontrol(1)=200.0d0
gacontrol(2)=2000.0d0
leafres/testarea/LeafGasFit_Stom.f
+6 -6
View File
@@ -596,8 +596,8 @@
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)
&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,
@@ -608,10 +608,10 @@
&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),
&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,
leafres/testarea/LeafGasPISCAL_mpi.f
+64 -86
View File
@@ -17,7 +17,7 @@
integer dataunit,spareunit,ierr(2),runvalues(8),ipos1,ipos2,
&ntotfiles,noutputfiles,i,j,k,rank_mpi,numproc_mpi,numproc,
&ierror_mpi,nshare,nmod,npartfiles,istartno,iendno,indexunit(20),
&numchar,needheader(20),rootprocess
&numchar,needheader(20),rootprocess,ic3c4cam
character rundate*8,runtime*10,runzone*5,longchar*5000,achar*5,
&longchar1*5000
character*100 datapath,outpath,storein,storeout,ACidata(8000)
@@ -26,12 +26,13 @@
! Set input / output directory
parameter(
& datapath=
&'../input/',
! &'/home/l2g/ngeetropics/gamboa/curves/',
! &'/home/l2g/ngeetropics/metropolitano/curves/',
! &'/home/l2g/ngeetropics/fortsherman/curves/',
! & '/home/l2g/ngeetropics/kelsey/curves/',
! & '/home/l2g/leafres/hybriddata/Berner/',
& '/home/l2g/SingleLeafModel/ACiSimulation/hybrid/',
! & '/home/l2g/SingleLeafModel/ACiSimulation/hybrid/',
! &'/home/l2g/leafweb/data/dweston/Sphagnum_leafweb_Oct2015/',
! & '/home/l2g/SingleLeafModel/ACiSimulation/wenting/',
@@ -61,12 +62,13 @@
! & '/home/l2g/dataassim/leaf/data/dweston/inputs/',
! & '/home/l2g/GEMSiS/curves/',
& outpath=
&'../output/fitresult/touser/',
! &'/home/l2g/ngeetropics/gamboa/results/',
! &'/home/l2g/ngeetropics/metropolitano/results/',
! &'/home/l2g/ngeetropics/fortsherman/',
! &'/home/l2g/ngeetropics/kelsey/results/',
! & '/home/l2g/leafres/hybriddata/Berner/',
& '/home/l2g/SingleLeafModel/ACiSimulation/hybrid/',
! & '/home/l2g/SingleLeafModel/ACiSimulation/hybrid/',
! &'/home/l2g/leafweb/data/dweston/Sphagnum_leafweb_Oct2015/',
! &'/home/l2g/leafres/hybriddata/cernusak/2014data/',
! & '/home/l2g/SingleLeafModel/ACiSimulation/wenting/',
@@ -100,23 +102,50 @@
! &storein='/home/l2g/leafweb/users/curves/',
! &storeout='/home/l2g/leafweb/users/results/',
&storein='/home/l2g/clm/results/',
&storeout='/home/l2g/clm/results/',
&storein='../output/clninput/',
&storeout='../output/fitresult/nottouser/',
! &storein='/home/l2g/junk/',
! &storeout='/home/l2g/junk/',
! &storein='/home/l2g/dataassim/leaf/data/ellsworth/outputs/',
! &storeout='/home/l2g/dataassim/leaf/data/ellsworth/outputs/',
& AllACiFiles='AllLeafGasFiles')
& AllACiFiles='../piscal.cfg')
!---------------End of variable declaration----------------
rootprocess=0
dataunit=1
spareunit=3
! if(rank_mpi.ne.rootprocess)goto 25
!read A/Ci curve names stored in AllACiFiles
open(unit=2,file=trim(datapath)//trim(AllACiFiles))
open(unit=2,file=trim(AllACiFiles))
ntotfiles=1
ic3c4cam=-9999
10 read(2,fmt=300,end=20)longchar
if(longchar.eq.''.or.longchar.eq.' ')goto 10
if(ntotfiles.eq.1.and.ic3c4cam.lt.0)then
i=0
if(index(longchar,'_photosynthesis_leafweb').gt.0)then
i=index(longchar,'c3')+index(longchar,'C3')
if(i.gt.0)then
ic3c4cam=1
else
i=index(longchar,'c4')+index(longchar,'C4')
if(i.gt.0)then
ic3c4cam=2
else
i=index(longchar,'cam')+index(longchar,'caM')+
&index(longchar,'cAm')+index(longchar,'cAM')+
&index(longchar,'Cam')+index(longchar,'CaM')+
&index(longchar,'CAm')+index(longchar,'CAM')
if(i.gt.0)ic3c4cam=3
endif
endif
endif
if(i.gt.0)goto 10
!if no indication is provided, c3 photosynthesis is assumed and the first line
!contains the name of the first data file
ic3c4cam=1
endif
i=len(longchar)
j=0
15 j=j+1
@@ -153,6 +182,9 @@
noutputfiles=11
!10 to 20 are used for file units for output files
do i=1,noutputfiles
if(ic3c4cam.eq.1)outputfile(i)='C3_'//outputfile(i)
if(ic3c4cam.eq.2)outputfile(i)='C4_'//outputfile(i)
if(ic3c4cam.eq.3)outputfile(i)='CAM_'//outputfile(i)
indexunit(i)=i+9
enddo
call MPI_INIT(ierror_mpi)
@@ -190,82 +222,16 @@
numchar=numchar+1
goto 30
40 call NumberToChar(rank_mpi,numchar,achar)
do i=1,noutputfiles-1
do i=1,noutputfiles
open(unit=indexunit(i),
&file=trim(outpath)//trim(outputfile(i))//trim(achar))
enddo
call ToLeafGasOptimization(npartfiles,ACidata(istartno:iendno),
&dataunit,spareunit,datapath,indexunit,ierr)
do i=1,noutputfiles-1
call ToLeafGasOptimization(ic3c4cam,npartfiles,
&ACidata(istartno:iendno),dataunit,spareunit,datapath,indexunit,
&ierr)
do i=1,noutputfiles
close(indexunit(i))
enddo
if(ierr(1).ne.0)then
i=indexunit(noutputfiles)
open(unit=i,
&file=trim(outpath)//trim(outputfile(noutputfiles))//trim(achar))
write(i,*)'Input data error in ',ACidata(ierr(2)+istartno-1)
write(i,*)
&'Please resubmit the data after correcting the following error:'
if(ierr(1).eq.1)then
write(i,*)'Photosynthesis (umol/m2/s) out of range'
endif
if(ierr(1).eq.2)then
write(i,*)'Intercellular CO2(ppm) out of range'
endif
if(ierr(1).eq.3)then
write(i,*)'Leaf temperature (oC) out of range'
endif
if(ierr(1).eq.4)then
write(i,*)'Chamber PAR (umol/m2/s) out of range'
endif
if(ierr(1).eq.5)then
write(i,*)'Atmospheric pressure (Pa) out of range'
endif
if(ierr(1).eq.13)then
write(i,*)'Check line 13 for data entry error'
endif
if(ierr(1).eq.14)then
write(i,*)'Specified chloroplastic CO2 compensation point',
&'(Pa) out of range'
endif
if(ierr(1).eq.15)then
write(i,*)'Specified Michaelis-Menten constant for the',
&'carboxylase (Kc) out of range'
endif
if(ierr(1).eq.16)then
write(i,*)'Specified Michaelis-Menten constant for the',
&'oxygenase (Ko) out of range'
endif
if(ierr(1).eq.17)then
write(i,*)'Specified fraction of nonreturned glycolate',
&'carbon(alpha) out of range 0~1'
endif
if(ierr(1).eq.18)then
write(i,*)'Specified dark respiration rate Rd out of range >0'
endif
if(ierr(1).eq.19)then
write(i,*)'Specified mesophyll) resistance rch or rwp out of',
&'of range >0'
endif
if(ierr(1).eq.34)then
write(i,*)'Check Column 33 or 34. Mixing area- and mass-based
&measurements is not allowed'
endif
if(ierr(1).eq.36)then
write(i,*)'Check line 16 for data entry error'
endif
if(ierr(1).eq.39)then
write(i,*)
&'Check the main body of data for data entry error, starting from
&line 19'
endif
if(ierr(1).eq.40)then
write(i,*)
&'Data file format cannot be recognized'
endif
close(i)
endif
!make sure everyone is done before wrapping up.
45 call MPI_BARRIER(MPI_COMM_WORLD,ierror_mpi)
if(rank_mpi.eq.rootprocess)then
@@ -326,29 +292,41 @@
enddo
!----------------------------------------------------------
!intercept the data
goto 450
399 call date_and_time(rundate,runtime,runzone,runvalues)
if(needheader(noutputfiles).eq.2)then
!if there is error in any input files, donot store the data
do i=1,ntotfiles
open(unit=1,file=trim(datapath)//'clean'//trim(ACidata(i)))
close(1,status='delete')
enddo
goto 450
endif
call date_and_time(rundate,runtime,runzone,runvalues)
do i=1,ntotfiles
open(unit=1,file=trim(datapath)//trim(ACidata(i)))
open(unit=1,file=trim(datapath)//'clean'//trim(ACidata(i)))
open(unit=2,file=
&trim(storein)//rundate//runtime(1:6)//trim(ACidata(i)))
&trim(storein)//rundate//runtime(1:6)//'clean'//trim(ACidata(i)))
400 read(1,fmt=300,end=410)longchar
write(2,310)trim(longchar)
goto 400
410 close(1)
410 close(1,status='delete')
close(2)
enddo
do i=1,6
do i=1,noutputfiles
k=0
open(unit=1,file=trim(outpath)//trim(outputfile(i)))
open(unit=2,file=
if(i.ge.3.and.i.le.5)then
open(unit=2,file=
&trim(storeout)//rundate//runtime(1:6)//trim(outputfile(i)))
else
open(unit=2,file=
&trim(outpath)//rundate//runtime(1:6)//trim(outputfile(i)))
endif
420 read(1,fmt=300,end=430)longchar
write(2,310)trim(longchar)
k=1
goto 420
430 if(k.eq.1)then
close(1)
close(1,status='delete')
close(2)
else
close(1,status='delete')
leafres/testarea/LeafGasPISCAL_single.f
+98 -112
View File
@@ -15,7 +15,7 @@
program main
implicit none
integer dataunit,spareunit,ierr(2),runvalues(8),ipos1,ipos2,
&ntotfiles,noutputfiles,i,j,k,indexunit(20)
&ntotfiles,noutputfiles,i,j,k,indexunit(20),ic3c4cam
character rundate*8,runtime*10,runzone*5,longchar*5000
character*100 datapath,outpath,storein,storeout,
&ACidata(8000)
@@ -23,11 +23,14 @@
! Set input / output directory
parameter(datapath=
! &'../input/',
&'/home/l2g/jimei/',
! &'/home/l2g/ngeetropics/gamboa/curves/',
! &'/home/l2g/ngeetropics/metropolitano/curves/',
! &'/home/l2g/ngeetropics/fortsherman/curves/',
! &'/home/l2g/ngeetropics/kelsey/curves/',
& '/home/l2g/SingleLeafModel/ACiSimulation/hybrid/',
! & '/home/l2g/SingleLeafModel/ACiSimulation/hybrid/',
! &'/home/l2g/leafres/hybriddata/nicksmith/data/',
! &'/home/l2g/leafres/hybriddata/dwestonpoplus/data3/',
! &'/home/l2g/leafres/hybriddata/cernusak/2014data/',
! &'/home/l2g/leafres/hybriddata/hanjimei/',
@@ -59,6 +62,8 @@
! & '/home/l2g/dataassim/leaf/data/dweston/inputs/',
! & '/home/l2g/GEMSiS/curves/',
& outpath=
! &'../output/fitresult/touser/',
&'/home/l2g/jimei/',
! &'/home/l2g/ngeetropics/gamboa/results/',
! &'/home/l2g/ngeetropics/metropolitano/results/',
! &'/home/l2g/ngeetropics/fortsherman/results/',
@@ -69,7 +74,9 @@
! &'/home/l2g/leafres/hybriddata/hanjimei/',
!
! & '/home/l2g/leafres/hybriddata/Berner/',
& '/home/l2g/SingleLeafModel/ACiSimulation/hybrid/',
! & '/home/l2g/SingleLeafModel/ACiSimulation/hybrid/',
! & '/home/l2g/leafres/hybriddata/nicksmith/results/',
! & '/home/l2g/leafres/hybriddata/huidafeng/',
! &'/home/l2g/leafres/hybriddata/dwestonpoplus/data_Pn_tree_1_195_v2/
! &',
@@ -99,43 +106,28 @@
! &storein='/home/l2g/leafweb/users/curves/',
! &storeout='/home/l2g/leafweb/users/results/',
&storein='/home/l2g/leafres/testdata/',
&storeout='/home/l2g/leafres/testdata/',
! &storein='/home/l2g/junk/',
! &storeout='/home/l2g/junk/',
! &storein='../output/clninput/',
! &storeout='../output/fitresult/nottouser/',
&storein='/home/l2g/jimei/',
&storeout='/home/l2g/jimei/',
! &storein='/home/l2g/dataassim/leaf/data/ellsworth/outputs/',
! &storeout='/home/l2g/dataassim/leaf/data/ellsworth/outputs/',
& AllACiFiles='AllLeafGasFiles')
! & AllACiFiles='../piscal.cfg')
&AllACiFiles='/home/l2g/jimei/piscal.cfg')
!---------------End of variable declaration----------------
ierr(1)=-1
ierr(2)=-1
outputfile(1)='leafgasparameters.csv'
outputfile(2)='leafgascomparison.csv'
outputfile(3)='stomwuecicaparameters.csv'
outputfile(4)='stomcomparison.csv'
outputfile(5)='wuecicacomparison.csv'
outputfile(6)='fluorescencefit.csv'
outputfile(7)='fluoresparameters.csv'
outputfile(8)='aciempfitparameters.csv'
outputfile(9)='alightempfitparameters.csv'
outputfile(10)='warningmessage'
outputfile(11)='errormessage'
noutputfiles=11
do i=1,noutputfiles
indexunit(i)=i+9
enddo
do i=1,noutputfiles-1
open(unit=indexunit(i),file=trim(outpath)//trim(outputfile(i)))
enddo
!read A/Ci curve names stored in AllACiFiles
dataunit=1
spareunit=3
open(unit=dataunit,status='scratch')
open(unit=spareunit,file=trim(datapath)//trim(AllACiFiles))
read(spareunit,fmt=300,err=40,end=40)longchar
open(unit=spareunit,file=trim(AllACiFiles))
read(spareunit,fmt=300,err=90,end=90)longchar
rewind(spareunit)
2 read(spareunit,fmt=300,err=40,end=5)longchar
2 read(spareunit,fmt=300,err=90,end=5)longchar
if(longchar.eq.''.or.longchar.eq.' ')goto 2
3 k=index(longchar,char(13))
if(k.gt.0)then
!DOS text format, convert it to unix format
@@ -147,7 +139,34 @@
5 close(spareunit)
rewind(dataunit)
ntotfiles=1
ic3c4cam=-9999
10 read(dataunit,fmt=300,end=20)longchar
if(ntotfiles.eq.1.and.ic3c4cam.lt.0)then
i=0
if((index(longchar,'_photosynthesis_leafweb')+
&index(longchar,'_Photosynthesis_leafweb')+
&index(longchar,'_Photosynthesis_LeafWeb')).gt.0)then
i=index(longchar,'c3')+index(longchar,'C3')
if(i.gt.0)then
ic3c4cam=1
else
i=index(longchar,'c4')+index(longchar,'C4')
if(i.gt.0)then
ic3c4cam=2
else
i=index(longchar,'cam')+index(longchar,'caM')+
&index(longchar,'cAm')+index(longchar,'cAM')+
&index(longchar,'Cam')+index(longchar,'CaM')+
&index(longchar,'CAm')+index(longchar,'CAM')
if(i.gt.0)ic3c4cam=3
endif
endif
endif
if(i.gt.0)goto 10
!if no indication is provided, c3 photosynthesis is assumed and the first line
!contains the name of the first data file
ic3c4cam=1
endif
i=len(longchar)
j=0
15 j=j+1
@@ -170,83 +189,32 @@
goto 10
20 ntotfiles=ntotfiles-1
close(dataunit)
call ToLeafGasOptimization(ntotfiles,ACidata,dataunit,spareunit,
&datapath,indexunit,ierr)
40 do i=1,noutputfiles-1
outputfile(1)='leafgasparameters.csv'
outputfile(2)='leafgascomparison.csv'
outputfile(3)='stomwuecicaparameters.csv'
outputfile(4)='stomcomparison.csv'
outputfile(5)='wuecicacomparison.csv'
outputfile(6)='fluorescencefit.csv'
outputfile(7)='fluoresparameters.csv'
outputfile(8)='aciempfitparameters.csv'
outputfile(9)='alightempfitparameters.csv'
outputfile(10)='warningmessage'
outputfile(11)='errormessage'
noutputfiles=11
do i=1,noutputfiles
if(ic3c4cam.eq.1)outputfile(i)='C3_'//outputfile(i)
if(ic3c4cam.eq.2)outputfile(i)='C4_'//outputfile(i)
if(ic3c4cam.eq.3)outputfile(i)='CAM_'//outputfile(i)
indexunit(i)=i+9
enddo
do i=1,noutputfiles
open(unit=indexunit(i),file=trim(outpath)//trim(outputfile(i)))
enddo
call ToLeafGasOptimization(ic3c4cam,ntotfiles,ACidata,dataunit,
&spareunit,datapath,indexunit,ierr)
do i=1,noutputfiles
close(indexunit(i))
enddo
if(ierr(1).ne.0)then
i=indexunit(noutputfiles)
open(unit=i,file=trim(outpath)//trim(outputfile(noutputfiles)))
if(ierr(1).eq.-1)then
close(spareunit)
write(i,*)
&'No data files to analyze or incorrect file name format'
else
write(i,*)'Input data error in ',trim(ACidata(ierr(2)))
write(i,*)
&'Please resubmit the data after correcting the following error:'
endif
if(ierr(1).eq.1)then
write(i,*)'Photosynthesis (umol/m2/s) out of range'
endif
if(ierr(1).eq.2)then
write(i,*)'Intercellular CO2(ppm) out of range'
endif
if(ierr(1).eq.3)then
write(i,*)'Leaf temperature (oC) out of range'
endif
if(ierr(1).eq.4)then
write(i,*)'Chamber PAR (umol/m2/s) out of range'
endif
if(ierr(1).eq.5)then
write(i,*)'Atmospheric pressure (Pa) out of range'
endif
if(ierr(1).eq.13)then
write(i,*)'Check line 13 for data entry error'
endif
if(ierr(1).eq.14)then
write(i,*)'Specified chloroplastic CO2 compensation point',
&'(Pa) out of range'
endif
if(ierr(1).eq.15)then
write(i,*)'Specified Michaelis-Menten constant for the',
&'carboxylase (Kc) out of range'
endif
if(ierr(1).eq.16)then
write(i,*)'Specified Michaelis-Menten constant for the',
&'oxygenase (Ko) out of range'
endif
if(ierr(1).eq.17)then
write(i,*)'Specified fraction of nonreturned glycolate',
&'carbon(alpha) out of range 0~1'
endif
if(ierr(1).eq.18)then
write(i,*)'Specified dark respiration rate Rd out of range >0'
endif
if(ierr(1).eq.19)then
write(i,*)'Specified internal (mesophyll) conductance gi out',
&'of range >0'
endif
if(ierr(1).eq.34)then
write(i,*)'Check Column 33 or 34. Mixing area- and mass-based
&measurements is not allowed'
endif
if(ierr(1).eq.36)then
write(i,*)'Check line 16 for data entry error'
endif
if(ierr(1).eq.39)then
write(i,*)
&'Check the main body of data for data entry error, starting from
&line 19'
endif
if(ierr(1).eq.40)then
write(i,*)
&'Data file format cannot be recognized'
endif
close(i)
endif
do j=1,noutputfiles
open(unit=2,file=trim(outpath)//trim(outputfile(j)))
read(2,*,end=70)
@@ -260,29 +228,47 @@
80 enddo
!----------------------------------------------------------
!intercept the data
goto 450
399 call date_and_time(rundate,runtime,runzone,runvalues)
90 if(ierr(1).ne.0)then
if(ierr(1).eq.-1)then
close(spareunit)
open(unit=spareunit,file=trim(outpath)//'errormessage')
write(spareunit,*)'No data files to analyze'
close(spareunit)
goto 450
endif
do i=1,ntotfiles
open(unit=1,file=trim(datapath)//'clean'//trim(ACidata(i)))
close(1,status='delete')
enddo
goto 450
endif
call date_and_time(rundate,runtime,runzone,runvalues)
do i=1,ntotfiles
open(unit=1,file=trim(datapath)//trim(ACidata(i)))
open(unit=1,file=trim(datapath)//'clean'//trim(ACidata(i)))
open(unit=2,file=
&trim(storein)//rundate//runtime(1:6)//trim(ACidata(i)))
&trim(storein)//rundate//runtime(1:6)//'clean'//trim(ACidata(i)))
400 read(1,fmt=300,end=410)longchar
write(2,310)trim(longchar)
goto 400
410 close(1)
410 close(1,status='delete')
close(2)
enddo
do i=1,6
do i=1,noutputfiles
k=0
open(unit=1,file=trim(outpath)//trim(outputfile(i)))
open(unit=2,file=
if(i.ge.3.and.i.le.5)then
open(unit=2,file=
&trim(storeout)//rundate//runtime(1:6)//trim(outputfile(i)))
else
open(unit=2,file=
&trim(outpath)//rundate//runtime(1:6)//trim(outputfile(i)))
endif
420 read(1,fmt=300,end=430)longchar
write(2,310)trim(longchar)
k=1
goto 420
430 if(k.eq.1)then
close(1)
close(1,status='delete')
close(2)
else
close(1,status='delete')
leafres/testarea/LeafGasParams.h
+2 -2
View File
@@ -58,7 +58,7 @@
&ha_stargammamin,ha_stargammamax,ha_stargamma_ori,ha_vcmaxmin,
&ha_vcmaxmax,ha_vcmax_ori,ha_jmaxmin,ha_jmaxmax,ha_jmax_ori,
&ha_tpumin,ha_tpumax,ha_tpu_ori,ha_gmesomin,ha_gmesomax,
&ha_gmeso_ori
&ha_gmeso_ori,c4aparslope,c4aparslope_ori,c4kp25,c4kp25_ori
integer minimumrubis,minimumfj,minimumvt,idorwp,idorch,idord,
&idostargamma,idoalpha,idokc,idoko,ifixunivparams(maxpsnparam),
@@ -84,7 +84,7 @@
&ha_stargammamin,ha_stargammamax,ha_stargamma_ori,ha_vcmaxmin,
&ha_vcmaxmax,ha_vcmax_ori,ha_jmaxmin,ha_jmaxmax,ha_jmax_ori,
&ha_tpumin,ha_tpumax,ha_tpu_ori,ha_gmesomin,ha_gmesomax,
&ha_gmeso_ori
&ha_gmeso_ori,c4aparslope,c4aparslope_ori,c4kp25,c4kp25_ori
common /intleafparams/minimumrubis,minimumfj,minimumvt,idorwp,
&idorch,idord,idostargamma,idoalpha,idokc,idoko,ifixunivparams,
leafres/testarea/LeafGasPrintToFiles.f
+26 -15
View File
@@ -1,8 +1,9 @@
subroutine LeafGasPrintToFiles(isitmassbased,indexunit)
subroutine LeafGasPrintToFiles(isitmassbased,indexunit,
&ic3c4cam)
implicit none
integer isitmassbased,indexunit(20),paramunit,compareunit,
&stomwuecicaoutunit,stomcompunit,wuecicacompunit,fluorescenceunit,
&fluoresparamunit,aciempfitunit,alightempfitunit
&fluoresparamunit,aciempfitunit,alightempfitunit,ic3c4cam
character *25,
& sitevars(50),unitsitevars(50),
& paramsvar(0:50),unitparamsvar(0:50),
@@ -363,7 +364,7 @@
unitparamsvar(41)='umolkg-1s-1'
unitparamsvar(42)='umolkg-1s-1'
endif
sitevars(1)='siteID'
sitevars(2)='Latitude'
sitevars(3)='Longitude'
@@ -411,15 +412,25 @@
unitsitevars(21)='ring/diffuse'
unitsitevars(22)='g/cm3'
unitsitevars(23)='Unitless'
write(paramunit,'(2000A)')(trim(univcomvars(i)),',',i=1,9),
if(ic3c4cam.eq.1)then
write(paramunit,'(2000A)')(trim(univcomvars(i)),',',i=1,9),
&(trim(paramsvar(i)),',',i=0,34),(trim(paramsvar(i)),',',i=39,42),
&(trim(sitevars(i)),',',i=1,22),trim(sitevars(23))
write(paramunit,'(2000A)')(trim(unitunivcomvars(i)),',',i=1,9),
write(paramunit,'(2000A)')(trim(unitunivcomvars(i)),',',i=1,9),
&(trim(unitparamsvar(i)),',',i=0,34),
&(trim(unitparamsvar(i)),',',i=39,42),
&(trim(unitsitevars(i)),',',i=1,22),trim(unitsitevars(23))
endif
if(ic3c4cam.eq.2)then
write(paramunit,'(2000A)')trim(univcomvars(1)),',',
&'Model,Vcmax25,c4aparslope,c4kp25,rdlight25,',
&(trim(paramsvar(i)),',',i=30,34),
&(trim(sitevars(i)),',',i=1,22),trim(sitevars(23))
write(paramunit,'(2000A)')trim(unitunivcomvars(1)),',',
&'NA,umolm-2s-1,CO2/photon,umolm-2s-1,umolm-2s-1,',
&(trim(unitparamsvar(i)),',',i=30,34),
&(trim(unitsitevars(i)),',',i=1,22),trim(unitsitevars(23))
endif
write(fluorescenceunit,'(1000A)')trim(univcomvars(1)),',',
&(trim(univcomvars(i)),',',i=10,14),
&(trim(univcomvars(i)),',',i=17,27),
@@ -514,9 +525,9 @@
unitstomwuecica(16)='umolkg-1s-1'
endif
write(stomcompunit,'(100A)')((trim(stomwuecica(i)),','),
write(stomcompunit,'(100A)')(trim(stomwuecica(i)),',',
&i=1,15),trim(stomwuecica(16))
write(stomcompunit,'(100A)')((trim(unitstomwuecica(i)),','),
write(stomcompunit,'(100A)')(trim(unitstomwuecica(i)),',',
&i=1,15),trim(unitstomwuecica(16))
!------------------------------------------------------------
stomwuecica(1)='curveno'
@@ -581,9 +592,9 @@
unitstomwuecica(29)='NA'
unitstomwuecica(30)='NA'
write(wuecicacompunit,'(200A)')((trim(stomwuecica(i)),','),
write(wuecicacompunit,'(200A)')(trim(stomwuecica(i)),',',
&i=1,29),trim(stomwuecica(30))
write(wuecicacompunit,'(200A)')((trim(unitstomwuecica(i)),','),
write(wuecicacompunit,'(200A)')(trim(unitstomwuecica(i)),',',
&i=1,29),trim(stomwuecica(30))
stomwuecica(1)='curveno'
@@ -875,10 +886,10 @@
unitstomwuecica(55)='umolkg-1s-1'
endif
write(stomwuecicaoutunit,'(2000A)')((trim(stomwuecica(i)),','),
&i=1,139),((trim(sitevars(i)),','),i=1,22),trim(sitevars(23))
write(stomwuecicaoutunit,'(2000A)')((trim(unitstomwuecica(i)),
&','),i=1,139),((trim(unitsitevars(i)),','),i=1,22),
write(stomwuecicaoutunit,'(2000A)')(trim(stomwuecica(i)),',',
&i=1,139),(trim(sitevars(i)),',',i=1,22),trim(sitevars(23))
write(stomwuecicaoutunit,'(2000A)')(trim(unitstomwuecica(i)),
&',',i=1,139),(trim(unitsitevars(i)),',',i=1,22),
&trim(unitsitevars(23))
return
end
leafres/testarea/SetUpLeafGasFit.f
+24 -11
View File
@@ -685,7 +685,7 @@
else
betamin(1)=0.5d0*amaxave
endif
betamax(1)=200.0d0
betamax(1)=1000.0d0
beta(2)=1.5d0
betamin(2)=1.0d-5
betamax(2)=1000.0d0
@@ -696,8 +696,8 @@
betamin(4)=0.0d0
betamax(4)=5000.0d0
beta(5)=-10.0d0
betamin(5)=-100.0d0
betamax(5)=100.0d0
betamin(5)=-1000.0d0
betamax(5)=1000.0d0
k=0
n=0
do j=1,nACiPoints(i)
@@ -717,6 +717,7 @@
wvector(n)=ACipco2ambient(j,i)
endif
enddo
!
call GenericRegres(nACiPoints(i),1,
&ACianet_obs(1:nACiPoints(i),i:i),1,ACipco2i(1:nACiPoints(i),i:i),
&weity,weitx,5,beta,betamin,betamax,xmin,xmax,iderivative,INFO,
@@ -726,13 +727,24 @@
&ACipco2i(nACiPoints(i):nACiPoints(i),i:i),der_ACiend(i),term,
&ACipco2i(1:1,i:i),ACipco2i(nACiPoints(i):nACiPoints(i),i:i),
&ACimaxcurvature(i),ACimaxcurvpco2i(i))
call GenericRegres(n,1,zvector,1,wvector,weity,weitx,5,beta,
if(n.ge.5)then
call GenericRegres(n,1,zvector,1,wvector,weity,weitx,5,beta,
&betamin,betamax,xmin,xmax,iderivative,INFO,fvector,gvector,
&sumsquare)
call properties_surffunc(5,beta,starco2a(i),der_starco2a(i),
call properties_surffunc(5,beta,starco2a(i),der_starco2a(i),
&Amax_ACa(i),ACainter(i),der_ACainter(i),40.0d0,der_ACa400ppm(i),
&anet_ACa400ppm(i),wvector(1),wvector(n),ACamaxcurvature(i),
&ACamaxcurvpco2a(i))
else
der_starco2a(i)=-9999.0d0
Amax_ACa(i)=-9999.0d0
ACainter(i)=-9999.0d0
der_ACainter(i)=-9999.0d0
der_ACa400ppm(i)=-9999.0d0
anet_ACa400ppm(i)=-9999.0d0
ACamaxcurvature(i)=-9999.0d0
ACamaxcurvpco2a(i)=-9999.0d0
endif
if(Amax_ACi(i).lt.50.0d0)amaxave=Amax_ACi(i)
j=min0(5,nACiPoints(i))
call y_aPLUSbx(j,ACipco2i(1:j,i:i),ACianet_obs(1:j,i:i),ac,at)
@@ -1268,7 +1280,7 @@
endif
enddo
idotempcoeff=0
if((term2-term1).gt.2.0d0)idotempcoeff=1
if((term2-term1).gt.5.0d0)idotempcoeff=1
!If temperature variation in the dataset is larger enough, try to estimate parameters in temperature response functions
!All variables are now in the right order. All ACi curves are ordered and All ALight curves are ordered.
!-------------------------------------------------------------------------------------------------------
@@ -1283,7 +1295,7 @@
pco2c_pco2i_flu(i)=-9999.0d0
enddo
if(ntotphips2.gt.5)then
do idorch=1,1
do idorch=0,0
!we do a fluorescence only fit
Prioriknowlimit=-1
ifitmode=1
@@ -1291,7 +1303,7 @@
!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
idorwp=1
idorwp=0
resistwp25_ori=resistwp25_ini
if(idorch.eq.1)then
resistch25_ori=resistch25_ini
@@ -1638,11 +1650,12 @@
co2imany(3)=3.0d0
co2imany(4)=4.0d0
co2imany(5)=5.0d0
m=5
co2imany(6)=6.0d0
m=6
term=ACipco2i(nACiPoints(i),i)+10.0d0
do ccc=6.0d0,term,2.5d0
do while (co2imany(m).le.term)
m=m+1
co2imany(m)=ccc
co2imany(m)=co2imany(m-1)+2.5d0
enddo
do j=1,m
ccc=co2imany(j)
leafres/testarea/ToLeafGasOptimization.f
+175 -50
View File
@@ -1,15 +1,16 @@
subroutine ToLeafGasOptimization(ntotfiles,ACidata,dataunit,
&spareunit,datapath,indexunit,ierr)
subroutine ToLeafGasOptimization(ic3c4cam,ntotfiles,ACidata,
&dataunit,spareunit,datapath,indexunit,ierr)
implicit none
!--------------All inputs except for ierr. Outputs are written to files----------------
integer ntotfiles,dataunit,spareunit,ierr(2),indexunit(20)
!ierr(1)=0, ok, >1 input data out of range
integer ic3c4cam,ntotfiles,dataunit,spareunit,ierr(2),
&indexunit(20)
!ierr(1)=0, ok, >=1 input data out of range
!ierr(2) specifies in which input file, the data is out of range
character*100 datapath,ACidata(ntotfiles)
!-------------------------------------------------------------------------------
integer ntotpoints,npoints(ntotfiles),i,j,k,n,curveno(ntotfiles),
&iobs,maxobs,nmax,iwarning,warningunit,isitmassbased(ntotfiles),
&iprintheader(ntotfiles),ivector(1000),startline
&iprintheader(ntotfiles),ivector(1000),startline,errorunit
parameter(maxobs=2000,nmax=100)
character*100 sample(ntotfiles)
character*50 chartime,siteID(ntotfiles),species(ntotfiles),ftime,
@@ -49,8 +50,14 @@
&stdco2,fmeanco2,xminco2,xmaxco2
!
warningunit=indexunit(10)
errorunit=indexunit(11)
ierr(1)=0
if(ic3c4cam.ne.1.and.ic3c4cam.ne.2)then
write(errorunit,*)'The analysis for CAM photosyntehsis is still
&under development. Check out LeafWeb for this function later.'
ierr(1)=1
return
endif
! open(unit=121,file='sphagnumdata.csv')
! write(121,'(200A)')'name,','hhmmss,','no,','time,','datumlimit,',
! &'stom_COND_mol,','CO2chamber_ppm,','CO2i_ppm,','PARi_umol,',
@@ -61,7 +68,7 @@
do 10 i=1,ntotfiles
isitmassbased(i)=0
iwarning=0
ierr(2)=i
ierr(2)=i
npoints(i)=0
sample(i)=trim(ACidata(i))
!fill any blank spaces in sample(i) with '_'
@@ -76,12 +83,12 @@
!In early 2015, the following section of code is added to allow flexibity for the starting rows to be used for metadata.
!There is no need for a strict number of rows for metadata because the main data section is now determined automatically.
!Locate the rows for the actual data
open(unit=spareunit,file=trim(datapath)//trim(ACidata(i)))
read(spareunit,fmt=300,err=35,end=35)longchar1
rewind(spareunit)
open(unit=dataunit,file=
&trim(datapath)//trim(ACidata(i))//'middle')
open(unit=spareunit,file=trim(datapath)//trim(ACidata(i)))
read(spareunit,fmt=300,err=40,end=40)longchar1
rewind(spareunit)
2 read(spareunit,fmt=300,err=40,end=5)longchar1
2 read(spareunit,fmt=300,err=35,end=5)longchar1
3 k=index(longchar1,char(13))
if(k.gt.0)then
!DOS text format, convert it to unix format
@@ -94,8 +101,8 @@
rewind(dataunit)
open(unit=spareunit,file=
&trim(datapath)//trim(ACidata(i))//'clean')
7 read(dataunit,fmt=310,err=40,end=9)longchar
&trim(datapath)//'clean'//trim(ACidata(i)))
7 read(dataunit,fmt=310,err=36,end=9)longchar
if(longchar.eq.''.or.longchar.eq.' ')goto 7
call charlineparser(longchar,nmax,charvars,n)
if(n.eq.0)goto 7
@@ -110,15 +117,21 @@
j=j+1
ivector(j)=n
goto 500
600 if(j.lt.12)then
close(spareunit,status='delete')
goto 630
else
rewind(spareunit)
endif
600 rewind(spareunit)
startline=0
610 startline=startline+1
if(startline.gt.j-11)goto 40
if(j.lt.12.or.startline.gt.j-11)then
if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'This file has incorrect data format or does
&not contain data'
ierr(1)=1
goto 630
endif
n=0
if(ivector(startline).ne.ivector(startline+1))n=1
if(ivector(startline).ne.ivector(startline+2))n=1
@@ -149,7 +162,7 @@
read(spareunit,*)
enddo
!=========================================================================================================================
read(spareunit,fmt=310,err=13)longchar
read(spareunit,fmt=310,err=40)longchar
call charlineparser(longchar,nmax,charvars,n)
do j=n+1,nmax
charvars(j)='-9999'
@@ -199,7 +212,7 @@
do j=1,2
read(spareunit,*)
enddo
read(spareunit,fmt=310,err=36)longchar
read(spareunit,fmt=310,err=40)longchar
call charlineparser(longchar,nmax,charvars,n)
do j=n+1,nmax
charvars(j)='-9999'
@@ -235,7 +248,7 @@
do j=1,2
read(spareunit,*)
enddo
20 read(spareunit,fmt=310,err=39,end=100)longchar
20 read(spareunit,fmt=310,err=40,end=100)longchar
call charlineparser(longchar,nmax,charvars,n)
if(n.le.25)goto 20
do j=n+1,nmax
@@ -323,7 +336,18 @@
!We assume the user requires mass-based calculations. We convert net photosynthesis,
!transpiration, conductance and PAR from area basis to mass basis. All fitted parameters
!are mass-based. However, mixing area- and mass- based calculations is not allowed.
if(npoints(i).gt.0.and.isitmassbased(i).eq.0)goto 34
if(npoints(i).gt.0.and.isitmassbased(i).eq.0)then
if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'Line starting with ',longchar(1:50)
write(errorunit,*)'Check Column 33 or 34. Mixing area- and
&mass-based measurements is not allowed'
ierr(1)=1
endif
isitmassbased(i)=1
!Convert PAR from umol/m2/s to umol/kg/s. tissuearea is in cm2 and tissuemass in in g
PARi_umol=PARi_umol*tissuearea/(tissuemass*10.0d0)
@@ -346,7 +370,18 @@
CO2i_ppm=((gtc-1.0d-3*transp_mmol/2.0d0)*CO2chamber_ppm-
&PNcor_umol)/(gtc-1.0d-3*transp_mmol/2.0d0)
else
if(isitmassbased(i).ne.0)goto 34
if(isitmassbased(i).ne.0)then
if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'Line starting with ',longchar(1:50)
write(errorunit,*)'Check Column 33 or 34. Mixing area- and
&mass-based measurements is not allowed'
ierr(1)=1
endif
endif
if(isitmassbased(i).eq.0)then
term=-100.0d0
@@ -356,8 +391,21 @@
term1=1.0d+10
endif
if(PNcor_umol.lt.term.or.PNcor_umol.gt.term1)then
ierr(1)=1
if(fm_fluoresce.le.0.0d0)return
if(fm_fluoresce.le.0.0d0)then
if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'Line starting with ',longchar(1:50), '...
&is within the main data body but has no valid photosynthesis data'
if(dabs(PNcor_umol+9999.0d0).gt.1.d-6)then
write(errorunit,*)'Photosynthesis out of range:'
write(errorunit,*)PNcor_umol
endif
ierr(1)=1
endif
else
if(transp_mmol.gt.0.0d0.and.stom_COND_mol.gt.0.0d0
&.and.BLCond.gt.0.0d0)then
@@ -381,13 +429,29 @@
endif
endif
if(CO2i_ppm.le.0.0d0.or.CO2i_ppm.gt.10000.0d0)then
! ierr(1)=2
! return
! if(ierr(2).gt.0)then
! write(errorunit,*)'Input data error in ',trim(ACidata(i))
! write(errorunit,*)
! &'Please resubmit the data after correcting the following error:'
! ierr(2)=-ierr(2)
! endif
! write(errorunit,*)'Intercellular CO2 (ppm) out of range'
! ierr(1)=1
if(fm_fluoresce.le.0.0d0)goto 20
endif
if(Tleaf_oC.lt.-50.0d0.or.Tleaf_oC.gt.100.0d0)then
ierr(1)=3
if(fm_fluoresce.le.0.0d0)return
if(fm_fluoresce.le.0.0d0)then
if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'Line starting with ',longchar(1:50), '...
&is within the main data body but has no valid leaf temperature'
write(errorunit,*)'Leaf temperature (oC) out of range'
ierr(1)=1
endif
endif
if(isitmassbased(i).eq.0)then
term1=1.0d+5
@@ -395,15 +459,29 @@
term1=1.0d+10
endif
if(PARi_umol.lt.-10.01d0.or.PARi_umol.gt.term1)then
ierr(1)=4
return
if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'Line starting with ',longchar(1:50), '.....
&is within the main data body but has no valid PAR data'
write(errorunit,*)'Sample chamber PAR out of range'
ierr(1)=1
else
PARi_umol=dmax1(0.0d0,PARi_umol)
endif
if(Press_KPa.lt.50.0d0.or.Press_KPa.gt.150.0d0)then
Press_KPa=98.9d0
! ierr(1)=5
! return
! if(ierr(2).gt.0)then
! write(errorunit,*)'Input data error in ',trim(ACidata(i))
! write(errorunit,*)
! &'Please resubmit the data after correcting the following error:'
! ierr(2)=-ierr(2)
! endif
! write(errorunit,*)'Air pressure out of range'
! ierr(1)=1
endif
if(Tair_oC.lt.-50.0d0.or.Tair_oC.gt.100.0d0)then
Tair_oC=Tleaf_oC
@@ -483,14 +561,47 @@
call CharToNumeric(chartime,term)
sampletime(i,npoints(i))=term
goto 20
100 close(spareunit,status='delete')
do j=1,npoints(i)
100 do j=1,npoints(i)
vectorhorse(j)=sampletime(i,j)
call time_resolution(npoints(i),vectorhorse,
& avetimeresolution(i),avetimesampled(i))
enddo
630 continue
630 close(spareunit)
goto 640
35 if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'This file has incorrect data format'
ierr(1)=1
close(spareunit)
goto 640
36 if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'This file has incorrect data format'
ierr(1)=1
close(dataunit,status='delete')
goto 640
40 if(ierr(2).gt.0)then
write(errorunit,*)'Input data error in ',trim(ACidata(i))
write(errorunit,*)
&'Please resubmit the data after correcting the following error:'
ierr(2)=-ierr(2)
endif
write(errorunit,*)'This file has incorrect data format'
ierr(1)=1
close(spareunit)
640 continue
10 enddo
if(ierr(1).eq.1)return
iprintheader(1)=1
do i=2,ntotfiles
if(isitmassbased(i).eq.isitmassbased(i-1))then
@@ -502,7 +613,8 @@
k=1
do i=1,ntotfiles
if(k.eq.1.or.iprintheader(i).eq.1)then
call LeafGasPrintToFiles(isitmassbased(i:i),indexunit)
call LeafGasPrintToFiles(isitmassbased(i:i),indexunit,
&ic3c4cam)
k=0
endif
if(npoints(i).lt.3)goto 1112
@@ -536,7 +648,30 @@
endif
endif
!------------------------------------------------------
call SetUpLeafGasFit(curveno(i:i),sample(i:i),npoints(i:i),
if(ic3c4cam.eq.1)
&call SetUpLeafGasFit(curveno(i:i),sample(i:i),npoints(i:i),
&CurveTypeID(i:i,1:npoints(i)),yAnet(i:i,1:npoints(i)),
&xpco2i(i:i,1:npoints(i)),templeaf(i:i,1:npoints(i)),
&pari(i:i,1:npoints(i)),pres_air(i:i,1:npoints(i)),
&po2i(i:i,1:npoints(i)),chlflphips2(i:i,1:npoints(i)),
&pco2ambient(i:i,1:npoints(i)),trmmol(i:i,1:npoints(i)),
&gswmeas(i:i,1:npoints(i)),vpdl(i:i,1:npoints(i)),
&tempair(i:i,1:npoints(i)),eambient(i:i,1:npoints(i)),
&fo_pam(i:i,1:npoints(i)),fm_pam(i:i,1:npoints(i)),
&fs_pam(i:i,1:npoints(i)),pam_measlight(i:i,1:npoints(i)),
&stargamma25_usr(i:i),fkc25_usr(i:i),fko25_usr(i:i),
&rdlight25_usr(i:i),alpha25_usr(i:i),resistwp25_usr(i:i),
&resistch25_usr(i:i),isitmassbased(i:i),indexunit,
&siteID(i:i),Latitude(i:i),Longitude(i:i),Elevation(i:i),
&yearsampled(i:i),sampledoy(i:i),GrowingSeasonStart(i:i),
&GrowingSeasonEnd(i:i),standage(i:i),CanopyHeight(i:i),
&LeafAreaIndex(i:i),species(i:i),avetimeresolution(i:i),
&avetimesampled(i:i),SampleHeight(i:i),Needleage(i:i),
&specificLAI(i:i),nitrogencontent(i:i),carboncontent(i:i),
&phoscontent(i:i),woodporosity(i:i),sapwooddensity(i:i),
&leafratio(i:i))
if(ic3c4cam.eq.2)
&call C4SetUpLeafGasFit(curveno(i:i),sample(i:i),npoints(i:i),
&CurveTypeID(i:i,1:npoints(i)),yAnet(i:i,1:npoints(i)),
&xpco2i(i:i,1:npoints(i)),templeaf(i:i,1:npoints(i)),
&pari(i:i,1:npoints(i)),pres_air(i:i,1:npoints(i)),
@@ -560,16 +695,6 @@
1112 continue
enddo
return
13 ierr(1)=13
return
34 ierr(1)=34
return
36 ierr(1)=36
return
39 ierr(1)=39
return
40 ierr(1)=40
return
300 format(a50000)
310 format(a5000)
340 format(a)
leafres/testarea/UnivParamsAlloc.f
+1 -1
View File
@@ -61,7 +61,7 @@
ifixunivparams(5)=1
if(idokc.eq.1)ifixunivparams(6)=1
if(idoko.eq.1)ifixunivparams(7)=1
if(idoha_vcmax)ifixunivparams(16)=1
if(idoha_vcmax.eq.1)ifixunivparams(16)=1
endif
if(Currentilimittype.le.2.or.Currentilimittype.eq.4.or.
&Currentilimittype.eq.6)then
leafres/testarea/UnivPhotoFit.f
+289 -116
View File
@@ -172,10 +172,12 @@
implicit none
include '../testarea/LeafGasParams.h'
include '../testarea/LeafGasHybridFit.h'
integer i,ndim,k,j,iderivative,iwrong,jnon
integer i,ndim,k,j,iderivative,iwrong,jnon,n,icompete,isame,i2,
&isitnaninf,nave
double precision beta(20),sumsquare0,beta0(20),sumsquarecp,
&betacp(20),ftol,xtol,shortx(maxobs,4),shorty(maxobs,2),ran2,
&ftol_relax
&betacp(20),ftol,xtol,shortx(maxobs,10),shorty(maxobs,5),
&ftol_relax,term1,term2,ran2,history(2000,25),discount,upper,lower,
&f1dim_UnivPhotoFit,ff_pikaia
parameter(ftol=1.0d-7,xtol=1.0d-7)
external funkmin_UnivPhotoFit,f1dim_UnivPhotoFit,
&FCN_UnivPhotoFit,ff_pikaia
@@ -193,113 +195,312 @@
enddo
isitbounded=1
call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
do i=1,ndim
beta0(i)=beta(i)
enddo
sumsquare0=sumsquare
ftol_relax=ftol
k=0
if(subbestsumsquare(Currentilimittype).gt.1.0d+9)then
jnon=0
ftol_relax=ftol*100.0d0
endif
30 call nongradopt(ndim,funkmin_UnivPhotoFit,f1dim_UnivPhotoFit,
&beta,betamin,betamax,ftol_relax,sumsquare)
call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
if((sumsquare+1.0d0).eq.sumsquare.or.sumsquare.gt.sumsquare0)then
do i=1,ndim
beta(i)=beta0(i)
enddo
sumsquare=sumsquare0
else
if((sumsquare0-sumsquare).gt.ftol_relax)then
!reset the counter for arriving at a better minimum
k=0
else
!if the same minimum is found, increment the counter
k=k+1
endif
!global search
do i=1,ndim
beta0(i)=beta(i)
history(1,i)=beta(i)
enddo
sumsquare0=sumsquare
endif
if(subbestsumsquare(Currentilimittype).gt.1.0d+9)then
jnon=jnon+1
!for the first run, try different initial guesses
if(jnon.lt.100.and.k.lt.5)then
if(ran2().gt.0.7d0)then
do i=1,ndim
beta(i)=betamin(i)+ran2()*(betamax(i)-betamin(i))
enddo
else
do i=1,ndim
if(ran2().gt.0.5d0)then
beta(i)=beta(i)+(ran2()**(3.0d0/dble(k+1)))*
&(betamax(i)-beta(i))
else
beta(i)=beta(i)-(ran2()**(3.0d0/dble(k+1)))*
&(beta(i)-betamin(i))
endif
enddo
endif
call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
goto 30
else
if((ftol_relax-ftol).gt.ftol)then
ftol_relax=ftol
goto 30
endif
endif
call RepeatCompassSearch(ndim,beta,sumsquare,betamin,
&betamax,funkmin_UnivPhotoFit,f1dim_UnivPhotoFit,xtol)
call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
if((sumsquare+1.0d0).eq.sumsquare.or.sumsquare.gt.sumsquare0)
&then
do i=1,ndim
beta(i)=beta0(i)
enddo
sumsquare=sumsquare0
endif
do i=1,ndim
betacp(i)=(beta(i)-betamin(i))/(betamax(i)-betamin(i))
history(1,ndim+1)=sumsquare
!entrance counter
history(1,ndim+2)=1.0d0
!failure counter
history(1,ndim+3)=0.0d0
!Is it a competition among different initial guesses?
icompete=0
!j the total number of calls to nongradopt; k is the number of returns to the current best and reset
!to zero if a better minumum is found; n is the number of scouting points over the landscape of the cost function.
!The first initial guess provided by the user is always part of the set of scouting points.the rest consist of outcomes
!from calls to nongradopt if they are significantly different from the current best.
jnon=0
isame=0
n=1
nave=n
ftol_relax=ftol*1000.0d0
discount=2.0d0
!relax the convergence criterion for scouting
30 do i=1,ndim
betacp(i)=beta(i)
enddo
sumsquarecp=sumsquare
isitbounded=0
call pikaia(ff_pikaia,ndim,gacontrol,betacp,sumsquarecp,i)
isitbounded=1
if(i.eq.0)then
iderivative=0
if(ifitmode.lt.0)then
iwrong=0
else
iwrong=1
endif
k=ifitmode
ifitmode=-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
!for odr_leastsquare, only the predicted value of the response variable is needed, i.e., the cost function value is not needed.
!also, only anet as a function of CO2i is considered (not the other way around) because odr_leastsquare cannot handle the situation
!co2i as a function of anet for tpu limitation when alpha=0
i=1
if(ntotphips2.ge.1)i=2
j=4
if(Currentiknowlimit.eq.-1)then
!fluorescence only fit. chlflphisi2 becomes a forcing variable
i=1
j=5
endif
call odr_leastsquare(ndim,FCN_UnivPhotoFit,beta,ntotsamples,
&forcings(1:ntotsamples,1:j),j,responses(1:ntotsamples,1:i),i,
&weitforcings(1:ntotsamples,1:j),weitresponses(1:ntotsamples,1:i),
&iderivative,shortx(1:ntotsamples,1:j),shorty(1:ntotsamples,1:i),
&sumsquare,iwrong)
ifitmode=k
!after odr_leastsquare, forcing variables are destroyed. restore to the origninals
do i=1,ntotsamples
pco2i(i)=pco2i_ori(i)
aPPFDlf(i)=aPPFDlf_ori(i)
templeaf(i)=templeaf_ori(i)
po2i(i)=po2i_ori(i)
chlflphips2(i)=chlflphips2_ori(i)
enddo
call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
if(isitnaninf(sumsquare).eq.1.or.sumsquare.gt.sumsquarecp)then
do i=1,ndim
betacp(i)=betamin(i)+betacp(i)*(betamax(i)-betamin(i))
beta(i)=betacp(i)
enddo
call funkmin_UnivPhotoFit(ndim,betacp,sumsquarecp)
sumsquare=sumsquarecp
else
do i=1,ndim
betacp(i)=beta(i)
enddo
sumsquarecp=sumsquare
endif
if((sumsquarecp+1.0d0).ne.sumsquarecp.and.
&sumsquare.gt.sumsquarecp)then
call nongradopt(ndim,funkmin_UnivPhotoFit,
&f1dim_UnivPhotoFit,beta,betamin,betamax,ftol_relax,sumsquare)
if(isitnaninf(sumsquare).eq.1.or.sumsquare.gt.sumsquarecp)then
do i=1,ndim
beta(i)=betacp(i)
enddo
sumsquare=sumsquarecp
endif
if(sumsquare.gt.1.0d0)then
term1=sumsquare*ftol_relax
else
term1=ftol_relax*10.0d0
endif
if(sumsquare.gt.sumsquare0)then
!failure
if((sumsquare-sumsquare0).gt.term1)then
if(icompete.eq.1)history(1,ndim+3)=history(1,ndim+3)+1.5d0
!even though sumsquare is much worse than sumsquare0, it is an output of optimization after all so
!include it in the set if it has not already been included in the set.
i=1
i2=1
40 if(dabs(history(i2,i)-beta(i)).gt.ftol_relax)then
if(dabs(history(i2,ndim+1)-sumsquare).lt.term1)then
history(i2,ndim+3)=history(i2,ndim+3)+1.0d0
goto 60
endif
if(i2.ge.n)goto 50
i2=i2+1
i=1
goto 40
else
if(i.ge.ndim)goto 60
i=i+1
goto 40
endif
50 n=n+1
do i=1,ndim
history(n,i)=beta(i)
enddo
history(n,ndim+1)=sumsquare
history(n,ndim+2)=0.0d0
history(n,ndim+3)=0.0d0
!use average only when there is imporvement
nave=n
else
!the difference is minimal even though sumsquare is larger than sumsquare0.
!Increment the counter for arriving at the same minimum.
if(icompete.eq.1)history(1,ndim+3)=history(1,ndim+3)+1.0d0
isame=isame+1
endif
60 do i=1,ndim
beta(i)=beta0(i)
enddo
sumsquare=sumsquare0
else
!success
if((sumsquare0-sumsquare).lt.term1)then
!negligible improvement. Increment the counter for arriving at the same minimum.
!no increment for the set of central initial guesses
if(icompete.eq.1)history(1,ndim+3)=history(1,ndim+3)+0.5d0
isame=isame+1
nave=n
else
!reset the counter for arriving at a better minimum.
!Increment the set of central initial guesses
if(dabs(discount-2.0d0).lt.ftol)then
discount=dmax1(0.001d0,(sumsquare0-sumsquare)/1000.0d0)
endif
isame=0
n=n+1
do i=1,ndim
history(n,i)=beta(i)
enddo
history(n,ndim+1)=sumsquare
history(n,ndim+2)=0.0d0
history(n,ndim+3)=0.0d0
endif
do i=1,ndim
beta0(i)=beta(i)
enddo
sumsquare0=sumsquare
endif
jnon=jnon+1
if(jnon.lt.200.and.isame.lt.3)then
!we first explore around the very first initial guess
if(jnon.lt.10)then
icompete=1
term1=0.05d0+dmin1(history(1,ndim+3)*0.1d0,0.9d0)
history(1,ndim+2)=history(1,ndim+2)+1.0d0
do i=1,ndim
lower=history(1,i)-term1*(history(1,i)-betamin(i))
upper=history(1,i)+term1*(betamax(i)-history(1,i))
beta(i)=lower+ran2()*(upper-lower)
enddo
goto 70
endif
!try average if n is incremented
if(n.gt.nave)then
term1=1.0d0/(history(1,ndim+1)+1.0d-5)
do i=2,n
term1=term1+1.0d0/(history(i,ndim+1)+1.0d-5)
enddo
do i=1,ndim
beta(i)=history(1,i)/(term1*(history(1,ndim+1)+1.0d-5))
do icompete=2,n
beta(i)=beta(i)+history(icompete,i)/
&(term1*(history(icompete,ndim+1)+1.0d-5))
enddo
enddo
nave=n
icompete=0
goto 70
endif
!try different initial guesses
if(ran2().gt.0.2d0)then
!guess around the best
icompete=1
term1=history(1,ndim+1)+
&discount*history(1,ndim+2)*history(1,ndim+3)
do i=2,n
term2=history(i,ndim+1)+
&discount*history(i,ndim+2)*history(i,ndim+3)
if(term2.le.term1)then
term1=term2
do i2=1,ndim+3
history(n+1,i2)=history(i,i2)
history(i,i2)=history(1,i2)
history(1,i2)=history(n+1,i2)
enddo
endif
enddo
term1=0.05d0+dmin1(history(1,ndim+2)*history(1,ndim+3)*
&0.015d0,0.9d0)
history(1,ndim+2)=history(1,ndim+2)+1.0d0
do i=1,ndim
lower=history(1,i)-term1*(history(1,i)-betamin(i))
upper=history(1,i)+term1*(betamax(i)-history(1,i))
beta(i)=lower+ran2()*(upper-lower)
enddo
else
!completely random guess
do i=1,ndim
beta(i)=betamin(i)+ran2()*(betamax(i)-betamin(i))
enddo
icompete=0
endif
70 call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
goto 30
else
if((ftol_relax-ftol).gt.ftol)then
if(isame.le.1)then
n=n+1
do i=1,ndim+3
history(n,i)=history(1,i)
enddo
do i=1,ndim
history(1,i)=beta(i)
enddo
history(1,ndim+1)=sumsquare
history(1,ndim+2)=0.0d0
history(1,ndim+3)=0.0d0
do i=1,n
do icompete=1,ndim
betacp(icompete)=history(i,icompete)
enddo
sumsquarecp=history(i,ndim+1)
call RepeatCompassSearch(ndim,betacp,sumsquarecp,
&betamin,betamax,funkmin_UnivPhotoFit,f1dim_UnivPhotoFit,
&ftol_relax)
call funkmin_UnivPhotoFit(ndim,betacp,sumsquarecp)
if(isitnaninf(sumsquarecp).eq.0.and.sumsquarecp.lt.
&sumsquare)then
do icompete=1,ndim
beta(icompete)=betacp(icompete)
enddo
sumsquare=sumsquarecp
endif
enddo
do i=1,ndim
beta0(i)=beta(i)
enddo
sumsquare0=sumsquare
jnon=0
icompete=1
else
icompete=0
endif
ftol_relax=ftol
goto 30
endif
endif
goto 110
do i=1,ndim
beta0(i)=beta(i)
betacp(i)=(beta(i)-betamin(i))/(betamax(i)-betamin(i))
enddo
sumsquare0=sumsquare
sumsquarecp=sumsquare
call pikaia(ff_pikaia,ndim,gacontrol,betacp,sumsquarecp,i)
if(i.eq.0)then
do i=1,ndim
betacp(i)=betamin(i)+betacp(i)*(betamax(i)-betamin(i))
enddo
call funkmin_UnivPhotoFit(ndim,betacp,sumsquarecp)
if(isitnaninf(sumsquarecp).eq.0.and.sumsquare.gt.sumsquarecp)
&then
do i=1,ndim
beta(i)=betacp(i)
enddo
sumsquare=sumsquarecp
endif
endif
else
return
!local search
call nongradopt(ndim,funkmin_UnivPhotoFit,f1dim_UnivPhotoFit,
&beta,betamin,betamax,ftol,sumsquare)
call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
endif
do i=1,ndim
beta0(i)=beta(i)
enddo
sumsquare0=sumsquare
iderivative=0
if(ifitmode.lt.0)then
iwrong=0
else
iwrong=1
endif
isitbounded=1
k=ifitmode
ifitmode=-1
!ifitmode: =-2, ordinary fitting with pco2i calculated as a function of anet
@@ -322,7 +523,6 @@
&weitforcings(1:ntotsamples,1:j),weitresponses(1:ntotsamples,1:i),
&iderivative,shortx(1:ntotsamples,1:j),shorty(1:ntotsamples,1:i),
&sumsquare,iwrong)
isitbounded=1
ifitmode=k
!after odr_leastsquare, forcing variables are destroyed. restore to the origninals
do i=1,ntotsamples
@@ -333,29 +533,12 @@
chlflphips2(i)=chlflphips2_ori(i)
enddo
call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
if((sumsquare+1.0d0).eq.sumsquare.or.sumsquare.gt.sumsquare0)then
if(isitnaninf(sumsquare).eq.1.or.sumsquare.gt.sumsquare0)then
do i=1,ndim
beta(i)=beta0(i)
enddo
sumsquare=sumsquare0
endif
k=0
do i=1,ndim
if(beta(i).lt.betamin(i))k=1
if(beta(i).gt.betamax(i))k=1
enddo
if(k.eq.1)then
do i=1,ndim
betacp(i)=(beta(i)-betamin(i))/(betamax(i)-betamin(i))
enddo
isitbounded=0
call pikaia(ff_pikaia,ndim,gacontrol,betacp,sumsquare,i)
do i=1,ndim
beta(i)=betamin(i)+betacp(i)*(betamax(i)-betamin(i))
enddo
isitbounded=1
call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
endif
j=0
100 jnon=0
105 sumsquare0=sumsquare
@@ -370,21 +553,11 @@
goto 105
endif
if(sumsquare.eq.sumsquare0)goto 110
if(dabs(sumsquare).le.dabs(sumsquare0))then
else
if(dabs(sumsquare).gt.1.0d+20)then
!in case of infinity (division by zero)
do i=1,ndim
beta(i)=beta0(i)
enddo
sumsquare=sumsquare0
else
!designed this way to avoid sumsquare='NAN'
do i=1,ndim
beta(i)=beta0(i)
enddo
sumsquare=sumsquare0
endif
if(isitnaninf(sumsquare).eq.1.or.sumsquare.gt.sumsquare0)then
do i=1,ndim
beta(i)=beta0(i)
enddo
sumsquare=sumsquare0
endif
sumsquarecp=sumsquare
do i=1,ndim
@@ -394,14 +567,14 @@
&betamax,funkmin_UnivPhotoFit,f1dim_UnivPhotoFit,xtol)
call funkmin_UnivPhotoFit(ndim,betacp,sumsquarecp)
if(sumsquare.eq.sumsquarecp)goto 110
if(dabs(sumsquarecp).lt.dabs(sumsquare))then
if(isitnaninf(sumsquarecp).eq.0.and.sumsquarecp.lt.sumsquare)then
do i=1,ndim
beta(i)=betacp(i)
enddo
sumsquare=sumsquarecp
endif
j=j+1
if(j.le.2.and.dabs(sumsquare-sumsquare0).gt.ftol)goto 100
if(j.le.2.and.(sumsquare0-sumsquare).gt.ftol)goto 100
!
!------------------------------------------------------
110 call funkmin_UnivPhotoFit(ndim,beta,sumsquare)
leafres/testarea/c4leafanetmodel.f
+89
View File
@@ -0,0 +1,89 @@
subroutine c4leafanetmodel(ilimittype,aPPFDlf,templeaf,pco2i,
&pres_air,vcmax25,c4aparslope,c4kp25,rdlight25,anet_pred,
&Postiphotolimit)
implicit none
!------------ Inputs -------------------
!ilimittype=1: Rubisco,RuBp and TPU limitations
!ilimittype=2: Rubisco and RuBp limitations only
!ilimittype=3: Rubisco and TPU limitations only
!ilimittype=4: RuBp and TPU limitations only
!ilimittype=5: Rubisco limitation only
!ilimittype=6: RuBp limitation only
!ilimittype=7: TPU limitation only
!aPPFDlf: Absorbed photosynthetic photon flux density by leaf (umol m-2 s-1)
!templeaf: Leaf temperature [K]
!pco2i: Intercellular air pressure [Pa]
!pres_air: Ambient air pressure [Pa]
!vcmax25: Maximum RuBP saturated rate of carboxylation at 25oC
! of leaf temperature [umol m-2 s-1]
!c4aparslope: Slope of the response of light-limited rate with respect
! to absorbed light
!c4kp25: Slope of the response of the PEP carboxylase-limited
! rate of carboxylation for C4 plants
!rdlight25: Mitochondrial respiration rate in the light at 25oC
double precision aPPFDlf,templeaf,pco2i,pres_air,
&vcmax25,c4aparslope,c4kp25,rdlight25
!------------Output---------------------
!anet_pred: Predicted net photosynthetic rate [umol m-2 s-1]
!Postiphotolimit: limit state indicator
! = 1 Rubisco-limited rate
! = 2 RuBP-regeneration limited rate
! = 3 Product-limited rate
double precision anet_pred
integer ilimittype,Postiphotolimit
!--------------------------------------
double precision q10,fh,fl,frd,wc,wj,wp,rd,thetacj,thetaip,Ai
q10=2.0d0
fh=1.0d0+dexp(0.3d0*(templeaf-313.15d0))
fl=1.0d0+dexp(0.2d0*(288.15d0-templeaf))
frd=1.0d0+dexp(1.3d0*(templeaf-328.15d0))
wc=vcmax25*(q10**((templeaf-298.15d0)/10.0d0))/(fh*fl)
wj=c4aparslope*aPPFDlf
wp=c4kp25*(q10**((templeaf-298.15)/10.0d0))*pco2i/pres_air
rd=rdlight25*(q10**((templeaf-298.15d0)/10.0d0))/frd
if((ilimittype.eq.1.and.wc.le.wj.and.wc.le.wp).or.
&ilimittype.eq.5)then
Postiphotolimit=1
anet_pred=wc-rd
endif
if((ilimittype.eq.1.and.wj.le.wc.and.wj.le.wp).or.
&ilimittype.eq.6)then
Postiphotolimit=2
anet_pred=wj-rd
endif
if((ilimittype.eq.1.and.wp.le.wc.and.wp.le.wj).or.
&ilimittype.eq.7)then
Postiphotolimit=3
anet_pred=wp-rd
endif
if(ilimittype.eq.2.and.wc.le.wj)then
Postiphotolimit=1
anet_pred=wc-rd
else
Postiphotolimit=2
anet_pred=wj-rd
endif
if(ilimittype.eq.3.and.wc.le.wp)then
Postiphotolimit=1
anet_pred=wc-rd
else
Postiphotolimit=3
anet_pred=wp-rd
endif
if(ilimittype.eq.4.and.wj.le.wp)then
Postiphotolimit=2
anet_pred=wj-rd
else
Postiphotolimit=3
anet_pred=wp-rd
endif
if(ilimittype.eq.1)then
thetacj=0.8d0
thetaip=0.95d0
Ai=((wc+wj)-dsqrt((wc+wj)**2-4.0d0*thetacj*wc*wj))/
&(2.0d0*thetacj)
anet_pred=((Ai+wp)-dsqrt((Ai+wp)**2-4.0d0*thetaip*Ai*wp))/
&(2.0d0*thetaip)-rd
endif
return
end
leafres/testarea/cica5.f
+1 -1
View File
@@ -11,7 +11,7 @@ c
integer i,ndim,imodel0
double precision beta(ndim),fatbeta,ftol,bmin0(ndim),
& bmax0(ndim)
& bmax0(ndim),f1dim_cica
parameter(ftol=1.0d-7)
external funkmin_cica,f1dim_cica
leafres/testarea/cica_Regression5.f
+1 -1
View File
@@ -156,7 +156,7 @@ C READ PROBLEM DATA, AND SET NONDEFAULT VALUE FOR ARGUMENT IFIXX
+ ISTOP)
implicit none
include '../src/cica.h'
include '../testarea/cica.h'
C SUBROUTINE ARGUMENTS
C ==> N NUMBER OF OBSERVATIONS
leafres/testarea/fluorescencejmax.f
+276 -88
View File
@@ -3,11 +3,14 @@
implicit none
include '../testarea/LeafGasParams.h'
include '../testarea/LeafGasHybridFit.h'
integer i,ndim,k,j,iderivative,iwrong
integer i,ndim,k,j,iderivative,iwrong,n,icompete,i2,isitnaninf,
&nave
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
&xvar(maxobs,2),weitx(maxobs,2),weity(maxobs),
&templflights0(maxobs),aparlights0(maxobs),termmin,termmax,
&ftol_relax,term1,term2,ran2,discount,history(2000,10),upper,lower,
&f1dim_flujmax,flujmax_pikaia
parameter(ftol=1.0d-7,xtol=1.0d-7)
external funkmin_flujmax,f1dim_flujmax,FCN_flujmax,flujmax_pikaia
!beta(1)=fjmax25
@@ -65,104 +68,298 @@
call funkmin_flujmax(ndim,beta,flujmaxfval)
do i=1,ndim
beta0(i)=beta(i)
history(1,i)=beta(i)
enddo
sumsquare0=flujmaxfval
history(1,ndim+1)=flujmaxfval
!entrance counter
history(1,ndim+2)=1.0d0
!failure counter
history(1,ndim+3)=0.0d0
!Is it a competition among different initial guesses?
icompete=0
!j the total number of calls to nongradopt; k is the number of returns to the current best and reset
!to zero if a better minumum is found; n is the number of scouting points over the landscape of the cost function.
!The first initial guess provided by the user is always part of the set of scouting points.the rest consist of outcomes
!from calls to nongradopt if they are significantly different from the current best.
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))
n=1
nave=1
ftol_relax=ftol*1000.0d0
discount=2.0d0
30 do i=1,ndim
betacp(i)=beta(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
sumsquarecp=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
if(isitnaninf(flujmaxfval).eq.1.or.flujmaxfval.gt.sumsquarecp)then
do i=1,ndim
beta(i)=betacp(i)
enddo
flujmaxfval=sumsquarecp
else
if(dabs(flujmaxfval).gt.1.0d+20)then
!in case of infinity (division by zero)
do i=1,ndim
betacp(i)=beta(i)
enddo
sumsquarecp=flujmaxfval
endif
call nongradopt(ndim,funkmin_flujmax,f1dim_flujmax,
&beta,betamin,betamax,ftol_relax,flujmaxfval)
if(isitnaninf(flujmaxfval).eq.1.or.flujmaxfval.gt.sumsquarecp)then
do i=1,ndim
beta(i)=betacp(i)
enddo
flujmaxfval=sumsquarecp
endif
if(flujmaxfval.gt.1.0d0)then
term1=flujmaxfval*ftol_relax
else
term1=ftol_relax*10.0d0
endif
if(flujmaxfval.gt.sumsquare0)then
!failure
if((flujmaxfval-sumsquare0).gt.term1)then
if(icompete.eq.1)history(1,ndim+3)=history(1,ndim+3)+1.5d0
!even though flujmaxfval is much worse than sumsquare0, it is an output of optimization after all so
!include it in the set if it has not already been included in the set.
i=1
i2=1
40 if(dabs(history(i2,i)-beta(i)).gt.ftol_relax)then
if(dabs(history(i2,ndim+1)-flujmaxfval).lt.term1)then
history(i2,ndim+3)=history(i2,ndim+3)+1.0d0
goto 60
endif
if(i2.ge.n)goto 50
i2=i2+1
i=1
goto 40
else
if(i.ge.ndim)goto 60
i=i+1
goto 40
endif
50 n=n+1
do i=1,ndim
beta(i)=beta0(i)
history(n,i)=beta(i)
enddo
flujmaxfval=sumsquare0
history(n,ndim+1)=flujmaxfval
history(n,ndim+2)=0.0d0
history(n,ndim+3)=0.0d0
!use average only when there is improvement
nave=n
else
!designed this way to avoid flujmaxfval='NAN'
!the difference is minimal even though flujmaxfval is larger than sumsquare0.
!Increment the counter for arriving at the same minimum.
if(icompete.eq.1)history(1,ndim+3)=history(1,ndim+3)+1.0d0
k=k+1
endif
60 do i=1,ndim
beta(i)=beta0(i)
enddo
flujmaxfval=sumsquare0
else
!success
if((sumsquare0-flujmaxfval).lt.term1)then
!negligible improvement. Increment the counter for arriving at the same minimum.
!no increment for the set of central initial guesses
if(icompete.eq.1)history(1,ndim+3)=history(1,ndim+3)+0.5d0
k=k+1
else
!reset the counter for arriving at a better minimum.
!Increment the set of central initial guesses
if(dabs(discount-2.0d0).lt.ftol)then
discount=dmax1(0.001d0,(sumsquare0-flujmaxfval)/1000.0d0)
endif
k=0
n=n+1
do i=1,ndim
beta(i)=beta0(i)
history(n,i)=beta(i)
enddo
flujmaxfval=sumsquare0
history(n,ndim+1)=flujmaxfval
history(n,ndim+2)=0.0d0
history(n,ndim+3)=0.0d0
endif
do i=1,ndim
beta0(i)=beta(i)
enddo
sumsquare0=flujmaxfval
endif
j=j+1
if(j.lt.200.and.k.lt.3)then
!first explore around the very first initial guess
if(j.lt.10)then
term1=0.05d0+dmin1(history(1,ndim+3)*0.1d0,0.9d0)
history(1,ndim+2)=history(1,ndim+2)+1.0d0
do i=1,ndim
lower=history(1,i)-term1*(history(1,i)-betamin(i))
upper=history(1,i)+term1*(betamax(i)-history(1,i))
beta(i)=lower+ran2()*(upper-lower)
enddo
icompete=1
goto 70
endif
!try average
if(n.gt.nave)then
term1=1.0d0/(history(1,ndim+1)+1.0d-5)
do i=2,n
term1=term1+1.0d0/(history(i,ndim+1)+1.0d-5)
enddo
do i=1,ndim
beta(i)=history(1,i)/(term1*(history(1,ndim+1)+1.0d-5))
do icompete=2,n
beta(i)=beta(i)+history(icompete,i)/
&(term1*(history(icompete,ndim+1)+1.0d-5))
enddo
enddo
nave=n
icompete=0
goto 70
endif
!try different initial guesses
if(ran2().gt.0.2d0)then
!guess around the best
icompete=1
term1=history(1,ndim+1)+
&discount*history(1,ndim+2)*history(1,ndim+3)
do i=2,n
term2=history(i,ndim+1)+
&discount*history(i,ndim+2)*history(i,ndim+3)
if(term2.le.term1)then
term1=term2
do i2=1,ndim+3
history(n+1,i2)=history(i,i2)
history(i,i2)=history(1,i2)
history(1,i2)=history(n+1,i2)
enddo
endif
enddo
term1=0.05d0+dmin1(history(1,ndim+2)*history(1,ndim+3)*
&0.015d0,0.9d0)
history(1,ndim+2)=history(1,ndim+2)+1.0d0
do i=1,ndim
lower=history(1,i)-term1*(history(1,i)-betamin(i))
upper=history(1,i)+term1*(betamax(i)-history(1,i))
beta(i)=lower+ran2()*(upper-lower)
enddo
else
!completely random guess
do i=1,ndim
beta(i)=betamin(i)+ran2()*(betamax(i)-betamin(i))
enddo
icompete=0
endif
70 call funkmin_flujmax(ndim,beta,flujmaxfval)
goto 30
else
if((ftol_relax-ftol).gt.ftol)then
if(k.le.1)then
n=n+1
do i=1,ndim+3
history(n,i)=history(1,i)
enddo
do i=1,ndim
history(1,i)=beta(i)
enddo
history(1,ndim+1)=flujmaxfval
history(1,ndim+2)=0.0d0
history(1,ndim+3)=0.0d0
do i=1,n
do icompete=1,ndim
betacp(icompete)=history(i,icompete)
enddo
sumsquarecp=history(i,ndim+1)
call RepeatCompassSearch(ndim,betacp,sumsquarecp,
&betamin,betamax,funkmin_flujmax,f1dim_flujmax,ftol_relax)
call funkmin_flujmax(ndim,betacp,sumsquarecp)
if(isitnaninf(sumsquarecp).eq.0.and.sumsquarecp.lt.
&flujmaxfval)then
do icompete=1,ndim
beta(icompete)=betacp(icompete)
enddo
flujmaxfval=sumsquarecp
endif
enddo
do i=1,ndim
beta0(i)=beta(i)
enddo
sumsquare0=flujmaxfval
j=0
icompete=1
else
icompete=0
endif
ftol_relax=ftol
goto 30
endif
endif
j=0
100 if(j.ge.10)then
goto 110
call RepeatCompassSearch(ndim,beta,flujmaxfval,betamin,
&betamax,funkmin_flujmax,f1dim_flujmax,xtol)
call funkmin_flujmax(ndim,beta,flujmaxfval)
if(isitnaninf(flujmaxfval).eq.1.or.flujmaxfval.gt.sumsquare0)then
do i=1,ndim
betacp(i)=(beta(i)-betamin(i))/(betamax(i)-betamin(i))
beta(i)=beta0(i)
enddo
isitbounded=0
call pikaia(flujmax_pikaia,ndim,gacontrol,betacp,flujmaxfval,i)
flujmaxfval=sumsquare0
else
do i=1,ndim
beta(i)=betamin(i)+betacp(i)*(betamax(i)-betamin(i))
beta0(i)=beta(i)
enddo
isitbounded=1
call funkmin_flujmax(ndim,beta,flujmaxfval)
sumsquare0=flujmaxfval
endif
sumsquare0=flujmaxfval
do i=1,ndim
betacp(i)=(beta(i)-betamin(i))/(betamax(i)-betamin(i))
enddo
call pikaia(flujmax_pikaia,ndim,gacontrol,betacp,flujmaxfval,i)
if(i.eq.0)then
do i=1,ndim
betacp(i)=betamin(i)+betacp(i)*(betamax(i)-betamin(i))
enddo
call funkmin_flujmax(ndim,betacp,flujmaxfval)
if(isitnaninf(flujmaxfval).eq.0.and.flujmaxfval.lt.sumsquare0)
&then
do i=1,ndim
beta(i)=betacp(i)
beta0(i)=betacp(i)
enddo
sumsquare0=flujmaxfval
endif
endif
flujmaxfval=sumsquare0
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)
!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(isitnaninf(flujmaxfval).eq.1.or.flujmaxfval.gt.sumsquare0)then
do i=1,ndim
beta(i)=beta0(i)
enddo
flujmaxfval=sumsquare0
endif
j=0
100 sumsquare0=flujmaxfval
do i=1,ndim
beta0(i)=beta(i)
enddo
@@ -170,21 +367,11 @@
&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
if(isitnaninf(flujmaxfval).eq.1.or.flujmaxfval.gt.sumsquare0)then
do i=1,ndim
beta(i)=beta0(i)
enddo
flujmaxfval=sumsquare0
endif
sumsquarecp=flujmaxfval
do i=1,ndim
@@ -194,14 +381,15 @@
&betamax,funkmin_flujmax,f1dim_flujmax,xtol)
call funkmin_flujmax(ndim,betacp,sumsquarecp)
if(flujmaxfval.eq.sumsquarecp)return
if(dabs(sumsquarecp).lt.dabs(flujmaxfval))then
if(isitnaninf(sumsquarecp).eq.0.and.flujmaxfval.gt.sumsquarecp)
&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
if(j.le.2.and.(sumsquare0-flujmaxfval).gt.ftol)goto 100
!
!------------------------------------------------------
110 call funkmin_flujmax(ndim,beta,flujmaxfval)
leafres/testarea/funkmin_C4Fit.f
+128
View File
@@ -0,0 +1,128 @@
subroutine funkmin_C4Fit(ndim,beta,fvalue)
implicit none
include '../testarea/LeafGasParams.h'
include '../testarea/LeafGasHybridFit.h'
integer ndim
double precision beta(1:ndim),fvalue
!(in) ndim: the dimension of the parameter vector
!(in) beta: the parameters
!(out) fvalue: the value of the cost function at beta
!
!---------Local variables--------------------------------------------------
integer i
!----------- End of variables declaration ---------------------------------
!check to see if parameters are out of bounds.
if(isitbounded.eq.1)then
do i=1,ndim
if(beta(i).lt.betamin(i).or.beta(i).gt.betamax(i))then
! parameter out of bound
fvalue=1.0d+100
return
endif
enddo
endif
vcmax25=beta(1)
c4aparslope=beta(2)
c4kp25=beta(3)
if(idord.eq.1)rdlight25=beta(ndim)
fvalue=0.0d0
do i=1,ntotsamples
call c4leafanetmodel(1,aPPFDlf(i),templeaf(i),pco2i(i),
&pres_air(i),vcmax25,c4aparslope,c4kp25,rdlight25,anet_pred(i),
&Postiphotolimit(i))
fvalue=fvalue+(anet_obs(i)-anet_pred(i))**2.0d0
enddo
return
end subroutine funkmin_C4Fit
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
double precision function f1dim_C4Fit(x)
implicit none
double precision x
CU USES funkmin_C4Fit
INTEGER j
!((((((((((((((((((((((((((((((((((((((((((((((((((((
integer NMAX,ncom
parameter(NMAX=1000)
double precision pcom(NMAX),xicom(NMAX)
COMMON /f1com/ pcom,xicom,ncom
save /f1com/
!))))))))))))))))))))))))))))))))))))))))))))))))))))
double precision xt(NMAX)
do 11 j=1,ncom
xt(j)=pcom(j)+x*xicom(j)
11 continue
call funkmin_C4Fit(ncom,xt,f1dim_C4Fit)
return
END
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
SUBROUTINE FCN_C4Fit(N,M,NP,NQ,
+ LDN,LDM,LDNP,
+ BETA,XPLUSD,
+ IFIXB,IFIXX,LDIFX,
+ IDEVAL,F,FJACB,FJACD,
+ ISTOP)
implicit none
include '../testarea/LeafGasParams.h'
include '../testarea/LeafGasHybridFit.h'
C SUBROUTINE ARGUMENTS
C ==> N NUMBER OF OBSERVATIONS
C ==> M NUMBER OF COLUMNS IN EXPLANATORY VARIABLE
C ==> NP NUMBER OF PARAMETERS
C ==> NQ NUMBER OF RESPONSES PER OBSERVATION
C ==> LDN LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING N
C ==> LDM LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING M
C ==> LDNP LEADING DIMENSION DECLARATOR EQUAL OR EXCEEDING NP
C ==> BETA CURRENT VALUES OF PARAMETERS
C ==> XPLUSD CURRENT VALUE OF EXPLANATORY VARIABLE, I.E., X + DELTA
C ==> IFIXB INDICATORS FOR "FIXING" PARAMETERS (BETA)
C ==> IFIXX INDICATORS FOR "FIXING" EXPLANATORY VARIABLE (X)
C ==> LDIFX LEADING DIMENSION OF ARRAY IFIXX
C ==> IDEVAL INDICATOR FOR SELECTING COMPUTATION TO BE PERFORMED
C <== F PREDICTED FUNCTION VALUES
C <== FJACB JACOBIAN WITH RESPECT TO BETA
C <== FJACD JACOBIAN WITH RESPECT TO ERRORS DELTA
C <== ISTOP STOPPING CONDITION, WHERE
C 0 MEANS CURRENT BETA AND X+DELTA WERE
C ACCEPTABLE AND VALUES WERE COMPUTED SUCCESSFULLY
C 1 MEANS CURRENT BETA AND X+DELTA ARE
C NOT ACCEPTABLE; ODRPACK SHOULD SELECT VALUES
C CLOSER TO MOST RECENTLY USED VALUES IF POSSIBLE
C -1 MEANS CURRENT BETA AND X+DELTA ARE
C NOT ACCEPTABLE; ODRPACK SHOULD STOP
C INPUT ARGUMENTS, NOT TO BE CHANGED BY THIS ROUTINE:
INTEGER I,IDEVAL,ISTOP,L,LDIFX,LDM,LDN,LDNP,M,N,NP,NQ
DOUBLE PRECISION BETA(NP),XPLUSD(LDN,M)
INTEGER IFIXB(NP),IFIXX(LDIFX,M)
C OUTPUT ARGUMENTS:
DOUBLE PRECISION F(LDN,NQ),FJACB(LDN,LDNP,NQ),FJACD(LDN,LDM,NQ)
integer k
double precision fvalue
c
ISTOP=0
do I=1,NP
if(BETA(I).lt.betamin(I).or.
&BETA(I).gt.betamax(I))then
ISTOP=1
return
endif
enddo
do I=1,N
pco2i(I)=XPLUSD(I,1)
aPPFDlf(I)=XPLUSD(I,2)
templeaf(I)=XPLUSD(I,3)
pres_air(I)=XPLUSD(I,4)
enddo
IF (MOD(IDEVAL,10).GE.1) THEN
call funkmin_C4Fit(NP,BETA,fvalue)
if(fvalue.gt.1.0d+20)then
ISTOP=1
return
endif
DO 100 I = 1,N
F(I,1)=anet_pred(I)
100 CONTINUE
END IF
RETURN
END
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
leafres/testarea/stomoptimization.f
+1 -1
View File
@@ -10,7 +10,7 @@ c
&gammas0(npoints),yAnet0(npoints),gswmeas0(npoints),
&pvapordef_s0(npoints),stomintercept,stomslope,rayDzero
integer i,ndim
double precision beta(10),fatbeta,ftol
double precision beta(10),fatbeta,ftol,f1dim_stom
parameter(ftol=1.0d-7)
external funkmin_stom,f1dim_stom
leafres/testrun/Makefile
+3 -3
View File
@@ -1,12 +1,11 @@
# This is the makefile for piscal
# name of executable
ALL = piscal
#mpipiscal
# compiler options
FF = mpif90
#FOPTS = -g -C
FOPTS = -g -fallow-argument-mismatch
FOPTS = -g
#Base directory
BASEDIR = ../..
@@ -27,7 +26,8 @@ OBJS = LeafGasPISCAL_single.o adsor.o clustering.o cppowell.o GenericRegres.o lf
LeafGasFit_Stom.o nonsyssolver.o time_resolution.o CharToNumeric.o cpfixedpoint.o funkmin_cica5.o NumberToChar.o\
stdmaxmeanmin.o ToLeafGasOptimization.o cica5.o cpnongradopt.o funkmin_stom.o LeafGasPrintToFiles.o odr_leastsquare.o StomatalConductance.o\
UnivParamsAlloc.o cica_Regression5.o cpnonsyssolver.o funkmin_UnivPhotoFit.o leafunivphotosyn.o odrpack.o stomlfitbasis.o UnivPhotoFit.o\
fluorescencejmax.o funkmin_flujmax.o pam_parameters.o
fluorescencejmax.o funkmin_flujmax.o pam_parameters.o C4SetUpLeafGasFit.o C4PhotoFit.o funkmin_C4Fit.o c4leafanetmodel.o d1mach.o dnqsol.o\
ierm1.o derv1.o dnrm2.o ierv1.o ermsg.o erfin.o
$(ALL): $(OBJS)
$(FF) $(FOPTS) $(OBJS) -o $@