!# This source file is distributed with code Pégase.3.0.1 (2019-02-21).
!# Copyright: Michel Fioc (Michel.Fioc@iap.fr), Sorbonne université, 
!# Institut d'astrophysique de Paris/CNRS, France.
!# 
!# Pégase.3.0.1 is governed by the CeCILL license under French law and abides 
!# by the rules of distribution of free software. You can use, modify and/or 
!# redistribute this software under the terms of the CeCILL license as circulated 
!# by CEA, CNRS and INRIA at "http://www.cecill.info". The text of this license
!# is also available in French and in English in directory "doc_dir/" of this
!# code.
!# 
!# As a counterpart to the access to the source code and to the rights to copy,
!# modify and redistribute it granted by the license, users are provided only
!# with a limited warranty, and the software's author, the holder of the
!# economic rights, and the successive licensors have only limited
!# liability. 
!# 
!# The fact that you are presently reading this means that you have had
!# knowledge of the CeCILL license and that you accept its terms.
!#====================================================================== 

module mod_convert_type

  use mod_types

  implicit none
  private

  interface to_string
     module procedure int_to_string, SPR_to_string, SPR_to_string_fmt, &
          DPR_to_string, DPR_to_string_fmt, bool_to_string
  end interface to_string

  interface E_format
     module procedure SPR_E_format, DPR_E_format
  end interface E_format

  character, parameter :: NAK = achar(6) !# Negative-acknowledge character.

  public :: int_to_string, SPR_to_string, SPR_to_string_fmt, &
       DPR_to_string, DPR_to_string_fmt, bool_to_string, to_string, &
       boolean_answer, E_format, SPR_E_format, DPR_E_format

contains

!#======================================================================

  pure function int_to_string_aux(x)

    use mod_types

    implicit none
    integer, intent(in) :: x
!#......................................................................
    character(len=std_string) :: int_to_string_aux
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    write(int_to_string_aux, *) x
    int_to_string_aux = adjustl(int_to_string_aux)

  end function int_to_string_aux

!#======================================================================

  function int_to_string(x)

    implicit none
    integer, intent(in) :: x
!#......................................................................
!# Surprisingly, the following works. Used to convert a number to a string
!# with exactly the right length to contain it. Inefficient because the 
!# `*_aux` function is called twice.
    character(len=len_trim(int_to_string_aux(x))) :: int_to_string 
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    int_to_string = int_to_string_aux(x)

  end function int_to_string

!#======================================================================

  pure function SPR_to_string_aux(x, fmt)

    use mod_types

    implicit none
    real(SPR), intent(in) :: x
    character(len=*), intent(in), optional :: fmt
!#......................................................................
    character(len=long_string) :: SPR_to_string_aux
    character(len=*), parameter :: fmt_def = "(es10.3)"
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (present(fmt)) then
       write(SPR_to_string_aux, fmt) x
    else
       write(SPR_to_string_aux, fmt_def) x
    endif
    SPR_to_string_aux = adjustl(SPR_to_string_aux)

!# If the number does not fit in the format...
    if (SPR_to_string_aux(1:1) == "*") then
       write(SPR_to_string_aux, *) x
       SPR_to_string_aux = NAK // "Inappropriate format `" // trim(fmt) // &
            "` for this real number: " // trim(adjustl(SPR_to_string_aux)) // &
            ". Stopped."
    endif

  end function SPR_to_string_aux

!#======================================================================

  function SPR_to_string(x)

    implicit none
    real(SPR), intent(in) :: x
!#......................................................................
!# See comment in `int_to_string`.
    character(len=len_trim(SPR_to_string_aux(x))) :: SPR_to_string
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    SPR_to_string = SPR_to_string_aux(x)

    if (SPR_to_string(1:1) == NAK) then
       write(*, "(a)") SPR_to_string(2:)
       stop
    endif

  end function SPR_to_string

!#======================================================================

  function SPR_to_string_fmt(x, fmt)

    implicit none
    real(SPR), intent(in) :: x
    character(len=*), intent(in) :: fmt
!#......................................................................
!# See comment in `int_to_string`.
    character(len=len_trim(SPR_to_string_aux(x, fmt))) :: &
         SPR_to_string_fmt
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    SPR_to_string_fmt = SPR_to_string_aux(x, fmt)

    if (SPR_to_string_fmt(1:1) == NAK) then
       write(*, "(a)") SPR_to_string_fmt(2:)
       stop
    endif

  end function SPR_to_string_fmt

!#======================================================================

  pure function DPR_to_string_aux(x, fmt)

    use mod_types

    implicit none
    real(DPR), intent(in) :: x
    character(len=*), intent(in), optional :: fmt
!#......................................................................
    character(len=std_string) :: DPR_to_string_aux
    character(len=*), parameter :: fmt_def = "(es10.3)"
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (present(fmt)) then
       write(DPR_to_string_aux, fmt) x
    else
       write(DPR_to_string_aux, fmt_def) x
    endif
    DPR_to_string_aux = adjustl(DPR_to_string_aux)

!# If the number does not fit in the format...
    if (DPR_to_string_aux(1:1) == "*") then
       write(DPR_to_string_aux, *) x
       DPR_to_string_aux = NAK // "Inappropriate format `" // trim(fmt) // &
            "` for this real number: " // trim(adjustl(DPR_to_string_aux)) // &
            ". Stopped."
    endif

  end function DPR_to_string_aux

!#======================================================================

  function DPR_to_string(x)

    implicit none
    real(DPR), intent(in) :: x
!#......................................................................
!# See comment in `int_to_string`.
    character(len=len_trim(DPR_to_string_aux(x))) :: DPR_to_string
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    DPR_to_string = DPR_to_string_aux(x)

    if (DPR_to_string(1:1) == NAK) then
       write(*, "(a)") DPR_to_string(2:)
       stop
    endif

  end function DPR_to_string

!#======================================================================

  function DPR_to_string_fmt(x, fmt)

    implicit none
    real(DPR), intent(in) :: x
    character(len=*), intent(in) :: fmt
!#......................................................................
!# See comment in `int_to_string`.
    character(len=len_trim(DPR_to_string_aux(x, fmt))) :: DPR_to_string_fmt
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    DPR_to_string_fmt = DPR_to_string_aux(x, fmt)

    if (DPR_to_string_fmt(1:1) == NAK) then
       write(*, "(a)") DPR_to_string_fmt(2:)
       stop
    endif

  end function DPR_to_string_fmt

!#======================================================================

  pure function bool_to_string_aux(x)

    use mod_types

    implicit none
    logical, intent(in) :: x
!#......................................................................
    character(len=std_string) :: bool_to_string_aux
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (x) then
       bool_to_string_aux = ".true."
    else
       bool_to_string_aux = ".false."
    endif

  end function bool_to_string_aux

!#======================================================================

  function bool_to_string(x)

    implicit none
    logical, intent(in) :: x
!#......................................................................
!# See comment in `int_to_string`.
    character(len=len_trim(bool_to_string_aux(x))) :: bool_to_string
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    bool_to_string = bool_to_string_aux(x)

  end function bool_to_string

!#======================================================================

  subroutine boolean_answer(boolean, default)

    use mod_strings, only : down_case, unquote_string

    implicit none
    logical, intent(out) :: boolean
    logical, intent(in), optional :: default
!#......................................................................
    character(len=long_string) :: string
    integer :: ios
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    do
       if (present(default)) then
          write(*, "(a)") "Default: """ // to_string(default) // &
               """. Press the <RETURN>/<ENTER> key to select it."
          write(*, "(a/a)") "Otherwise, type either "".true."" or "".false.""", &
               "(or any equivalent to these: ""T""/""true""/""Y""/""yes""... &
               &or ""F""/""false""/""N""/""no""...)."
       else
          write(*, "(a/a)") "Type either "".true."" or "".false.""", &
               "(or any equivalent to these: ""T""/""true""/""Y""/""yes""... &
               &or ""F""/""false""/""N""/""no""...)."
       endif

       read(*, "(a)") string
       string = unquote_string(string)
       string = down_case(string)
       if (present(default) .and. string == "") then
          boolean = default
          return
       endif

       if (string == "y" .or. string == "yes") then
          boolean = .true.
          return
       else if (string == "n" .or. string == "no") then
          boolean = .false.
          return
       else
          read(string,*,iostat=ios) boolean
          if (ios == 0) then
             return
          else
             write(*, "(a/)") "Wrong input."
          endif
       endif
    enddo

  end subroutine boolean_answer

!#======================================================================

  elemental function SPR_E_format(number, w_fmt, d_fmt)

!# Converts a scalar real number or an array of real numbers to
!# "ES|w_fmt|.|d_fmt|E2" format with the following modifications, to
!# ensure that the exponent part (the part following decimals) always start
!# with "E":
!#
!# -- for very small numbers (magnitude < 1O^-99), the exponent part
!#    is never written as "-^3 digits^" but as "E-99".
!#    As a consequence, leading zeroes are added and the number of significant
!#    figures is reduced (denormalized output).
!#    Example: the number 1.234*10^-101, normally output as "1.234-101"
!#    with format "ES9.3" and as "*********" with "ES9.3E2", will be printed
!#    as "0.012E-99";
!#
!# -- even smaller numbers are formatted as 0.
!#    Example: the number 1.234*10^-103, normally output as "1.234-103"
!#    with format "ES9.3", will be printed as "0.000E+00";
!#
!# -- for very large numbers (magnitude >= 10^100), the exponent part
!#    is never written as "+^3 digits^" but as "E+^3 digits^". As a consequence,
!#    the number of figures after the decimal point is reduced by 1.
!#    Example: the number 1.234*10^102, normally output as "1.234+102"
!#    with format "ES9.3" and as "*********" with "ES9.2E2", will be printed
!#    as "1.23E+102".
!#
!# Note that some cases cannot occur for usual single precision reals.

    use mod_types
    implicit none
    character(len=std_string) :: SPR_E_format !# Ideally, `len` would be \
!# assigned to `w_fmt`, but this is not possible for an elemental function,
!# so assign `len` to some value >= `|w_fmt|` and print the formatted values
!# with "write(.,"(a|w_fmt|)") SPR_E_format(array, d_fmt, w_fmt)"
!# in the calling routine.
    real(kind=SPR), intent(in) :: number
    integer, intent(in) :: d_fmt, w_fmt
!#......................................................................
    real(kind=DPR) :: abs_number, decapower
    character(len=std_string) :: fmt
    integer :: n_leading_zeros
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    abs_number = abs(number)

    if (abs_number >= 1.e-99_DPR .and. abs_number < 1.e100_DPR) then
       write(fmt,"(a,i0,a,i0,a)") "(ES", w_fmt, ".", d_fmt, "E2)"
       write(SPR_E_format, fmt) number
    else if (abs_number >= 1.e100_DPR) then !# >= 10.E99
       if (d_fmt > 0) then
          write(fmt,"(a,i0,a,i0,a)") "(ES", w_fmt, ".", d_fmt-1, "E3)"
          write(SPR_E_format, fmt) number
       else
          write(fmt,"(a,i0,a,i0,a)") "(ES", w_fmt, ".", d_fmt, "E2)"
          write(SPR_E_format, fmt) number !# Will be filled with "*". \
!# The "NAK" trick used in other procedures to stop with some explanations
!# cannot be used here because this function is elemental, and therefore pure:
!# it can contain neither a "write" statement to an external file (including the
!# standard output) nor a "stop" statement.
       endif
    else !# < 1.E-99
       decapower = 1.e-99_DPR/10**d_fmt
       if (abs_number < decapower) then
          write(fmt,"(a,i0,a,i0,a)") "(ES", w_fmt, ".", d_fmt, "E2)"
          write(SPR_E_format, fmt) 0._SPR
       else
          decapower = 1.e-99_DPR
          do n_leading_zeros = 1, d_fmt
             decapower = decapower/10
             if (abs_number >= decapower) then
                write(fmt,"(a,i0,a,i0,a,i0,a)") "(", 1-n_leading_zeros, &
                     "P E", w_fmt, ".", d_fmt, "E2)"
                write(SPR_E_format, fmt) number
                exit
             endif
          enddo
       endif
    endif

  end function SPR_E_format

!#======================================================================

  elemental function DPR_E_format(number, w_fmt, d_fmt)

!# DPR version of `SPR_E_format`. See comments therein.

    use mod_types
    implicit none
    character(len=std_string) :: DPR_E_format
    real(kind=DPR), intent(in) :: number
    integer, intent(in) :: d_fmt, w_fmt
!#......................................................................
    real(kind=DPR) :: abs_number, decapower
    character(len=std_string) :: fmt
    integer :: n_leading_zeros
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    abs_number = abs(number)

    if (abs_number >= 1.e-99_DPR .and. abs_number < 1.e100_DPR) then
       write(fmt,"(a,i0,a,i0,a)") "(ES", w_fmt, ".", d_fmt, "E2)"
       write(DPR_E_format, fmt) number
    else if (abs_number >= 1.e100_DPR) then !# >= 10.E99
       if (d_fmt > 0) then
          write(fmt,"(a,i0,a,i0,a)") "(ES", w_fmt, ".", d_fmt-1, "E3)"
          write(DPR_E_format, fmt) number
       else
          write(fmt,"(a,i0,a,i0,a)") "(ES", w_fmt, ".", d_fmt, "E2)"
          write(DPR_E_format, fmt) number !# Will be filled with "*".
       endif
    else !# < 1.E-99
       decapower = 1.e-99_DPR/10**d_fmt
       if (abs_number < decapower) then
          write(fmt,"(a,i0,a,i0,a)") "(ES", w_fmt, ".", d_fmt, "E2)"
          write(DPR_E_format, fmt) 0._DPR
       else
          decapower = 1.e-99_DPR
          do n_leading_zeros = 1, d_fmt
             decapower = decapower/10
             if (abs_number >= decapower) then
                write(fmt,"(a,i0,a,i0,a,i0,a)") "(", 1-n_leading_zeros, &
                     "P E", w_fmt, ".", d_fmt, "E2)"
                write(DPR_E_format, fmt) number
                exit
             endif
          enddo
       endif
    endif

  end function DPR_E_format

end module mod_convert_type
