!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module mapping_list_tool
  use gbl_message
  use gbl_format
  use gkernel_types
  use gkernel_interfaces
  use mapping_interfaces, only : map_message
  !
  public :: get_i4list_fromsic
  public :: get_r4list_fromsic
  private
  !
contains
  !
  subroutine get_i4list_fromsic(rname,line,opt,nf,list,error)
    !------------------------------------------------------------------------
    ! Return in the allocatable array the content of the 1-D
    ! SIC variable given as argument of Option # opt.
    ! Return the size of the array in NF
    ! If NF is non zero on entry, the size must match and the
    ! array is pre-allocated.
    !------------------------------------------------------------------------
    character(len=*),     intent(in)    :: rname
    character(len=*),     intent(in)    :: line
    integer,              intent(in)    :: opt
    integer,              intent(inout) :: nf
    integer, allocatable, intent(inout) :: list(:)
    logical,              intent(inout) :: error
    !
    logical :: found
    integer :: na,ier
    integer(kind=address_length) :: jpd
    integer, save :: memory(2)
    character(len=64) :: listname
    type(sic_descriptor_t) :: desc
    !
    call sic_ch(line,opt,1,listname,na,.true.,error)
    if (error) return
    call sic_descriptor(listname,desc,found)
    if (.not.found) then
       call sic_i4(line,opt,1,na,.true.,error)
       if (error) then
          call map_message(seve%e,rname,'Variable '//trim(listname)//' does not exists.')
          return 
       endif
       if (nf.eq.0) then
          nf = 1
          allocate(list(nf),stat=ier)
       else if (nf.ne.1) then
          call map_message(seve%e,rname,'Number of elements mismatch in List')
          error = .true.
       else if (.not.allocated(list)) then
          call map_message(seve%e,rname,'List is not allocated')
          error = .true.
       endif
       if (error) return
       list(1:nf) = na
       return
    else if (desc%type.ne.fmt_i4) then
       call map_message(seve%e,rname,'Variable '//trim(listname)//' must be Integer ')
       error = .true.
       return
    endif
    if (desc%ndim.ne.1) then
       call map_message(seve%e,rname,'Variable '//trim(listname)//' must have rank 1')
       error = .true.
       return
    endif
    if (nf.eq.0) then
       nf = desc%dims(1)
       allocate(list(nf),stat=ier)
    else if (nf.ne.desc%dims(1)) then
       call map_message(seve%e,rname,'Number of elements mismatch in List')
       error = .true.
    else if (.not.allocated(list)) then
       call map_message(seve%e,rname,'List is not allocated')
       error = .true.
    endif
    if (error) return
    !
    jpd = gag_pointer(desc%addr,memory)
    call i4toi4(memory(jpd),list,nf)
  end subroutine get_i4list_fromsic
  !
  subroutine get_r4list_fromsic(rname,line,opt,nf,list,error)
    !------------------------------------------------------------------------
    ! Return in the allocatable array the content of the 1-D
    ! SIC variable given as argument of Option # opt.
    ! Return the size of the array in NF
    ! If NF is non zero on entry, the size must match and the
    ! array is pre-allocated.
    !------------------------------------------------------------------------
    character(len=*),  intent(in)    :: rname
    character(len=*),  intent(in)    :: line
    integer,           intent(in)    :: opt
    integer,           intent(inout) :: nf
    real, allocatable, intent(inout) :: list(:)
    logical,           intent(inout) :: error
    !
    logical :: found
    integer :: na,ier
    integer(kind=address_length) :: jpd
    integer, save :: memory(2)
    type(sic_descriptor_t) :: desc
    character(len=64) :: listname
    !
    call sic_ch(line,opt,1,listname,na,.true.,error)
    if (error) return
    call sic_descriptor(listname,desc,found)
    if (.not.found) then
       call sic_i4(line,opt,1,na,.true.,error)
       if (error) then
          call map_message(seve%e,rname,'Variable '//trim(listname)//' does not exists.')
          return 
       endif
       if (nf.eq.0) then
          nf = 1
          allocate(list(nf),stat=ier)
       else if (nf.ne.1) then
          call map_message(seve%e,rname,'Number of elements mismatch in List')
          error = .true.
       else if (.not.allocated(list)) then
          call map_message(seve%e,rname,'List is not allocated')
          error = .true.
       endif
       if (error) return
       list(1:nf) = na
       return
    else if (desc%type.ne.fmt_i4) then
       call map_message(seve%e,rname,'Variable '//trim(listname)//' must be Integer ')
       error = .true.
       return
    endif
    if (desc%ndim.ne.1) then
       call map_message(seve%e,rname,'Variable '//trim(listname)//' must have rank 1')
       error = .true.
       return
    endif
    if (nf.eq.0) then
       nf = desc%dims(1)
       allocate(list(nf),stat=ier)
    else if (nf.ne.desc%dims(1)) then
       call map_message(seve%e,rname,'Number of elements mismatch in List')
       error = .true.
    else if (.not.allocated(list)) then
       call map_message(seve%e,rname,'List is not allocated')
       error = .true.
    endif
    if (error) return
    !
    jpd = gag_pointer(desc%addr,memory)
    call r4tor4(memory(jpd),list,nf)
  end subroutine get_r4list_fromsic
end module mapping_list_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
