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

Initial commit

Browse Source
This commit is contained in:
poprhythm
2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
leafres/testarea/LeafGasPISCAL_mpi.f
+364
View File
@@ -0,0 +1,364 @@
!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
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=
! &'/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=
! &'/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='/home/l2g/clm/results/',
&storeout='/home/l2g/clm/results/',
! &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')
!---------------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))
ntotfiles=1
10 read(2,fmt=300,end=20)longchar
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
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-1
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
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
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
goto 450
399 call date_and_time(rundate,runtime,runzone,runvalues)
do i=1,ntotfiles
open(unit=1,file=trim(datapath)//trim(ACidata(i)))
open(unit=2,file=
&trim(storein)//rundate//runtime(1:6)//trim(ACidata(i)))
400 read(1,fmt=300,end=410)longchar
write(2,310)trim(longchar)
goto 400
410 close(1)
close(2)
enddo
do i=1,6
k=0
open(unit=1,file=trim(outpath)//trim(outputfile(i)))
open(unit=2,file=
&trim(storeout)//rundate//runtime(1:6)//trim(outputfile(i)))
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(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
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@