!# This source file is part of 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_colors

  use mod_types
  use mod_linked_list

  implicit none
  private

  integer,save :: dim_col = 0

  integer, save :: unit_colors, dim_output_age
  real(CDR), dimension(:), pointer, save :: output_age => null()
  type(lk_lst_CDR), dimension(:), pointer, save :: row => null()
  type(lk_lst_long_string), save :: fmt

  interface add_column
     module procedure add_column_SPR, add_column_DPR
  end interface add_column

  public :: add_column, write_table, unit_colors, dim_output_age, output_age

contains
  
!#======================================================================
  
  subroutine add_column_SPR(column_heading, column, fmt_col)

    use mod_convert_type, only : to_string

    implicit none
    character(len=*) :: column_heading
    real(SPR), dimension(:), intent(in) :: column
    character(len=*), optional :: fmt_col
!#......................................................................
    character(std_string) :: fmt_col_eff, fmt_col_def = "f8.3"
    integer :: heading_width, content_width, pos_digit, pos_point
    character(std_string) :: left, right
    integer :: i_output_age, ios
    type(lk_lst_CDR), dimension(:), pointer, save :: row_node => null()
    type(lk_lst_long_string), pointer, save :: fmt_node => null()
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
!# Set the content width.
    if (present(fmt_col)) then
       fmt_col_eff = fmt_col
    else
       fmt_col_eff = fmt_col_def
    endif

    if (dim_col == 0) then
       write(unit_colors, "(a8,tr2)", advance="no", iostat=ios) "   age  "
!# Needed because of the gfortran bug mentionned in subroutine `skip_comment_lines`
!# of "mod_file_access.f90": {
       if (ios /= 0)  write(unit_colors, "(a8,tr2)", advance="no", iostat=ios) "   age  "
!# }
       call lk_lst_initialize(fmt)
       if (associated(row)) deallocate(row)
       allocate(row(size(column)))
       if (associated(row_node)) deallocate(row_node)
       allocate(row_node(size(column)))
       do i_output_age = 1, size(column)
          call lk_lst_initialize(row(i_output_age))
       enddo
    endif
    pos_digit = scan(fmt_col_eff, "0123456789")
    pos_point = index(fmt_col_eff, ".")
    read(fmt_col_eff(pos_digit:pos_point-1),*) content_width

!# Format and write the column heading.
    heading_width = len_trim(adjustl(column_heading))
    if (max(content_width-heading_width,0)/2 > 0) then
       left = "(tr" // to_string(max(content_width-heading_width,0)/2) // ","
    else
       left = "("
    endif
    if (max(content_width-heading_width,0)-max(content_width-heading_width,0)/2 > 0) then
       right = ",tr" // to_string(max(content_width-heading_width,0)- &
            max(content_width-heading_width,0)/2) // ","
    else
       right = ","
    endif

    write(unit_colors, &
         trim(adjustl(left)) // "a" // trim(adjustl(right)) // "tr2)", &
         advance="no") adjustl(column_heading)

!# Format the column content and fill a new column in array.

    if (max(heading_width-content_width,0)/2 > 0) then
       left = "tr" // to_string(max(heading_width-content_width,0)/2) // ","
    else
       left = ""
    endif
    if (max(heading_width-content_width,0)-max(heading_width-content_width,0)/2 > 0) then
       right = ",tr" // to_string(max(heading_width-content_width,0)- &
            max(heading_width-content_width,0)/2)
    else
       right = ""
    endif
    call lk_lst_new_node(fmt, fmt_node)
    fmt_node % val = "(tr2," // trim(adjustl(left)) // &
         trim(fmt_col_eff) // trim(adjustl(right)) // ")"

    dim_col = dim_col+1
    do i_output_age = 1, size(column)
       call lk_lst_new_node(row(i_output_age), row_node(i_output_age) % ptr)
       row_node(i_output_age) % ptr % val = column(i_output_age)
    enddo

  end subroutine add_column_SPR

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

  subroutine add_column_DPR(column_heading, column, fmt_col)

    use mod_convert_type, only : to_string
    
    implicit none
    character(len=*) :: column_heading
    real(DPR), dimension(:), intent(in) :: column
    character(len=*), optional :: fmt_col
!#......................................................................
    character(std_string) :: fmt_col_eff, fmt_col_def = "f8.3"
    integer :: heading_width, content_width, pos_digit, pos_point
    character(std_string) :: left, right
    integer :: i_output_age, ios
    type(lk_lst_CDR), dimension(:), pointer, save :: row_node => null()
    type(lk_lst_long_string), pointer, save :: fmt_node => null()
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
!# Set the content width.
    if (present(fmt_col)) then
       fmt_col_eff = fmt_col
    else
       fmt_col_eff = fmt_col_def
    endif

    if (dim_col == 0) then
       write(unit_colors, "(a8,tr2)", advance="no", iostat=ios) "   age  "
!# Needed because of the gfortran bug mentionned in subroutine `skip_comment_lines`
!# of "mod_file_access.f90": {
       if (ios /= 0)  write(unit_colors, "(a8,tr2)", advance="no", iostat=ios) "   agee  "
!# }
       call lk_lst_initialize(fmt)
       if (associated(row)) deallocate(row)
       allocate(row(size(column)))
       if (associated(row_node)) deallocate(row_node)
       allocate(row_node(size(column)))
       do i_output_age = 1, size(column)
          call lk_lst_initialize(row(i_output_age))
       enddo
    endif
    pos_digit = scan(fmt_col_eff, "0123456789")
    pos_point = index(fmt_col_eff, ".")
    read(fmt_col_eff(pos_digit:pos_point-1),*) content_width

!# Format and write the column heading.
    heading_width = len_trim(adjustl(column_heading))
    if (max(content_width-heading_width,0)/2 > 0) then
       left = "(tr" // to_string(max(content_width-heading_width,0)/2) // ","
    else
       left = "("
    endif
    if (max(content_width-heading_width,0)-max(content_width-heading_width,0)/2 > 0) then
       right = ",tr" // to_string(max(content_width-heading_width,0)- &
            max(content_width-heading_width,0)/2) // ","
    else
       right = ","
    endif

    write(unit_colors, &
         trim(adjustl(left)) // "a" // trim(adjustl(right)) // "tr2)", &
         advance="no") adjustl(column_heading)

!# Format the column content and fill a new column in array.

    if (max(heading_width-content_width,0)/2 > 0) then
       left = "tr" // to_string(max(heading_width-content_width,0)/2) // ","
    else
       left = ""
    endif
    if (max(heading_width-content_width,0)-max(heading_width-content_width,0)/2 > 0) then
       right = ",tr" // to_string(max(heading_width-content_width,0)- &
            max(heading_width-content_width,0)/2)
    else
       right = ""
    endif
    call lk_lst_new_node(fmt, fmt_node)
    fmt_node % val = "(tr2," // trim(adjustl(left)) //  &
         trim(fmt_col_eff) // trim(adjustl(right)) // ")"

    dim_col = dim_col+1
    do i_output_age = 1, size(column)
       call lk_lst_new_node(row(i_output_age), row_node(i_output_age) % ptr)
       row_node(i_output_age) % ptr % val = column(i_output_age)
    enddo

  end subroutine add_column_DPR

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

  subroutine write_table

    implicit none
!#......................................................................
    integer :: i_output_age, i_col
    type(lk_lst_long_string), pointer :: fmt_node => null()
    type(lk_lst_CDR), pointer :: row_node => null()
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    write(unit_colors,*) !# To finish the line of headings and move to the next one.
    do i_output_age = 1, dim_output_age
       fmt_node => fmt % ptr
       row_node => row(i_output_age) % ptr
       write(unit_colors, "(f8.2)", advance="no") output_age(i_output_age)
       do i_col = 1, dim_col-1
          write(unit_colors, fmt_node % val, advance="no") row_node % val
          fmt_node => fmt_node % ptr
          row_node => row_node % ptr
       end do
       write(unit_colors, fmt_node % val, advance="yes") row_node % val
    enddo
    dim_col = 0    

  end subroutine write_table

end module mod_colors
