!# 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_linked_list

  use mod_types
  implicit none
  private

  type :: lk_lst_CDR
     real(CDR) :: val
     type(lk_lst_CDR), pointer :: ptr => null()
  end type lk_lst_CDR

  type :: lk_lst_DPR
     real(DPR) :: val
     type(lk_lst_DPR), pointer :: ptr => null()
  end type lk_lst_DPR

  type :: lk_lst_std_string
     character(len=std_string) :: val
     type(lk_lst_std_string), pointer :: ptr => null()
  end type lk_lst_std_string

  type :: lk_lst_long_string
     character(len=long_string) :: val
     type(lk_lst_long_string), pointer :: ptr => null()
  end type lk_lst_long_string

  interface lk_lst_destroy
     module procedure lk_lst_destroy_CDR, &
          lk_lst_destroy_DPR, &
          lk_lst_destroy_std_string, &
          lk_lst_destroy_long_string
  end interface lk_lst_destroy

  interface lk_lst_initialize
     module procedure lk_lst_initialize_CDR, &
          lk_lst_initialize_DPR, &
          lk_lst_initialize_std_string, &
          lk_lst_initialize_long_string
  end interface lk_lst_initialize

  interface lk_lst_new_node
     module procedure lk_lst_new_node_CDR, &
          lk_lst_new_node_DPR, &
          lk_lst_new_node_std_string, &
          lk_lst_new_node_long_string
  end interface lk_lst_new_node

  interface lk_lst_to_array
     module procedure lk_lst_to_array_CDR, &
          lk_lst_to_array_DPR, &
          lk_lst_to_array_std_string, &
          lk_lst_to_array_long_string
  end interface lk_lst_to_array

  public :: lk_lst_CDR, lk_lst_DPR, &
       lk_lst_std_string, lk_lst_long_string, &
       lk_lst_destroy, lk_lst_initialize, lk_lst_new_node, &
       lk_lst_to_array

contains

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

  subroutine lk_lst_destroy_CDR(head_node)

    implicit none
    type(lk_lst_CDR), intent(inout) :: head_node
!#......................................................................
    type(lk_lst_CDR), pointer :: current_node, next_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete linked list, if already existing.
    current_node => head_node % ptr
    do
       if (.not.associated(current_node)) exit
       next_node => current_node % ptr
       deallocate(current_node)
       current_node => next_node
    enddo

  end subroutine lk_lst_destroy_CDR

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

  subroutine lk_lst_initialize_CDR(head_node)

    implicit none
    type(lk_lst_CDR), intent(inout) :: head_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete linked list, if already existing.
    call lk_lst_destroy_CDR(head_node)

!# Set the head of the linked list.
    nullify(head_node % ptr)

  end subroutine lk_lst_initialize_CDR

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

  subroutine lk_lst_new_node_CDR(head_node, current_node)

    implicit none
    type(lk_lst_CDR), intent(inout) :: head_node
    type(lk_lst_CDR), pointer :: current_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (.not.associated(head_node % ptr)) then
       allocate(head_node % ptr)
       current_node => head_node % ptr
    else
       allocate(current_node % ptr)
       current_node => current_node % ptr
    endif
    nullify(current_node % ptr)

  end subroutine lk_lst_new_node_CDR

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

  subroutine lk_lst_to_array_CDR(head_node, array, dim_array)

!# Convert linked list `head_node` to the 1D array `array` and destroy the linked list.
!# If not provided, the size of the array, `dim_array` is computed from the linked list.

    implicit none
    type(lk_lst_CDR) :: head_node
    real(CDR), dimension(:), pointer :: array
    integer, intent(in), optional :: dim_array
!#......................................................................
    integer :: dim_array_eff, i
    type(lk_lst_CDR), pointer :: current_node, next_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (present(dim_array)) then
       dim_array_eff = dim_array
    else
       dim_array_eff = 0
       current_node => head_node % ptr
       do
          if (.not.associated(current_node)) exit
          dim_array_eff = dim_array_eff + 1
          current_node => current_node % ptr
       enddo
    endif

    if (associated(array)) deallocate(array)
    allocate(array(dim_array_eff))

    current_node => head_node % ptr
    do i = 1, dim_array_eff
       if (.not.associated(current_node)) then
          write(*,"(a)") "The length of the linked list is larger than &
               &the size of the array into which it is converted. Stopped."
          stop
       endif
       next_node => current_node % ptr
       array(i) = current_node % val
       deallocate(current_node)
       current_node => next_node
    enddo

    nullify(head_node % ptr)

  end subroutine lk_lst_to_array_CDR

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

  subroutine lk_lst_destroy_DPR(head_node)

    implicit none
    type(lk_lst_DPR), intent(inout) :: head_node
!#......................................................................
    type(lk_lst_DPR), pointer :: current_node, next_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete linked list, if already existing.
    current_node => head_node % ptr
    do
       if (.not.associated(current_node)) exit
       next_node => current_node % ptr
       deallocate(current_node)
       current_node => next_node
    enddo

  end subroutine lk_lst_destroy_DPR

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

  subroutine lk_lst_initialize_DPR(head_node)

    implicit none
    type(lk_lst_DPR), intent(inout) :: head_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete linked list, if already existing.
    call lk_lst_destroy_DPR(head_node)

!# Set the head of the linked list.
    nullify(head_node % ptr)

  end subroutine lk_lst_initialize_DPR

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

  subroutine lk_lst_new_node_DPR(head_node, current_node)

    implicit none
    type(lk_lst_DPR), intent(inout) :: head_node
    type(lk_lst_DPR), pointer :: current_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (.not.associated(head_node % ptr)) then
       allocate(head_node % ptr)
       current_node => head_node % ptr
    else
       allocate(current_node % ptr)
       current_node => current_node % ptr
    endif
    nullify(current_node % ptr)

  end subroutine lk_lst_new_node_DPR

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

  subroutine lk_lst_to_array_DPR(head_node, array, dim_array)

!# Convert linked list `head_node` to the 1D array `array` and destroy the linked list.
!# If not provided, the size of the array, `dim_array` is computed from the linked list.

    implicit none
    type(lk_lst_DPR) :: head_node
    real(DPR), dimension(:), pointer :: array
    integer, intent(in), optional :: dim_array
!#......................................................................
    integer :: dim_array_eff, i
    type(lk_lst_DPR), pointer :: current_node, next_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (present(dim_array)) then
       dim_array_eff = dim_array
    else
       dim_array_eff = 0
       current_node => head_node % ptr
       do
          if (.not.associated(current_node)) exit
          dim_array_eff = dim_array_eff + 1
          current_node => current_node % ptr
       enddo
    endif

    if (associated(array)) deallocate(array)
    allocate(array(dim_array_eff))

    current_node => head_node % ptr
    do i = 1, dim_array_eff
       if (.not.associated(current_node)) then
          write(*,"(a)") "The length of the linked list is larger than &
               &the size of the array into which it is converted. Stopped."
          stop
       endif
       next_node => current_node % ptr
       array(i) = current_node % val
       deallocate(current_node)
       current_node => next_node
    enddo

    nullify(head_node % ptr)

  end subroutine lk_lst_to_array_DPR

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

  subroutine lk_lst_destroy_std_string(head_node)

    implicit none
    type(lk_lst_std_string), intent(inout) :: head_node
!#......................................................................
    type(lk_lst_std_string), pointer :: current_node, next_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete linked list, if already existing.
    current_node => head_node % ptr
    do
       if (.not.associated(current_node)) exit
       next_node => current_node % ptr
       deallocate(current_node)
       current_node => next_node
    enddo

  end subroutine lk_lst_destroy_std_string

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

  subroutine lk_lst_initialize_std_string(head_node)

    implicit none
    type(lk_lst_std_string), intent(inout) :: head_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete linked list, if already existing.
    call lk_lst_destroy_std_string(head_node)

!# Set the head of the linked list.
    nullify(head_node % ptr)

  end subroutine lk_lst_initialize_std_string

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

  subroutine lk_lst_new_node_std_string(head_node, current_node)

    implicit none
    type(lk_lst_std_string), intent(inout) :: head_node
    type(lk_lst_std_string), pointer :: current_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (.not.associated(head_node % ptr)) then
       allocate(head_node % ptr)
       current_node => head_node % ptr
    else
       allocate(current_node % ptr)
       current_node => current_node % ptr
    endif
    nullify(current_node % ptr)

  end subroutine lk_lst_new_node_std_string

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

  subroutine lk_lst_to_array_std_string(head_node, array, dim_array)

!# Convert linked list `head_node` to the 1D array `array` and destroy the linked list.
!# If not provided, the size of the array, `dim_array` is computed from the linked list.

    implicit none
    type(lk_lst_std_string) :: head_node
    character(len=*), dimension(:), pointer :: array
    integer, intent(in), optional :: dim_array
!#......................................................................
    integer :: dim_array_eff, i
    type(lk_lst_std_string), pointer :: current_node, next_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (present(dim_array)) then
       dim_array_eff = dim_array
    else
       dim_array_eff = 0
       current_node => head_node % ptr
       do
          if (.not.associated(current_node)) exit
          dim_array_eff = dim_array_eff + 1
          current_node => current_node % ptr
       enddo
    endif

    if (associated(array)) deallocate(array)
    allocate(array(dim_array_eff))

    current_node => head_node % ptr
    do i = 1, dim_array_eff
       if (.not.associated(current_node)) then
          write(*,"(a)") "The length of the linked list is larger than &
               &the size of the array into which it is converted. Stopped."
          stop
       endif
       next_node => current_node % ptr
       array(i) = current_node % val
       deallocate(current_node)
       current_node => next_node
    enddo

    nullify(head_node % ptr)

  end subroutine lk_lst_to_array_std_string

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

  subroutine lk_lst_destroy_long_string(head_node)

    implicit none
    type(lk_lst_long_string), intent(inout) :: head_node
!#......................................................................
    type(lk_lst_long_string), pointer :: current_node, next_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete linked list, if already existing.
    current_node => head_node % ptr
    do
       if (.not.associated(current_node)) exit
       next_node => current_node % ptr
       deallocate(current_node)
       current_node => next_node
    enddo

  end subroutine lk_lst_destroy_long_string

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

  subroutine lk_lst_initialize_long_string(head_node)

    implicit none
    type(lk_lst_long_string), intent(inout) :: head_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

!# Delete linked list, if already existing.
    call lk_lst_destroy_long_string(head_node)

!# Set the head of the linked list.
    nullify(head_node % ptr)

  end subroutine lk_lst_initialize_long_string

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

  subroutine lk_lst_new_node_long_string(head_node, current_node)

    implicit none
    type(lk_lst_long_string), intent(inout) :: head_node
    type(lk_lst_long_string), pointer :: current_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (.not.associated(head_node % ptr)) then
       allocate(head_node % ptr)
       current_node => head_node % ptr
    else
       allocate(current_node % ptr)
       current_node => current_node % ptr
    endif
    nullify(current_node % ptr)

  end subroutine lk_lst_new_node_long_string

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

  subroutine lk_lst_to_array_long_string(head_node, array, dim_array)

!# Convert linked list `head_node` to the 1D array `array` and destroy the linked list.
!# If not provided, the size of the array, `dim_array` is computed from the linked list.

    implicit none
    type(lk_lst_long_string) :: head_node
    character(len=*), dimension(:), pointer :: array
    integer, intent(in), optional :: dim_array
!#......................................................................
    integer :: dim_array_eff, i
    type(lk_lst_long_string), pointer :: current_node, next_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (present(dim_array)) then
       dim_array_eff = dim_array
    else
       dim_array_eff = 0
       current_node => head_node % ptr
       do
          if (.not.associated(current_node)) exit
          dim_array_eff = dim_array_eff + 1
          current_node => current_node % ptr
       enddo
    endif

    if (associated(array)) deallocate(array)
    allocate(array(dim_array_eff))

    current_node => head_node % ptr
    do i = 1, dim_array_eff
       if (.not.associated(current_node)) then
          write(*,"(a)") "The length of the linked list is larger than &
               &the size of the array into which it is converted. Stopped."
          stop
       endif
       next_node => current_node % ptr
       array(i) = current_node % val
       deallocate(current_node)
       current_node => next_node
    enddo

    nullify(head_node % ptr)

  end subroutine lk_lst_to_array_long_string

end module mod_linked_list
