! Just change the atmospheric CO2 number in the CO2_data file
!  
! compile on vayu using
! ifort -o atmCO2conc  atmCO2conc.f90  -L /apps/netcdf/3.6.3/lib/Intel/ -lnetcdf -I /apps/netcdf/3.6.3/include/Intel/
!ifort -o atmCO2conc atmCO2conc.f90 -L/opt/netcdf/lib -lnetcdf -I/opt/netcdf/include
!
PROGRAM atmCO2conc
   use getopt_m
  IMPLICIT NONE
  INTEGER :: iyear, fyear, fmon
  INTEGER :: ii, jj, yy    ! counter
  INTEGER :: ioerror
  REAL    :: LC, LU, FF, OC, monFF
  REAL    :: oldconc, newconc
  INTEGER, DIMENSION(11) :: futureYr
  REAL,    DIMENSION(11) :: FFfuture, LUfuture
  CHARACTER(LEN=150) :: dummy
  DATA futureYr /  2005,  2010,  2020,  2030,  2040,  2050, &
                   2060,  2070,  2080,  2090,  2100 /
  DATA FFfuture / 7.971, 8.926,11.538,13.839,16.787,20.205, &
                 23.596,25.962,27.406,28.337,28.740 /
  DATA LUfuture / 1.196, 1.044, 0.906, 0.715, 0.645, 0.576, &
                  0.501, 0.412, 0.309, 0.194, 0.077 /
   integer :: nopt, opt, ios
   character(len=80) :: optarg

! get actual year to use for emissions files
   do 
      call getopt("c:",nopt,opt,optarg)
      if ( opt == -1 ) then
         exit ! End of options
      end if
      select case ( char(opt) )
      case ( "c" )
         read(optarg,*) newconc
	  print *, newconc 
      case default
         print*, " Error: Unknown option "
         print*, "Usage: updateCO2 -c conc"
         stop
      end select
   end do
        
! Obtain the former CO2 concentration from the radiation file
  OPEN(UNIT=9,FILE='co2_data.18l')
  OPEN(UNIT=10,FILE='co2_data.new')
  READ(9,*) ii
  write(10,*) ii
  DO ii = 1, 3
    READ(9,'(a90)') dummy
    write(10,'(a90)') dummy
  enddo
   READ(9,*) oldconc
  newconc = newconc*1e-6  ! convert from ppm 
  write(10,*) newconc

  DO ii = 1, 5000
    READ(9,'(a90)',end=100) dummy
    write(10,'(a90)') dummy
  enddo
 100 continue

  CLOSE(9)
  CLOSE(10)

  end