module astro_register_type
  use astro_types
  !
  public
  private :: register_reallocate,register_free,register_add_febe
  !
  integer(kind=4), parameter :: m_register_alloc=16
  !
  type noema_febe_register_t
    !
    integer(kind=4) :: m_saved=0
    integer(kind=4) :: n_saved=0
    integer(kind=4) :: n_index=0
    type(noema_febe_t), allocatable :: saved_febe(:) 
    !
    contains
      procedure, public :: free => register_free
      procedure, public :: reallocate => register_reallocate
      procedure, public :: add => register_add_febe
      procedure, public :: save => register_save_febe
      procedure, public :: clear => register_clear
      procedure, public :: list => register_list
      procedure, public :: load => register_load_febe
      procedure, public :: remove => register_remove_febe
  end type noema_febe_register_t
  !
contains
  subroutine register_reallocate(register,m_febe,error)
    use gkernel_interfaces
    ! Reallocate register%n_saved_febe if needed
    class(noema_febe_register_t), intent(inout) :: register
    integer(kind=4), intent(in) :: m_febe
    logical, intent(inout)      :: error
    !
    character(len=*), parameter :: rname='REGISTER>REALLOCATE'
    integer(kind=4) :: ier
    logical :: alloc
    !
    alloc=.true.
    ! First check if alloc already
    if (allocated(register%saved_febe)) then
      if (register%m_saved.eq.m_febe) then
        ! Already allocated at the right size
        alloc = .false.
      else
        ! Not the right size: deallocate
        call register%free(error)
        if (error) return
        alloc=.true.
      endif
    endif
    if (alloc) then
      ! Allocate to right size
      allocate(register%saved_febe(m_febe),stat=ier)
      if (failed_allocate(rname,'REGISTER saved FEBE',ier,error))  return
      register%m_saved=m_febe
    endif
    !
  end subroutine register_reallocate
  !
  subroutine register_free(register,error)
    ! Deallocate pfx%unit
    class(noema_febe_register_t), intent(inout) :: register
    logical, intent(inout)      :: error
    !
    if (allocated(register%saved_febe)) deallocate(register%saved_febe)
    !
  end subroutine register_free
  !
  subroutine register_add_febe(register,lfebe,error)
    use gbl_message
    !-----------------------------------------------------------------------
    ! add current freq setup to the multifreq list
    !-----------------------------------------------------------------------
    class(noema_febe_register_t), intent(inout) :: register
    type(noema_febe_t), intent(inout) :: lfebe
    logical, intent(inout) :: error
    ! local
    character(len=*), parameter :: rname='FEBE>ADD'
    integer(kind=4) :: i,idx,inum
    character(len=256) :: mess
    !
    ! Check that there is at least 1 spectral window
    if (lfebe%spw%out%n_spw.eq.0) then
      call astro_message(seve%e,rname,'Current FEBE does not contain any SPW, nothing done')
      error=.true.
      return
    endif
    ! Get the first free slot
    idx=-1
    do i=1,register%m_saved
      if (.not.register%saved_febe(i)%defined) then
        idx=i
        exit
      endif
    enddo
    ! Get the number
    inum=register%n_index+1
    ! 
    if (idx.eq.-1) then
      call astro_message(seve%e,rname, &
           'No space left in register, remove some FEBE before trying to add new ones')
      error=.true.
      return
    endif
    call register%saved_febe(idx)%pfx%reallocate(lfebe%pfx%n_units,error)
    if (error) return
    register%saved_febe(idx)=lfebe
    register%saved_febe(idx)%id=inum
    register%saved_febe(idx)%defined=.true.
    register%saved_febe(idx)%loaded=.false.
    register%n_saved=register%n_saved+1
    register%n_index=inum
    !
    write (mess,'(a,1x,i0.0)') 'Current frontend-backend settings saved to register under number',inum
    call astro_message(seve%i,rname,mess)
    !
    lfebe%loaded=.false.
    !
  end subroutine register_add_febe
  !
  subroutine register_save_febe(register,lfebe,error)
    use gbl_message
    !-----------------------------------------------------------------------
    ! save current freq setup to the multifreq list (at the place of the loaded febe)
    !-----------------------------------------------------------------------
    class(noema_febe_register_t), intent(inout) :: register
    type(noema_febe_t), intent(inout) :: lfebe
    logical, intent(inout) :: error
    ! local
    character(len=*), parameter :: rname='FEBE>SAVE'
    integer(kind=4) :: i,idx
    character(len=256) :: mess
    !
    ! Get the slot of the loaded FEBE
    idx=-1
    do i=1,register%m_saved
      if (register%saved_febe(i)%id.ne.lfebe%id) cycle
      idx=i
    enddo
    ! 
    if (idx.eq.-1) then
      call astro_message(seve%e,rname, &
           'Index of the loaded FEBE is not found')
      error=.true.
      return
    endif
    if (.not.lfebe%loaded) then
      call astro_message(seve%e,rname, &
           'Need to load a FEBE before saving')
      error=.true.
      return
    endif
    call register%saved_febe(idx)%pfx%reallocate(lfebe%pfx%n_units,error)
    if (error) return
    register%saved_febe(idx)=lfebe
    register%saved_febe(idx)%defined=.true.
    register%saved_febe(idx)%loaded=.false.
    !
    write (mess,'(a,1x,i0.0)') 'Current frontend-backend saved in number',lfebe%id
    call astro_message(seve%i,rname,mess)
    !
    lfebe%loaded=.false.
    !
  end subroutine register_save_febe
  !
  subroutine register_clear(register,error)
    !-----------------------------------------------------------------------
    ! reset the register to 0
    !-----------------------------------------------------------------------
    class(noema_febe_register_t), intent(inout) :: register
    logical, intent(inout) :: error
    ! local
    character(len=*), parameter :: rname='FEBE>CLEAR'
    integer(kind=4) :: i
    !
    do i=1,register%m_saved
      register%saved_febe(i)%defined=.false.
      register%saved_febe(i)%id=0
      register%saved_febe(i)%name=''
    enddo
    register%n_saved=0
    register%n_index=0
    !
  end subroutine register_clear
  !
  subroutine register_list(register,recdesc,error)
    use gbl_message
    use ast_astro
    !-----------------------------------------------------------------------
    ! list current freq setups in the register
    !-----------------------------------------------------------------------
    class(noema_febe_register_t), intent(inout) :: register
    type(receiver_desc_t), intent(in) :: recdesc
    logical, intent(inout) :: error
    ! local
    character(len=*), parameter :: rname='FEBE>LIST'
    integer(kind=4) :: i,j,dband,imode
    character(len=256) :: mess,vmess
    real(kind=8) :: dfreq
    character(len=32) :: dbandname,dmodename,vtype
    logical :: found
    !
    if (register%n_saved.eq.0) then
      call astro_message(seve%r,rname,'The register does not contain any FEBE')
      return
    endif
    if (soukind.ne.soukind_none) then
      if (source_invtype(1:2).eq.'LS') then
        vtype='LSR'
        write (vmess,'(a,1x,f0.3,1x,a)') trim(vtype),source_vlsr,'km/s'
      else if (source_invtype(1:2).eq.'RE') then
        vtype='REDSHIFT'
        write (vmess,'(a,1x,f0.3)') trim(vtype),source_redshift
      else
        vtype=''
        vmess=''
      endif
      if (soukind.eq.soukind_full) then
        write (mess,'(a,1x,a,1x,a)')  'List of tunings defined for current source:', &
                                            trim(astro_source_name),trim(vmess)
      else if (soukind.eq.soukind_vlsr.or.soukind.eq.soukind_red) then
        write (mess,'(a,1x,a)')  'List of tunings defined for',trim(vmess)
      endif
      call astro_message(seve%r,rname,mess)
    endif
    !
    do i=1,register%n_index ! loop on the idx numbers
      found=.false.
      do j=1,register%m_saved ! Find the corresponding saved FEBE in the register
        if (.not.register%saved_febe(j)%defined) cycle
        if (register%saved_febe(j)%id.ne.i) cycle
        dband=register%saved_febe(j)%rectune%iband
        dbandname=recdesc%bandname(dband)
        call register%saved_febe(j)%pfx%getmode(dmodename,error)
        if (error) return
        dfreq=register%saved_febe(j)%rectune%frest*ghzpermhz ! displayed freq in GHz
        found=.true.
        exit ! quit loop when found
      enddo
      if (found) then
        write (mess,'(a,i0.0,1x,a,1x,f0.3,1x,a,1x,a)') &
            'Saved #',i,trim(dbandname),dfreq,'GHz - PFX Mode:',trim(dmodename)
      else
        write (mess,'(a,i0.0,1x,a)')  'Saved #',i,'not defined'
      endif
      call astro_message(seve%r,rname,mess)
    enddo
    !
  end subroutine register_list
  !
  subroutine register_load_febe(register,il,setup,error)
    use gbl_message
    !-----------------------------------------------------------------------
    ! copy one setup from the register to the current one
    !-----------------------------------------------------------------------
    class(noema_febe_register_t), intent(inout) :: register
    integer(kind=4), intent(in) :: il
    type(noema_febe_t), intent(inout) :: setup
    logical, intent(inout) :: error
    ! local
    character(len=*), parameter :: rname='FEBE>LOAD'
    character(len=256) :: mess
    integer(kind=4) :: i,idx
    !
    ! Get the idx
    idx=0
    do i=1,register%m_saved
      if (register%saved_febe(i)%id.ne.il) cycle
      idx=i
      exit
    enddo
    if (idx.eq.0) then
      call astro_message(seve%e,rname,'The setup to load is not found')
      error=.true.
      return
    endif
    if (.not.register%saved_febe(idx)%defined) then
      call astro_message(seve%e,rname,'The setup to load is not defined')
      error=.true.
      return
    endif
    setup=register%saved_febe(idx)
    setup%id=register%saved_febe(idx)%id
    setup%name='LOADED'
    setup%loaded=.true.
    !
    write (mess,'(a,1x,i0.0,1x,a)') 'Setup',il,'loaded to current'
    call astro_message(seve%i,rname,mess)
    !
  end subroutine register_load_febe
  !
  subroutine register_remove_febe(register,ir,error)
    use gbl_message
    !-----------------------------------------------------------------------
    ! remove 1 tuning from the register
    !-----------------------------------------------------------------------
    class(noema_febe_register_t), intent(inout) :: register
    integer(kind=4), intent(in) :: ir  ! febe to remove
    logical, intent(inout) :: error
    ! local
    character(len=*), parameter :: rname='FEBE>REMOVE'
    character(len=256) :: mess
    integer(kind=4) :: i,idx
    !
    ! Get the idx
    idx=0
    do i=1,register%m_saved
      if (register%saved_febe(i)%id.ne.ir) cycle
      idx=i
      exit
    enddo
    if (idx.eq.0) then
      call astro_message(seve%e,rname,'The setup to remove is not found')
      error=.true.
      return
    endif
    register%saved_febe(idx)%defined=.false.
    register%saved_febe(idx)%name='DELETED'
    register%n_saved=register%n_saved-1 ! n_saved is changed, N_index not to get a kind of history
    !
    write (mess,'(a,1x,i0.0,1x,a)') 'Setup',ir,'removed from saved list'
    call astro_message(seve%i,rname,mess)
    !
  end subroutine register_remove_febe
  !
end module astro_register_type
