! See copyright notice in the COPYRIGHT file.
! ****************************************************************************** !
!> This module provides the definition of various abort criteria upon which
!! a simulation should be stopped.
module tem_abortCriteria_module
  use env_module, only: labelLen, newunit
  use tem_convergence_module, only: tem_convergence_type, tem_convergence_load

  use aotus_module, only: flu_State, aot_get_val
  use aot_table_module, only: aot_table_open, &
    &                         aot_table_close

  use aot_out_general_module, only: aot_out_type,        &
    &                               aot_out_close_table, &
    &                               aot_out_open_table

  use aot_out_module, only: aot_out_val

  implicit none

  private

  public :: tem_abortCriteria_type
  public :: tem_abortCriteria_new
  public :: tem_abortCriteria_load
  public :: tem_abortCriteria_out
  public :: tem_abortCriteria_dump
  public :: tem_stop_file_exists

  !> Definition of the various abort criteria.
  !!
  !! Currently we only have two in addition to the time controlled and
  !! erroneous aborts.
  type tem_abortCriteria_type
    !> A file which should cause the simulation to stop.
    !! Default: ''.
    !!
    !! If this is a non empty string, the solver will stop at the next
    !! opportunity if it detects a file with the name provided here in the
    !! current working directory. Thus the simulation could be stopped by
    !! doing a "touch stop" in the working directory of the application.
    !! Such an empty file will be deleted, after it is detected.
    !! If you want the stop file to stay on the file system, there has to
    !! be something in it, which can be achieved by "echo keep > stop"
    !! for example.
    character(len=labelLen) :: stop_file

    !> Should the simulation be checked for a steady state convergence and
    !! stop if it is detected? Default: .false.
    logical :: steady_state

    !> Convergence conditions for steady state check.
    !! Filled only when steady_state is True
    type(tem_convergence_type), allocatable :: convergence(:)
  end type tem_abortCriteria_type


contains


  ! **************************************************************************** !
  !> Define new abortCriteria.
  !!
  !! A new abortCriteria object will be filled according to the parameters
  !! passed into the function.
  function tem_abortCriteria_new(stop_file, steady_state) result(ac)
    ! --------------------------------------------------------------------------!
    !> Name of the stop file to react on. Default=''.
    !!
    !! Any non-empty string activates this criterion.
    character(len=*), optional, intent(in) :: stop_file

    !> Flag to indicate if the simulation should stop upon reaching a steady
    !! state. What a steady state exactly is has to be defined in the solver.
    !! Default: .false.
    logical, optional, intent(in) :: steady_state

    !> A new variable of abortCriteria filled with the values provided as
    !! arguments.
    type(tem_abortCriteria_type) :: ac
    ! --------------------------------------------------------------------------!

    if (present(stop_file)) then
      ac%stop_file = trim(stop_file)
    else
      ac%stop_file = ''
    end if

    if (present(steady_state)) then
      ac%steady_state = steady_state
    else
      ac%steady_state = .false.
    end if

    allocate(ac%convergence(0))

  end function tem_abortCriteria_new
  ! **************************************************************************** !


  ! **************************************************************************** !
  !> Load the abortCriteria from a given configuration.
  !!
  !! The abort_critera are defined in a table as follows:
  !!```
  !! abort_criteria = {stop_file='', steady_state=false}
  !!```
  !!
  !! stop_file indicates, which file should be checked for
  !! to stop the execution. A typical setting would for example
  !! be stop_file = 'stop'. If the string is empty, no checks
  !! are performed. The default is an empty string.
  !! Empty stop files will be deleted after they are encountered.
  !! Non-empty ones are kept.
  !!
  !! steady_state indicates if the simulation should stop when
  !! a steady_state solution is found. Default ist false.
  !!
  !! If steady_state is True then load convergence table for condition to
  !! check for steady state
  subroutine tem_abortCriteria_load(me, conf, parent, key)
    ! --------------------------------------------------------------------------!
    !> Abort criteria to load from the Lua table.
    type(tem_abortCriteria_type), intent(out) :: me

    !> Handle for the Lua script.
    type(flu_state) :: conf

    !> Parent table to read from.
    integer, intent(in), optional :: parent

    !> Name of the time control table. Default: 'time_control'
    character(len=*), intent(in), optional :: key
    ! --------------------------------------------------------------------------!
    character(len=labelLen) :: loc_key
    integer :: thandle
    integer :: iErr
    ! --------------------------------------------------------------------------!

    loc_key = 'abort_criteria'
    if (present(key)) loc_key = key

    call aot_table_open( L       = conf,    &
      &                  parent  = parent,  &
      &                  thandle = thandle, &
      &                  key     = loc_key  )

    if (thandle /= 0) then

      call aot_get_val( L       = conf,         &
        &               thandle = thandle,      &
        &               val     = me%stop_file, &
        &               key     = 'stop_file',  &
        &               default = '',           &
        &               ErrCode = iErr          )

      call aot_get_val( L       = conf,            &
        &               thandle = thandle,         &
        &               val     = me%steady_state, &
        &               key     = 'steady_state',  &
        &               default = .false.,         &
        &               ErrCode = iErr             )

      if (me%steady_state) then
        call tem_convergence_load( me           = me%convergence, &
          &                        conf         = conf,           &
          &                        parent       = thandle,        &
          &                        steady_state = me%steady_state )
      end if
    else

      me%stop_file = ''
      me%steady_state = .false.

    end if

    ! If no steady state is defined
    if (.not. me%steady_state) allocate(me%convergence(0))

    call aot_table_close( L       = conf,   &
      &                   thandle = thandle )

  end subroutine tem_abortCriteria_load
  ! **************************************************************************** !


  ! **************************************************************************** !
  !> Saves the abortCriteria to a given configuration.
  !!
  !! For further information, see TEM_abortCriteria_load()
  subroutine tem_abortCriteria_out(me, conf, key)
    ! --------------------------------------------------------------------------!
    !> The abortCriteria to write out as a Lua table.
    type(tem_abortCriteria_type), intent(in) :: me

    !> Handle for the Lua script to write to.
    type(aot_out_type), intent(inout) :: conf

    !> A name for the table to write the abortCriteria to.
    !! Default: 'abort_criteria'.
    character(len=*), optional :: key
    ! --------------------------------------------------------------------------!
    character(len=labelLen) :: loc_key
    ! --------------------------------------------------------------------------!

    loc_key = 'abort_criteria'
    if (present(key)) loc_key = key

    call aot_out_open_table( put_conf = conf,   &
      &                      tname    = loc_key )

    call aot_out_val( put_conf = conf,   &
      &              val = me%stop_file, &
      &              vname = 'stop_file' )

    call aot_out_val( put_conf = conf,       &
      &               val = me%steady_state, &
      &               vname = 'steady_state' )

!KM!    if (me%steady_state) call tem_convergence_out(me%convergence, conf)

    call aot_out_close_table(put_conf = conf)

  end subroutine tem_abortCriteria_out
  ! **************************************************************************** !


  ! **************************************************************************** !
  !> Dump abort criteria information to the specified outUnit.
  subroutine tem_abortCriteria_dump(me, outUnit)
    ! --------------------------------------------------------------------------!
    !> Abort criteria settings to write on outUnit.
    type(tem_abortCriteria_type), intent(in) :: me

    !> File unit to write the settings to.
    integer, intent(in) :: outUnit
    ! --------------------------------------------------------------------------!

    write(outUnit,*) ' stop_file: '//trim(me%stop_file)
    write(outUnit,*) ' steady_state: ', me%steady_state
!KM!    call tem_convergence_dump(me%convegence, outUnit)

  end subroutine tem_abortCriteria_dump
  ! **************************************************************************** !


  ! **************************************************************************** !
  !> Check if the stop file exists.
  !!
  !! The check is only done by the root process and only if the stop_file
  !! setting is not empty.
  !! If the stop file exists, but is empty it is deleted after probing its
  !! existence. Non-empty files are kept.
  !! Thus, you can create a stop file that is to be deleted upon
  !! encountering with: touch stop
  !! While one, that should be kept can be created by:
  !! echo keep > stop
  function tem_stop_file_exists(abortCriteria, rank) result(sf_exists)
    ! --------------------------------------------------------------------------!
    !> Abort criteria settings to use in this check for a stop file.
    type(tem_abortCriteria_type), intent(in) :: abortCriteria

    !> Rank of the probing process, only rank==0 actually checks for the file.
    integer, intent(in) :: rank

    !> Result that indicates, if the stop files exists.
    logical :: sf_exists
    ! --------------------------------------------------------------------------!
    integer :: fu
    integer :: ios
    character(len=labelLen) :: probe
    ! --------------------------------------------------------------------------!

    sf_exists = .false.

    if (trim(abortCriteria%stop_file) /= '') then
      if (rank == 0) then
        inquire( file  = trim(abortCriteria%stop_file), &
          &      exist = sf_exists                      )

        if (sf_exists) then
          fu = newunit()
          open( unit   = fu,                            &
            &   file   = trim(abortCriteria%stop_File), &
            &   status = 'old'                          )

          read(fu,'(a)', iostat=ios) probe
          if (ios < 0) then
            close( unit   = fu,      &
              &    status = 'DELETE' )
          else
            close(fu)
          end if

        end if
      end if
    end if

  end function tem_stop_file_exists
  ! **************************************************************************** !

end module tem_abortCriteria_module
