module amip_forcing_mod

    use config_mod
    use NetCDF

    implicit none

    private

    public setup_amip_forcing
    public update_sst_and_sic
    public finalise_amip_forcing

    real(RNP),pointer     :: AMIP_sst(:,:)
    real(RNP),pointer     :: AMIP_sic(:,:)

    real(kind=8) :: deltaT

    integer :: ifile,ncid_sst,varid_sst,ncid_sic,varid_sic
    integer :: t_index,old_t_index
    integer :: yr_sim

    ! keep precision of variables in the netcdf files here
    real(kind=8) :: sst(GridNX,GridNY,2)
    real(kind=8) :: sic(GridNX,GridNY,2)
    real(kind=8), allocatable :: t_sst(:)

    ! First and last data sets available in a FixYear
    real(kind=8) :: sst_first(GridNX,GridNY)=0., sst_last(GridNX,GridNY)=0.
    real(kind=8) :: sic_first(GridNX,GridNY)=0., sic_last(GridNX,GridNY)=0.

    ! timesteps [days since refdate]
    real(kind=8) :: t,t1,t2     ! running step, step before and after with data
    real(kind=8) :: tnewyear    ! step when next simulated year starts
    real(kind=8) :: t0101,t1231 ! step at Jan 1st and Dec 31
    real(kind=8) :: tlastfeb    ! step at last day of February

    character (len=fname_length) :: fname_sst,fname_sic

    logical :: lfirst,file_found,lstored=.false.
    logical :: lleapfx1=.false., lleapfx2=.false.    ! flags for discordant leap years

contains

    !
    ! Init method
    !
    subroutine setup_amip_forcing(yy,mm,dd)

        use CPLNG

        integer, intent(in) :: yy,mm,dd
        
        integer      :: yyref
        logical      :: leap
        
        AMIP_sst  => CPLNG_FLD(CPLNG_IDX('AMIP_sst'))%D
        AMIP_sic  => CPLNG_FLD(CPLNG_IDX('AMIP_sic'))%D
        
        ! time axis unit = days
        deltaT = TimeStepSec/86400.

        ! simulated year
        yr_sim = yy

        ! amip_reader year
        if ( FixYear > 0 ) then
           yyref = FixYear
        else
           yyref = yy
        endif
        
        call days_since_refdate(yyref, mm, dd, t    )
        call days_since_refdate(yyref,  1,  1, t0101)
        call days_since_refdate(yyref, 12, 31, t1231)

        ! find out when we switch year in amip_year according to simulated year
        tnewyear = t0101 + 365.
        if (is_leap(yy)) tnewyear = t0101 + 366.
        
        if (LDebug) then
           write(LOGLUN,'(A,3I5)') 'AMIP INIT - simulated/amip/fixed years:', yy, yyref, FixYear
           write(LOGLUN,'("AMIP INIT - tstart  :", F8.1)') t
           write(LOGLUN,'("AMIP INIT - t0101   :", F8.1)') t0101
           write(LOGLUN,'("AMIP INIT - t1231   :", F8.1)') t1231
           write(LOGLUN,'("AMIP INIT - tnewyear:", F8.1)') tnewyear
        endif
        
        ! initialise with dummy values
        t1=-9999.
        t2=-9999.

        ! point to first file
        ifile=1
        lfirst=.true.

        ! setup BC for FixYear
        if (FixYear>0) then
           if (.not.lstored) then
               call setup_fixyear_bc
               lstored = .true.
           endif
           call discordant_leap_years(yr_sim, Fixyear)
        endif
        
    end subroutine setup_amip_forcing

    !
    ! Done method
    !
    subroutine finalise_amip_forcing

        call close_file(ifile)

    end subroutine finalise_amip_forcing
    
    !
    ! Leap year test
    !
    logical function is_leap(year)
      integer, intent(in) :: year
      is_leap = (mod(year,4)==0 .and. (mod(year,100)/=0 .or. mod(year,400)==0))
    end function is_leap
    
    !
    ! Returns nb of days since reference date of AMIP dataset
    !
    subroutine days_since_refdate(yy,mm,dd,nd)

        integer, intent(in)       :: yy,mm,dd
        real(kind=8), intent(out) :: nd
        integer                   :: yy0,dpm(12)
        logical                   :: leapyear

        leapyear = is_leap(yy)

        ! sets correct number of days for Jan 1 of year yy
        ! refdate is Jan 1, 1870 (in AMIP forcing dataset for CMIP6)
        yy0 = DATA_YREF_MIN
        nd=(yy-yy0)*365+int((yy-(yy0/4)*4)/4)- &
            & int((yy-(yy0/100)*100)/100)+int((yy-(yy0/400)*400)/400)

        if (leapyear) nd=nd-1

        dpm=(/31,28,31,30,31,30,31,31,30,31,30,31/)
        if (leapyear) dpm(2)=29

        if (mm>1) then
           nd=nd+sum(dpm(1:(mm-1)))+dd-1
        else
           nd=nd+dd-1
        endif

    end subroutine days_since_refdate

    ! Check for discordant leap years.
    ! In fix year condition the Gregorian calendar of EC-Earth may conflict
    ! with the calendar of the selected fixyear.
    ! This function activates the lleapfx flags to avoid time mismatch of SST/SIC
    ! See issue #820.
    subroutine discordant_leap_years(simyr, fixyr)

      integer, intent(in)       :: simyr, fixyr

      ! Define the last day of February
      ! Redundant here but clearer inside the subroutine
      if (is_leap(fixyr)) then
          call days_since_refdate(fixyr, 02, 29, tlastfeb)
      else
          call days_since_refdate(fixyr, 02, 28, tlastfeb)
      end if

      ! if the FixYear is a leap year and the model year is not
      if ((.not. is_leap(simyr)) .and. (is_leap(fixyr))) then
          lleapfx1 = .true.
          tnewyear = tnewyear + 1
      end if
      ! if the FixYear is not a leap year and the model year is a leap year
      if ((is_leap(simyr)) .and. (.not. is_leap(fixyr))) then
          lleapfx2 = .true.
          tnewyear = tnewyear - 1
      end if
      if (LDebug) then
          write(LOGLUN,*) "  Discordant leap years,", simyr, fixyr
          write(LOGLUN,*) "  lleapfx1, lleapfx2", lleapfx1, lleapfx2
          write(LOGLUN,'("UPDATED AMIP INIT - tnewyear:", F8.1)') tnewyear
          write(LOGLUN,'("AMIP INIT - tlastfeb:", F8.1)') tlastfeb
      end if

    end subroutine discordant_leap_years
    
    !
    ! Scan the datasets in the file(s) and store the first and last
    ! available data for current AMIP year. Used for FixYear case.
    !
    subroutine setup_fixyear_bc

      real(kind=8) :: tinit
      integer :: FixYearInit, i, istart, iend
      
      tinit = t
      FixYearInit = FixYear
      FixYear = -999

      istart = nint(t0101)
      iend = nint(t1231)

      ! Scan must start on January 1st
      t = t0101
      
      do i = istart, iend
         
         call update_sst_and_sic

         if (t==t0101) then
            if (LDebug) &
                 write(LOGLUN,'("  stored first BC using data from t2=",F8.1)') t2
            sst_first = sst(:,:,2)
            sic_first = sic(:,:,2)
         endif
         if (t==t1231) then
            if (LDebug) &
                 write(LOGLUN,'("  stored last BC using data from t1=",F8.1)') t1
            sst_last = sst(:,:,1)
            sic_last = sic(:,:,1)
         endif
      enddo
      
      ! finish and reset
      call close_file(ifile)
      FixYear = FixYearInit
      t = tinit
      t1=-9999.
      t2=-9999.

      ifile=1
      lfirst=.true.

      if (LDebug) write(LOGLUN,*) "  Done storing BC"

    end subroutine setup_fixyear_bc
    
    !
    ! Scan the data until next time step is covered.
    ! 
    recursive subroutine update_sst_and_sic

        integer :: nn

        if (lfirst) then
            call open_file(ifile)
            if ( t < t_sst(1) ) then
                t_index=1
            else
                do t_index=1,size(t_sst)-1
                    if (t_sst(t_index)<=t .and. t<t_sst(t_index+1)) exit
                enddo
            endif
            if (LDebug) then
               write(LOGLUN,'(A,F8.1)') 'updating t=',t
            endif
            t2=t_sst(t_index)
            t1=t2
            old_t_index=t_index
            call read_file
            lfirst=.false.
        else
            t=t+deltaT
            if (LDebug) then
               write(LOGLUN,'(A,F8.1)') 'updating t=',t
            endif

            ! fix for discordant leap years
            if (t == tlastfeb .and. lleapfx1) then
               write(LOGLUN,*) 'Skipping 29th of February'
               t=t+deltaT 
               lleapfx1=.false.
            else if (t == tlastfeb .and. lleapfx2) then
               write(LOGLUN,*) 'Repeating 28th of February'
               t=t-deltaT
               lleapfx2=.false.
            end if

            ! if FixYear and a new year, reset everything
            if (( FixYear>0 ) .and. ( abs( t - tnewyear ) < spacing(tnewyear) )) then
               if (LDebug) then
                  write(LOGLUN,*) 'NEWYEAR: t, tnewyear', t, tnewyear
               endif
               yr_sim = yr_sim + 1
               call close_file(ifile)
               call setup_amip_forcing(yr_sim,1,1)
               call update_sst_and_sic
               return
            endif
        endif

        do while ( t > t2 .and. file_found )
            call read_next_timestep_from_file
        enddo

        if (LInterpolate) then
            ! linear time interpolation
            if ( t1 < t2 ) then
                if (LDebug) then
                    write(LOGLUN,'(A,3F8.1)') 'time interpolation t1,t,t2',t1,t,t2
                endif
                ! Clipping required for CMIP6 BCs
                AMIP_sst=max(((t-t1)*sst(:,:,2)+(t2-t)*sst(:,:,1))/(t2-t1),271.38d0)
                AMIP_sic=max(0.d0,min(1.d0,((t-t1)*sic(:,:,2)+(t2-t)*sic(:,:,1))/(t2-t1)))
            else
                if (LDebug) then
                    write(LOGLUN,'(A,3F8.1)') 'no time interpolation t,t2',t,t2
                endif
                AMIP_sst=sst(:,:,2)
                AMIP_sic=max(0.d0,min(1.d0,sic(:,:,2)))
            endif
        else
            ! nearest neighbour
            if ( t1 < t2 ) then
                if ( (floor(t)-floor(t1)) < (floor(t2)-floor(t)) ) then
                    nn=1
                else
                    nn=2
                endif
            else
                nn=2
            endif
            if (LDebug) then
                write(LOGLUN,'(A,I4,3F8.1)') 'nearest neigbour nn,t1,t,t2',nn,t1,t,t2
            endif
            AMIP_sst=sst(:,:,nn)
            AMIP_sic=max(0.d0,min(1.d0,sic(:,:,nn)))
        endif

    end subroutine update_sst_and_sic

    !
    ! Read next time step. Open next file if needed.
    !
    subroutine read_next_timestep_from_file

        t1=t2
        sst(:,:,1)=sst(:,:,2)
        sic(:,:,1)=sic(:,:,2)
        
        if ( t > maxval(t_sst) ) then
            call close_file(ifile)
            ifile=ifile+1
            call open_file(ifile)

            if ( .not.file_found ) then
                ifile=ifile-1
                return
            endif

            old_t_index=0
        endif
        
        t_index=old_t_index+1
        
        t2=t_sst(t_index)
        call read_file

        old_t_index=t_index

    end subroutine read_next_timestep_from_file

    !
    ! Open files, read time steps
    !
    subroutine open_file(i)

        integer, intent(in) :: i

        integer :: dimid_time,time_len,varid_time

        fname_sst=FileListSST(i)

        inquire(file=fname_sst,exist=file_found)
        if ( .not.file_found ) return

        write(LOGLUN,*) 'open SST file ',trim(fname_sst)
        call nf90_chkerr(nf90_open(fname_sst,NF90_NOWRITE,ncid_sst))

        fname_sic=FileListSIC(i)
        write(LOGLUN,*) 'open SIC file ',trim(fname_sic)
        call nf90_chkerr(nf90_open(fname_sic,NF90_NOWRITE,ncid_sic))

        ! length of time dimension
        call nf90_chkerr(nf90_inq_dimid(ncid_sst,'time',dimid_time))
        call nf90_chkerr(nf90_inquire_dimension(ncid_sst,dimid_time,len=time_len))
        if (allocated(t_sst)) deallocate(t_sst)
        allocate(t_sst(time_len))

        ! get time variable
        ! assume time variables are identical in sst and sic file
        ! therefore use only t_sst
        call nf90_chkerr(nf90_inq_varid(ncid_sst,'time',varid_time))
        call nf90_chkerr(nf90_get_var(ncid_sst,varid_time,t_sst))

        ! get varid
        call nf90_chkerr(nf90_inq_varid(ncid_sst,'tosbcs',varid_sst))
        call nf90_chkerr(nf90_inq_varid(ncid_sic,'siconcbcs',varid_sic))

    end subroutine open_file

    !
    ! Read data for t_index step
    !
    subroutine read_file
      
      if ((FixYear>0) .and. ( t_sst(t_index) >= tnewyear )) then
         if (LDebug) then
            write(LOGLUN,'("...use first BC data for timestep ",F8.1)') t_sst(t_index)
         endif
         ! Assign BC only if values have been assigned previously
         if (sum(sst_first) > 1e-20) then
            sst(:,:,2) = sst_first
            sic(:,:,2) = sic_first
         else 
            call error('First BC are empty, what are you doing? Aborting!')
         end if
      else if ((FixYear>0) .and. ( t_sst(t_index) < t0101 )) then
         if (LDebug) then
            write(LOGLUN,'("...use last BC data for timestep :",F8.1)') t_sst(t_index)
         endif
         ! Assign BC only if values have been assigned previously
         if (sum(sst_last) > 1e-20) then
            sst(:,:,2) = sst_last
            sic(:,:,2) = sic_last
         else
            call error('Last BC are empty, what are you doing? Aborting!')
         end if

      else
         write(LOGLUN,*) '...read timestep',t_index,t_sst(t_index)
         call nf90_chkerr(nf90_get_var(ncid_sst,varid_sst,sst(:,:,2), &
              & start=(/1,1,t_index/),count=(/GridNX,GridNY,1/)))
         call nf90_chkerr(nf90_get_var(ncid_sic,varid_sic,sic(:,:,2), &
              & start=(/1,1,t_index/),count=(/GridNX,GridNY,1/)))

         ! units change with AMIP forcing dataset v1.1.2
         sst(:,:,2)=sst(:,:,2)+273.15d0
         sic(:,:,2)=sic(:,:,2)*0.01d0
      endif

    end subroutine read_file

    !
    ! Close files
    !
    subroutine close_file(i)

        integer, intent(in) :: i

        if ( file_found ) then
            write(LOGLUN,*) 'close SST file ',trim(fname_sst)
            call nf90_chkerr(nf90_close(ncid_sst))

            write(LOGLUN,*) 'close SIC file ',trim(fname_sic)
            call nf90_chkerr(nf90_close(ncid_sic))
        endif

    end subroutine close_file


    subroutine nf90_chkerr(iret)
        integer,intent(in) :: iret
        if (iret /= NF90_NOERR) call ERROR(nf90_strerror(iret))
    end subroutine nf90_chkerr


end module amip_forcing_mod
