!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_spectrum_real
  use cubemain_messaging
  !
  public :: spectrum_t
  private
  ! 
  type spectrum_t
     integer(kind=chan_k) :: n = 0 ! Current number of valid channels
     integer(kind=chan_k) :: m = 0 ! Maximum number of channels
     integer(kind=chan_k), pointer :: c(:) => null() ! Channel
     real(kind=coor_k),    pointer :: v(:) => null() ! Velocity 
     real(kind=coor_k),    pointer :: f(:) => null() ! Frequency
     real(kind=sign_k),    pointer :: w(:) => null() ! Weight
     real(kind=sign_k),    pointer :: t(:) => null() ! Temperature
     integer(kind=4)   :: ccode = code_pointer_null ! 
     integer(kind=4)   :: tcode = code_pointer_null ! 
     real(kind=sign_k) :: noi  = 0.0
     real(kind=coor_k) :: inc = 0d0
     real(kind=coor_k) :: val = 0d0
     real(kind=coor_k) :: ref = 0d0
     ! *** JP The following two fields are used only in mean-spectrum right now
     real(kind=coor_k) :: xoff = 0d0
     real(kind=coor_k) :: yoff = 0d0
     ! *** JP
   contains
     procedure, public  :: reallocate           => cubemain_spectrum_reallocate
     procedure, public  :: reallocate_and_init  => cubemain_spectrum_reallocate_and_init
     procedure, public  :: reassociate_and_init => cubemain_spectrum_reassociate_and_init
     procedure, public  :: point_to             => cubemain_spectrum_point_to
     procedure, public  :: get                  => cubemain_spectrum_get
     procedure, public  :: put                  => cubemain_spectrum_real_put
     final :: cubemain_spectrum_free
  end type spectrum_t
  !
contains
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_spectrum_reallocate_and_init(spec,cube,error)
    use cube_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spectrum_t), intent(inout) :: spec
    type(cube_t),      intent(in)    :: cube
    logical,           intent(inout) :: error
    !
    integer(kind=chan_k) :: nchan
    character(len=*), parameter :: rname='SPECTRUM>REALLOCATE>AND>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    nchan = cube%head%spe%nc
    call spec%reallocate('spectrum',nchan,error)
    if (error) return
    call cubemain_spectrum_init(cube,spec,error)
    if (error) return
  end subroutine cubemain_spectrum_reallocate_and_init
  !  
  subroutine cubemain_spectrum_reassociate_and_init(spec,cube,error)
    use cube_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spectrum_t), intent(inout) :: spec
    type(cube_t),      intent(in)    :: cube
    logical,           intent(inout) :: error
    !
    integer(kind=chan_k) :: nchan
    character(len=*), parameter :: rname='SPECTRUM>REASSOCIATE>AND>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    nchan = cube%head%spe%nc
    call cubemain_spectrum_reassociate(nchan,'spectrum',spec,error)
    if (error) return
    call cubemain_spectrum_init(cube,spec,error)
    if (error) return
  end subroutine cubemain_spectrum_reassociate_and_init
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_spectrum_init(cube,spec,error)
    use cubetools_nan
    use cube_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_t),     intent(in)    :: cube
    type(spectrum_t), intent(inout) :: spec
    logical,          intent(inout) :: error
    !
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname='SPECTRUM>INIT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (spec%ccode.eq.code_pointer_allocated) then
       do ichan=1,spec%n
          spec%c(ichan) = cube%head%spe%c%coord(ichan)
          spec%v(ichan) = cube%head%spe%v%coord(ichan)
          spec%f(ichan) = cube%head%spe%f%coord(ichan)
          spec%w(ichan) = 0
       enddo ! ichan
    else
       ! Does nothing
    endif
    if (spec%tcode.eq.code_pointer_allocated) then
       do ichan=1,spec%n
          spec%t(ichan) = gr4nan
       enddo ! ichan
    else
       ! Does nothing
    endif
    spec%inc = cube%head%spe%inc%v
    spec%val = cube%head%spe%ref%v
    spec%ref = cube%head%spe%ref%c
    spec%noi = gr4nan
  end subroutine cubemain_spectrum_init
  !
  subroutine cubemain_spectrum_reallocate(spec,kind,nchan,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spectrum_t),    intent(inout) :: spec
    character(len=*),     intent(in)    :: kind
    integer(kind=chan_k), intent(in)    :: nchan
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRUM>REALLOCATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nchan.le.0) then
       call cubemain_message(seve%e,rname,'Negative or zero number of channels')
       error = .true.
      return
    endif
    call cubemain_spectrum_reallocate_c(nchan,kind,spec,error)
    if (error) return
    call cubemain_spectrum_reallocate_t(nchan,kind,spec,error)
    if (error) return
    ! Allocation success => spec%n, and spec%m may be updated
    spec%n = nchan
    spec%m = nchan  ! ZZZ This is not at the correct place!
  end subroutine cubemain_spectrum_reallocate
  !
  subroutine cubemain_spectrum_reassociate(nchan,kind,spec,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: nchan
    character(len=*),     intent(in)    :: kind
    type(spectrum_t),     intent(inout) :: spec
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRUM>REASSOCIATE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Sanity check
    if (nchan.le.0) then
       call cubemain_message(seve%e,rname,'Negative or zero number of channels')
       error = .true.
       return
    endif
    call cubemain_spectrum_reallocate_c(nchan,kind,spec,error)
    if (error) return
    call cubemain_spectrum_reassociate_t(nchan,kind,spec,error)
    if (error) return
    ! Allocation success => spec%n, and spec%m may be updated
    spec%n = nchan
    spec%m = nchan  ! ZZZ This is not at the correct place!
  end subroutine cubemain_spectrum_reassociate
  !
  subroutine cubemain_spectrum_free(spec)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectrum_t), intent(inout) :: spec
    !
    character(len=*), parameter :: rname='SPECTRUM>FREE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    spec%n = 0
    spec%m = 0
    call cubemain_spectrum_free_c(spec)
    call cubemain_spectrum_free_t(spec)
  end subroutine cubemain_spectrum_free
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_spectrum_reallocate_c(nchan,kind,spec,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: nchan
    character(len=*),     intent(in)    :: kind
    type(spectrum_t),     intent(inout) :: spec
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPECTRUM>REALLOCATE>C'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    alloc = .true.
    if (associated(spec%c)) then
       if (spec%m.eq.nchan) then
          write(mess,'(a,a,i0)')  &
            kind,' c already associated at the right size: ',nchan
          call cubemain_message(mainseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',kind,  &
            ' c already associated but with a different size => Freeing it first'
          call cubemain_message(mainseve%alloc,rname,mess)
          call cubemain_spectrum_free_c(spec)
       endif
    endif
    if (alloc) then
       allocate(spec%c(nchan),spec%v(nchan),spec%f(nchan),spec%w(nchan),stat=ier)
       if (failed_allocate(rname,trim(kind)//' spectrum c',ier,error)) return
    endif
    spec%ccode = code_pointer_allocated
  end subroutine cubemain_spectrum_reallocate_c
  !
  subroutine cubemain_spectrum_free_c(spec)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectrum_t), intent(inout) :: spec
    !
    character(len=*), parameter :: rname='SPECTRUM>FREE>C'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (spec%ccode.eq.code_pointer_allocated) then
       if (associated(spec%c)) deallocate(spec%c)
       if (associated(spec%v)) deallocate(spec%v)
       if (associated(spec%f)) deallocate(spec%f)
       if (associated(spec%w)) deallocate(spec%w)
    else
       spec%c => null()
       spec%v => null()
       spec%f => null()
       spec%w => null()
    endif
    spec%ccode = code_pointer_null
  end subroutine cubemain_spectrum_free_c
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_spectrum_reallocate_t(nchan,kind,spec,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: nchan
    character(len=*),     intent(in)    :: kind
    type(spectrum_t),     intent(inout) :: spec
    logical,              intent(inout) :: error
    !
    logical :: alloc
    integer(kind=4) :: ier
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPECTRUM>REALLOCATE>T'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    alloc = .true.
    if (spec%tcode.eq.code_pointer_allocated) then
       ! The request is to get an associated pointer
       if (spec%m.eq.nchan) then
          write(mess,'(a,a,i0)')  &
               kind,' t already associated at the right size: ',nchan
          call cubemain_message(mainseve%alloc,rname,mess)
          alloc = .false.
       else
          write(mess,'(a,a,a)') 'Pointer ',kind,  &
               ' t already associated but with a different size => Freeing it first'
          call cubemain_message(mainseve%alloc,rname,mess)
          call cubemain_spectrum_free_t(spec)
       endif
    else
       ! spec%t is either null or associated, so I will need to allocate it anyway
    endif
    if (alloc) then
       allocate(spec%t(nchan),stat=ier)
       if (failed_allocate(rname,trim(kind)//' spectrum t',ier,error)) return
    endif
    ! Allocation success => spec%tcode may be updated
    spec%tcode = code_pointer_allocated
  end subroutine cubemain_spectrum_reallocate_t
  !
  subroutine cubemain_spectrum_reassociate_t(nchan,kind,spec,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: nchan
    character(len=*),     intent(in)    :: kind
    type(spectrum_t),     intent(inout) :: spec
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRUM>REASSOCIATE>T'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! The request is to get a null pointer without memory leak => Free when needed.
    call cubemain_spectrum_free_t(spec)
    ! *** JP *** The following is curious as the pointer as not be reassociated yet.
    spec%tcode = code_pointer_associated
  end subroutine cubemain_spectrum_reassociate_t
  !
  subroutine cubemain_spectrum_free_t(spec)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectrum_t), intent(inout) :: spec
    !
    character(len=*), parameter :: rname='SPECTRUM>FREE>T'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (spec%tcode.eq.code_pointer_allocated) then
       if (associated(spec%t)) deallocate(spec%t)
    else
       spec%t => null()
    endif
    spec%tcode = code_pointer_null
  end subroutine cubemain_spectrum_free_t
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_spectrum_get(spec,cube,ispec,error)
    use cube_types
    use cubeio_types
    use cubeio_pix
    use gkernel_interfaces
    use cubetuple_entry
    !---------------------------------------------------------------------
    ! Get the ispec-th spectrum from the cube
    ! When spec%t is an allocated pointer, we make a copy.
    ! In all other cases (associated or null), we make it point to the data.
    !---------------------------------------------------------------------
    class(spectrum_t),    intent(inout) :: spec
    type(cube_t),         intent(inout) :: cube
    integer(kind=entr_k), intent(in)    :: ispec
    logical,              intent(inout) :: error
    ! 
    type(cube_pix_t) :: pix
    integer(kind=pixe_k) :: xpix,ypix
    character(len=*), parameter :: rname='GET>SPECTRUM'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (cube%iscplx()) then
      call cubemain_message(seve%e,rname,  &
        'Invalid attempt to get a R*4 spectrum from a C*4 cube')
      error = .true.
      return
    endif
    !
    ypix = (ispec-1)/cube%tuple%current%desc%nx+1
    xpix = ispec - cube%tuple%current%desc%nx*(ypix-1)
    call cubetuple_get_pix(cube%user,cube%prog,cube,xpix,ypix,pix,error)
    if (error) return
    !
    if (spec%tcode.eq.code_pointer_allocated) then
       spec%t(:) = pix%r4(:)
    else
       spec%t => pix%r4
       spec%tcode = code_pointer_associated
    endif
    !
    call cubeio_free_pix(pix,error)
    if (error)  return
  end subroutine cubemain_spectrum_get
  !
  subroutine cubemain_spectrum_real_put(spec,cube,ispec,error)
    use cube_types
    use cubeio_types
    use cubeio_pix
    use cubetuple_entry
    !---------------------------------------------------------------------
    ! Put the ispec-th spectrum to the cube
    ! Only use pointers => Nothing to free
    !---------------------------------------------------------------------
    class(spectrum_t),    intent(in)    :: spec
    type(cube_t),         intent(inout) :: cube
    integer(kind=entr_k), intent(in)    :: ispec
    logical,              intent(inout) :: error
    !
    type(cube_pix_t) :: pix
    integer(kind=pixe_k) :: xpix,ypix
    character(len=*), parameter :: rname='SPECTRUM>REAL>PUT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (cube%iscplx()) then
      call cubemain_message(seve%e,rname,  &
        'Invalid attempt to put a R*4 spectrum to a C*4 cube')
      error = .true.
      return
    endif
    !
    pix%allocated = code_pointer_associated
    pix%nc = size(spec%t)
    pix%r4 => spec%t
    pix%iscplx = .false.
    !
    ypix = (ispec-1)/cube%tuple%current%desc%nx+1
    xpix = ispec - cube%tuple%current%desc%nx*(ypix-1)
    call cubetuple_put_pix(cube%user,cube%prog,cube,xpix,ypix,pix,error)
    if (error) return
  end subroutine cubemain_spectrum_real_put
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_spectrum_point_to(specou,specin,ifirst,ilast,noise,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spectrum_t),        intent(inout) :: specou
    type(spectrum_t), target, intent(in)    :: specin
    integer(kind=chan_k),     intent(in)    :: ifirst
    integer(kind=chan_k),     intent(in)    :: ilast
    real(kind=sign_k),        intent(in)    :: noise
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRUM>POINT>TO'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    specou%n = ilast-ifirst+1
    specou%m = specou%n
    if (specou%ccode.eq.code_pointer_allocated) then
       call cubemain_message(seve%e,rname,'Cannot associate the spectral pointers as they are already allocated')
       call cubemain_message(seve%e,rname,'=> Free them first')
       error = .true.
       return
    else
       specou%c => specin%c(ifirst:ilast)
       specou%v => specin%v(ifirst:ilast)
       specou%f => specin%f(ifirst:ilast)
       specou%w => specin%w(ifirst:ilast)
       specou%ccode = code_pointer_associated
    endif
    if (specou%tcode.eq.code_pointer_allocated) then
       call cubemain_message(seve%e,rname,'Cannot associate the t pointer as it is already allocated')
       call cubemain_message(seve%e,rname,'=> Free it first')
       error = .true.
       return
    else
       specou%t => specin%t(ifirst:ilast)
       specou%tcode = code_pointer_associated
    endif
    specou%ref = specin%ref
    specou%val = specin%val
    specou%inc = specin%inc
    specou%noi = noise
  end subroutine cubemain_spectrum_point_to
end module cubemain_spectrum_real
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
