!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
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
