# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
module util_mod
  use type_mod
  use external_mod

  !---------------
  implicit none

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


  type(trun), public :: run
  integer, private :: 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
!----------------------------------------------------------------
   subroutine houaxes(file,a1,a2,a3,a4,a5,a6)
    character(len=*), intent(in) :: file
    type(axis), intent(in) :: a1,a2,a3,a4,a5,a6
    optional :: a2,a3,a4,a5,a6

    call houaxis(file,a1,1)
    if(present(a2)) call houaxis(file,a2,2)
    if(present(a3)) call houaxis(file,a3,3)
    if(present(a4)) call houaxis(file,a4,4)
    if(present(a5)) call houaxis(file,a5,5)
    if(present(a6)) call houaxis(file,a6,6)
   end subroutine
!----------------------------------------------------------------
   logical function file_val_assign(tag,val)
    complex :: val
    integer, parameter :: big_int = selected_int_kind(15)
    integer(kind=big_int) :: ndone,n123,ndo
    integer :: naxes,n,block,ierr,i
    real :: o,d
    character(len=128) :: label
    character(len=*) :: tag
    complex :: my_buf(1000000)
    integer, external :: sep_get_number_data_axes
    file_val_assign=F
    if(0/=sep_get_number_data_axes(tag,naxes)) then
      write(run%io,*) "trouble getting number axes"
      return
    end if
    n123=1
    do i=1,naxes
     call sep_get_data_axis_par(tag,i,n,o,d,label); n123=n123*n
    end do

   ierr= sseek(tag,0,0)
    ndone=0
    my_buf=val
    do while(ndone< n123)
      ndo=min(int(n123-ndone),1000000);block=ndo
      ierr= srite(tag,my_buf,block*8)
      ndone=ndone+block
    end do
    file_val_assign=T
   end function

!----------------------------------------------------------------
  subroutine printaxis(a)
    type(axis), intent(in) :: a
    write(run%io,*) "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(run%io,"(a)",advance='no') '        '
    do i=1,depth
       write(run%io,"(a)",advance='no') '  '
    end do
    write(run%io,*) '>>> enter ',trim(t)

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

    write(run%io,"(a)",advance='no') '        '
    do i=1,depth
       write(run%io,"(a)",advance='no') '  '
    end do
    write(run%io,*) '<<< 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 line()
    write (0,'("         SP ",a,"=",i8)') trim(n),v
    call line()
  end subroutine print_integer
!----------------------------------------------------------------
  subroutine print_real(n,v)
    character(len=*), intent(in) :: n
    real, intent(in) :: v
! call line()
    write (0,'("         SP ",a,"=",f15.6)') trim(n),v
    call line()
  end subroutine print_real
!----------------------------------------------------------------
  subroutine print_character(n,v)
    character(len=*), intent(in) :: n,v
    write (0,'("         SP ",a,"=",a)') trim(n),trim(v)
! call line()
  end subroutine print_character
  subroutine print_info(n)
    character(len=*), intent(in) :: n
! call line()
    write (0,'("         SP ",a)') trim(n)
    call line()
  end subroutine print_info
  subroutine print_logical(n,v)
    character(len=*), intent(in) :: n
    logical, intent(in) :: v
! call line()
    write (0,'("         SP ",a,"=",l2)') trim(n),v
    call line()
  end subroutine print_logical
  !----------------------------------------------------------------
  subroutine line()
    write(run%io,*)'        SP *************Faster Pussycat!****************'
  end subroutine line
  !----------------------------------------------------------------
end module util_mod
