module formatting

contains

  function ihformat(ll, n) result(ss)

    use typedef, only: &
         int32, int64

    implicit none

    integer(kind=int32), parameter :: &
         nmax = 64

    integer(kind=int64), intent(in) :: &
         ll
    integer(kind=int32), intent(in) :: &
         n

    character(len=n) :: &
         ss

    integer(kind=int64) :: &
         l
    integer(kind=int32) :: &
         i,j,k
    character(len=nmax) :: &
         s

    l = abs(ll)
    i = 0
    do j=1,nmax
       s(j:j) = ' '
    end do
    do while (l > 0)
       if (mod(i,4)==3) then
          i = i + 1
          s(i:i) = ','
       endif
       i = i + 1
       write(s(i:i), '(I1)') mod(l, 10)
       l = l / 10
    end do
    if (ll == 0) then
       i = 1
       s(i:i) = '0'
    end if
    if (ll < 0) then
       i = i + 1
       s(i:i) = '-'
    endif
    if (i > n) then
       do j = 1, n
          ss(j:j) = '*'
       enddo
    else
       do j=1,n-1
          ss(j:j) = ' '
       enddo
       do j=1,i
          k = n-j+1
          ss(k:k) = s(j:j)
       enddo
    endif

  end function ihformat

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

  function itformat(ll, n, zero) result(s)

    ! zero (logical) if set, prion ot dezimal even if it is 0

    use typedef, only: &
         int32, int64, real64

    implicit none

    integer(kind=int32), parameter :: &
         ntime = 12
    character(len=3), dimension(ntime), parameter :: &
         cunit = (/ &
         's  ', 'min', 'h  ', 'd  ', 'yr ', 'kyr', &
         'Myr', 'Gyr', 'Pyr', 'Eyr', 'Zyr', 'Yyr' /)

    integer(kind=int64), intent(in) :: &
         ll
    integer(kind=int32), intent(in) :: &
         n
    logical, optional :: &
         zero
    character(len=n) :: &
         s

    logical :: &
         z
    real(kind=real64) :: &
         f
    integer(kind=int64) :: &
         l, lk, ld
    integer(kind=int32) :: &
         j,k

    if (present(zero)) then
       z = zero
    else
       z = .False.
    endif

    l = abs(ll)
    k = 0
    ld = -1
    if (l < 99) then
       lk = l
       k = 1
    else if (l < 5970) then
       ld = nint(l / 6.d0)
       lk = ld / 10
       if (lk >= 10) then
          lk = nint(l / 60.d0)
          ld = -1
       else
          ld = ld - 10 * lk
       endif
       k = 2
    else if (l < 358200) then
       ld = nint(l / 360.d0)
       lk = ld / 10
       if (lk >= 10) then
          lk = nint(l / 3600.d0)
          ld = -1
       else
          ld = ld - 10 * lk
       endif
       k = 3
    else if (l < 86356800) then
       ld = nint(l / 8640.d0)
       lk = ld / 10
       if (lk >= 10) then
          lk = nint(l / 86400.d0)
          ld = -1
       else
          ld = ld - 10 * lk
       endif
       k = 4
    else
       f = 1.d0 / 30779352d0
       lk = l
       k = 4
       do while (lk > 999)
          ld = nint(l * (f * 10d0))
          lk = ld / 10
          if (lk >= 10) then
             lk = nint(l * f)
             ld = -1
          else
             ld = ld - 10 * lk
          endif
          f = f * 1.d-3
          k = k + 1
       enddo
       if (k > ntime) error stop '[itformat] value too large'
    end if

    if (ll < 0) then
       lk = -lk
    endif

    if ((n < 7).or.((ll<0).and.(n<8)))  then
       do j = 1, n
          s(j:j) = '*'
       enddo
    else
       do j=1,n
          s(j:j) = ' '
       end do
       s(n-2:n) = cunit(k)(1:3)
       if ((ld < 0).or.((.not.z).and.(ld < 1))) then
          if (ll < 0) then
             write(s(n-7:n-4), '(I4)') lk
          else
             write(s(n-6:n-4), '(I3)') lk
          endif
       else
          s(n-5:n-5) = '.'
          write(s(n-4:n-4), '(I1)') ld
          if (ll < 0) then
             write(s(n-7:n-6), '(I2)') lk
          else
             write(s(n-6:n-6), '(I1)') lk
          endif
       endif
    endif

  end function itformat


end module formatting