! This is part of the netCDF package.
! Copyright 2006 University Corporation for Atmospheric Research/Unidata.
! See COPYRIGHT file for conditions of use.
      
! This is a simple example which reads a small dummy array, from a
! netCDF data file created by the companion program simple_xy_wr.f90.
      
! This is intended to illustrate the use of the netCDF fortran 77
! API. This example program is part of the netCDF tutorial, which can
! be found at:
! http://www.unidata.ucar.edu/software/netcdf/docs/netcdf-tutorial
      
! Full documentation of the netCDF Fortran 90 API can be found at:
! http://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f90

! $Id: simple_xy_rd.f90,v 1.7 2006/12/09 18:44:58 russ Exp $

program vegfra
  use netcdf 
  implicit none
  include 'modelgrid.inc'
  include 'vegfra_csiro_grid_0.05.inc'  

! We are reading 2D data 
  real :: vegfra1(imll,jmll), vegfra2(imll,jmll)
  real :: vegfra1_interp(imi,jmi), vegfra2_interp(imi,jmi)
  real :: vegfra_interp(imi,jmi), misvals(imi,jmi), vals(imi,jmi), vegfrcPv(imi,jmi), vegfrcNpv(imi,jmi)
  real :: lat(imi), lon(imi), lats(jmll), lons(imll)

! This will be the netCDF ID for the file and data variable.
  integer :: ncid, ncid1, ncid2, vegfra_varid, vegfra_varid1, vegfra_varid2
  integer :: vf1out_varid, vf2out_varid, sm_varid
  integer :: lat_varid, lon_varid, rlat_varid,rlon_varid 
  integer :: lon_dimid, lat_dimid, south_north(jmi),west_east(imi)
! Loop indexes, and error handling.
  integer :: x, y, i, j, m, t, jm60
!
  real :: almd,aphd,tlm,tph,wb,sb,tph0,ctph0,stph0,dlm,dph
  real :: coh(3,imi,jmi),sm(imi,jmi),snow(imi,jmi),vfclim(imi,jmi)
  integer :: inh(4,imi,jmi),jnh(4,imi,jmi)

  logical :: global
!
  real, parameter :: dtr=3.1415926535897932384626433832795/180., rtd=1./dtr
!
  character :: clim_char
  integer   :: clim
!
  integer :: dimids(2)
!
  logical(kind=4):: run
! 
  character(128):: infile,infile1,infile2,outfile

  integer(kind=4),dimension(1:3)  :: idat
  integer(kind=4),dimension(1:12) :: month
  integer(kind=4),dimension(1:13) :: jmonth

  integer(kind=4):: ihrst,iday,imon,iyear,jday,mnth1,mnth2,mon

  real(kind=4):: wght

  character(2):: sfx

  character(4):: yrx, vtype
!
  character (len = *), parameter :: LAT_NAME = "latitude"
  character (len = *), parameter :: LON_NAME = "longitude"
  real :: rlat(imi,jmi), rlon(imi,jmi)
  character (len = *), parameter :: UNITS = "units"
  character (len = *), parameter :: LAT_UNITS = "degrees_north"
  character (len = *), parameter :: LON_UNITS = "degrees_east"
! 
  logical :: file_exists
!
  data month/31,28,31,30,31,30,31,31,30,31,30,31/
!-----------------------------------------------------------------------
!
  global=im.gt.imi
!
!-----------------------------------------------------------------------
  
  call getarg(1, clim_char)
  read (clim_char, *) clim
!
!----------------------------------------------------------------------
      infile='../output/llspl.000'
      open(unit=1,file=infile,status='old',form='unformatted')
      read(1) run,idat,ihrst
      close(1)
!
      print*,'Cycle data read from ',infile
      print*,'Cycle ',idat,ihrst,' UTC'
!-------------julian day for 15th of each month-------------------------
      jmonth(1)=15
      do imon=2,13
        jmonth(imon)=0
        do mon=1,imon-1
          jmonth(imon)=jmonth(imon)+month(mon)
        enddo
        jmonth(imon)=jmonth(imon)+15
      enddo
!--------------julian day for current date------------------------------
      iday=idat(1)
      imon=idat(2)
      iyear=idat(3)
      jday=iday
      if(imon.gt.1) then
        do mon=2,imon
          jday=jday+month(mon-1)
        enddo
      endif
!
      if(jday.lt.15) jday=365+jday
!-----------------------------------------------------------------------
      do mon=1,12
        if(jday.ge.jmonth(mon).and.jday.lt.jmonth(mon+1)) then
          mnth1=mon
          mnth2=mon+1
          wght=float(jday-jmonth(mon)) &
              /float(jmonth(mon+1)-jmonth(mon))
          go to 100
        endif
      enddo
 100  continue
      if(mnth2.gt.12) mnth2=1
!-------------read in vegfrac data for mnth1 and mnth2-------------------
! read sea mask
  open(unit=3,file='../output/seamask',status='unknown',form='unformatted')
  read(3) sm
  close(3)
! 
  do t = 1,2 ! prepare data both for PV and NPV 
     if (t == 1) then 
        vtype = 'Pv'    ! photosynthetic vegetation
     else 
        vtype = 'Npv'   ! non-photosynthetic vegetation
     endif 
     print*, 'Processing ', vtype
     if ( clim.eq.1 ) then   ! use actual year if available 
! 
        if (mnth2.eq.1.and.jday.gt.365) then
! 
           write(yrx,'(i4.4)') iyear-1
           write(sfx,'(i2.2)') mnth1
           infile1='../geodata/csiro_modis_vegfrc/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//yrx//sfx//'_corr.nc'
           INQUIRE(FILE=infile1, EXIST=file_exists)
           if (file_exists) then 
              print*,'vegfrc csiro modis read data for month/year ', sfx, '/', yrx
           else
              print*, 'file not found: ', infile1
              infile1='../geodata/csiro_modis_vegfrc/CLIM/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//sfx//'_clim.nc'
              print*,'vegfrc csiro modis read data for month ', sfx, ' from climatology (2001-2017)'
           endif 
! 
           write(yrx,'(i4.4)') iyear
           write(sfx,'(i2.2)') mnth2
           infile2='../geodata/csiro_modis_vegfrc/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//yrx//sfx//'_corr.nc'
           INQUIRE(FILE=infile2, EXIST=file_exists)
           if (file_exists) then 
              print*,'vegfrc csiro modis read data for month/year ', sfx, '/', yrx
           else
              print*, 'file not found: ', infile2
              infile2='../geodata/csiro_modis_vegfrc/CLIM/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//sfx//'_clim.nc'
              print*,'vegfrc csiro modis read data for month ', sfx, ' from climatology (2001-2017)'
           endif 
!
        elseif (mnth1.eq.12 .and. mnth2.eq.1 .and. jday.le.365) then 
! 
           write(yrx,'(i4.4)') iyear
           write(sfx,'(i2.2)') mnth1
           infile1='../geodata/csiro_modis_vegfrc/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//yrx//sfx//'_corr.nc'
           INQUIRE(FILE=infile1, EXIST=file_exists)
           if (file_exists) then 
              print*,'vegfrc csiro modis read data for month/year ', sfx, '/', yrx
           else
              print*, 'file not found: ', infile1
              infile1='../geodata/csiro_modis_vegfrc/CLIM/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//sfx//'_clim.nc'
              print*,'vegfrc csiro modis read data for month ', sfx, ' from climatology (2001-2017)'
           endif 
! 
           write(yrx,'(i4.4)') iyear+1
           write(sfx,'(i2.2)') mnth2
           infile2='../geodata/csiro_modis_vegfrc/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//yrx//sfx//'_corr.nc'
           INQUIRE(FILE=infile2, EXIST=file_exists)
           if (file_exists) then 
              print*,'vegfrc csiro modis read data for month/year ', sfx, '/', yrx
           else
              print*, 'file not found: ', infile2
              infile2='../geodata/csiro_modis_vegfrc/CLIM/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//sfx//'_clim.nc'
              print*,'vegfrc csiro modis read data for month ', sfx, ' from climatology (2001-2017)'
           endif 
! 
        else  
!
           write(yrx,'(i4.4)') iyear
           write(sfx,'(i2.2)') mnth1
           infile1='../geodata/csiro_modis_vegfrc/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//yrx//sfx//'_corr.nc'
           INQUIRE(FILE=infile1, EXIST=file_exists)
           if (file_exists) then 
              print*,'vegfrc csiro modis read data for month/year ', sfx, '/', yrx
           else
              print*, 'file not found: ', infile1
              infile1='../geodata/csiro_modis_vegfrc/CLIM/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//sfx//'_clim.nc'
              print*,'vegfrc csiro modis read data for month ', sfx, ' from climatology (2001-2017)'
           endif 
! 
           write(yrx,'(i4.4)') iyear
           write(sfx,'(i2.2)') mnth2
           infile2='../geodata/csiro_modis_vegfrc/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//yrx//sfx//'_corr.nc'
           INQUIRE(FILE=infile2, EXIST=file_exists)
           if (file_exists) then 
              print*,'vegfrc csiro modis read data for month/year ', sfx, '/', yrx
           else
              print*, 'file not found: ', infile2
              infile2='../geodata/csiro_modis_vegfrc/CLIM/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//sfx//'_clim.nc'
              print*,'vegfrc csiro modis read data for month ', sfx, ' from climatology (2001-2017)'
           endif 
!
        endif

     else     ! use climatology (currently 2001-2017)
!
         write(sfx,'(i2.2)') mnth1
         infile1='../geodata/csiro_modis_vegfrc/CLIM/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//sfx//'_clim.nc'
         write(sfx,'(i2.2)') mnth2
         infile2='../geodata/csiro_modis_vegfrc/CLIM/vegfrc'//trim(vtype)//'/vegfrc'//trim(vtype)//'_'//sfx//'_clim.nc'
!
         print*,'vegfrc csiro modis read data for month ', sfx, ' from climatology (2001-2017)'
         print*,'vegfrc csiro modis read data for month ', sfx, ' from climatology (2001-2017)'
!
     endif    ! clim
! 
! Open the file. NF90_NOWRITE tells netCDF we want read-only access to
! the file.
     call check( nf90_open(infile1, NF90_NOWRITE, ncid1) )
     call check( nf90_open(infile2, NF90_NOWRITE, ncid2) )
!
! Get the varids of the latitude and longitude coordinate variables.
     call check( nf90_inq_varid(ncid1, 'lat', lat_varid) )
     call check( nf90_inq_varid(ncid1, 'lon', lon_varid) )
!
! Read the latitude and longitude data.
     call check( nf90_get_var(ncid1, lat_varid, lats) )
     call check( nf90_get_var(ncid1, lon_varid, lons) )
!
! Get the varid of the data variable, based on its name.
     call check( nf90_inq_varid(ncid1, 'vegfrc'//vtype, vegfra_varid1) )
     call check( nf90_inq_varid(ncid2, 'vegfrc'//vtype, vegfra_varid2) )
! 
! Read the data.
!  call check( nf90_get_var(ncid, varid, source, start=(/1,1/), count=(/y,x/)) )
     call check( nf90_get_var(ncid1, vegfra_varid1, vegfra1) )
     call check( nf90_get_var(ncid2, vegfra_varid2, vegfra2) )
!
! Close the file, freeing all resources.
     call check( nf90_close(ncid1) )
     call check( nf90_close(ncid2) )
! 
     print *,"*** SUCCESS reading ", infile1
     print *,"*** SUCCESS reading ", infile2
! Set to 0 below -60N
     jm60 = (-60.-bosout)/delat
     vegfra1(:,1:jm60) = 0.
     vegfra2(:,1:jm60) = 0.
!
!-----------------------------------------------------------------------
!***  umo domain geometry
!-----------------------------------------------------------------------
!
     wb=wbd*dtr
     sb=sbd*dtr
     tph0=tph0d*dtr
     ctph0=cos(tph0)
     stph0=sin(tph0)
     dlm=dlmd*dtr
     dph=dphd*dtr
!
     call preina (global,wb,sb,tlm0d,ctph0,stph0,dlm,dph,imi,jmi,coh,inh,jnh)
!
! Selects interpolation method depending on grid resolution 
! (dlmd and dphd are from modelgrid.inc and delon and delat are from vegfra_csiro_grid_0.05.inc) 
!      
     if( dlmd.le.0.065 .and. dphd.le.0.065 ) then ! bilinear interpolation (for high resolution, about 0.05x0.05 deg or higher; threshold value of 0.065 obtained through testing)
!
        print*, 'bilinear interpolation'
        call bilinb(coh,inh,jnh,imll,jmll,imi,jmi,vegfra1,vegfra1_interp)
        call bilinb(coh,inh,jnh,imll,jmll,imi,jmi,vegfra2,vegfra2_interp)
!         
        where (sm.gt.0) ! need to set sea-cells to zero before fill_missing
           vegfra1_interp = 0.
           vegfra2_interp = 0.
        endwhere
! 
        do m = 1, 2  ! vegfra1_interp and vegfra2_interp
! 
           if (m.eq.1) then 
              vals = vegfra1_interp
           else 
              vals = vegfra2_interp
           endif 
! 
           call fill_missing(m, imi, jmi, sm, vals, misvals)
! 
           if (sum(misvals).gt.0) then 
               print*, 'replacing ', sum(misvals), ' values using default climatology/constant'
! read default climatological vegetation fraction to fill remaining missing values that could not be filled using same-data climatology
               open(unit=3,file='../output/vegfrac',status='unknown',form='unformatted')
               read(3) vfclim  
               close(3) 
! 
              if (t.eq.1) then   ! PV
                 where (vals.eq.-999) vals = vfclim
              else               ! NPV
                 where (vals.eq.-999) vals = 0.01
              endif
! 
           endif
!         
           if (m.eq.1) then 
              vegfra1_interp = vals
           else 
              vegfra2_interp = vals 
           endif 
! 
        enddo 
! Do this again, just in case
        where (sm.gt.0) 
           vegfra1_interp = 0.
           vegfra2_interp = 0.
        endwhere
! 
! 
! 
     else  ! averaging inside each grid cell (for coarse resolutions > 0.05x0.05 deg)
!
        print*, 'average gridcell' 
        call average_gridcell(imll,jmll,lons,lats,vegfra1,vegfra1,vegfra1_interp)
        call average_gridcell(imll,jmll,lons,lats,vegfra2,vegfra2,vegfra2_interp)
! 
        where (sm.gt.0)  ! need to set sea-cells to zero before fill_missing
           vegfra1_interp = 0.
           vegfra2_interp = 0.
        endwhere
! 
        do m = 1, 2  ! vegfra1_interp and vegfra2_interp
! 
           if (m.eq.1) then 
              vals = vegfra1_interp
           else 
              vals = vegfra2_interp
           endif 
! 
           call fill_missing(m, imi, jmi, sm, vals, misvals)
! 
           if (sum(misvals).gt.0) then 
               print*, 'replacing ', sum(misvals), ' values using default climatology/constant'
! read default climatological vegetation fraction to fill remaining missing values that could not be filled using same-data climatology
               open(unit=3,file='../output/vegfrac',status='unknown',form='unformatted')
               read(3) vfclim  
               close(3) 
! 
              if (t.eq.1) then   ! PV
                 where (vals.eq.-999) vals = vfclim
              else               ! NPV
                 where (vals.eq.-999) vals = 0.01
              endif
! 
           endif
!         
           if (m.eq.1) then 
              vegfra1_interp = vals
           else 
              vegfra2_interp = vals 
           endif 
! 
        enddo 
! Do this again, just in case
        where (sm.gt.0) 
           vegfra1_interp = 0.
           vegfra2_interp = 0.
        endwhere
! 
     endif  ! interpolation method     
!
!--------------do the time interpolation--------------------------------
      do i=1,imi
        do j=1,jmi
! 
          vegfra_interp(i,j)=(vegfra2_interp(i,j)-vegfra1_interp(i,j))*wght &
                            +vegfra1_interp(i,j)
        enddo
      enddo
! 
     if (t == 1) then 
        vegfrcPv = vegfra_interp   ! for netcdf
     else 
        vegfrcNpv = vegfra_interp
     endif
  enddo ! PV/NPV

  if (maxval(vegfrcPv+vegfrcNpv).gt.1.) then 
     print*, maxval(vegfrcPv+vegfrcNpv)
     vegfrcPv = vegfrcPv/maxval(vegfrcPv+vegfrcNpv)
     vegfrcNpv = vegfrcNpv/maxval(vegfrcPv+vegfrcNpv)
  endif 
! 
  open(unit=1,file='../output/vegfrcPv',status='unknown',form='unformatted')
  write(1) vegfrcPv
  close(1)
! 
  open(unit=1,file='../output/vegfrcNpv',status='unknown',form='unformatted')
  write(1) vegfrcNpv
  close(1)

!----------------------------------------------------------------------------------------
!Create netcdf to check everything is correct
!----------------------------------------------------------------------------------------

  tph=sb-dph
  do j=1,jmi
     tph=tph+dph
     tlm=wb-dlm
     do i=1,imi
        tlm=tlm+dlm
!
!-----------------------------------------------------------------------
!***  tll to ll conversion
!-----------------------------------------------------------------------
!
       if(.not.global) then
         call rtll(tlm,tph,tlm0d,ctph0,stph0,almd,aphd)
       else
         almd=tlm*rtd
         aphd=tph*rtd
       endif
!
       rlat(i,j)=aphd
       rlon(i,j)=almd
!
     enddo
  enddo
!
  do i=1,jmi
     south_north(i)=i
  enddo
!
  do i=1,imi
     west_east(i)=i
  enddo
!
!----------------------------------------------------------------------------------------
!
  call check( nf90_create("vegfrc_csiro_modis.nc", NF90_CLOBBER, ncid) )
!
! Define the dimensions. NetCDF will hand back an ID for each. 
  call check( nf90_def_dim(ncid, "lon", imi, lon_dimid) )
  call check( nf90_def_dim(ncid, "lat", jmi, lat_dimid) )
!
! The dimids array is used to pass the IDs of the dimensions of
! the variables. Note that in fortran arrays are stored in
! column-major format.
!
  dimids =  (/ lon_dimid, lat_dimid /)
!
! Define the variable. The type of the variable in this case is
! NF90_INT (4-byte integer).
!
  call check( nf90_def_var(ncid, "vegfrc", NF90_REAL, dimids, vegfra_varid) )
  call check( nf90_def_var(ncid, "vegfrcPv", NF90_REAL, dimids, vf1out_varid) )
  call check( nf90_def_var(ncid, "vegfrcNpv", NF90_REAL, dimids, vf2out_varid) )
  call check( nf90_def_var(ncid, "seamask", NF90_REAL, dimids, sm_varid) )
  call check( nf90_put_att(ncid, vegfra_varid, "standard_name", "vegetation fraction (PV and NPV)") )
  call check( nf90_def_var(ncid, "lat", NF90_REAL, dimids, rlat_varid) )
  call check( nf90_def_var(ncid, "lon", NF90_REAL, dimids, rlon_varid) )
  call check( nf90_put_att(ncid, rlat_varid, "units", "degrees_north") )
  call check( nf90_put_att(ncid, rlat_varid, "standard_name", "latitude") )
  call check( nf90_put_att(ncid, rlon_varid, "units", "degrees_east") )
  call check( nf90_put_att(ncid, rlon_varid, "standard_name", "longitude") )
  call check( nf90_enddef(ncid) )
!
! Write the pretend data to the file. Although netCDF supports
! reading and writing subsets of data, in this case we write all the
! data in one operation.
!
  call check( nf90_put_var(ncid, vegfra_varid, vegfrcPv + vegfrcNpv) )
  call check( nf90_put_var(ncid, vf1out_varid, vegfrcPv) )
  call check( nf90_put_var(ncid, vf2out_varid, vegfrcNpv) )
!   call check( nf90_put_var(ncid, vf3out_varid, cvegfra1_interp) )
!   call check( nf90_put_var(ncid, vf4out_varid, cvegfra2_interp) )
!   call check( nf90_put_var(ncid, vf5out_varid, vfclim) )
!   call check( nf90_put_var(ncid, vf6out_varid, svegfra_interp) )
!   call check( nf90_put_var(ncid, vf7out_varid, svegfra_all_interp) )
  call check( nf90_put_var(ncid, sm_varid, sm) )
  call check( nf90_put_var(ncid, rlat_varid, rlat) )
  call check( nf90_put_var(ncid, rlon_varid, rlon) )
!
! Close the file. This frees up any internal netCDF resources
! associated with the file, and flushes any buffers.
!
  call check( nf90_close(ncid) )
!
  print *, "*** SUCCESS writing vegfrc-csiro-modis! "
!
!
!Subroutines
!
contains
  subroutine check(status)
    integer, intent ( in) :: status
    
    if(status /= nf90_noerr) then 
      print *, trim(nf90_strerror(status))
      stop "Stopped"
    end if
  end subroutine check


  subroutine preina (global,wb,sb,tlm0d,ctph0,stph0,dlm,dph,imi,jmi,coh,inh,jnh)
!
!-----------------------------------------------------------------------
      include 'vegfra_csiro_grid_0.05.inc'
!-----------------------------------------------------------------------
!
      real(kind=4),parameter ::  dtr=3.1415926535897932384626433832795/180.,rtd=1./dtr
!
!-----------------------------------------------------------------------
!
      logical :: global
      integer :: imi, jmi
      real ::  x,y,coh(3,imi,jmi),almd,aphd,tlm,tph,wb,sb,tlm0d,ctph0,stph0,dlm,dph
      integer :: inh(4,imi,jmi),jnh(4,imi,jmi),indec,jndec
!
!-----------------------------------------------------------------------
!***  entry to the umo i,j loop
!***  neighbour avn index identification (avn data defined in ll system)
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
      tph=sb-dph
              do j=1,jmi
          tph=tph+dph
          tlm=wb-dlm
          do i=1,imi
      tlm=tlm+dlm
!
!-----------------------------------------------------------------------
!***  tll to ll conversion
!-----------------------------------------------------------------------
!
      if(.not.global) then
        call rtll(tlm,tph,tlm0d,ctph0,stph0,almd,aphd)
      else
        almd=tlm*rtd
        aphd=tph*rtd
      endif
!
!-----------------------------------------------------------------------
!-------------conversion from -180,180 range to 0,360 range-------------
!-----------------------------------------------------------------------
!
!      if(almd.lt.0.) almd=360.+almd    NO NEED HERE
!
!
!-----------------------------------------------------------------------
!-------------check if model point is out of llgrid domain--------------
!-----------------------------------------------------------------------
!
      if(almd.lt.bowest-delon/2      .or.  &
         almd.gt.boeast+delon/2+0.1  ) then
!     &   almd.gt.boeast+delon.or.
!     &   aphd.lt.bosout      .or.
!     &   aphd.gt.bonort          ) then
        print*,'h point i=',i,' j=',j,almd,aphd &
     ,' is out of the llgrid domain SFC2'
        print*,'program will stop'
        stop
      endif
!
!----------------------------------------------------------------------
!
      if(aphd.ge.bosout.or.  &
        aphd.le.bonort) then

      x=almd-bowest
      y=aphd-bosout
!
      indec=x/delon+1
      jndec=y/delat+1
!
      if(indec.eq.0) indec=imll
      if(indec.gt.imll) indec=1
      if(jndec.eq.0) jndec=1
      if(jndec.ge.jmll) jndec=jmll-1
!
      x=x-(indec-1)*delon
      y=y-(jndec-1)*delat
!-----------------------------------------------------------------------
      coh(1,i,j)=x/delon
      coh(2,i,j)=y/delat
      coh(3,i,j)=coh(1,i,j)*coh(2,i,j)
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
      inh(1,i,j)=indec
      inh(3,i,j)=indec
          if(indec.lt.imll) then
      inh(2,i,j)=indec+1
      inh(4,i,j)=indec+1
          else
      inh(2,i,j)=1
      inh(4,i,j)=1
          endif
!
      jnh(1,i,j)=jndec
      jnh(2,i,j)=jndec
      jnh(3,i,j)=jndec+1
      jnh(4,i,j)=jndec+1
     else

      coh(1,i,j)=0.
      coh(2,i,j)=0.
      coh(3,i,j)=coh(1,i,j)*coh(2,i,j)
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
      inh(1,i,j)=1
      inh(3,i,j)=1
          if(indec.lt.imll) then
      inh(2,i,j)=1
      inh(4,i,j)=1
          else
      inh(2,i,j)=1
      inh(4,i,j)=1
          endif
!
      jnh(1,i,j)=1
      jnh(2,i,j)=1
      jnh(3,i,j)=1
      jnh(4,i,j)=1
!-----------------------------------------------------------------------

      endif

          enddo
              enddo
!-----------------------------------------------------------------------
      end subroutine
!-----------------------------------------------------------------------

      subroutine rtll(tlm,tph,tlm0d,ctph0,stph0,almd,aphd)
!     ****************************************************************
!     *                                                              *
!     *  programer: z. janjic, shmz, feb. 1981                       *
!     *  ammended:  z. janjic, ncep, jan. 1996                       *
!     *                                                              *
!     *  transformation from rotated lat-lon to lat-lon coordinates  *
!     ****************************************************************
!     ****************************************************************
!     *  tlm   - transformed longitude, rad.                         *
!     *  tph   - transformed latitude, rad.                          *
!     *  tlm0d - the angle of rotation of the transformed lat-lon    *
!     *          system in the longitudinal direction, degs          *
!     *  ctph0 - cos(tph0), tph0 is the angle of rotation of the     *
!     *          transformed lat-lon systemn in the latitudinal      *
!     *          direction, precomputed                              *
!     *  stph0 - sin(tph0), tph0 is the angle of rotation of the     *
!     *          transformed lat-lon systemn in the latitudinal      *
!     *          direction, precomputed                              *
!     *  almd  - geographical longitude, degs, range -180.,180       *
!     *  aphd  - geographical latitude,  degs, range - 90., 90.,     *
!     *          poles are singular                                  *
!     ****************************************************************
!
!-----------------------------------------------------------------------
!
      real, parameter :: dtr=3.1415926535897932384626433832795/180.
      real :: almd,aphd,tph,tlm,ctph0,stph0,tlm0d,stlm,ctlm,stph,ctph
      real :: sph,aph,anum,denom,relm

!
      stlm=sin(tlm)
      ctlm=cos(tlm)
      stph=sin(tph)
      ctph=cos(tph)
!
      sph=ctph0*stph+stph0*ctph*ctlm
      sph=min(sph,1.)
      sph=max(sph,-1.)
      aph=asin(sph)
      aphd=aph/dtr
      anum=ctph*stlm
      denom=(ctlm*ctph-stph0*sph)/ctph0
      relm=atan2(anum,denom)
      almd=relm/dtr+tlm0d
!
      if(almd.gt. 180.)    almd=almd-360.
      if(almd.lt.-180.)    almd=almd+360.
!
!-----------------------------------------------------------------------
!
      end subroutine

      subroutine bilinb(cob,inb,jnb,imll,jmll,imi,jmi,ww,wfb)
!
!-----------------------------------------------------------------------
!
      real :: cob(3,imi,jmi)
      integer :: inb(4,imi,jmi),jnb(4,imi,jmi),imll,jmll,imi,jmi
      real :: ww(imll,jmll),wfb(imi,jmi)
      integer :: i00,i10,i01,i11,j00,j10,j01,j11
      real :: p,q,pq,z
      integer :: valid(4), n
      real :: a00, a10, a01, a11, anorm
!
!-----------------------------------------------------------------------
              do j=1,jmi
          do i=1,imi
! 
! Find missing values 
      do n = 1,4
         if ( ww(inb(n,i,j),jnb(n,i,j)) .eq. -999.) then 
            valid(n) = 0
         else 
            valid(n) = 1
         endif 
      enddo 
! 
! x-indices
      i00=inb(1,i,j)
      i10=inb(2,i,j)
      i01=inb(3,i,j)
      i11=inb(4,i,j)
! y-indices
      j00=jnb(1,i,j)
      j10=jnb(2,i,j)
      j01=jnb(3,i,j)
      j11=jnb(4,i,j)
! x, y, xy
      p=cob(1,i,j)
      q=cob(2,i,j)
      pq=cob(3,i,j)
! weighting areas
      a00 = 1. - p - q + pq
      a10 = p - pq
      a01 = q - pq
      a11 = pq
      anorm = valid(1)*a00 + valid(2)*a10 + valid(3)*a01 + valid(4)*a11
!       write(31,*) 'area ', a00 + a10 + a01 + a11, anorm
!
      if ( anorm .ne. 0. ) then 
         z=valid(1)*ww(i00,j00)  &
         +p*(valid(2)*ww(i10,j10)-valid(1)*ww(i00,j00))  &
         +q*(valid(3)*ww(i01,j01)-valid(1)*ww(i00,j00))  &
         +pq*(valid(1)*ww(i00,j00)-valid(2)*ww(i10,j10)-valid(3)*ww(i01,j01)+valid(4)*ww(i11,j11))      
! 
         z=z/anorm      
      else 
         z = -999. 
      endif 
! 
!       z=ww(i00,j00)  &
!       +p*(ww(i10,j10)-ww(i00,j00))  &
!       +q*(ww(i01,j01)-ww(i00,j00))  &
!       +pq*(ww(i00,j00)-ww(i10,j10)-ww(i01,j01)+ww(i11,j11))
!
      wfb(i,j)=z
!
          enddo
              enddo
!-----------------------------------------------------------------------
!
      end subroutine

      subroutine average_gridcell(ix,jy,lon,lat,input_tot,input,output)      

      include 'modelgrid.inc'
!-----------------------------------------------------------------------
      integer,parameter :: lclass=1                    ! total, natural and anthropogenic
      real,parameter :: pi=3.1415926535897932384626433832795, dtr=pi/180.,scalex=0.50,scaley=0.50
      integer :: i,i1,i2,iavg,idata,ie,is,j,j1,j2,jdata,je,js,l,ix,jy
      real :: ctph,ctph0,dlm,dph,edlm,edph,elmh,elml,ephh,ephl,rctph &
                    ,rdlm,rdph,sb,stph0,tlm,tlm0,tph,tph0,wb,xdata,ydata,rr
      integer :: kount(lclass,imi,jmi)
      real :: output(imi,jmi)
      real :: input(ix,jy),input_tot(ix,jy)
      real :: lon(ix)
      real :: lat(jy)
!-----------------------------------------------------------------------
      tlm0=tlm0d*dtr
      tph0=tph0d*dtr
      stph0=sin(tph0)
      ctph0=cos(tph0)
!
      wb=wbd*dtr
      sb=sbd*dtr
      dlm=dlmd*dtr
      dph=dphd*dtr
!
      rdlm=1./dlm
      rdph=1./dph
!
      do j=1,jmi
        do i=1,imi
          output(i,j)=0.
          do l=1,lclass
          kount(l,i,j)=0
          enddo
        enddo
      enddo
!-----------------------------------------------------------------------
          do jdata=1,jy
!
            do idata=1,ix

!-----------------------------------------------------------------------
              if(im.gt.imi) then ! global domain
!-----------------------------------------------------------------------
                tlm=lon(idata)*dtr
                tph=lat(jdata)*dtr
!
                ctph=abs(cos(tph))
                if(ctph.gt.0.00001) then
                  rctph=max(dph/(ctph*dlm),1.)
                else
                  rctph=999999.
                endif
!
                edlm=min(dlm*rctph*scalex,pi)
                elml=tlm-edlm
                elmh=tlm+edlm
!
                if(elml.lt.-pi) elml=elml+pi+pi
                if(elmh.gt. pi) elmh=elmh-pi-pi
!
                is=int((elml-wb)*rdlm+0.99999)+1
                ie=int((elmh-wb)*rdlm        )+1
!
                if(is.lt.1  ) is=1
                if(ie.lt.1  ) ie=1
                if(is.gt.imi) is=imi
                if(ie.gt.imi) ie=imi
!
                edph=dph*scaley
                ephl=tph-edph
                ephh=tph+edph
!
                if(ephl.lt. sb) ephl= sb
                if(ephh.gt.-sb) ephh=-sb

                js=int((ephl-sb)*rdph+0.99999)+1
                je=int((ephh-sb)*rdph+0.00001)+1
!
                if(js.lt.1  ) js=1
                if(je.lt.1  ) je=1
                if(js.gt.jmi) js=jmi
                if(je.gt.jmi) je=jmi
!
                do j=js,je
                  if(is.gt.ie) then
                    do i=is,imi
                     if (input_tot(idata, jdata).ge.0. ) then   ! use .ge. here as missing values (negative) are kept 
                         kount(1,i,j)=kount(1,i,j)+1
                         output(i,j)=output(i,j)+input(idata, jdata)
                     endif
                    enddo
                    do i=1,ie
                     if (input_tot(idata, jdata).ge.0. ) then
                         kount(1,i,j)=kount(1,i,j)+1
                         output(i,j)=output(i,j)+input(idata, jdata)
                     endif
                    enddo
                  else
                    do i=is,ie
                     if (input_tot(idata, jdata).ge.0. ) then
                         kount(1,i,j)=kount(1,i,j)+1
                         output(i,j)=output(i,j)+input(idata, jdata)
                     endif
                    enddo
                  endif
                enddo
!-----------------------------------------------------------------------
              else ! regional domain
                call tll(lon(idata),lat(jdata),tlm0d,dtr,ctph0,stph0,tlm,tph)
!
                ctph=cos(tph)
                rctph=max(dph/(ctph*dlm),1.)
!
                edlm=dlm*rctph*scalex
                elml=tlm-edlm
                elmh=tlm+edlm
!
                is=int((elml-wb)*rdlm+0.99999)+1
                ie=int((elmh-wb)*rdlm        )+1
!
                edph=dph*scaley
                ephl=tph-edph
                ephh=tph+edph
!
                js=int((ephl-sb)*rdph+0.99999)+1
                je=int((ephh-sb)*rdph+0.00001)+1
!
                if(ie.ge.1.and.is.le.imi.and. &
                   je.ge.1.and.js.le.jmi) then ! data point inside
!
                  if(is.lt.1  ) is=1
                  if(ie.gt.imi) ie=imi
                  if(js.lt.1  ) js=1
                  if(je.gt.jmi) je=jmi

                  do j=js,je
                    do i=is,ie
                     if (input_tot(idata, jdata).ge.0. ) then
                         kount(1,i,j)=kount(1,i,j)+1
                         output(i,j)=output(i,j)+input(idata, jdata)
                     endif
                    enddo
                  enddo
                endif
!-----------------------------------------------------------------------
              endif ! end of global/regional branching
!-----------------------------------------------------------------------
            enddo
          enddo
!-----------------------------------------------------------------------
      if(im.gt.imi) then
        do j=1,jmi
          do l=1,lclass
            iavg=(kount(l,1,j)+kount(l,imi,j))/2
            kount(l,1  ,j)=iavg
            kount(l,imi,j)=iavg
          enddo
        enddo
      endif
!
      do j=1,jmi
        do i=1,imi
           if(kount(1,i,j).gt.0)then
             rr=real(kount(1,i,j))
             output(i,j)=output(i,j)/rr
           else 
             output(i,j)=-999.    ! to identify missing values
           endif
        enddo
      enddo

      end subroutine

end program vegfra

      subroutine tll(almd,aphd,tlm0d,dtr,ctph0,stph0,tlm,tph)
!     ****************************************************************
!     *                                                              *
!     *  programer: z. janjic, shmz, feb. 1981                       *
!     *  ammended:  z. janjic, ncep, jan. 1996                       *
!     *                                                              *
!     *  transformation from lat-lon to rotated lat-lon coordinates  *
!     ****************************************************************
!     ****************************************************************
!     *  tlm   - transformed longitude, rad.                         *
!     *  tph   - transformed latitude, rad.                          *
!     *  tlm0d - the angle of rotation of the transformed lat-lon    *
!     *          system in the longitudinal direction, degs          *
!     *  ctph0 - cos(tph0), tph0 is the angle of rotation of the     *
!     *          transformed lat-lon systemn in the latitudinal      *
!     *          direction, precomputed                              *
!     *  stph0 - sin(tph0), tph0 is the angle of rotation of the     *
!     *          transformed lat-lon systemn in the latitudinal      *
!     *          direction, precomputed                              *
!     *  almd  - geographical longitude, degs, range -180.,180       *
!     *  aphd  - geographical latitude,  degs, range - 90., 90.,     *
!     *          poles are singular                                  *
!     ****************************************************************
!
      relm=(almd-tlm0d)*dtr
      srlm=sin(relm)
      crlm=cos(relm)
      aph=aphd*dtr
      sph=sin(aph)
      cph=cos(aph)
      cc=cph*crlm
      anum=cph*srlm
      denom=ctph0*cc+stph0*sph
!
      tlm=atan2(anum,denom)
      tph=asin(ctph0*sph-stph0*cc)
!
      return
      endsubroutine tll
!-----------------------------------------------------------------------
      subroutine fill_missing(m, imi, jmi, sm, vals, misvals)
! 
      implicit none
!#######################################
! 
      integer, intent(in)      :: imi, jmi, m
      real, dimension(imi,jmi), intent(in)    :: sm
      real, dimension(imi,jmi), intent(inout) :: vals
      real, dimension(imi,jmi), intent(out)   :: misvals
! local variables
      integer                  :: i, j, i0, j0
      integer                  :: nreps, n, nsea, ncheck, nmisvals
! 
!#######################################

      where (vals.eq.-999.)
          misvals = 1
      elsewhere
          misvals = 0
      endwhere
! Fill missing values 
      nreps = 0
      do while (sum(misvals).gt.0)
         nreps = nreps + 1
         nmisvals =  sum(misvals)
!          print*, nreps, nmisvals
! 
         do j=1,jmi
         do i=1,imi
           if (sm(i,j).le.0.5 .and. vals(i,j).eq.-999.) then   ! land  
              n=0
              nsea=0
              ncheck=0
! 
! Interpolated using neighboring grid cells (8 including corners) 
              do j0=0,2    
              do i0=0,2    ! subtract 1 such that ranges are [i-1:i+1] and [j-1:j+1]
                 if (i0.ne.1 .or. j0.ne.1) then   ! don't do (i,j)
                 if(vals(i+i0-1,j+j0-1).ge.0..and.sm(i+i0-1,j+j0-1).le.0.5) then   ! valid value and land
                    if (n.eq.0) then
                       vals(i,j)=vals(i+i0-1,j+j0-1)
                    else 
                       vals(i,j)=vals(i,j) + vals(i+i0-1,j+j0-1)
                    endif 
                    n=n+1
                 elseif (vals(i+i0-1,j+j0-1).ge.0..and.sm(i+i0-1,j+j0-1).gt.0.5) then ! count number of water cells around
                    nsea=nsea+1
                 else 
                    ncheck=ncheck+1
                 endif
                 endif 
              enddo
              enddo
              if (n.gt.0) then  ! value can be filled
! print*, 'n ', n, 'nsea ', nsea, 'ncheck ', n + ncheck + nsea
                 vals(i,j) = vals(i,j)/n
              else  ! value still missing, needs another iteration
                 vals(i,j) = -999. 
              endif
           endif  ! land
         enddo
         enddo
! Update misvals 
         where (vals.eq.-999.)
            misvals = 1
         elsewhere
            misvals = 0
         endwhere
! 
         if (sum(misvals).eq.nmisvals) then   ! number of missing values stagnating - no more grid cells can be filled; exit and replace missing with default climatology
! !             print*, 'point ', i, j
! !             print*, vals(i-1:i+1,j+1)
! !             print*, vals(i-1:i+1,j)
! !             print*, vals(i-1:i+1,j-1)
! !             print*, sm(i-1:i+1,j+1)
! !             print*, sm(i-1:i+1,j)
! !             print*, sm(i-1:i+1,j-1)
            exit
         endif 
      enddo ! missing
      if (sum(misvals).eq.nmisvals) then 
         print*, 'vegfra', m
         print*, 'Some missing values left; No more grid cells can be filled after #iterations: ', nreps
      else
         print*, 'vegfra', m 
         print*, 'All missing values filled; Iterations needed to fill missing values: ', nreps
      endif 

      end subroutine
