! See copyright notice in the COPYRIGHT file.
! ****************************************************************************** !
!> author: Kartik Jain
!! This module contains type definition and simple routine to load conditions
!! Condition type has a threshold and an operator against which a quantity
!! can be compared. This can be used for flow properties based geometry
!! changes as well as for assessing the convergence
!!
module tem_condition_module

  ! include treelm modules
  use env_module,              only: rk, labelLen
  use tem_aux_module,          only: tem_abort
  use tem_logging_module,      only: logUnit
  use tem_float_module,        only: operator(.feq.)

  ! include aotus modules
  use aotus_module,     only: flu_State, aot_get_val, aoterr_Fatal,            &
    &                         aoterr_WrongType, aoterr_NonExistent
  use aot_table_module, only: aot_table_open, aot_table_close,                 &
    &                         aot_table_length, aot_get_val
  use aot_out_module,   only: aot_out_type, aot_out_open,  aot_out_close,      &
    &                         aot_out_val, aot_out_open_table,                 &
    &                         aot_out_close_table


  implicit none
  private

  public :: tem_condition_type
  public :: tem_load_condition
  public :: tem_condition_out
  public :: tem_condition_dump
  public :: tem_comparator


  !> Datatype containing different conditions to be checked
  !! Currently only threshold and operator are defined
  type tem_condition_type
    !> Contains the threshold value defined in lua file
    real(kind=rk) :: threshold
    !> Contains the operator defined in lua file
    character(len=2) :: operation
  end type tem_condition_type

  interface tem_condition_dump
    module procedure tem_condition_dump_vector
    module procedure tem_condition_dump_single
  end interface tem_condition_dump

  interface tem_condition_out
    module procedure tem_condition_out_vector
    module procedure tem_condition_out_single
  end interface tem_condition_out

contains


! ****************************************************************************** !
  !> Load the condition table in case of convergence
  !!
  !! Example:
  !! condition = {threshold = 2.0e-10, operator = '<='}
  !!
  !! \author: Kartik Jain
  !!
  subroutine tem_load_condition( me, conf, parent )
    ! ---------------------------------------------------------------------------
    !>
    type(tem_condition_type), allocatable, intent(inout) :: me(:)
    !>
    type(flu_state), intent(in)             :: conf
    !>
    integer, intent(in)                     :: parent
    ! ---------------------------------------------------------------------------
    integer :: cond_handle          ! handle for the condition table
    integer :: sub_cond_handle      ! handle for subtables inside condition
    integer :: nCond                ! number of conditions
    integer :: iCond                ! index for condition loop
    ! ---------------------------------------------------------------------------
    !! Open the condition table
    call aot_table_open( L       = conf,                                       &
      &                  parent  = parent,                                     &
      &                  thandle = cond_handle,                                &
      &                  key     = 'condition' )
    !! The tables inside condition table should be equal to the nVars
    !! If thats not the case we return an error message
    nCond = aot_table_length( L=conf, thandle=cond_handle )
    !! check single or multiple table
    call aot_table_open( L       = conf,                                       &
      &                  parent  = cond_handle,                                &
      &                  thandle = sub_cond_handle,                            &
      &                  pos     = 1 )

    if (sub_cond_handle == 0) then
      call aot_table_close( L = conf, thandle = sub_cond_handle )
      ! just one table within
      allocate ( me(1) )
      call tem_load_cond_single( me(1), conf, cond_handle )
    else
      ! IF there are more tables within condition
      call aot_table_close( L = conf, thandle = sub_cond_handle )
      allocate ( me(nCond) )
      do iCond = 1, nCond
        call aot_table_open( L       = conf,                                   &
          &                  parent  = cond_handle,                            &
          &                  thandle = sub_cond_handle,                        &
          &                  pos     = iCond )
        call tem_load_cond_single( me(iCond), conf, sub_cond_handle )
        call aot_table_close( L = conf, thandle = sub_cond_handle )
      end do
    end if ! sub condition check
    call aot_table_close(L=conf, thandle=cond_handle )

  end subroutine tem_load_condition
! ****************************************************************************** !


! ****************************************************************************** !
  !> Load the conditions for geomIncr and convergence check within convergence
  !! conditions mean the operator and threshold against which the macroscopic
  !! variable has to be compared
  !!
  subroutine tem_load_cond_single( cond, conf, thandle )
    ! ---------------------------------------------------------------------------
    !>
    type(tem_condition_type), intent(inout) :: cond
    !>
    type(flu_state), intent(in)             :: conf
    !>
    integer, intent(in)                     :: thandle
    ! ---------------------------------------------------------------------------
    integer :: iError
    ! ---------------------------------------------------------------------------
    call aot_get_val( L       = conf,                                          &
      &               thandle = thandle,                                       &
      &               val     = cond%threshold,                                &
      &               ErrCode = iError,                                        &
      &               key     = 'threshold' )
    if ( btest(iError, aoterr_Fatal) ) then
      write(logUnit(0),*) "Fata Error: In reading 'threshold' in condition"
      if ( btest(iError, aoterr_NonExistent) ) &
        & write(logUnit(0),*) 'NonExistent.'
      if( btest(iError, aoterr_WrongType) ) write(logUnit(0),*) 'WrongType.'
      call tem_abort()
    end if

    call aot_get_val( L       = conf,                                          &
      &               thandle = thandle,                                       &
      &               val     = cond%operation,                                &
      &               ErrCode = iError,                                        &
      &               key     = 'operator' )
    if ( btest(iError, aoterr_Fatal) ) then
      write(logUnit(0),*) "Fata Error: In reading 'operator' for condition"
      if ( btest(iError, aoterr_NonExistent) ) &
        & write(logUnit(0),*) 'NonExistent.'
      if( btest(iError, aoterr_WrongType) ) write(logUnit(0),*) 'WrongType.'
      call tem_abort()
    end if

  end subroutine tem_load_cond_single
! ****************************************************************************** !


! ****************************************************************************** !
  !> author: Kartik Jain
  !! Return a logical if the input relation holds where the relation is:
  !! val _operation_ threshold
  !!
  !! @todo: SZ: A check for equality and inequality might lead to bugs for reals
  !!
  function tem_comparator( val, operation, threshold ) result(comp)
    ! ---------------------------------------------------------------------------
    !>
    real(kind=rk), intent(in)      :: val
    !>
    character(len=2), intent(in)   :: operation
    !>
    real(kind=rk), intent(in)      :: threshold
    !> return value
    logical                        :: comp
    ! ---------------------------------------------------------------------------
    comp = .false.

    select case( trim(operation))
      case('<')
        if (val .lt. threshold) then
          comp = .true.
        else
          comp = .false.
        end if
      case('<=')
        if (val .le. threshold) then
          comp = .true.
        else
          comp = .false.
        end if
      case('>')
        if (val .gt. threshold) then
          comp = .true.
        else
          comp = .false.
        end if
      case('>=')
        if (val .ge. threshold) then
          comp = .true.
        else
          comp = .false.
        end if
      case('=')
        if (val .feq. threshold) then
          comp = .true.
        else
          comp = .false.
        end if
    end select

  end function tem_comparator
! ****************************************************************************** !


  ! **************************************************************************** !
  !> Dumps array of condition to given unit
  subroutine tem_condition_dump_vector(me, outUnit)
    ! ---------------------------------------------------------------------------
    !> condition to write into the lua file
    type(tem_condition_type), intent(in) :: me(:)
    !> unit to write to
    integer, intent(in) :: outUnit
    ! ---------------------------------------------------------------------------
    ! aotus type handling the output to the file in lua format
    type(aot_out_type) :: conf
    ! ---------------------------------------------------------------------------
    call aot_out_open( put_conf = conf, outUnit = outUnit )
    call tem_condition_out_vector( me, conf )
    call aot_out_close( put_conf = conf )

  end subroutine tem_condition_dump_vector
  ! **************************************************************************** !


  ! **************************************************************************** !
  !> Dump single condition to given unit
  subroutine tem_condition_dump_single(me, outUnit)
    ! ---------------------------------------------------------------------------
    !> condition to write into the lua file
    type(tem_condition_type), intent(in) :: me
    !> unit to write to
    integer, intent(in) :: outUnit
    ! ---------------------------------------------------------------------------
    ! aotus type handling the output to the file in lua format
    type(aot_out_type) :: conf
    ! ---------------------------------------------------------------------------
    call aot_out_open( put_conf = conf, outUnit = outUnit )
    call tem_condition_out_single( me, conf )
    call aot_out_close( put_conf = conf )

  end subroutine tem_condition_dump_single
  ! **************************************************************************** !


  ! **************************************************************************** !
  !> Allows the output of array of condition to lua out
  subroutine tem_condition_out_vector(me, conf)
    ! ---------------------------------------------------------------------------
    !> condition to write into the lua file
    type(tem_condition_type), intent(in) :: me(:)
    !> aotus type handling the output to the file in lua format
    type(aot_out_type), intent(inout) :: conf
    ! ---------------------------------------------------------------------------
    integer :: iCond
    ! ---------------------------------------------------------------------------
    call aot_out_open_table( put_conf = conf, tname='condition' )
    do iCond = 1,size(me)
      call tem_condition_out_single( me(iCond), conf, level=1 )
    end do
    call aot_out_close_table( put_conf = conf )

  end subroutine tem_condition_out_vector
  ! **************************************************************************** !


  ! **************************************************************************** !
  !> Allows the output of the single condition to lua out.
  !!
  !! The data is written into the file, the lunit is connected to.
  !! It is formatted as a Lua table.
  !!
  subroutine tem_condition_out_single(me, conf, level)
    ! ---------------------------------------------------------------------------
    !> condition to write into the lua file
    type(tem_condition_type), intent(in) :: me
    !> aotus type handling the output to the file in lua format
    type(aot_out_type), intent(inout) :: conf
    !> to dump variable with key or without key
    integer, optional, intent(in) :: level
    ! ---------------------------------------------------------------------------
    integer :: level_loc
    ! ---------------------------------------------------------------------------
    if (present(level)) then
      level_loc = level
    else
      level_loc = 0
    end if

    if( level_loc == 0) then
      call aot_out_open_table( put_conf = conf, tname = 'condition' )
    else
      call aot_out_open_table( put_conf = conf )
    end if

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

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

    call aot_out_close_table( put_conf = conf )

  end subroutine tem_condition_out_single
  ! **************************************************************************** !


end module tem_condition_module
! ****************************************************************************** !
