!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_labelling_tools
  use cubemain_messaging
  !
  public :: cubemain_labelling
  private
  !
  type label_list_t
     integer(kind=data_k)              :: n = 0
     integer(kind=data_k), allocatable :: list(:)
   contains
     procedure, private :: newlabel     => cubemain_label_list_newlabel
     procedure, private :: merge1label  => cubemain_label_list_merge_1_label
     procedure, private :: merge2labels => cubemain_label_list_merge_2_labels
     procedure, private :: merge3labels => cubemain_label_list_merge_3_labels
     procedure, private :: compress     => cubemain_label_list_compress
  end type label_list_t
  !
contains
  !
  function cubemain_label_list_newlabel(label,error) result(newlabel)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Add a new label to the list. Increase list size when needed.
    !----------------------------------------------------------------------
    class(label_list_t), intent(inout) :: label
    logical,             intent(inout) :: error
    integer(kind=data_k)               :: newlabel
    !
    integer(kind=4) :: ier
    integer(kind=data_k) :: nl,ntmp
    integer(kind=data_k), allocatable :: tmp(:)
    character(len=message_length) :: mess
    character(len=*), parameter :: rname='LABEL>LIST>INCREMENT'
    !
    if (allocated(label%list)) then
       nl = ubound(label%list,1)
       if (nl.le.label%n) then
          write(mess,'(a,i0)') 'Double label%list size to ',2*nl
          call cubemain_message(mainseve%alloc,rname,mess)
          allocate(tmp(nl),stat=ier)
          if (failed_allocate(rname,'tmp',ier,error)) return
          ntmp = label%n
          tmp(:) = label%list(:)
          deallocate(label%list)
          allocate(label%list(2*nl),stat=ier)
          if (failed_allocate(rname,'label%list',ier,error)) return
          label%list(1:nl) = tmp
          label%n = ntmp
       endif
    else
       write(mess,'(a,i0)') 'First allocation of label%list to 1024'
       call cubemain_message(mainseve%alloc,rname,mess)
       allocate(label%list(1024),stat=ier)
       if (failed_allocate(rname,'label%list',ier,error)) return
       label%n = 0
    endif
    label%n = label%n+1
    label%list(label%n) = label%n
    newlabel = label%n
  end function cubemain_label_list_newlabel
  !
  function cubemain_label_list_merge_1_label(label,labin) result(labmin)
    !----------------------------------------------------------------------
    ! Search for the minimum occurence of one label
    !----------------------------------------------------------------------
    class(label_list_t),  intent(inout) :: label
    integer(kind=data_k), intent(in)    :: labin
    integer(kind=data_k)                :: labmin
    !
    integer(kind=data_k) :: labcurr
    !
    labmin = labin
    do
       labcurr = label%list(labmin)
       if (labcurr.eq.labmin) return
       labmin = labcurr
    enddo
  end function cubemain_label_list_merge_1_label
  !
  function cubemain_label_list_merge_2_labels(label,lab1,lab2) result(labmin)
    !----------------------------------------------------------------------
    ! Labels of previous pixels one and two exist, are positive, but have
    ! different values => Merge them to their common minimum value
    !----------------------------------------------------------------------
    class(label_list_t),  intent(inout) :: label
    integer(kind=data_k), intent(in)    :: lab1
    integer(kind=data_k), intent(in)    :: lab2
    integer(kind=data_k)                :: labmin
    !
    integer(kind=data_k) :: lab1min,lab2min
    !
    lab1min = label%merge1label(lab1)
    lab2min = label%merge1label(lab2)
    labmin = min(lab1min,lab2min)
    label%list(lab1min) = labmin
    label%list(lab2min) = labmin
  end function cubemain_label_list_merge_2_labels
  !
  function cubemain_label_list_merge_3_labels(label,lab1,lab2,lab3) result(labmin)
    !----------------------------------------------------------------------
    ! Labels of previous pixels exist, are positive, but have
    ! different values => Merge them to their common minimum value
    !----------------------------------------------------------------------
    class(label_list_t),  intent(inout) :: label
    integer(kind=data_k), intent(in)    :: lab1
    integer(kind=data_k), intent(in)    :: lab2
    integer(kind=data_k), intent(in)    :: lab3
    integer(kind=data_k)                :: labmin
    !
    integer(kind=data_k) :: lab1min,lab2min,lab3min
    !
    lab1min = label%merge1label(lab1)
    lab2min = label%merge1label(lab2)
    lab3min = label%merge1label(lab3)
    labmin = min(lab1min,lab2min,lab3min)
    label%list(lab1min) = labmin
    label%list(lab2min) = labmin
    label%list(lab3min) = labmin
  end function cubemain_label_list_merge_3_labels
  !
  subroutine cubemain_label_list_compress(compressed,complete,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Make final list of labels
    !----------------------------------------------------------------------
    class(label_list_t), intent(inout) :: compressed
    type(label_list_t),  intent(inout) :: complete
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: ier
    integer(kind=data_k) :: il,minlab
    character(len=*), parameter :: rname='LABEL>LIST>COMPRESS'
    !
    allocate(compressed%list(complete%n),stat=ier)
    if (failed_allocate(rname,'compressed%list',ier,error)) return
    compressed%n = 0
    do il=1,complete%n
       minlab = complete%merge1label(il)
       if (il.eq.minlab) then
          compressed%n = compressed%n+1
          compressed%list(il) = compressed%n
       endif
    enddo ! il
  end subroutine cubemain_label_list_compress
  !   
  subroutine cubemain_labelling(cube,minval,labeled,nlabels,error)
    use gkernel_interfaces
    use cubetools_nan
    use cubemain_subcube_real
    !----------------------------------------------------------------------
    ! Labeling islands above a given threshold using a segmentation algorithm 
    !----------------------------------------------------------------------
    type(subcube_t),      intent(in)    :: cube
    real(kind=sign_k),    intent(in)    :: minval
    type(subcube_t),      intent(inout) :: labeled
    integer(kind=data_k), intent(out)   :: nlabels
    logical,              intent(inout) :: error
    !
    integer(kind=data_k) :: nx,ix
    integer(kind=data_k) :: ny,iy
    integer(kind=data_k) :: nz,iz
    integer(kind=data_k) :: xprevlab,yprevlab,zprevlab,xyzcurrlab
    type(label_list_t) :: currlist,finallist
    real(sign_k), parameter :: null = 0.0
    character(len=message_length) :: mess
    character(len=*), parameter :: rname='LABELLING'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    nx = cube%n1
    ny = cube%n2
    nz = cube%n3
    !
    xprevlab = 0
    yprevlab = 0
    zprevlab = 0
    do iz=1,nz
       do iy=1,ny
          do ix=1,nx
             if ((ieee_is_nan(cube%data(ix,iy,iz))).or.(cube%data(ix,iy,iz).lt.minval)) then
                ! Blanked value or under threshold => Easy case
                xyzcurrlab = null
             else
                ! Above threshold => Is the pixel contiguous to a previously labeled island?
                ! Start with the hypothesis that it is not
                xyzcurrlab = null
                if (ix.ne.1) then
                   ! Search for previous x label at constant (y,z) when it exists
                   xprevlab = labeled%data(ix-1,iy,iz)
                   if (xprevlab.ne.null) then
                      ! Previous x label exists and it is positive => Found our label!
                      xyzcurrlab = xprevlab
                   endif
                endif ! First ix?
                if (iy.ne.1) then
                   ! Search for previous y label at constant (x,z) when it exists
                   yprevlab = labeled%data(ix,iy-1,iz)
                   if (xprevlab.eq.null) then
                      if (yprevlab.ne.null) then
                         ! Previous x label is null valued but previous y label is positive => Found our label!
                         xyzcurrlab = yprevlab
                      endif
                   else
                      if (yprevlab.ne.null) then
                         if (yprevlab.ne.xprevlab) then
                            ! Previous x and y labels exist, are positive, but have different values
                            xyzcurrlab = currlist%merge2labels(xprevlab,yprevlab)
                         endif
                      else
                         ! Previous y label is null valued but previous x label exists and is positive => This case has already been handled above!
                      endif
                   endif ! Is x previous label positive?
                endif ! First iy?
                if (iz.ne.1) then
                   ! Search for previous z label at constant (x,y) when it exists
                   zprevlab = labeled%data(ix,iy,iz-1)
                   if (xprevlab.eq.null) then
                      if (yprevlab.eq.null) then
                         if (zprevlab.eq.null) then
                            ! Previous x, y, z labels are null valued => Increment label list!
                            xyzcurrlab = currlist%newlabel(error)
                            if (error) return
                         else
                            ! Previous x and y labels are null valued but previous z label is positive => Found our label!
                            xyzcurrlab = zprevlab
                         endif
                      else
                         if (zprevlab.ne.null) then
                            if (zprevlab.ne.yprevlab) then
                               ! Previous x label is null valued but previous z and y labels exist, are positive, but have different values
                               xyzcurrlab = currlist%merge2labels(yprevlab,zprevlab)
                            endif
                         else
                            ! Previous x and z labels are null valued but previous y label exists and is positive => This case has already been handled above!
                         endif
                      endif ! Is y previous label positive?
                   else
                      if (yprevlab.eq.null) then
                         if (zprevlab.ne.null) then
                            if (zprevlab.ne.xprevlab) then
                               ! Previous y label is null valued but previous z and x labels exist, are positive, but have different values
                               xyzcurrlab = currlist%merge2labels(xprevlab,zprevlab)
                            endif
                         else
                            ! Previous y and z labels are null valued but previous x label exists and is positive => This case has already been handled above!
                         endif
                      else
                         if (zprevlab.ne.null) then
                            if ((zprevlab.ne.xprevlab).or.(zprevlab.ne.yprevlab)) then
                               ! Previous x, y, and z labels exist, are positive, but have different values
                               xyzcurrlab = currlist%merge3labels(xprevlab,yprevlab,zprevlab)
                            endif
                         else
                            ! This case has already been handled above!
                         endif
                      endif
                   endif ! Is x previous label positive?
                endif ! First iz?
                if (xyzcurrlab.eq.null) then
                   ! This means that ix, iy, iz all equal to 1 => Initialization
                   xyzcurrlab = currlist%newlabel(error)
                   if (error) return
                endif
             endif ! Pixel to be labeled?
             labeled%data(ix,iy,iz) = xyzcurrlab
          enddo ! ix
       enddo ! iy
    enddo ! iz
    ! Create the final list by compression of the currlist
    call finallist%compress(currlist,error)
    if (error) return
    ! Reattribute labels using the final list
    do iz=1,nz
       do iy=1,ny
          do ix=1,nx
             if (ieee_is_nan(cube%data(ix,iy,iz))) then
                labeled%data(ix,iy,iz) = gr4nan
             else
                xyzcurrlab = labeled%data(ix,iy,iz)
                if (xyzcurrlab.eq.null) then
                   labeled%data(ix,iy,iz) = 1
                else
                   labeled%data(ix,iy,iz) = 1+finallist%list(currlist%merge1label(xyzcurrlab))
                endif
             endif
          enddo ! ix
       enddo ! iy
    enddo ! iz
    ! User feedback
    nlabels = finallist%n+1
    write(mess,'(a,i0,a)') 'Found ',nlabels,' segments'
    call cubemain_message(seve%r,rname,mess)
  end subroutine cubemain_labelling
end module cubemain_labelling_tools
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_label
  use cube_types
  use cubetools_structure
  use cubeadm_cubeid_types
  use cubemain_messaging
  !
  public :: label
  public :: cubemain_label_command
  private
  !
  type :: label_comm_t
     type(option_t), pointer :: comm
     type(option_t), pointer :: minsnr
   contains
     procedure, public  :: register => cubemain_label_register
     procedure, private :: parse    => cubemain_label_parse
     procedure, private :: main     => cubemain_label_main
  end type label_comm_t
  type(label_comm_t) :: label
  !
  integer(kind=4), parameter :: isnr = 1
  type label_user_t
     type(cubeid_user_t)   :: cubeids
     character(len=argu_l) :: minsnr
   contains
     procedure, private :: toprog => cubemain_label_user_toprog
  end type label_user_t
  !
  type label_prog_t
     real(kind=sign_k)     :: minsnr
     integer(kind=data_k)  :: nlabels
     type(cube_t), pointer :: snr
     type(cube_t), pointer :: labeled
   contains
     procedure, private :: header => cubemain_label_prog_header
     procedure, private :: data   => cubemain_label_prog_data
     procedure, private :: act    => cubemain_label_prog_act
     procedure, private :: write  => cubemain_label_prog_write_energy
  end type label_prog_t
  !
contains
  !
  subroutine cubemain_label_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(label_user_t) :: user
    character(len=*), parameter :: rname='LABEL>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call label%parse(line,user,error)
    if (error) return
    call label%main(user,error)
    if (error) continue
  end subroutine cubemain_label_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_label_register(label,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(label_comm_t), intent(inout) :: label
    logical,             intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: comm_abstract=&
         'Segment a cube into contiguous regions of decreasing SNR'
    character(len=*), parameter :: comm_help=&
         'This command requires that the input cube fits into the&
         &RAM memory of your computer.'
    character(len=*), parameter :: rname='LABEL>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'SEGMENT','[snrid]',&
         comm_abstract,&
         comm_help,&
         cubemain_label_command,&
         label%comm,error)
    if (error) return
    call cubearg%register(&
         'SNR',&
         'SNR cube', &
         strg_id,&
         code_arg_optional, &
         [flag_snr],&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'MINSNR','value',&
         'Minimum SNR value when segmenting the cube',&
         strg_id,&
         label%minsnr,error)
    if (error) return
    call stdarg%register(&
         'minsnr', &
         'Minimum SNR value',&
         'Default is 2.0',&
         code_arg_mandatory, error)
    if (error) return
  end subroutine cubemain_label_register
  !
  subroutine cubemain_label_parse(label,line,user,error)
    !----------------------------------------------------------------------
    ! LABEL cubeid [/MINSNR value]
    !----------------------------------------------------------------------
    class(label_comm_t), intent(in)    :: label
    character(len=*),    intent(in)    :: line
    type(label_user_t),  intent(out)   :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='LABEL>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,label%comm,user%cubeids,error)
    if (error) return
    call cubemain_label_parse_minsnr(line,label%minsnr,user%minsnr,error)
    if (error) return
  end subroutine cubemain_label_parse
  !
  subroutine cubemain_label_parse_minsnr(line,opt,user,error)
    !----------------------------------------------------------------------
    ! /MINSNR minsnr
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    type(option_t),   intent(in)    :: opt
    character(len=*), intent(out)   :: user
    logical,          intent(inout) :: error
    !
    logical :: present
    integer(kind=4), parameter :: iarg=1
    character(len=*), parameter :: rname='LABEL>PARSE>MINSNR'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call opt%present(line,present,error)
    if (error) return
    if (present) then
       call cubetools_getarg(line,opt,iarg,user,mandatory,error)
       if (error) return
    else
       user = strg_star
    endif
  end subroutine cubemain_label_parse_minsnr
  !
  subroutine cubemain_label_main(label,user,error)    
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(label_comm_t), intent(in)    :: label
    type(label_user_t),  intent(inout) :: user
    logical,             intent(inout) :: error
    !
    type(label_prog_t) :: prog
    character(len=*), parameter :: rname='LABEL>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(label,prog,error)
    if (error) return
    call prog%header(error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubemain_label_main
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_label_user_toprog(user,comm,prog,error)
    use cubetools_user2prog
    use cubetools_unit
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(label_user_t), intent(in)    :: user
    type(label_comm_t),  intent(in)    :: comm
    type(label_prog_t),  intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    type(unit_user_t) :: nounit
    real(kind=sign_k), parameter :: default=2.0
    character(len=*), parameter :: rname='LABEL>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_get_header(label%comm,isnr,user%cubeids,&
         code_access_fullset,code_read,prog%snr,error)
    if (error) return
    !
    call cubetools_unit_get(strg_star,code_unit_unk,nounit,error)
    if (error) return
    call cubetools_user2prog_resolve_star(user%minsnr,nounit,default,&
         prog%minsnr,error)
    if (error) return
  end subroutine cubemain_label_user_toprog
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_label_prog_header(prog,error)
    use cubedag_allflags
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(label_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='LABEL>PROG>HEADER'
    !
    call cubemain_message(seve%d,rname,'Welcome')
    !
    ! Labeled output cube
    call cubeadm_clone_header(prog%snr,flag_segments,prog%labeled,error)
    if (error) return
  end subroutine cubemain_label_prog_header
  !
  subroutine cubemain_label_prog_data(prog,error)
    use cubeadm_opened
    use cubeadm_entryloop
    use cubemain_subcube_real
    !----------------------------------------------------------------------
    ! For detailed explanations, see the command-fullcube.f90 file.
    !----------------------------------------------------------------------
    class(label_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    integer(kind=entr_k) :: isubcube
    type(cubeadm_iterator_t) :: iter
    type(subcube_iterator_t) :: siter
    type(subcube_t) :: snr,labeled
    character(len=*), parameter :: rname='LABEL>PROG>DATA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    do while (cubeadm_dataiterate_all(iter,error))
       do isubcube=iter%first,iter%last
          call cubeadm_entryloop_iterate(isubcube,error)
          if (error) return
          call siter%init(iter,isubcube,error)
          if (error) return
          call snr%init(prog%snr,error)
          if (error) return
          call labeled%reallocate(prog%labeled,siter,error)
          if (error) return
          call snr%get(prog%snr,siter,error)
          if (error)  return
          call prog%act(snr,labeled,error)
          if (error) return
          call labeled%put(prog%labeled,siter,error)
          if (error) return
       enddo ! isubcube
    enddo ! ie
  end subroutine cubemain_label_prog_data
  !   
  subroutine cubemain_label_prog_act(prog,snr,labeled,error)
    use cubemain_subcube_real
    use cubemain_labelling_tools
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(label_prog_t), intent(inout) :: prog
    type(subcube_t),     intent(inout) :: snr
    type(subcube_t),     intent(inout) :: labeled
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='LABEL>PROG>ACT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_labelling(snr,prog%minsnr,labeled,prog%nlabels,error)
    if (error) return
    call cubemain_label_prog_sort_labels(prog,snr,labeled,error)
    if (error) return
  end subroutine cubemain_label_prog_act  
  !   
  !------------------------------------------------------------------------
  !
  subroutine cubemain_label_prog_sort_labels(prog,snr,labeled,error)
    use gkernel_interfaces
    use cubetools_nan
    use cubemain_subcube_real
    !----------------------------------------------------------------------
    ! Sort label by increasing SNR energy (in the sense of signal processing)
    !----------------------------------------------------------------------
    class(label_prog_t), intent(inout) :: prog
    type(subcube_t),     intent(in)    :: snr
    type(subcube_t),     intent(inout) :: labeled
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: ier
    integer(kind=data_k) :: nx,ix
    integer(kind=data_k) :: ny,iy
    integer(kind=data_k) :: nz,iz
    integer(kind=data_k) :: il,nl
    integer(kind=data_k), allocatable :: npix(:),iorder(:),jorder(:)
    real(kind=8), allocatable :: energy(:)
    character(len=*), parameter :: rname='LABEL>PROG>SORT>LABELS'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    nx = snr%n1
    ny = snr%n2
    nz = snr%n3
    nl = prog%nlabels
    !
    ! Sum SNR energy per label label
    allocate(energy(nl),npix(nl),iorder(nl),jorder(nl),stat=ier)
    if (failed_allocate(rname,'energy',ier,error)) return
    energy = 0
    npix = 0
    do iz=1,nz
       do iy=1,ny
          do ix=1,nx
             if (.not.ieee_is_nan(snr%data(ix,iy,iz))) then
                il = labeled%data(ix,iy,iz)
                if  ((0.lt.il).and.(il.le.nl)) then
                   if (il.eq.1) then
                      ! Outside the region where SNR meets the criterion
                   else
                      ! Inside  the region where SNR meets the criterion
                      energy(il) = energy(il)+abs(snr%data(ix,iy,iz))
                      npix(il) = npix(il)+1
                   endif
                else
                   print *,ix,iy,iz,il,nl
                endif ! Inside [1,nl]?
             endif ! Not NaN?
          enddo ! ix
       enddo ! iy
    enddo ! iz
    ! Sort by increasing SNR energy
    call gr8_trie(energy,iorder,nl,error)
    if (error) return
    call sort(npix,iorder,nl,error)
    if (error) return
    ! I need to invert the iorder sorting array before using jorder!
    do il=1,nl
       jorder(iorder(il)) = il
    enddo
    ! Reorder the labels accordingly
    do iz=1,nz
       do iy=1,ny
          do ix=1,nx
             if (.not.ieee_is_nan(labeled%data(ix,iy,iz))) then
                il = labeled%data(ix,iy,iz)
                if ((0.lt.il).and.(il.le.nl)) then
                   labeled%data(ix,iy,iz) = jorder(il)
                else
                   print *,ix,iy,iz,il,nl
                endif ! Inside [1,nl]?
             endif
          enddo ! ix
       enddo ! iy
    enddo ! iz
    ! Write SNR energy per label before ordering
    call prog%write(energy,npix,error)
    if (error) return
    !
  contains
    !
    subroutine sort(x,key,nx,error)
      !---------------------------------------------------------------------
      ! Reorder an integer*8 array by increasing order using the sorted
      ! indexes computed by a G*_TRIE subroutine
      !---------------------------------------------------------------------
      integer(kind=8), intent(in)    :: nx
      integer(kind=8), intent(inout) :: x(nx)
      integer(kind=8), intent(in)    :: key(nx)
      logical,         intent(inout) :: error
      !
      integer(kind=4) :: ier
      integer(kind=8) :: ix
      integer(kind=8), allocatable :: work(:)
      !
      allocate(work(nx),stat=ier)
      if (failed_allocate(rname,'work',ier,error)) return
      !
      if (nx.le.1) return
      do ix=1,nx
         work(ix) = x(key(ix))
      enddo ! ix
      do ix=1,nx
         x(ix) = work(ix)
      enddo ! ix
    end subroutine sort
  end subroutine cubemain_label_prog_sort_labels
  !
  subroutine cubemain_label_prog_write_energy(prog,energy,npix,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(label_prog_t), intent(inout) :: prog
    real(kind=8),        intent(in)    :: energy(:)
    integer(kind=8),     intent(in)    :: npix(:)
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: ier,mylun
    integer(kind=data_k) :: il,nl
    character(len=filename_length) :: outname
    character(len=*), parameter :: rname='LABEL>PROG>WRITE>ENERGY'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ier = sic_getlun(mylun)
    if (mod(ier,2).eq.0) then
       call putmsg('E-SIC, ',ier)
       error=.true.
       return
    endif
    write(outname,'(a,i0,a)') "energy.dat"
    ier = sic_open(mylun,outname,'NEW',.false.)
    if (ier.ne.0) then
       call putios('E-SIC, ',ier)
       error = .true.
       goto 10
       return
    endif
    nl = ubound(energy,1)
   do il=1,nl
       write(mylun,'(i0,2x,1e15.6,2x,1e15.6,2x,i9)') nl-il+1,energy(il),energy(il)/real(npix(il)),npix(il)
    enddo ! il
    ier = sic_close(mylun)
    !
10  continue 
    call sic_frelun(mylun)
    mylun = 0
  end subroutine cubemain_label_prog_write_energy
  !
!!$  subroutine cubemain_label_prog_write_energy(prog,energy,error)
!!$    use cubetools_axis_types
!!$    use cubetools_unit
!!$    use cubetools_header_methods
!!$    use cubedag_allflags
!!$    use cubeadm_clone
!!$    use cubeadm_ioloop
!!$    use cubemain_spectrum_real
!!$    !----------------------------------------------------------------------
!!$    !
!!$    !----------------------------------------------------------------------
!!$    class(label_prog_t), intent(inout) :: prog
!!$    real(kind=8),        intent(in)    :: energy(:)
!!$    logical,             intent(inout) :: error
!!$    !
!!$    type(axis_t) :: axis
!!$    type(spectrum_t) :: ouspec
!!$    type(cube_t), pointer :: oucube
!!$    integer(kind=chan_k), parameter :: one = 1
!!$    character(len=*), parameter :: rname='LABEL>PROG>WRITE>ENERGY'
!!$    !
!!$    call cubemain_message(mainseve%trace,rname,'Welcome')
!!$    !
!!$    ! Make header
!!$    call cubeadm_clone_header(prog%snr,flag_energy,oucube,&
!!$         error,access=code_access_fullset)
!!$    if (error) return
!!$    call cubetools_header_get_axis_head_c(oucube%head,axis,error)
!!$    if (error) return
!!$    axis%name = 'Label'
!!$    axis%unit = 'integer'
!!$    axis%kind = code_unit_unk
!!$    axis%genuine = .true.
!!$    axis%regular = .true. ! Should it be false?
!!$    axis%ref = 1.0
!!$    axis%val = 1.0
!!$    axis%inc = 1.0
!!$    axis%n = prog%nlabels
!!$    call cubetools_header_update_axset_c(axis,oucube%head,error)
!!$    if (error) return
!!$    call cubetools_header_nullify_axset_l(oucube%head,error)
!!$    if (error) return
!!$    call cubetools_header_nullify_axset_m(oucube%head,error)
!!$    if (error) return
!!$    !
!!$    ! Make data
!!$    call ouspec%reallocate('energy',prog%nlabels,error)
!!$    if(error) return
!!$    call cubeadm_io_iterate(one,one,oucube,error)
!!$    if (error) return
!!$    ouspec%t(:) = energy(:) ! *** JP Is the copy required?
!!$    call ouspec%put(oucube,one,error)
!!$    if (error) return
!!$  end subroutine cubemain_label_prog_write_energy
end module cubemain_label
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
