module timer

  use mpi
  use com_cpl
  use ESMF
  use ccc_io

  implicit none

  private

  public :: wall_time
  public :: wall_time_stats

  !--- A derived type to hold info about a single timer
  type timer_t
    !--- The name associated with this timer
    character(64)   :: name=" "
    !--- Elapsed time is current time - start_time
    type(ESMF_Time) :: start_time
    !--- Keep track of the start time
    real(kind=8)    :: start=0.0_8
    !--- Keep track of elapsed time between calls
    real(kind=8)    :: elapsed=0.0_8
    !--- Accumulate net time (the sum of all elapsed times)
    real(kind=8)    :: net=0.0_8
    !--- Calcuate average time
    real(kind=8)    :: avg=0.0_8
    !--- Count the number of times this timer calculates elasped time
    integer         :: count=0
  end type timer_t

  !--- A list of timers
  type(timer_t), pointer, dimension(:), save :: timers => null()

  !--- The maximum number of timers allowed
  integer, parameter :: max_timers=100

  !--- The number of timers currently in use
  integer, save :: n_timer=0

  contains

    !--- Get or set the elapsed wall time
    subroutine wall_time(name, elapsed, reset, verbose)
      !--- The name associated with this timer
      character(*), intent(in) :: name

      !--- The elapsed time in seconds
      real(kind=8), intent(out), optional :: elapsed

      !--- Reset this timer
      logical, intent(in), optional :: reset

      !--- Control the amount of diagnostic output
      integer, intent(in), optional :: verbose

      !--- Local
      integer :: wordy, idx, tindex
      integer         :: wall_values(8)
      integer(kind=4) :: wall_values4(8)
      character(32)   :: wall_string
      type(ESMF_TimeInterval) :: time_interval
      type(ESMF_Time) :: wall_curr_time
      real(kind=8)    :: wall_elapsed, wt1
      logical :: reset_called

      !--- Allocate the timer array if this is the first call
      if ( .not. associated(timers) ) allocate( timers(max_timers) )

      if ( present(verbose) ) then
        wordy = verbose
      else
        wordy = 1
      endif

      !--- Identify the index in the timers array for the current name
      !--- If this name is already associated with a timer then use that index
      !--- If not then assign this name to the next timer
      reset_called = .false.
      if ( n_timer == 0 ) then
        !--- No timers have been defined
        n_timer = 1
        timers(n_timer)%name = trim(name)
        tindex = n_timer
        !--- Initialize the new timer
        if ( wordy > 0 ) then
          write(6,*)"wall_time: Initialize ",trim(timers(tindex)%name)," with index ",tindex
          call flush(6)
        endif
        call reset_timer(tindex, wordy)
        reset_called = .true.
        !--- The first time a timer is requested, initialize it and then return
        return
      else
        tindex = 0
        do idx=1,n_timer
          if ( trim(adjustl(name)) .eq. trim(adjustl(timers(idx)%name)) ) then
            !--- This timer already exists
            tindex = idx
            exit
          endif
        enddo
        if ( tindex == 0 ) then
          !--- There is no timer associated with this name
          n_timer = n_timer + 1
          if ( n_timer > max_timers ) then
            write(6,*)"wall_time: Exceeded maximum number of timers."
            write(6,*)"wall_time: Timer ",trim(name)," will not be used."
            return
          endif
          timers(n_timer)%name = trim(name)
          tindex = n_timer
          !--- Initialize the new timer
          if ( wordy > 0 ) then
            write(6,*)"wall_time: Initialize ",trim(timers(tindex)%name)," with index ",tindex
            call flush(6)
          endif
          call reset_timer(tindex, wordy)
          reset_called = .true.
          !--- The first time a timer is requested, initialize it and then return
          return
        endif
      endif

      if ( present(reset) ) then
        if ( reset ) then
          !--- If this is the first time this timer is seen then reset_timer
          !--- will have been called above, so do not repeat the call here
          if ( .not. reset_called ) then
            !--- Reset the start time for this timer
            call reset_timer(tindex, wordy)
          endif
        else
          !--- If reset is present but false then do nothing
          write(6,*)"wall_time: User supplied reset=.false. Nothing will be done."
          call flush(6)
        endif
        return
      endif

      !--- Set the current wall time
      call date_and_time(values=wall_values)
      wall_values4 = wall_values
      call ESMF_TimeSet(wall_curr_time, &
                        yy=wall_values4(1), mm=wall_values4(2), dd=wall_values4(3), &
                         h=wall_values4(5),  m=wall_values4(6),  s=wall_values4(7), &
                        ms=wall_values4(8), calkindflag=ESMF_CALKIND_GREGORIAN )

      !--- Determine elapsed wall time in seconds
      time_interval = wall_curr_time - timers(tindex)%start_time
      call ESMF_TimeIntervalGet(time_interval, s_r8=wall_elapsed)

      !--- Use mpi_wtime instead of ESMF_TimeIntervalGet to determine elapsed time
      wt1 = mpi_wtime()
      wall_elapsed = wt1 - timers(tindex)%start

      !--- Save the elapsed time between calls
      timers(tindex)%elapsed = wall_elapsed

      !--- Update the net elapsed time
      timers(tindex)%net = timers(tindex)%net + wall_elapsed

      !--- Increment the number of calculations of elapsed time
      timers(tindex)%count = timers(tindex)%count + 1

      !--- Calculate the average elapsed time
      timers(tindex)%avg = timers(tindex)%net/real(timers(tindex)%count,8)

      if ( present(elapsed) ) then
        !--- Send elapsed time back to the caller
        elapsed = wall_elapsed
      endif

      if ( wordy > 0 ) then
        if ( wordy > 1 ) then
          wall_string = " "
          call ESMF_TimeGet(wall_curr_time, timeStringISOFrac=wall_string)
          !--- Replace the letter T between the date and time with a blank
          wall_string(11:11) = " "
          write(6,'(4a)')      "wall_time: ",trim(timers(tindex)%name), &
                               " current time is ",trim(wall_string)
        endif
        write(6,'(2a,3(a,f14.3))')"wall_time: ",trim(timers(tindex)%name), &
                             " elapsed: ",wall_elapsed, &
                             "  net: ",timers(tindex)%net, &
                             "  average: ",timers(tindex)%avg
        call flush(6)
      endif

    end subroutine wall_time

    !--- Print current stats
    subroutine wall_time_stats(save_to_datapath, verbose)
      !--- Save the timing stats file created here to DATAPATH/RUNPATH
      logical, intent(in), optional :: save_to_datapath

      !--- Control the amount of diagnostic output
      integer, intent(in), optional :: verbose

      !--- Local
      integer :: wordy, idx
      character(len=64) :: local_name, saved_name
      logical :: save_to_dpath

      if ( present(save_to_datapath) ) then
        save_to_dpath = save_to_datapath
      else
        save_to_dpath = .false.
      endif

      if ( present(verbose) ) then
        wordy = verbose
      else
        wordy = 1
      endif

!xxx      if ( len_trim(env_model) > 0 ) then
!xxx        local_name = trim(adjustl(env_model))//"cplstats"
!xxx      else if ( len_trim(env_runid) > 0 ) then
!xxx        local_name = trim(adjustl(env_runid))//"_cplstats"
!xxx      else
!xxx        local_name = "cplstats"
!xxx      endif
      local_name = "cpl_stats"

      open(173, file=trim(local_name), form="formatted", position="append")
      if( n_timer > 0 ) then
        do idx=1,n_timer
          write(6,'(a,$)')"wall_time_stats: "
          write(6,'(i3,2x,a,2x,a64,a,i5,a,f14.3,a,f14.3)') &
              idx,trim(cpl_time_string),trim(timers(idx)%name)," count=",timers(idx)%count, &
              "  seconds net=",timers(idx)%net,"  seconds avg=",timers(idx)%avg
          write(173,'(i3,2x,a,2x,a64,a,i5,a,f14.3,a,f14.3)') &
              idx,trim(cpl_time_string),trim(timers(idx)%name)," count=",timers(idx)%count, &
              "  seconds net=",timers(idx)%net,"  seconds avg=",timers(idx)%avg
        enddo
      endif
      close(173)
      write(6,*)"wall_time_stats: Wrote stats to file ",trim(local_name)
      call flush(6)

      if ( save_to_dpath ) then
        !--- Also save this file to DATAPATH/RUNPATH
        !--- Wait for 2 seconds before proceeding to let the file system catch up
        call system('sleep 2')
        if ( len_trim(env_model) > 0 ) then
          saved_name = trim(adjustl(env_model))//"cplstats"
        else if ( len_trim(env_runid) > 0 ) then
          saved_name = trim(adjustl(env_runid))//"_cplstats"
        else
          saved_name = "wall_time_cplstats"
        endif
        call cc_save(local_name,saved_name,.false.,.true.,.true.,0)
        write(6,*)"wall_time_stats: Saved stats file as ",trim(saved_name)
        call flush(6)
      endif

    end subroutine wall_time_stats

    subroutine reset_timer(tindex, verbose)
      integer, intent(in) :: tindex
      integer, intent(in) :: verbose

      !--- Local
      integer         :: wall_values(8)
      integer(kind=4) :: wall_values4(8)
      character(32)   :: wall_string
      integer         :: idx

      !--- Reset the start time to the current wall clock time
      call date_and_time(values=wall_values)
      wall_values4 = wall_values
      call ESMF_TimeSet(timers(tindex)%start_time, &
                        yy=wall_values4(1), mm=wall_values4(2), dd=wall_values4(3), &
                         h=wall_values4(5),  m=wall_values4(6),  s=wall_values4(7), &
                        ms=wall_values4(8), calkindflag=ESMF_CALKIND_GREGORIAN )
      timers(tindex)%start = mpi_wtime()

      if ( verbose > 1 ) then
        wall_string = " "
        call ESMF_TimeGet(timers(tindex)%start_time, timeStringISOFrac=wall_string)
        !--- Replace the letter T between the date and time with a blank
        wall_string(11:11) = " "
        write(6,'(4a)')"wall_time: Reset ",trim(timers(tindex)%name)," reference time to ",trim(wall_string)
        call flush(6)
      endif

    end subroutine reset_timer

end module timer
