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:
poprhythm
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/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)