module parameters

  use typedef, only: &
       real64, int64

  implicit none

  real(kind=real64), parameter :: &
       cutoff_default = 1.d99
  real(kind=real64), parameter :: &
       interact_default = 0.d0

  real(kind=real64), parameter :: &
       epslim_default = 0.01d0, &
       omegalim_default = 0.5d0

  save

  real(kind=real64) :: &
       epslim = epslim_default, &
       omegalim = omegalim_default

  real(kind=real64), dimension(:), allocatable :: &
       cutoff
  logical :: &
       has_cutoff = .FALSE.

  real(kind=real64), dimension(:,:), allocatable :: &
       interact
  logical :: &
       has_interact

  integer(kind=int64), parameter :: &
       IVERB_INTERACT  = 0, &
       IVERB_DRIVER    = 1, &
       IVERB_INTEGRATE = 2, &
       IVERB_ETA       = 3

  logical :: &
       verb_interact  = .TRUE., &
       verb_driver    = .TRUE., &
       verb_integrate = .TRUE., &
       verb_eta       = .TRUE.

contains

  ! ======================================================================

  subroutine set_verbose(verbose)

    use typedef, only: &
         int64

    implicit none

    integer(kind=int64), intent(IN) :: &
         verbose

    verb_interact  = btest(verbose, IVERB_INTERACT )
    verb_driver    = btest(verbose, IVERB_DRIVER   )
    verb_integrate = btest(verbose, IVERB_INTEGRATE)
    verb_eta       = btest(verbose, IVERB_ETA      )

  end subroutine set_verbose

  ! ======================================================================

  function get_verbose() result(verbose)

    use typedef, only: &
         int64

    implicit none

    integer(kind=int64) :: &
         verbose

    verbose = 0

    if (verb_interact ) verb_interact  = ibset(verbose, IVERB_INTERACT )
    if (verb_driver   ) verb_driver    = ibset(verbose, IVERB_DRIVER   )
    if (verb_integrate) verb_integrate = ibset(verbose, IVERB_INTEGRATE)
    if (verb_eta      ) verb_eta       = ibset(verbose, IVERB_ETA      )

  end function get_verbose

  ! ======================================================================

  subroutine set_cutoff(cutoff_)

    use typedef, only: &
         real64

    implicit none

    real(kind=real64), intent(in), dimension(:) :: &
         cutoff_

    if (allocated(cutoff)) &
       deallocate(cutoff)

    allocate(cutoff(size(cutoff_, 1)))

    where (cutoff_ <= 0.d0)
       cutoff(:) = cutoff_default
    else where
       cutoff(:) = cutoff_(:)
    end where

    has_cutoff = .TRUE.

  end subroutine set_cutoff

  ! ======================================================================

  subroutine get_cutoff(cutoff_)

    use typedef, only: &
         real64

    implicit none

    real(kind=real64), intent(out), dimension(:) :: &
         cutoff_

    if (.not.allocated(cutoff)) &
         error stop '[get_cutoff] No cutoff allocated.'

    if (.not.has_cutoff) &
         error stop '[get_cutoff] Has no cutoff.'

    if (size(cutoff, 1) /= size(cutoff_, 1)) &
         error stop '[get_cutoff] Wrong cutoff dimension.'

    cutoff_(:) = cutoff(:)

  end subroutine get_cutoff

  ! ======================================================================

  subroutine get_cutoff_size(n)

    use typedef, only: &
         int64

    implicit none

    integer(kind=int64), intent(out) :: &
         n

    if (allocated(cutoff).and.has_cutoff) then
       n = size(cutoff, 1)
    else
       n = 0
    endif

  end subroutine get_cutoff_size

  ! ======================================================================

  subroutine reset_cutoff

    implicit none

    save

    if (allocated(cutoff)) &
         deallocate(cutoff)

    has_cutoff = .FALSE.

  end subroutine reset_cutoff

  ! ======================================================================
  ! interact
  ! ======================================================================

  subroutine set_interact(interact_)

    use typedef, only: &
         real64, int32

    implicit none

    real(kind=real64), intent(in), dimension(:,:) :: &
         interact_

    integer(kind=int32) :: &
         i,j

    if (allocated(interact)) &
       deallocate(interact)

    if (size(interact_, 1) /= size(interact_, 2)) &
       error stop '[set_interact] Need 2D array with equal dimensions'

    allocate(interact(size(interact_,1), size(interact_,2)))

    where (interact_ <= 0.d0)
       interact(:,:) = interact_default
    else where
       interact(:,:) = interact_(:,:)
    end where

    do i=1, size(interact, 1)
       do j=1, size(interact, 2)
          if (interact(i,j) == 0.d0) &
               interact(i,j) = interact(j,i)
          if (i==j) &
               interact(i,j) = 0.d0
       end do
    end do

    do i=1, size(interact, 1)
       do j=1, size(interact, 2)
          if (interact(i,j) /= interact(j,i)) &
               error stop '[set_interact] asymmetric interaction'
       end do
    end do

    has_interact = .TRUE.

  end subroutine set_interact

  ! ======================================================================

  subroutine get_interact(interact_)

    use typedef, only: &
         real64

    implicit none

    real(kind=real64), intent(out), dimension(:,:) :: &
         interact_

    if (.not.allocated(interact)) &
         error stop '[get_interact] No interact allocated.'

    if (.not.has_interact) &
         error stop '[get_interact] Has no interact.'

    if (any(shape(interact) /= shape(interact_))) &
         error stop '[get_interact] Wrong interact dimensions.'

    interact_(:,:) = interact(:,:)

  end subroutine get_interact

  ! ======================================================================

  subroutine get_interact_size(n)

    use typedef, only: &
         int64

    implicit none

    integer(kind=int64), intent(out) :: &
         n

    if (allocated(interact).and.has_interact) then
       n = size(interact, 1)
    else
       n = 0
    endif

  end subroutine get_interact_size

  ! ======================================================================

  subroutine reset_interact

    implicit none

    save

    if (allocated(interact)) &
         deallocate(interact)

    has_interact = .FALSE.

  end subroutine reset_interact

  ! ======================================================================

end module parameters