module wei_util
  use sep
  use wei_external
  !---------------
  implicit none

  interface weimessage
     module procedure print_integer
     module procedure print_real
     module procedure print_character
     module procedure print_logical
     module procedure print_info
  end interface

  !----------------------------------------------------------------  
  type, public        :: axis
     integer          :: n
     real             :: o,d
     character(len=2) :: l    !! label (i.e. axis name)
  end type axis
  !----------------------------------------------------------------  
  character(len=18), parameter, public :: weitab="         WEI    "

  integer, private, save  :: depth=0
contains
  !----------------------------------------------------------------
  !! load axis info from a header file
  subroutine hinaxis(file,a,i)
    character(len=*), intent(in)  :: file
    integer,          intent(in)  :: i
    type(axis),       intent(out) :: a
    character(len=128)            :: buf

    write(buf,"(a,i1)") 'n',i; call from_aux(trim(file),trim(buf),a%n,1 )
    write(buf,"(a,i1)") 'o',i; call from_aux(trim(file),trim(buf),a%o,0.)
    write(buf,"(a,i1)") 'd',i; call from_aux(trim(file),trim(buf),a%d,1.)
  end subroutine hinaxis
  !----------------------------------------------------------------
  !! write axis info to a header file
  subroutine houaxis(file,a,i)
    character(len=*), intent(in)  :: file
    integer,          intent(in)  :: i
    type(axis),       intent(in)  :: a
    character(len=128)            :: buf

    write(buf, "(a,i1)") 'n'    ,i; call to_history(trim(buf),     a%n, trim(file))
    write(buf, "(a,i1)") 'o'    ,i; call to_history(trim(buf),     a%o, trim(file))
    write(buf, "(a,i1)") 'd'    ,i; call to_history(trim(buf),     a%d, trim(file))
    write(buf, "(a,i1)") 'label',i; call to_history(trim(buf),trim(a%l),trim(file))
  end subroutine houaxis
  !----------------------------------------------------------------
  !! write axis info to an aux file
  subroutine aouaxis(file,a,i)
    character(len=*), intent(in)  :: file
    integer,          intent(in)  :: i
    type(axis),       intent(in)  :: a
    character(len=128)            :: buf

    write(buf, "(a,i1)") 'n'    ,i; call auxputch(trim(buf),'i',    a%n,  trim(file))
    write(buf, "(a,i1)") 'o'    ,i; call auxputch(trim(buf),'f',    a%o,  trim(file))
    write(buf, "(a,i1)") 'd'    ,i; call auxputch(trim(buf),'f',    a%d,  trim(file))
    write(buf, "(a,i1)") 'label',i; call auxputch(trim(buf),'s',trim(a%l),trim(file))
  end subroutine aouaxis
  !----------------------------------------------------------------  
  !! load axis info from a parameter file
  subroutine pinaxis(a)
    type(axis),       intent(out) :: a
    character(len=128)            :: buf

    write(buf,"('a',a,a)") a%l,'_n'
    call from_param(trim(buf),a%n,1  )
    call to_history(trim(buf),a%n)

    write(buf,"('a',a,a)") a%l,'_o'
    call from_param(trim(buf),a%o,0.0)
    call to_history(trim(buf),a%o)

    write(buf,"('a',a,a)") a%l,'_d'
    call from_param(trim(buf),a%d,1.0)
    call to_history(trim(buf),a%d)

  end subroutine pinaxis
  !----------------------------------------------------------------
  subroutine printaxis(a)
    type(axis),       intent(in)  :: a
    write(0,*) "n=",a%n,"o=",a%o,"d=",a%d,"l=",a%l
  end subroutine printaxis
  !----------------------------------------------------------------  
  !! COmpare AXes
  logical function coax(a1,a2) result(stat)
    type(axis) :: a1,a2
    !! 1=yes, the axes are   compatible
    !! 0=no,  the axes are incompatible

    stat=.true. !! presume compatible

    if(a1%n /= a2%n .or. a1%o /= a2%o .or. a1%d /= a2%d) then
       stat = .false.
       call printaxis(a1)
       call printaxis(a2)
    end if
  end function coax
  !----------------------------------------------------------------
  subroutine matchaxis(oper,a1,a2)
    character(len=5), intent(in) :: oper
    type(axis) :: a1,a2

    if(a1%n /= a2%n .or. a1%o /= a2%o .or. a1%d /= a2%d) then
       call printaxis(a1)
       call printaxis(a2)
       call seperr("axis mismatch")
    end if
  end subroutine matchaxis
  !----------------------------------------------------------------
  !! enter a function/subroutine
  subroutine in(t)
    character(len=*), intent(in) :: t
    integer :: i

    depth=depth+1
    write(0,"(a)",advance='no') '        '
    do i=1,depth
       write(0,"(a)",advance='no') '  '
    end do
    write(0,*) depth,'>>> enter ',trim(t)

  end subroutine in
  !----------------------------------------------------------------
  !! exit a function/subroutine
  subroutine out(t)
    character(len=*), intent(in) :: t
    integer :: i

    write(0,"(a)",advance='no') '        '
    do i=1,depth
       write(0,"(a)",advance='no') '  '
    end do
    write(0,*) depth,'<<< exit  ',trim(t)
    depth=depth-1

  end subroutine out
  !----------------------------------------------------------------
  !! check if a tag is associated with an actual file on the disk
  logical function isfile(tag) result(is)
    character(len=128), intent(in) :: tag

    is = auxin(tag) /=-1
    call auxclose(tag)

  end function isfile
  !----------------------------------------------------------------

  subroutine print_integer(n,v)
    character(len=*), intent(in) :: n
    integer,          intent(in) :: v
    call weiline()
    write (0,'("         WEI ",a,"=",i8)') trim(n),v
    call weiline()
  end subroutine print_integer
  subroutine print_real(n,v)
    character(len=*), intent(in) :: n
    real,             intent(in) :: v
    call weiline()
    write (0,'("         WEI ",a,"=",f15.6)') trim(n),v
    call weiline()
  end subroutine print_real
  subroutine print_character(n,v)
    character(len=*), intent(in) :: n,v
    call weiline()
    write (0,'("         WEI ",a,"=",a)') trim(n),trim(v)
    call weiline()
  end subroutine print_character
  subroutine print_info(n)
    character(len=*), intent(in) :: n
    call weiline()
    write (0,'("         WEI ",a)') trim(n)
    call weiline()
  end subroutine print_info
  subroutine print_logical(n,v)
    character(len=*), intent(in) :: n
    logical,          intent(in) :: v
    call weiline()
    write (0,'("         WEI ",a,"=",l2)') trim(n),v
    call weiline()
  end subroutine print_logical
  !----------------------------------------------------------------
  subroutine weiline()
    write(0,*)'        WEI================================================================'
  end subroutine weiline
  !----------------------------------------------------------------

  !----------------------------------------------------------------  
end module wei_util





