!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetemplate_list
  use cubetools_parameters
  use cubetools_list
  use cubetools_structure
  use cubetemplate_messaging
  !---------------------------------------------------------------------
  ! This template shows how to use the generic list types available in
  !   cube/lib/core/tools/type-list.f90
  ! Such lists rely on 3 types:
  !   1) tools_object_t:
  !      all objects you want to reference in the list must be extended
  !      from this type. This type is completely empty, you can do
  !      nothing with it except extending for your use case.
  !   2) tools_object_p_t:
  !      pointer to a class(tools_object_t). The main goal of this
  !      object is that it is much more efficient to deal with a list
  !      of pointers (in particular to increase the size of the list
  !      below). It provides 3 important methods:
  !        p%allocate(model,error): allocate a new object based on the
  !                                 model passed as argument. The model
  !                                 is a dummy object of the type to be
  !                                 stored.
  !        p%associate(target,error): same as allocate but the object is
  !                                   already allocated on your side, you
  !                                   just want to associate the pointer
  !                                   to the given target.
  !        p%nullify(error): nullify the pointer, performing the proper
  !                          cleaning, in particular deallocating the
  !                          object if it was allocated.
  !   3) tools_list_t:
  !      the list of objects, more precisely list of pointers to objects
  !      of class(tools_object_t). Its basic contents are:
  !        type(tools_list_t) :: a
  !          a%n:         number of useful components in the list
  !          a%list(i)    the i-th tools_object_p_t
  !          a%list(i)%p: pointer to the i-th object of class(tools_object_t)
  !      Note that the list can store pointers to differents types,
  !      this is possible as long as they are all of
  !      class(tools_object_t). The tools_list_t also provides public
  !      methods shown in this template.
  !      You can extend the tools_list_t if you want more features, e.g.
  !      to add an additional descriptive array of the same size of the
  !      list.
  !
  ! All in all, main pros and cons are:
  !  - pros: we have a generic list type which factorizes features and
  !          methods like (re)allocation/deallocation, dealing with
  !          allocated or associated targets.
  !  - cons: the drawback is that we deal with generic objects of class
  !          tools_object_t. We can not do anything with these, we have
  !          to get the pointer to the actual type to work on it.
  !---------------------------------------------------------------------
  !
  public :: list
  private
  !
  ! --- Data-related types ---
  !
  ! A custom object with just a name:
  type, extends(tools_object_t) :: template_object_t
    character(len=16) :: name=''
  contains
    procedure, private :: dump => cubetemplate_object_dump
  end type template_object_t
  !
  ! A custom list with custom methods. Extending the basic type or not
  ! depends if you need extra features.
  type, extends(tools_list_t) :: template_list_t
  contains
    procedure, private :: dump => cubetemplate_list_dump
  end type template_list_t
  !
  ! A list of objects; in this example this list has a permanent life
  ! and is hosted in the current module.
  type(template_list_t) :: collection
  !
  ! --- Command-related types ---
  type :: list_comm_t
    type(option_t), pointer :: comm
    type(option_t), pointer :: allocate
    type(option_t), pointer :: associate
    type(option_t), pointer :: free
  contains
    procedure, public  :: register => cubetemplate_list_comm_register
    procedure, private :: parse    => cubetemplate_list_comm_parse
    procedure, private :: main     => cubetemplate_list_comm_main
  end type list_comm_t
  type(list_comm_t) :: list
  !
  type :: list_user_t
    logical :: doallocate
    logical :: doassociate
    logical :: dofree
  contains
    procedure, private :: toprog => cubetemplate_list_user_toprog
  end type list_user_t
  !
  type :: list_prog_t
    logical :: doallocate
    logical :: doassociate
    logical :: dofree
  contains
    procedure, private :: act       => cubetemplate_list_prog_act
    procedure, private :: allocate  => cubetemplate_list_prog_allocate
    procedure, private :: associate => cubetemplate_list_prog_associate
    procedure, private :: free      => cubetemplate_list_prog_free
  end type list_prog_t
  !
contains
  !
  subroutine cubetemplate_list_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(list_user_t) :: user
    character(len=*), parameter :: rname='LIST>COMMAND'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call list%parse(line,user,error)
    if (error) return
    call list%main(user,error)
    if (error) continue
  end subroutine cubetemplate_list_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetemplate_list_comm_register(comm,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(list_comm_t), intent(inout) :: comm
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='LIST>COMM>REGISTER'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    ! Syntax
    call cubetools_register_command(  &
         'LIST','',  &
         'Test of the Fortran list type',  &
         'Without option, dump the current list contents. A typical session&
         & could be:'//strg_cr//                                    &
         '  t\list            ! Empty at first'        //strg_cr//  &
         '  t\list /allocate  ! Allocate  a 1st object'//strg_cr//  &
         '  t\list /allocate  ! Allocate  a 2nd object'//strg_cr//  &
         '  t\list /associate ! Associate a 3rd object'//strg_cr//  &
         '  t\list /allocate  ! Allocate  a 4th object'//strg_cr//  &
         '  t\list            ! Dump the contents'     //strg_cr//  &
         '  t\list /free      ! Free the list'         //strg_cr//  &
         '  t\list            ! Empty at last',  &
         cubetemplate_list_command,  &
         comm%comm,  &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'ALLOCATE','',&
         'Allocate a new object in the list',&
         strg_id,&
         comm%allocate,error)
    if (error) return
    !
    call cubetools_register_option(&
         'ASSOCIATE','',&
         'Associate a new object in the list',&
         strg_id,&
         comm%associate,error)
    if (error) return
    !
    call cubetools_register_option(&
         'FREE','',&
         'Free the allocated targets and the list itself',&
         strg_id,&
         comm%free,error)
    if (error) return
  end subroutine cubetemplate_list_comm_register
  !
  subroutine cubetemplate_list_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! LIST
    !  /ALLOCATE
    !  /ASSOCIATE
    !  /FREE
    !----------------------------------------------------------------------
    class(list_comm_t), intent(in)    :: comm
    character(len=*),   intent(in)    :: line
    type(list_user_t),  intent(out)   :: user
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='LIST>COMM>PARSE'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    ! ZZZ the options are exclusive
    call comm%allocate%present(line,user%doallocate,error)
    if (error)  return
    call comm%associate%present(line,user%doassociate,error)
    if (error)  return
    call comm%free%present(line,user%dofree,error)
    if (error)  return
  end subroutine cubetemplate_list_comm_parse
  !
  subroutine cubetemplate_list_comm_main(comm,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(list_comm_t), intent(in)    :: comm
    type(list_user_t),  intent(inout) :: user
    logical,            intent(inout) :: error
    !
    type(list_prog_t) :: prog
    character(len=*), parameter :: rname='LIST>MAIN'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call user%toprog(comm,prog,error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%act(error)
    if (error) continue
    call cubeadm_timing_process2postpro()
  end subroutine cubetemplate_list_comm_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetemplate_list_user_toprog(user,comm,prog,error)
    use cubeadm_get
    !--------------------------------------------------------------------
    !
    !--------------------------------------------------------------------
    class(list_user_t), intent(in)    :: user
    type(list_comm_t),  intent(in)    :: comm
    type(list_prog_t),  intent(out)   :: prog
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='LIST>USER>TOPROG'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    prog%doallocate  = user%doallocate
    prog%doassociate = user%doassociate
    prog%dofree      = user%dofree
  end subroutine cubetemplate_list_user_toprog
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetemplate_list_prog_act(prog,error)
    !-------------------------------------------------------------------
    ! Actual work
    !-------------------------------------------------------------------
    class(list_prog_t), intent(in)    :: prog
    logical,            intent(inout) :: error
    !
    if (prog%doallocate) then
      ! Add a new allocated object
      call prog%allocate(collection,error)
      if (error)  return
    elseif (prog%doassociate) then
      ! Add a new associated object
      call prog%associate(collection,error)
      if (error)  return
    elseif (prog%dofree) then
      ! Free the list
      call prog%free(collection,error)
      if (error)  return
    else
      ! Default: dump the list
      call collection%dump(error)
      if (error)  return
    endif
  end subroutine cubetemplate_list_prog_act
  !
  subroutine cubetemplate_list_prog_allocate(prog,list,error)
    !-------------------------------------------------------------------
    ! Allocate a new object in the list and fill it with some value.
    ! Main advantage: I do not have to deal with the allocation of the
    ! object and save it in a way or another; the number of allocations
    ! is virtually unlimited.
    !-------------------------------------------------------------------
    class(list_prog_t),    intent(in)    :: prog
    type(template_list_t), intent(inout) :: list
    logical,               intent(inout) :: error
    !
    integer(kind=list_k) :: inew
    type(template_object_t) :: model  ! Just a dummy model (template) for the Fortran allocation
    type(template_object_t), pointer :: obj  ! Pointer to the actual object
    character(len=*), parameter :: rname='LIST>PROG>ALLOCATE'
    !
    ! First enlarge the list
    inew = list%n+1
    call list%realloc(inew,error)  ! list%n (number of used components) is
                                   ! not modified at this stage
    if (error)  return
    !
    ! Then allocate a new object in the list according to the desired type (model)
    call list%list(inew)%allocate(model,error)
    if (error)  return
    list%n = inew  ! The object is now allocated: update list%n
    !
    ! Fetch pointer to the allocated object
    obj => cubetemplate_object_ptr(list%list(inew)%p,error)
    if (error)  return
    !
    ! Work with the object
    write(obj%name,'(a,i0,a)') '#',inew,' allocated'
  end subroutine cubetemplate_list_prog_allocate
  !
  subroutine cubetemplate_list_prog_associate(prog,list,error)
    !-------------------------------------------------------------------
    ! Associate a new object in the list and fill it with some value.
    ! Main advantage: I directly have the object at hand to work on it.
    ! But: I have to deal by myself with the life of my objects.
    !-------------------------------------------------------------------
    class(list_prog_t),    intent(in)    :: prog
    type(template_list_t), intent(inout) :: list
    logical,               intent(inout) :: error
    !
    type(template_object_t), save :: myobject
    integer(kind=list_k) :: inew
    character(len=*), parameter :: rname='LIST>PROG>ASSOCIATE'
    !
    ! For this example, I have only one target object available (note the
    ! SAVE attribute). In a real use-case, you would have to ensure that
    ! each target exists as long as the list references it.
    if (index(myobject%name,'associated').ne.0) then
      call cubetemplate_message(seve%e,rname,  &
        'This example can not associate more than 1 object in list')
      error = .true.
      return
    endif
    !
    ! First enlarge the list
    inew = list%n+1
    call list%realloc(inew,error)  ! list%n (number of used components) is
                                   ! not modified at this stage
    if (error)  return
    !
    ! Then associate my object in the list
    call list%list(inew)%associate(myobject,error)
    if (error)  return
    list%n = inew  ! The object is now associated: update list%n
    !
    ! Work with the object
    write(myobject%name,'(a,i0,a)') '#',inew,' associated'
  end subroutine cubetemplate_list_prog_associate
  !
  subroutine cubetemplate_list_prog_free(prog,list,error)
    !-------------------------------------------------------------------
    ! Free the list. Main actions:
    !  - free the objects allocated in the list, if any.
    !  - nullify the associated pointers to target objects, if any.
    !    Obviously the targets are not modified.
    !  - free the list array itself.
    !-------------------------------------------------------------------
    class(list_prog_t),    intent(in)    :: prog
    type(template_list_t), intent(inout) :: list
    logical,               intent(inout) :: error
    !
    call list%free(error)
    if (error)  return
  end subroutine cubetemplate_list_prog_free
  !
  !---------------------------------------------------------------------
  !
  subroutine cubetemplate_list_dump(list,error)
    !-------------------------------------------------------------------
    ! Dump the whole list
    !-------------------------------------------------------------------
    class(template_list_t), intent(in)    :: list
    logical,                intent(inout) :: error
    !
    integer(kind=list_k) :: i
    type(template_object_t), pointer :: obj
    !
    print *,list%n,' elements in list'
    do i=1,list%n
      obj => cubetemplate_object_ptr(list%list(i)%p,error)
      if (error)  return
      call obj%dump(error)
      if (error)  return
    enddo
  end subroutine cubetemplate_list_dump
  !
  !---------------------------------------------------------------------
  !
  function cubetemplate_object_ptr(obj,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(template_object_t), and return
    ! a pointer to it if relevant.
    !-------------------------------------------------------------------
    type(template_object_t), pointer :: cubetemplate_object_ptr
    class(tools_object_t),   pointer       :: obj
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='OBJECT>PTR'
    !
    select type(obj)
    type is (template_object_t)
      cubetemplate_object_ptr => obj
    class default
      cubetemplate_object_ptr => null()
      call cubetemplate_message(seve%e,rname,  &
        'Internal error: object is not a template_object_t type')
      error = .true.
      return
    end select
  end function cubetemplate_object_ptr
  !
  subroutine cubetemplate_object_dump(obj,error)
    !-------------------------------------------------------------------
    ! Dump one object
    !-------------------------------------------------------------------
    class(template_object_t), intent(in)    :: obj
    logical,                  intent(inout) :: error
    !
    print *,'Name: ',obj%name
  end subroutine cubetemplate_object_dump
  !
end module cubetemplate_list
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
