! See copyright notice in the COPYRIGHT file.
! ****************************************************************************** !
!> The tem_bc_header is providing an overview of the boundary conditions
!! defined in the configuration of the solver.
!!
!! It provides collects the
!! labels and the kinds of the configured BCs, and connects them to the
!! corresponding boundaries defined in the mesh, given in the BC_prop.
!!
module tem_bc_header_module

  ! include treelm modules
  use env_module,         only: LabelLen
  use tem_tools_module,   only: tem_horizontalSpacer
  use tem_aux_module,     only: tem_abort
  use tem_bc_prop_module, only: tem_bc_prop_type
  use tem_logging_module, only: logUnit

  ! include aotus modules
  use aot_table_module, only: aot_table_open, aot_table_close, aot_get_val,    &
    &                         aot_table_length
  use flu_binding,      only: flu_State

  implicit none

  private

  public :: tem_bc_header_type
  public :: tem_load_bc_header, tem_open_bc
  public :: tem_out_bc_header

  !> This type describes the general, not solver specific, header information
  !! given in the Lua configuration of the solvers.
  type tem_bc_header_type
    integer :: nBCs !< Number of Bounary conditions in the Lua config
    !> Label for each boundary condition
    character(len=LabelLen), allocatable :: label(:)
    !> The kind of each boundary condition
    character(len=LabelLen), allocatable :: BC_kind(:)
    !> ID of the boundary in the mesh property, as defined by the bc_prop
    !! If an entry is not positive, there is no corresponding boundary
    !! condition found.
    integer, allocatable :: BC_ID(:)
  end type


contains


! ****************************************************************************** !
  !> This subroutine reads in the boundary conditions specified in the
  !! configuration file, and connects them to the corresponding entries in the
  !! treelmesh.
  !! If there boundary conditions in the mesh, for which no configuration is
  !! found, the program is aborted!
  !!
  subroutine tem_load_bc_header( me, conf, parentHandle, BC_prop )
    ! ---------------------------------------------------------------------------
    !> The boundary conditions to fill
    type(tem_bc_header_type), intent(inout) :: me
    !> A handle to the Lua configuration script, to read the data from
    type(flu_State) :: conf
    !> The boundary properties of the treelmesh, to connect the header to
    type(tem_BC_prop_type), intent(in) :: BC_prop
    !> handle for schemes table
    integer, intent(in),optional       :: parentHandle
    ! ---------------------------------------------------------------------------
    integer :: iBC, nBCs
    integer :: bc_handle, myHandle
    integer :: iError
    ! ---------------------------------------------------------------------------

    call tem_horizontalSpacer(fUnit=logUnit(1))
    write(logUnit(1),*) ' Loading BC header'
    ! if fluid informations in scheme table parentHandle /= 0
    call aot_table_open( L       = conf,                                       &
      &                  parent  = parentHandle,                               &
      &                  thandle = bc_handle,                                  &
      &                  key     = 'boundary_condition' )
    nBCs = aot_table_length(L=conf, thandle=bc_handle)

    ! allocate the label, bc_kind and BC_ID arrays in me
    call tem_init_bc_header( me, nBCs )

    do iBC = 1, nBCs
      call aot_table_open( L       = conf,                                     &
        &                  parent  = bc_handle,                                &
        &                  thandle = myHandle,                                 &
        &                  pos     = iBC )
      if (myHandle /= 0) then
        call aot_get_val( L       = conf,                                      &
          &               thandle = myHandle,                                  &
          &               val     = me%label(iBC),                             &
          &               ErrCode = iError,                                    &
          &               key     = 'label',                                   &
          &               default = 'unnamed' )

        call aot_get_val( L       = conf,                                      &
          &               thandle = myHandle,                                  &
          &               val     = me%BC_kind(iBC),                           &
          &               ErrCode = iError,                                    &
          &               key     = 'kind',                                    &
          &               default = 'none' )
        write(logUnit(1),*)'  Found BC '//trim(me%Label(iBC))//' of kind '//   &
          &            trim(me%BC_kind(iBC))
      else
        write(logUnit(1),*)'WARNING: BC definition should be a table!'
        write(logUnit(1),*)'       : Assuming unnamed BC with kind none!'
        me%Label(iBC) = 'unnamed'
        me%BC_kind(iBC) = 'none'
      end if
      call aot_table_close(L=conf, thandle=myHandle)
    end do ! iBC

    call aot_table_close(L=conf, thandle=bc_handle)

    ! Now all the BCs defined in the config file are known,
    ! try to match them against the labels in the BC_prop.
    ! if a bc label can not be matched, treat it as a fatal error.
    call tem_match_bc_header( me = me, BC_prop = BC_prop )

    if ( nBCs .gt. 0 ) then
      write(logUnit(1),"(A, I0)") ' Number of Boundaries: ', me%nBCs
    else
      write(logUnit(1),*) ' No Boundary conditions!'
    end if

  end subroutine tem_load_bc_header
! ****************************************************************************** !


! ****************************************************************************** !
  !> This subroutine looks for a given label in the given boundary conditions
  !! table, and returns the according table handle.
  !! Note, that this should usually not be necessary, as the number of
  !! the header is given by the ordering in the bc_header_type, and you
  !! can use the desired position directly to look up a specific bc in the
  !! configuration script.
  !!
  subroutine tem_open_bc( label, bc_table, conf, thandle )
    ! ---------------------------------------------------------------------------
    !> The label to look for
    character(len=LabelLen), intent(in) :: label
    !> Handle to the boundary_condition table, to look in
    integer, intent(in) :: bc_table
    !> Handle of the Lua script to use
    type(flu_State) :: conf
    !> Returned handle of to the entry providing the requested label
    integer, intent(out) :: thandle
    ! ---------------------------------------------------------------------------
    character(len=LabelLen) :: bc_name
    integer :: myHandle
    integer :: iBC, iError
    integer :: nBCs
    ! ---------------------------------------------------------------------------

    nBCs = aot_table_length(L=conf, thandle=bc_table)
    ! Default thandle to nothing found.
    thandle = 0
    do iBC=1,nBCs
      call aot_table_open( L       = conf,                                     &
        &                  parent  = bc_table,                                 &
        &                  thandle = myHandle,                                 &
        &                  pos     = iBC )
      if (myHandle /= 0) then
        call aot_get_val( L       = conf,                                      &
          &               thandle = myHandle,                                  &
          &               val     = bc_name,                                   &
          &               ErrCode = iError,                                    &
          &               key     = 'label',                                   &
          &               default = 'unnamed' )
        if (adjustl(bc_name) == adjustl(label)) then
          ! Found the matching boundary table, returning it...
          thandle = myHandle
          exit
        end if
      end if
      call aot_table_close(L=conf, thandle=myHandle)
    end do

  end subroutine tem_open_bc
! ****************************************************************************** !


! ****************************************************************************** !
  !> This routine does the allocation job
  !!
  subroutine tem_init_bc_header( me, nBCs )
    ! ---------------------------------------------------------------------------
    !> The boundary header
    type(tem_bc_header_type), intent(out) :: me
    integer, intent(in) :: nBCs
    ! ---------------------------------------------------------------------------

    me%nBCs = nBCs
    allocate(me%Label(me%nBCs))
    allocate(me%BC_kind(me%nBCs))
    allocate(me%BC_ID(me%nBCs))

    ! Set initial values for BC_ID
    me%BC_ID = -1

  end subroutine tem_init_bc_header
! ****************************************************************************** !


! ****************************************************************************** !
  !> This routine match the labels in me(tem_bc_header_type) against the labels
  !! in the bcProp([[tem_BC_prop_type]]).
  !! If a bc label can not be matched, the code will STOP!
  !!
  subroutine tem_match_bc_header( me, BC_prop )
    ! ---------------------------------------------------------------------------
    !> The boundary header to fill
    type(tem_bc_header_type) :: me
    !> The boundary properties of the treelmesh, to connect the header to
    type(tem_BC_prop_type), intent(in) :: BC_prop
    ! ---------------------------------------------------------------------------
    integer :: iBC, iBCtype
    character(len=LabelLen) :: proplabel
    logical :: MatchedBC
    ! ---------------------------------------------------------------------------

    write(logUnit(3),"(A)") ' matching boundary defination in lua to mesh'
    ! Outside loop: loop over the bc labels in BC_prop
    do iBCtype = 1, BC_prop%nBCtypes

      proplabel = adjustl(BC_prop%BC_label(iBCtype))
      matchedBC = .false.
      ! Inside loop: loop over the bc labels in bc header
      do iBC = 1, me%nBCs
        if (me%BC_ID(iBC) == -1) then
          ! This ID has not been matched yet, check it now
          ! BC_ID is set to be -1 during initialization
          if (adjustl(me%label(iBC)) == proplabel) then
            ! Found a match, assign the configured BC, and leave the loop
            me%BC_ID(iBC) = iBCtype
            matchedBC = .true.
            exit
          end if
        end if
      end do ! iBC in me%label

      ! If this BC is not matched, give a error message and stop the code.
      if ( .not. matchedBC ) then
        write(logUnit(1),*)"ERROR:"
        write(logUnit(1),*)"No configuration found for boundary "//            &
          &             trim(proplabel)//" from the BC property in the mesh!"
        write(logUnit(1),*)"This could also be caused by double definition "   &
          &            //"of the same BC in the mesh."
        write(logUnit(1),*)"This is fatal, STOPPING execution now..."
        call tem_abort()
      end if
    end do ! iBCtype in bc_prop

    if (minval(me%BC_ID) == -1) then
      write(logUnit(1),*)"WARNING: There are more boundaries defined in the "  &
        &                //" config file, than in the mesh properties!"
    end if

  end subroutine tem_match_bc_header
! ****************************************************************************** !

! ****************************************************************************** !
  subroutine tem_out_bc_header( me, outUnit )
    type( tem_bc_header_type ), intent(in) :: me
    integer, intent(in) :: outUnit
    integer :: iBC

    write( outUnit, "(A, I2)") ' in bc_header, number of BCs: ', me%nBCs
    write( outUnit, "(3A12)" ) 'label', 'BC kind', 'BC_ID'
    do iBC = 1, me%nBCs
      write( outUnit, "( A12, A12, I12)" ) &
        &               trim(me%label(iBC)), trim(me%BC_kind(iBC)), me%BC_ID(iBC)
    end do
  end subroutine tem_out_bc_header
! ****************************************************************************** !


end module tem_bc_header_module
! ****************************************************************************** !
