!Photosynthetic, Internal and Stomatal Conductance Analyses of Leaves (PISCAL) ! !Created by: Lianhong Gu ! Environmental Sciences Dvision ! Oak Ridge National Laboratory ! Oak Ridge, TN 37831 ! lianhong-gu@ornl.gov !with support from Department of Energy Office of Science, Biological !and Environmental Research Program ! !PISCAL first created 10 July 2008 !Paralle PISCAL 20 Feb 2013 !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()() program main implicit none include 'mpif.h' 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,ic3c4cam character rundate*8,runtime*10,runzone*5,longchar*5000,achar*5, &longchar1*5000 character*100 datapath,outpath,storein,storeout,ACidata(8000) character*50 AllACiFiles,outputfile(20) ! 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/leafweb/data/dweston/Sphagnum_leafweb_Oct2015/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/wenting/', ! &'/home/l2g/leafres/hybriddata/dwestonpoplus/data_Pn_tree_1_195_v2/ ! &', ! &'/home/l2g/leafres/hybriddata/dwestonpoplus/data3/', ! &'/home/l2g/leafres/hybriddata/cernusak/2014data/', ! & '/home/l2g/dataassim/leaf/data/moflux/2008/inputs/', ! & '/home/l2g/leafres/hybriddata/sphagnum/2014data1/', !for moflux data, 2004-2008 requires correction of Ci. Other years do not ! & '/home/l2g/dataassim/leaf/data/LawData/inputs/', ! & '/home/l2g/dataassim/leaf/data/dweston/inputs/', ! & '/home/l2g/dataassim/leaf/data/johnbaker/inputs/', ! & '/home/l2g/dataassim/leaf/data/martins/inputs/', ! & '/home/l2g/dataassim/leaf/data/benzi/inputs/', ! & '/home/l2g/dataassim/leaf/data/loos/inputs/', ! & '/home/l2g/dataassim/leaf/data/ellsworth/inputs/', ! & '/home/l2g/dataassim/leaf/data/fromleafweb/inputs/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/testkco/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/rwprch/', ! & '/home/l2g/dataassim/leaf/data/panama/sept2012/inputs/', ! &'/home/l2g/dataassim/leaf/data/williams/inputs/', ! & '/home/l2g/dataassim/leaf/test/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/Martins/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/collantes/', ! & '/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/leafweb/data/dweston/Sphagnum_leafweb_Oct2015/', ! &'/home/l2g/leafres/hybriddata/cernusak/2014data/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/wenting/', ! &'/home/l2g/leafres/hybriddata/dwestonpoplus/data3/', ! &'/home/l2g/leafres/hybriddata/dwestonpoplus/data_Pn_tree_1_195_v2/ ! &', ! & '/home/l2g/dataassim/leaf/data/moflux/2008/outputs/', ! & '/home/l2g/dataassim/leaf/data/moflux/2012/outputs/', ! & '/home/l2g/dataassim/leaf/data/LawData/outputs/', ! & '/home/l2g/dataassim/leaf/data/dweston/outputs/', ! & '/home/l2g/dataassim/leaf/data/johnbaker/outputs/', ! & '/home/l2g/dataassim/leaf/data/martins/outputs/', ! & '/home/l2g/dataassim/leaf/data/benzi/outputs/', ! & '/home/l2g/dataassim/leaf/data/loos/outputs/', ! & '/home/l2g/dataassim/leaf/data/ellsworth/outputs/', ! &'/home/l2g/leafres/hybriddata/sphagnum/2014results1/', ! &'/home/l2g/junk/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/testkco/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/rwprch/results/', ! & '/home/l2g/dataassim/leaf/data/panama/sept2012/outputs/', ! &'/home/l2g/dataassim/leaf/data/panama/sept2012/outputs/rwprch/', ! & '/home/l2g/mpitest/', ! &'/home/l2g/dataassim/leaf/data/williams/outputs/', ! & '/home/l2g/dataassim/leaf/data/fromleafweb/outputs/withpad/', ! & '/home/l2g/dataassim/leaf/test/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/collantes/', ! & '/home/l2g/SingleLeafModel/ACiSimulation/Martins/', ! & '/home/l2g/dataassim/leaf/data/dweston/outputs/', ! & '/home/l2g/GEMSiS/results/', ! &storein='/home/l2g/leafweb/users/curves/', ! &storeout='/home/l2g/leafweb/users/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='../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(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 if(longchar(j:j).ne.''.or.longchar(j:j).ne.' ')then ipos1=j else if(j.ge.i)goto 10 goto 15 endif j=i+1 16 j=j-1 if(longchar(j:j).ne.''.or.longchar(j:j).ne.' ')then ipos2=j else if(j.le.1)goto 10 goto 16 endif ACidata(ntotfiles)=longchar(ipos1:ipos2) ntotfiles=ntotfiles+1 goto 10 20 ntotfiles=ntotfiles-1 close(2) 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 !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) call MPI_COMM_RANK(MPI_COMM_WORLD,rank_mpi,ierror_mpi) call MPI_COMM_SIZE(MPI_COMM_WORLD,numproc,ierror_mpi) !25 continue ! call MPI_BCAST(ACidata,ntotfiles,MPI_CHARACTER,rootprocess, ! &MPI_COMM_WORLD,ierror_mpi) ! call MPI_BCAST(ntotfiles,1,MPI_INTEGER,rootprocess, ! &MPI_COMM_WORLD,ierror_mpi) ! call MPI_BCAST(outputfile,noutputfiles,MPI_CHARACTER,rootprocess, ! &MPI_COMM_WORLD,ierror_mpi) ! call MPI_BCAST(indexunit,noutputfiles,MPI_INTEGER,rootprocess, ! &MPI_COMM_WORLD,ierror_mpi) ! call MPI_BCAST(noutputfiles,1,MPI_INTEGER,rootprocess, ! &MPI_COMM_WORLD,ierror_mpi) !make sure the number of processors actually needed not to exceed the number of curves numproc_mpi=min0(ntotfiles,numproc) !only processors with ranks 0,1,.......numproc_mpi-1 actually do work and the rest !go idle if(rank_mpi.ge.numproc_mpi)goto 45 nshare=ntotfiles/numproc_mpi nmod=ntotfiles-nshare*numproc_mpi if((rank_mpi+1).le.nmod)then npartfiles=nshare+1 istartno=rank_mpi*npartfiles+1 iendno=(rank_mpi+1)*npartfiles else npartfiles=nshare istartno=nmod*(nshare+1)+(rank_mpi+1-nmod-1)*nshare+1 iendno=istartno+nshare-1 endif numchar=1 30 if(rank_mpi.lt.(10**numchar))goto 40 numchar=numchar+1 goto 30 40 call NumberToChar(rank_mpi,numchar,achar) do i=1,noutputfiles open(unit=indexunit(i), &file=trim(outpath)//trim(outputfile(i))//trim(achar)) enddo call ToLeafGasOptimization(ic3c4cam,npartfiles, &ACidata(istartno:iendno),dataunit,spareunit,datapath,indexunit, &ierr) do i=1,noutputfiles close(indexunit(i)) enddo !make sure everyone is done before wrapping up. 45 call MPI_BARRIER(MPI_COMM_WORLD,ierror_mpi) if(rank_mpi.eq.rootprocess)then do j=1,noutputfiles open(unit=indexunit(j),file= &trim(outpath)//trim(outputfile(j))) needheader(j)=0 enddo !needheader=0: the two headerlines as well as data have not been written yet !needheader=1: the two headerlines but no data have been written !needheader=2: the two headerlines and data have been written do i=1,numproc_mpi rank_mpi=i-1 numchar=1 50 if(rank_mpi.lt.(10**numchar))goto 60 numchar=numchar+1 goto 50 60 call NumberToChar(rank_mpi,numchar,achar) do j=1,noutputfiles-2 k=0 open(unit=2,file= &trim(outpath)//trim(outputfile(j))//trim(achar)) if(needheader(j).eq.1.or.needheader(j).eq.2)then read(2,*,end=70) read(2,*,end=70) else read(2,fmt=300,end=70)longchar read(2,fmt=300,end=70)longchar1 write(indexunit(j),310)trim(longchar) write(indexunit(j),310)trim(longchar1) needheader(j)=1 endif 65 read(2,fmt=300,end=70)longchar write(indexunit(j),310)trim(longchar) needheader(j)=2 k=1 goto 65 70 close(2,status='delete') enddo do j=noutputfiles-1,noutputfiles open(unit=2,file= &trim(outpath)//trim(outputfile(j))//trim(achar)) 75 read(2,fmt=300,end=80)longchar write(indexunit(j),310)trim(longchar) needheader(j)=2 goto 75 80 close(2,status='delete') enddo enddo do j=1,noutputfiles if(needheader(j).eq.2)then !keep files that contain data close(indexunit(j)) else !delete files that contain no data close(indexunit(j),status='delete') endif enddo !---------------------------------------------------------- !intercept the data 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)//'clean'//trim(ACidata(i))) open(unit=2,file= &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,status='delete') close(2) enddo do i=1,noutputfiles k=0 open(unit=1,file=trim(outpath)//trim(outputfile(i))) 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,status='delete') close(2) else close(1,status='delete') close(2,status='delete') endif enddo endif 450 call MPI_FINALIZE(ierror_mpi) !---------------------------------------------------------- 300 format(a5000) 310 format(a) end !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@