!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefield_pixprop_types
  use cubetools_parameters
  use cubefield_messaging
  !
  public :: pixcoor_t,pixprop_t
  private
  !
  type pixcoor_t
     real(kind=coor_k) :: x = 0.0
     real(kind=coor_k) :: y = 0.0
  end type pixcoor_t
  !
  type :: pixprop_t
     integer(kind=pixe_k), public :: ix = 0
     integer(kind=pixe_k), public :: iy = 0
   contains
     generic,   public  :: list       => list_short,list_long
     procedure, private :: list_short => pixprop_list_short
     procedure, private :: list_long  => pixprop_list_long
  end type pixprop_t
  !
contains
  !
  subroutine pixprop_list_short(pix,error)
    !------------------------------------------------------------------
    !
    !------------------------------------------------------------------
    class(pixprop_t), intent(in)    :: pix
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='PIXPROP>LIST>SHORT'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    print *,pix%ix,pix%iy
  end subroutine pixprop_list_short
  !
  subroutine pixprop_list_long(pix,name,image,error)
    use phys_const
    use cubeadm_image_types
    !------------------------------------------------------------------
    !
    !------------------------------------------------------------------
    class(pixprop_t), intent(in)    :: pix
    character(len=*), intent(in)    :: name
    type(image_t),    intent(in)    :: image
    logical,          intent(inout) :: error
    !
    real(kind=coor_k) :: x,y
    character(len=*), parameter :: rname='PIXPROP>LIST>LONG'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call image%x%pixel2offset(pix%ix,x,error)
    if (error) return
    call image%y%pixel2offset(pix%iy,y,error)
    if (error) return
    print *,trim(name),pix%ix,x*sec_per_rad,pix%iy,y*sec_per_rad
  end subroutine pixprop_list_long
end module cubefield_pixprop_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefield_pixlist_types
  use cubetools_parameters
  use cubetools_array_types
  use cubeadm_image_types
  use cubefield_messaging
  use cubefield_pixprop_types
  !
  public :: pixlist_t
  private
  !
  type :: pixlist_t
     character(len=name_l),  private :: name = strg_unk               ! List name
     integer(kind=indx_k),   public  :: m = 0                         ! Allocated number of list items 
     integer(kind=indx_k),   public  :: n = 0                         ! Current   number of list items 
     type(pixprop_t),        public, pointer :: prop(:) => null()     ! List address
     integer(kind=code_k),   private :: pointeris = code_pointer_null ! Null, allocated, or associated?
     type(image_t), pointer, private :: image => null()               ! Associated image
     type(long_2d_t),        private :: ilist                         ! ilist(ix,iy)
   contains
     procedure, public :: init          => pixlist_init
     procedure, public :: enlarge       => pixlist_enlarge
     procedure, public :: reallocate    => pixlist_reallocate
     procedure, public :: free          => pixlist_free
     final             :: pixlist_final
     !
     procedure, public :: get_next_from           => pixlist_get_next_from
     procedure, public :: put_label_into_image    => pixlist_put_label_into_image
     procedure, public :: get_good_from_image     => pixlist_get_good_from_image
     procedure, public :: check_all_are_good      => pixlist_check_all_are_good
     procedure, public :: pixel_already_processed => pixlist_pixel_already_processed
     procedure, public :: mark_pixel_as_processed => pixlist_mark_pixel_as_processed
     procedure, public :: max                     => pixlist_max
     procedure, public :: list                    => pixlist_list
  end type pixlist_t
  !
contains
  !
  subroutine pixlist_init(list,name,image,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(pixlist_t), intent(out)   :: list
    character(len=*), intent(in)    :: name
    type(image_t),    intent(in)    :: image
    logical,          intent(inout) :: error
    !
    integer(kind=indx_k), parameter :: ninit = 128
    character(len=*), parameter :: rname='PIXLIST>INIT'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    if (list%pointeris.eq.code_pointer_null) then
       call list%reallocate(name,ninit,image,error)
       if (error) return
    else if (list%pointeris.ne.code_pointer_associated) then
       call cubefield_message(seve%e,rname,'Unallocated pointer => Can not use it for a growing list!')
       error = .true.
       return
    endif
    list%n = 0
  end subroutine pixlist_init
  !
  subroutine pixlist_enlarge(list,error)
    use gkernel_interfaces
    !------------------------------------------------------------------
    !
    !------------------------------------------------------------------
    class(pixlist_t), intent(inout) :: list
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: ier
    integer(kind=indx_k) :: mold,mnew
    type(pixprop_t), allocatable :: tmp(:)
    character(len=*), parameter :: rname='PIXLIST>ENLARGE'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    ! Sanity checks
    if (list%pointeris.ne.code_pointer_allocated) then
       call cubefield_message(seve%e,rname,'Unallocated pointer => Can not enlarge it!')
       error = .true.
       return
    endif
    mold = list%m
    mnew = 2*mold
    if (mold.le.0) then
       call cubefield_message(seve%e,rname,'Negative or zero number of list items => Can not enlarge it!')
       error = .true.
      return
    endif
    !
    allocate(tmp(mold),stat=ier)
    if (failed_allocate(rname,'tmp',ier,error)) return
    tmp(1:mold) = list%prop(1:mold)
    !
    if (associated(list%prop)) deallocate(list%prop)
    allocate(list%prop(mnew),stat=ier)
    if (failed_allocate(rname,trim(list%name)//' pixlist',ier,error)) return
    list%m = mnew
    !
    list%prop(1:mold) = tmp(1:mold)
  end subroutine pixlist_enlarge
  !
  subroutine pixlist_reallocate(list,name,m,image,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(pixlist_t),      intent(inout) :: list
    character(len=*),      intent(in)    :: name
    integer(kind=indx_k),  intent(in)    :: m
    type(image_t), target, intent(in)    :: image
    logical,               intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='PIXLIST>REALLOCATE'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (m.le.0) then
       call cubefield_message(seve%e,rname,'Negative or zero number of list items')
       error = .true.
      return
    endif
    !
    if (list%pointeris.eq.code_pointer_allocated) then
       ! The request is to get an allocated pointer
       if (list%m.eq.m) then
          write(mess,'(a,a,i0)')  &
               name,' pixlist already allocated at the right size: ',m
          call cubefield_message(fieldseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',name,  &
               ' pixlist already allocated but with a different size => Freeing it first'
          call cubefield_message(fieldseve%alloc,rname,mess)
          call pixlist_free(list)
          alloc = .true.
       endif
    else
       ! list%prop is either null or associated => need to allocate it anyway
       alloc = .true.
    endif
    if (alloc) then
       allocate(list%prop(m),stat=ier)
       if (failed_allocate(rname,trim(name)//' pixlist',ier,error)) return
    endif
    ! Allocation success => list%pointeris may be updated
    list%pointeris = code_pointer_allocated
    list%m = m
    list%n = m
    ! Complete with image related array
    list%image => image
    call list%ilist%reallocate(trim(name)//' ilist',image%nx,image%ny,error)
    if (error) return
  end subroutine pixlist_reallocate
  !
  subroutine pixlist_prepare_association(list,name,m,error)
    !----------------------------------------------------------------------
    ! Prepare for the next reassociation
    !----------------------------------------------------------------------
    class(pixlist_t),     intent(inout) :: list
    character(len=*),     intent(in)    :: name
    integer(kind=indx_k), intent(in)    :: m
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='PIXLIST>PREPARE>ASSOCIATION'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (m.le.0) then
       call cubefield_message(seve%e,rname,'Negative or zero number of pixels')
       error = .true.
      return
    endif
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call list%free()
    ! Association success => list%code_pointer may be updated
    list%name = name
    list%m = m
    list%n = m
    list%pointeris = code_pointer_null
  end subroutine pixlist_prepare_association
  !
  subroutine pixlist_free(list)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(pixlist_t), intent(inout) :: list
    !
    character(len=*), parameter :: rname='PIXLIST>FREE'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    if (list%pointeris.eq.code_pointer_allocated) then
       if (associated(list%prop)) deallocate(list%prop)
    else
       list%prop => null()
    endif
    list%name = strg_unk
    list%m = 0
    list%n = 0
    list%pointeris = code_pointer_null
    list%image => null()
  end subroutine pixlist_free
  !
  subroutine pixlist_final(list)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(pixlist_t), intent(inout) :: list
    !
    call pixlist_free(list)
  end subroutine pixlist_final
  !
  !------------------------------------------------------------------------
  !
  subroutine pixlist_get_next_from(list,prop,error)
    !------------------------------------------------------------------
    !
    !------------------------------------------------------------------
    class(pixlist_t), intent(inout) :: list
    type(pixprop_t),  intent(in)    :: prop
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='PIXLIST>GET>NEXT>FROM'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    list%n = list%n+1
    if (list%n.gt.list%m) then
       call list%enlarge(error)
       if (error) return
    endif
    list%prop(list%n) = prop
  end subroutine pixlist_get_next_from
  !
  subroutine pixlist_get_good_from_image(list,image,error)
    use cubetools_nan
    !---------------------------------------------------------------------
    ! Go from a 2D image to a 1D list of good pixels
    !---------------------------------------------------------------------
    class(pixlist_t), intent(inout) :: list
    type(image_t),    intent(in)    :: image
    logical,          intent(inout) :: error
    !
    integer(kind=pixe_k) :: ix,iy
    integer(kind=indx_k) :: ngood,ilist
    character(len=*), parameter :: rname='PIXLIST>GET>GOOD>FROM>IMAGE'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call image%ngood(ngood,error)
    if (error) return
    call list%reallocate('good pixel',ngood,image,error)
    if (error) return
    call list%ilist%set(0_8,error)
    if (error) return
    !
    ilist = 0
    do iy=1,image%ny
       do ix=1,image%nx
          if (isnan(image%val(ix,iy))) cycle
          ilist = ilist+1
          if (ilist.le.list%n) then
             list%prop(ilist)%ix = ix
             list%prop(ilist)%iy = iy
             list%ilist%val(ix,iy) = ilist
          else
             call cubefield_message(seve%e,rname,'Internal error: ilist > list%n')
             print *,ilist,list%n
             error = .true.
             return
          endif
       enddo ! ix
    enddo ! iy
    ! Sanity check
    if (ilist.ne.list%n) then
       call cubefield_message(seve%e,rname,'Internal error: ilist /= list%n')
       print *,ilist,list%n
       error = .true.
       return
    endif
  end subroutine pixlist_get_good_from_image
  !
  subroutine pixlist_put_label_into_image(list,label,image,error)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(pixlist_t), target, intent(in)    :: list
    real(kind=sign_k),        intent(in)    :: label
    type(image_t),            intent(inout) :: image
    logical,                  intent(inout) :: error
    !
    integer(kind=indx_k) :: ilist
    integer(kind=pixe_k), pointer :: ix,iy
    character(len=*), parameter :: rname='PIXLIST>PUT>LABEL>INTO>IMAGE'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    do ilist=1,list%n
       ix => list%prop(ilist)%ix
       iy => list%prop(ilist)%iy
       if (image%contain(ix,iy)) then
          image%val(ix,iy) = label
       else
          call cubefield_message(seve%e,rname,'Pixel outside image!')
          call list%prop(ilist)%list(error)
          error = .true.
          return
       endif
    enddo ! ilist
  end subroutine pixlist_put_label_into_image
  !
  subroutine pixlist_check_all_are_good(list,error)
    use cubetools_nan
    !---------------------------------------------------------------------
    ! Sanity check to debug!
    !---------------------------------------------------------------------
    class(pixlist_t), intent(in)    :: list
    logical,          intent(inout) :: error
    !
    integer(kind=indx_k) :: ilist
    integer(kind=pixe_k), pointer :: ix,iy
    real(kind=sign_k), pointer :: val
    character(len=*), parameter :: rname='PIXLIST>CHECK>ALL>ARE>GOOD'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    do ilist=1,list%n
       ix => list%prop(ilist)%ix
       iy => list%prop(ilist)%iy
       val => list%image%val(ix,iy)
       if (isnan(val)) then
          print *,"Inconsitent pixel list at: ",ilist,list%n,list%m,ix,iy,val
          error = .true.
          return
       endif
    enddo ! ilist
  end subroutine pixlist_check_all_are_good
  !
  subroutine pixlist_mark_pixel_as_processed(list,pix,error)
    !---------------------------------------------------------------------
    ! Replace the item associated with pixel (ix,iy) by the last one,
    ! update the associated ilist backpointer, and decrease the number of items
    ! by one. Updating the image associated to the list is *not* part of
    ! the job of this subroutine!
    !---------------------------------------------------------------------
    class(pixlist_t), intent(inout) :: list
    type(pixprop_t),  intent(in)    :: pix
    logical,          intent(inout) :: error
    !
    integer(kind=indx_k), pointer :: ilist
    character(len=*), parameter :: rname='PIXLIST>MARK>PIXEL>AS>PROCESSED'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    ilist => list%ilist%val(pix%ix,pix%iy)
    if (ilist.le.list%n) then
       ! Replacement by last list item required
       list%prop(ilist)%ix = list%prop(list%n)%ix
       list%prop(ilist)%iy = list%prop(list%n)%iy
       list%ilist%val(list%prop(ilist)%ix,list%prop(ilist)%iy) = ilist
       ! Remove pixel from active part of list
       list%prop(list%n)%ix = pix%ix
       list%prop(list%n)%iy = pix%iy
       list%ilist%val(pix%ix,pix%iy) = list%n
       list%n = list%n-1
    endif
  end subroutine pixlist_mark_pixel_as_processed
  !
  function pixlist_pixel_already_processed(list,pix) result(processed)
    !---------------------------------------------------------------------
    !---------------------------------------------------------------------
    class(pixlist_t), intent(in) :: list
    type(pixprop_t),  intent(in) :: pix
    logical                      :: processed ! intent(out)
    !
    character(len=*), parameter :: rname='PIXLIST>PIXEL>ALREADY>PROCESSED'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    processed = list%ilist%val(pix%ix,pix%iy).gt.list%n    
  end function pixlist_pixel_already_processed
  !
  subroutine pixlist_max(list,ixmax,iymax,valmax,found)
    !---------------------------------------------------------------------
    ! Find position of image maximum in the list of selected pixels
    !---------------------------------------------------------------------
    class(pixlist_t),     intent(in)  :: list
    integer(kind=pixe_k), intent(out) :: ixmax
    integer(kind=pixe_k), intent(out) :: iymax
    real(kind=sign_k),    intent(out) :: valmax
    logical,              intent(out) :: found
    !
    integer(kind=indx_k) :: ilist,ilistmax
    real(kind=sign_k), pointer :: val
    character(len=*), parameter :: rname='PIXLIST>MAX'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    valmax = -huge(valmax)
    do ilist=1,list%n
       val => list%image%val(list%prop(ilist)%ix,list%prop(ilist)%iy)
       if (val.gt.valmax) then
          valmax = val
          ilistmax = ilist
          endif
    enddo ! ilist
    found = valmax.ne.-huge(valmax)
    if (found) then
       ixmax = list%prop(ilistmax)%ix
       iymax = list%prop(ilistmax)%iy
    else
       ixmax = 0
       iymax = 0
    endif
  end subroutine pixlist_max
  !
  subroutine pixlist_list(list,error)
    !------------------------------------------------------------------
    !
    !------------------------------------------------------------------
    class(pixlist_t), intent(inout) :: list
    logical,          intent(inout) :: error
    !
    integer(kind=indx_k) :: ilist
    character(len=mess_l) :: name
    character(len=*), parameter :: rname='PIXLIST>LIST'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    do ilist=1,list%n
       write(name,'(i0)') ilist
       call list%prop(ilist)%list(name,list%image,error)
       if (error) return
    enddo ! ipix
  end subroutine pixlist_list
end module cubefield_pixlist_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefield_pixel_types
  use cubefield_pixprop_types
  use cubefield_pixlist_types
  !
  public :: pixcoor_t,pixprop_t,pixlist_t
  private
end module cubefield_pixel_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
