subroutine pico_emir(line,error)
  use gbl_message
  use gildas_def
  use gkernel_interfaces
  use astro_interfaces, except_this=>pico_emir
  use astro_types
  use ast_astro
  use my_receiver_globals
  use plot_molecules_globals
  use frequency_axis_globals
  !-----------------------------------------------------------------------
  ! @ private
  ! EMIR command to define and visualize EMIR coverage
  ! EMIR F1 SB1 F2 SB2 /CATALOG /zoom
  !-----------------------------------------------------------------------
  character(len=*), intent(inout) :: line        ! command line
  logical, intent(inout) :: error
  ! local
  character(len=*), parameter :: rname='EMIR'
  integer(kind=4),parameter :: optzoom=1 ! option /ZOOM
  integer(kind=4),parameter :: optpagewidth=2 ! option /PAGEWIDTH
  integer(kind=4),parameter :: optinfo=3 ! option /INFO
  integer(kind=4) :: lpar,izoom,nzmode,it
  integer(kind=4), parameter :: m_zmodes=2
  character(len=20) ::  zmodes(m_zmodes),zmode
  logical :: noarg
  real(kind=8) :: fcomm
  data zmodes/'ID','BOTH'/
  !
  error = .false.
  !
  if (obsname.ne.'PICOVELETA'.and.obsname.ne.'VELETA') then
      call astro_message(seve%e,rname,'Inconsistency between Receiver Name and Observatory')
      error = .true.
      return
  endif
  !
  !Define receiver parameters
  call astro_def_receiver(rname,'EMIR',emir%rec%desc,error)
  if (error) return
  !Define emir switchbox parameters
  call rec_define_emir_switchbox(emir%switch,error)
  if (error) return
  !
  emir%rec%desc%redshift=.true.
  call astro_def_recsource(rname,emir%rec%desc,emir%rec%source,error)
  if (error) return
  !
  !Print Receiver info in the terminal
  if (sic_present(optinfo,0)) then
    call astro_receiver_info(emir%rec%desc,rname,error)
    if (error) return
  endif
  !Decoding Line Command
  ! First tuning
  zmode='ID'
  izoom=0
  emir%comm%n_tunings = 0
  if (error) return
  if (sic_present(0,1)) then
    noarg = .false.
    call pico_reset_emir(emir,error)
    emir%comm%n_tunings = 1
    call sic_r8(line,0,1,fcomm,.true.,error)
    if (error) return
    call rec_inputtorest(rname,fcomm,freq_axis%main,emir%rec%source,emir%comm%frest(1),error)
    if (error) return
    call sic_ch(line,0,2,emir%comm%code(1),lpar,.true.,error)
    if (error) return
    ! Second tuning
    emir%comm%frest(2) = 0
    emir%comm%code(2) = ''
    if (sic_present(0,3)) then
      ! second tuning
      emir%comm%n_tunings = 2
      call sic_r8(line,0,3,fcomm,.true.,error)
      if (error) return
      call rec_inputtorest(rname,fcomm,freq_axis%main,emir%rec%source,emir%comm%frest(2),error)
      if (error) return
      call sic_ch(line,0,4,emir%comm%code(2),lpar,.true.,error)
      if (error) return
    endif
  else ! case without argument
    noarg=.true.
    call astro_message(seve%i,rname,'Showing the coverage of EMIR bands')
  endif
  ! Options
  ! Zoom parameter
  if (sic_present(optzoom,0)) then
    if (sic_present(optzoom,1)) then
      emir%comm%zoommode = 'NULL'
      call sic_ke (line,optzoom,1,emir%comm%zoommode,lpar,.false.,error)
      if (error) return
      call sic_ambigs_sub(rname,trim(emir%comm%zoommode),zmode,nzmode,zmodes,m_zmodes,error)
      if (error) return
      if (nzmode.eq.0) then !means that keyword was not recognized
        if (sic_present(optzoom,2)) then
          zmode='FREQ'
          call sic_r8(line,optzoom,1,fcomm,.true.,error)
          if (error) return
          fcomm=fcomm*mhzperghz
          call rec_inputtorest(rname,fcomm,freq_axis%main,emir%rec%source,emir%comm%fz1,error)
          if (error) return
          call sic_r8(line,optzoom,2,fcomm,.true.,error)
          if (error) return
          fcomm=fcomm*mhzperghz
          call rec_inputtorest(rname,fcomm,freq_axis%main,emir%rec%source,emir%comm%fz2,error)
          if (error) return
        else
          if (emir%comm%n_tunings.eq.0) then
            call astro_message(seve%e,rname,'Try to tune on a not tune band')
            error = .true.
            return
          endif
          zmode='SINGLE'
          call sic_i0(line,optzoom,1,izoom,.true.,error)
          if (error) return
        endif
      endif
    else
      if (emir%comm%n_tunings.eq.1) then
        izoom = 1
        zmode='SINGLE'
      else if (emir%comm%n_tunings.eq.2) then
        izoom = 0
        zmode='BOTH'
      else
        call astro_message(seve%e,rname,'/ZOOM option without argument is ambiguous in this case')
        error = .true.
        return
      endif
    endif
  endif
  ! /pagewidth option
  if (sic_present(optpagewidth,0)) then
    emir%comm%fixed_scale = .false.
  else
    emir%comm%fixed_scale = .true.
  endif
  !
  !Prepare for the plot
  call pico_emir_setup(emir,error)
  if (error) return
  !
  if (zmode.eq.'ID') then
    call rec_plot_mbands(emir%rec%desc,emir%rec%source, &
                        molecules,emir%comm%fixed_scale,cplot,freq_axis,error)
    if (error) return
    if (emir%rec%n_tunings.ne.0) then
      do it=1,emir%rec%n_tunings
        call rec_plot_tuned(emir%rec%desc,emir%rec%source,emir%rec%tune(it), &
                        molecules,cplot,freq_axis,error)
        if (error) return
      enddo
    endif
  else if (zmode.eq.'BOTH') then
    if (emir%rec%n_tunings.ne.2) then
      call astro_message(seve%e,rname,'Tried to zoom on a not tuned band')
      error = .true.
      return
    endif
    call rec_plot_nbands(emir%rec,molecules,emir%comm%fixed_scale,cplot,freq_axis,error)
    if (error) return
  else if (zmode.eq.'SINGLE') then
    if (izoom.le.0.or.izoom.gt.emir%comm%n_tunings.or.emir%comm%n_tunings.eq.0) then
      call astro_message(seve%e,rname,'Tried to zoom on a not tuned band')
      error = .true.
      return
    endif
    call rec_plot_sidebands(emir%rec%desc,emir%rec%source,emir%rec%tune(izoom),cplot,molecules,freq_axis,error)
    if (error) return
  else if (zmode.eq.'FREQ') then
    call rec_zoom(molecules,emir%comm%fz1,emir%comm%fz2, &
                  emir%rec%desc,emir%rec%source,cplot,freq_axis,error)
    if (error) return
    if (emir%rec%n_tunings.ne.0) then
      do it=1,emir%rec%n_tunings
        call rec_plot_tuned(emir%rec%desc,emir%rec%source,emir%rec%tune(it), &
                        molecules,cplot,freq_axis,error)
        if (error) return
      enddo
    endif
  endif
  !
  !
  if (noarg) then
    ! if no tuning was entered, reset the rec%n_tuning to 0
    ! like this ifproc/backend command will not work (need at least 1 tuning)
    emir%rec%n_tunings = 0
  endif
  !
  ! Let the user with the limits in main axis frequency frame
  call rec_set_limits(rname,cplot,freq_axis%main,error)
  if (error) return
  !
end subroutine pico_emir
!
subroutine rec_define_emir(rname,rdesc,error)
  use gbl_message
  use astro_interfaces, except_this=>rec_define_emir
  use ast_line
  use astro_types
  !-----------------------------------------------------------------------
  ! @ private
  ! fill in the receiver type according to input name
  !-----------------------------------------------------------------------
  character(len=*), intent(in) :: rname
  type(receiver_desc_t), intent(inout) :: rdesc ! receiver parameters
  logical, intent(inout)        :: error
  ! local
  integer(kind=4)       :: i
  real(kind=8)          :: loexplore
  real(kind=8)          :: fold_offset  
  !
  ! Handle the change of frequency implemented in 2021
  if (obs_year.eq.2016) then
    fold_offset=0d0
  else if  (obs_year.eq.2021) then
    fold_offset=320d0
  else
    call astro_message(seve%e,rname,'PICO generation not understood')
    error = .true.
    return
  endif
  !
  rdesc%name = 'EMIR'
  rdesc%defined=.true.
  rdesc%n_rbands = 4
  rdesc%bandname(1) = 'E090'
  rdesc%bandname(2) = 'E150'
  rdesc%bandname(3) = 'E230'
  rdesc%bandname(4) = 'E330'
  rdesc%rejection(1) = 10
  rdesc%rejection(2) = 10
  rdesc%rejection(3) = 10
  rdesc%rejection(4) = 10
  rdesc%n_sbands = 2
  rdesc%n_bbands = 2
  rdesc%n_polar = 2
  rdesc%n_backends = 3
  ! Use FTS wide limits because it is the wider backend
  rdesc%iflim(1) = 3950d0
  rdesc%iflim(2) = 11730d0+fold_offset
  rdesc%ifband = rdesc%iflim(2)-rdesc%iflim(1)
  !basebands
  rdesc%flo2 = 0d0 !we ignore if2 for pico
  rdesc%bbname(1) = 'OUTER'
  rdesc%bblim(1,1) = 7680d0+fold_offset
  rdesc%bblim(2,1) = 11730d0+fold_offset
  rdesc%bbref(1) = 9430d0+fold_offset !from emir doc - center of vespa region
  rdesc%bbname(2) = 'INNER'
  rdesc%bblim(1,2) = 3950d0
  rdesc%bblim(2,2) = 8000d0
  rdesc%bbref(2) = 6250d0 !from emir doc - center of vespa region
  ! Polars
  rdesc%polname(1) = 'HORIZONTAL'
  rdesc%polname(2) = 'VERTICAL'
  !LO limits deduced from EMIR Doc Observable Limits
  !Take the widest range independtly on USB/LSB, a check of feasibility is done afterwards (pico_emir_lo_call)
  rdesc%locall(1,1) = 73.0d3+rdesc%bbref(1)-fold_offset !LSB outer
  rdesc%locall(2,1) = 102d3+rdesc%bbref(2) ! LSB inner allows to go ghigher than USB (in exploration mode)
  rdesc%locall(1,2) = 125d3+rdesc%bbref(1)-fold_offset !LSB outer
  rdesc%locall(2,2) = 184d3-rdesc%bbref(1)+fold_offset  !USB outer
  rdesc%locall(1,3) = 217d3-rdesc%bbref(2) ! USB inner  allows to go lower than USB
  rdesc%locall(2,3) = 263.5d3+rdesc%bbref(2) ! LSB inner
  rdesc%locall(1,4) = 277d3+rdesc%bbref(1)-fold_offset
  rdesc%locall(2,4) = 375d3-rdesc%bbref(1)+fold_offset
  !
  ! Limits from the call to guess the band (limits of possible requested freq)
  rdesc%rfcallreq(1,1) = 72.68d3
  rdesc%rfcallreq(2,1) = 117d3
  rdesc%rfcallreq(1,2) = 125d3
  rdesc%rfcallreq(2,2) = 184d3
  rdesc%rfcallreq(1,3) = 202d3
  rdesc%rfcallreq(2,3) = 274d3
  rdesc%rfcallreq(1,4) = 277d3
  rdesc%rfcallreq(2,4) = 375d3
  !
  ! wider ranges to let the user explore the edge of the bands
  ! Arbitrarily wider by 2GHz in both sides
  ! Wider limits to let some margin to explore the edge of the bands
  loexplore=1.49d3
  do i=1,rdesc%n_rbands
    rdesc%lohard(1,i) = rdesc%locall(1,i)-loexplore
    rdesc%lohard(2,i) = rdesc%locall(2,i)+loexplore
    rdesc%rfcallreq(1,i) = rdesc%rfcallreq(1,i)-loexplore
    rdesc%rfcallreq(2,i) = rdesc%rfcallreq(2,i)+loexplore

  enddo
  ! limits to be used for tuning
  do i=1,rdesc%n_rbands
      rdesc%lolim(1,i) = min(rdesc%locall(1,i),rdesc%lohard(1,i))
      rdesc%lolim(2,i) = max(rdesc%locall(2,i),rdesc%lohard(2,i))
  enddo
  ! Tolerance for tuning close to the band edge
  rdesc%lotol = 100d0  
  ! RF limits from LO +- IFmax
  do i=1,rdesc%n_rbands
      rdesc%rflim(1,i) = rdesc%lolim(1,i)-rdesc%iflim(2)
      rdesc%rflim(2,i) = rdesc%lolim(2,i)+rdesc%iflim(2)
  enddo
  ! RF limits from Call +- IFmax
  do i=1,rdesc%n_rbands
      rdesc%rfcall(1,i) = rdesc%locall(1,i)-rdesc%iflim(2)
      rdesc%rfcall(2,i) = rdesc%locall(2,i)+rdesc%iflim(2)
  enddo
  !
  rdesc%tuninggrid = .false.
  rdesc%gridbin = 0d0 ! MHz
  rdesc%gridtol = 0d0 ! MHz
  !
end subroutine rec_define_emir
!
subroutine pico_emir_lo_call(rname,ib,flo,sb,error)
  use gbl_message
  use astro_interfaces, except_this=>pico_emir_lo_call
  use astro_types
  !-----------------------------------------------------------------------
  ! @ private
  ! call for proposal offers different LO limits according to tuning sideband
  ! rec_define_emir takes union of LSB and USB limits, we check feasibility here
  !-----------------------------------------------------------------------
  character(len=*) , intent(in) :: rname
  integer(kind=4), intent(in) :: ib
  real(kind=8), intent(in)    :: flo
  character(len=*), intent(in)    :: sb
  logical, intent(inout)        :: error
  ! local
  integer(kind=4) :: isb
  real(kind=8) :: cmin,cmax
  !
  if (sb.eq."LSB") then
    isb=lsb_code
  else if (sb.eq."USB") then
    isb=usb_code
  else
    call astro_message(seve%e,rname,"Problem with Sideband")
    error=.true.
    return
  endif
  !
  if (ib.eq.1.and.isb.eq.lsb_code) then
    ! band 1 LSB: warning when Fcent above 97 in LSB
    if (flo.gt.103250d0.and.flo.le.108250d0) then
      call astro_message(seve%w,rname,'Tuning performance might not be optimal, consider switching to USB')
    endif
  else if (ib.eq.1.and.isb.eq.usb_code.and.flo.gt.1072500d0) then
    ! LSB LOmax B1 is higher than USB LOmax
    call astro_message(seve%e,rname,'This LO frequency is reachable only in LSB mode')
    error=.true.
    return
  else if (ib.eq.1.and.isb.eq.usb_code.and.flo.lt.82750d0) then
    ! USB LOmin B1 is higher than LSB LOmin
    call astro_message(seve%e,rname,'This LO frequency is reachable only in LSB mode')
    error=.true.
    return
  else if (ib.eq.3.and.isb.eq.usb_code.and.flo.gt.264250d0) then
    ! USB LOmax is smaller than LSB LOmax
    call astro_message(seve%e,rname,'This LO frequency is reachable only in LSB mode')
    error=.true.
    return
  else if (ib.eq.3.and.isb.eq.lsb_code.and.flo.lt.211750d0) then
    ! USB LOmin is smaller than LSB LOmmin
    call astro_message(seve%e,rname,'This LO frequency is reachable only in USB mode')
    error=.true.
    return
  else if (ib.eq.4.and.isb.eq.lsb_code.and.flo.gt.341250d0) then
    ! USB LOmax is higher than LSB LOMax
    call astro_message(seve%e,rname,'This LO frequency is reachable only in USB mode')
    error=.true.
    return
  endif
  !
end subroutine pico_emir_lo_call
!
subroutine rec_define_emir_switchbox(emirsw,error)
  use gbl_message
  use astro_interfaces, except_this=>rec_define_emir_switchbox
  use astro_types
  !-----------------------------------------------------------------------
  ! @ private
  ! switchbox characteristics
  !-----------------------------------------------------------------------
  type(correlator_input_t), intent(inout) :: emirsw ! emir switchbox parameters
  logical, intent(inout)        :: error
  ! local
  integer(kind=4) :: i
  ! Switchbox
  emirsw%n_ifcables = 8
  emirsw%m_usercables = 4
  emirsw%mode = ''
  emirsw%defined = .false.
  do i=1,m_ifcables
    emirsw%ifc(i)%label = ''
    emirsw%ifc(i)%iband = 0
    emirsw%ifc(i)%sb_code = 0
    emirsw%ifc(i)%bb_code = 0
    emirsw%ifc(i)%pol_code = 0
  enddo
  !
end subroutine rec_define_emir_switchbox
!
subroutine pico_reset_emir(emir,error)
  use astro_interfaces, except_this=>pico_reset_emir
  use astro_types
  !-----------------------------------------------------------------------
  ! @ private
  ! reset emir specific parameters
  !-----------------------------------------------------------------------
  type(emir_t), intent(inout) :: emir 
  logical, intent(inout)        :: error
  ! Local
  integer(kind=4)       :: i
  !
  !Command parameters
  emir%comm%n_tunings = 0
  do i=1,m_tunings
    emir%comm%frest(i) = 0
    emir%comm%code(i) = ''
  enddo
  emir%comm%zoommode = ''
  emir%comm%fz1 = 0
  emir%comm%fz2 = 0
  emir%comm%fixed_scale = .false.
  !
  ! Setup parameters
  do i=1,m_tunings
    emir%setup%sb_code(i) = 0
    emir%setup%polar(i) = ''
    emir%setup%pol_code(i) = 0
  enddo
  emir%setup%sb_mode = ''
  emir%setup%polmode = ''
  !
  ! Switchbox
  emir%switch%mode = ''
  emir%switch%defined = .false.
  do i=1,m_ifcables
    emir%switch%ifc(i)%label = ''
    emir%switch%ifc(i)%iband = 0
    emir%switch%ifc(i)%sb_code = 0
    emir%switch%ifc(i)%bb_code = 0
    emir%switch%ifc(i)%pol_code = 0
  enddo
  !
end subroutine pico_reset_emir
!
subroutine pico_emir_setup(emir,error)
  use gbl_message
  use gkernel_interfaces
  use astro_interfaces, except_this=>pico_emir_setup
  use astro_types
  !-----------------------------------------------------------------------
  ! @ private
  ! Check feasability and tune emir requested bands
  !-----------------------------------------------------------------------
  type(emir_t), intent(inout) :: emir !command line parameters
  logical, intent(inout)        :: error
  ! Local
  character(len=*), parameter :: rname='EMIR'
  integer, parameter :: m_codes=4
  integer(kind=4) :: it,icode
  character(len=2) :: emircodes(m_codes),emircode
  data emircodes/'UI','LI','UO','LO'/
  !
  emir%rec%n_tunings=emir%comm%n_tunings
  do it=1,emir%rec%n_tunings 
    emir%rec%comm(it)%rec_name = 'EMIR'
    emir%rec%comm(it)%frest = emir%comm%frest(it)
    call sic_upper(emir%comm%code(it))
    call sic_ambigs(rname,emir%comm%code(it),emircode,icode,emircodes,m_codes,error)
    if (error) then
      call astro_message(seve%e,rname,'Problem decoding tuning sideband code (UI LI UO LO)')
      return
    endif
    select case (emir%comm%code(it))
      case ('UI')
         emir%rec%comm(it)%sideband = 'USB'
         emir%rec%comm(it)%fcent = emir%rec%desc%bbref(inner_code)
      case ('UO')
         emir%rec%comm(it)%sideband = 'USB'
         emir%rec%comm(it)%fcent = emir%rec%desc%bbref(outer_code)
      case ('LI')
         emir%rec%comm(it)%sideband = 'LSB'
         emir%rec%comm(it)%fcent = emir%rec%desc%bbref(inner_code)
      case ('LO')
         emir%rec%comm(it)%sideband = 'LSB'
         emir%rec%comm(it)%fcent = emir%rec%desc%bbref(outer_code)
    end select
    emir%rec%comm(it)%name = ''
    ! tune the bands
    call astro_tune_receiver(rname,emir%rec%desc,emir%rec%source,emir%rec%comm(it),emir%rec%tune(it),error)
    if (error) return
    !
    !Check compliance with call for proposal LO limits
    call pico_emir_lo_call(rname,emir%rec%tune(it)%iband,emir%rec%tune(it)%flo1,emir%rec%comm(it)%sideband,error)
    if (error) return
  enddo
  !
  !Check band combination feasability (in n_tunings>1)
  !
  if (emir%rec%n_tunings.gt.1) then
    !Band combination
    if (emir%rec%tune(1)%iband.eq.emir%rec%tune(2)%iband) then
      call astro_message(seve%e,rname,'A receiver band can be tuned at only one frequency at a time')
      call rec_display_error('A receiver band can be tuned at only one frequency at a time',error)
      if (error) return
      error = .true.
      return
    endif
    if (emir%rec%desc%bandname(emir%rec%tune(1)%iband).eq.'E090') then
      if (emir%rec%desc%bandname(emir%rec%tune(2)%iband).eq.'E330') then
        call astro_message(seve%e,rname,'Band combination is not allowed')
        call astro_message(seve%i,rname,'E090 can be combined with E150 or E230')
        call rec_display_error('Band combination is not allowed',error)
        if (error) return
        error = .true.
        return
      endif
    endif
    if (emir%rec%desc%bandname(emir%rec%tune(1)%iband).eq.'E150') then
      if (emir%rec%desc%bandname(emir%rec%tune(2)%iband).eq.'E230') then
        call astro_message(seve%e,rname,'Band combination is not allowed')
        call astro_message(seve%i,rname,'E150 can be combined with E090 or E330')
        call rec_display_error('Band combination is not allowed',error)
        if (error) return
        error = .true.
        return
      endif
    endif
    if (emir%rec%desc%bandname(emir%rec%tune(1)%iband).eq.'E230') then
      if (emir%rec%desc%bandname(emir%rec%tune(2)%iband).ne.'E090') then
        call astro_message(seve%e,rname,'Band combination is not allowed')
        call astro_message(seve%i,rname,'E230 can be combined with E090 only')
        call rec_display_error('Band combination is not allowed',error)
        if (error) return
        error = .true.
        return
      endif
    endif
    if (emir%rec%desc%bandname(emir%rec%tune(1)%iband).eq.'E330') then
      if (emir%rec%desc%bandname(emir%rec%tune(2)%iband).ne.'E150') then
        call astro_message(seve%e,rname,'Band combination is not allowed')
        call astro_message(seve%i,rname,'E330 can be combined with E150 only')
        call rec_display_error('Band combination is not allowed',error)
        if (error) return
        error = .true.
        return
      endif
    endif
  endif
  !
end subroutine pico_emir_setup
!
subroutine emir_switchbox(line,error)
  use gbl_message
  use gkernel_interfaces
  use astro_interfaces, except_this=>emir_switchbox
  use astro_types
  use ast_astro
  use my_receiver_globals
  use plot_molecules_globals
  use frequency_axis_globals
  !-----------------------------------------------------------------------
  ! @ private
  ! SWITCHBOX command to define what are the basebands brought to the backends
  ! no arg = defaults =  single band or maximize FTS coverage + dual polar when possible
  ! option SINGLEPOLAR (only dual band) = maximize FTS coverage + single polar when possible
  ! with arguments : sets explicitely the content of the 1-4 if cables
  !-----------------------------------------------------------------------
  character(len=*), intent(inout) :: line        ! command line
  logical, intent(inout)        :: error
  ! local
  character(len=*), parameter :: rname = 'EMIR'
  integer(kind=4), parameter :: optsingle = 1
  integer(kind=4)       :: lpar,i
  logical               :: dopchanged
  character(len=5)     :: cablecode(emir%switch%m_usercables)
  character(len=200)    :: comm
  !
  if (obsname.ne.'PICOVELETA'.and.obsname.ne.'VELETA') then
    call astro_message(seve%e,rname,'Observatory changed since last tuning - Please define a new tuning')
    error = .true.
    return
  endif
  ! Check that a tuning has been set
  if (emir%rec%n_tunings.eq.0) then
    call astro_message(seve%e,rname,'Please define a tuning (EMIR command) before setting the switchbox configuration')
    error = .true.
    return
  endif
  !
  !check that doppler did not changed since last tuning command
  call rec_check_doppler(emir%rec%source,emir%rec%desc%redshift,dopchanged,error)
  if (error) return
  if (dopchanged) then
    call astro_message(seve%e,rname,'Source properties changed since last tuning')
    call astro_message(seve%i,rname,'You should set again the tuning (EMIR command)')
    call rec_display_error('Source changed since last tuning',error)
    error = .true.
    return
  endif
  !
  !
  ! Automatic = widest possible / dual polar when possible
  ! + define all possible codes for cables
  emir%switch%mode = 'AUTO'
  if (sic_present(0,1)) then
    emir%switch%mode = 'LIST'
    do i=1,emir%switch%m_usercables
      call sic_ke(line,0,i,cablecode(i),lpar,.true.,error)
      if (error) return
    enddo
  endif
  if (sic_present(optsingle,0)) then
    if (emir%switch%mode.eq.'LIST') then
      call astro_message(seve%e,rname,'The option SINGLEPOLAR cannot be used when a list of basebands is provided')
      error = .true.
      return
    endif
    if (emir%rec%n_tunings.lt.2) then
      call astro_message(seve%e,rname,'The option /SINGLEPOLAR has no sense when using only 1 receiver band')
      error = .true.
      return
    endif
    emir%switch%mode = 'SINGLE'
  endif
  !
  !define the switch box situation corresponding to the setup
  if (emir%switch%mode.eq.'SINGLE'.or.emir%switch%mode.eq.'AUTO') then
    call emir_switch_autosetup(emir,error)
    if (error) return
  else if (emir%switch%mode.eq.'LIST') then
    call emir_switch_listsetup(emir,cablecode,error)
    if (error) return
!    call astro_message(seve%e,rname,'NOT YET IMPLEMENTED')
  else
    call astro_message(seve%e,rname,'Problem with switchbox mode')
    error = .true.
    return
  endif
  !
  do i=1,emir%switch%n_ifcables
    write (comm,'(a,1x,i0,1x,a,1x,a)') 'IF Cable #',i,'contains',emir%switch%ifc(i)%label
    call astro_message(seve%i,rname,comm)
  enddo
  !
  emir%switch%defined = .true.
  !
  call pico_switch_plot(emir,molecules,cplot,freq_axis,error)
  if (error) return
  !
  ! Let the user with the limits in main axis frequency frame
  call rec_set_limits(rname,cplot,freq_axis%main,error)
  if (error) return
  !
end subroutine emir_switchbox
!
subroutine emir_switch_autosetup(emir,error)
  use gbl_message
  use gkernel_interfaces
  use astro_interfaces, except_this=>emir_switch_autosetup
  use astro_types
  !-----------------------------------------------------------------------
  ! @ private
  ! assign the right baseband to the 8 emir if cables - default with inner and outer
  !-----------------------------------------------------------------------
  type(emir_t), intent(inout)   :: emir
  logical, intent(inout)        :: error
  ! Local      
  character(len=*), parameter :: rname = 'EMIR'
  integer(kind=4) :: it,is,ip,ib,icable,iother, n_polar
  integer(kind =4):: sb_code(m_sideband),bbcode(m_bbands),n_sidebands,polcode(emir%rec%desc%n_polar)
  integer(kind=4), parameter :: polh_code = 1
  integer(kind=4), parameter :: polv_code = 2
  character(len=5)      :: cablecode
  character(len=1)      :: polname(emir%rec%desc%n_polar)
  !
  bbcode(1) = outer_code
  bbcode(2) = inner_code
!   if (rec%desc%n_polar.eq.1) then
!     polname(1) = rec%desc%polname(1)(1:1)
!     if (polname(1).eq.'H') then
!       polcode(1) = polh_code
!     else if (polname(1).eq.'V') then
!       polcode(1) = polv_code
!     else
!       call astro_message(seve%e,rname,'Unknown polarization type')
!       error = .true.
!       return
!     endif
!   else if 
!     polcode(1) = polh_code
!     polcode(2) = polv_code
!     polname(1) = rec%desc%polname(1)
!     polname(2) = rec%desc%polname(2)
!   else
!     call astro_message(seve%e,rname,'Problem with polarization types')
!     error = .true.
!     return
!   endif
  !
  ! sideband and polar consequences of the band combination + SINGLE POLAR OPTION
  if (emir%rec%n_tunings.eq.2) then
    if (emir%rec%tune(1)%sb_code.ne.emir%rec%tune(2)%sb_code) then
      emir%setup%polmode='SINGLE'
      emir%setup%sb_mode = '2SB'
      emir%setup%sb_code(1) = 0
      emir%setup%sb_code(2) = 0
      call astro_message(seve%i,rname,'This tuning combination provides:')
      call astro_message(seve%i,rname,'2 sidebands and only 1 polar in each band')
      call astro_message(seve%i,rname,'Single polar observations are not recommended')
      call astro_message(seve%i,rname,'(lack of cross checks for ghostlines/calibration)') 
      call astro_message(seve%i,rname,'You may tune the two bands in the same sideband (U/L)')
      call astro_message(seve%i,rname,'to get dual polar in 1 sideband only')
    else
      if (emir%switch%mode.eq.'AUTO') then
        emir%setup%polmode='DUAL'
        emir%setup%polar(1) = 'H+V'
        emir%setup%polar(2) = 'H+V'
        emir%setup%sb_mode = 'SSB'
        emir%setup%sb_code(1) = emir%rec%tune(1)%sb_code
        emir%setup%sb_code(2) = emir%rec%tune(2)%sb_code
        call astro_message(seve%i,rname,'The default configuration for this combination provides:')
        call astro_message(seve%i,rname,'only 1 sideband and 2 polars in each band')
        call astro_message(seve%i,rname,'The option /SINGLEPOLAR can be used to get:')
        call astro_message(seve%i,rname,'2 sidebands and only 1 polar in each band')
        call astro_message(seve%i,rname,'Single polar observations are not recommended')
        call astro_message(seve%i,rname,'(lack of cross checks for ghostlines/calibration)') 
     else if (emir%switch%mode.eq.'SINGLE') then
        emir%setup%polmode='SINGLE'
        emir%setup%sb_mode = '2SB'
        emir%setup%sb_code(1) = 0
        emir%setup%sb_code(2) = 0
        call astro_message(seve%i,rname,'The option /SINGLEPOLAR forces the use of')
        call astro_message(seve%i,rname,'2 sidebands and only 1 polar')
        call astro_message(seve%i,rname,'Single polar observations are not recommended')
        call astro_message(seve%i,rname,'(lack of cross checks for ghostlines/calibration)')
        call astro_message(seve%i,rname,'Without the option, this band combination would provide')
        call astro_message(seve%i,rname,'2 polars in only 1 sideband in each band')
      else
        call astro_message(seve%e,rname,'Problem with switchbox mode')
        error = .true.
        return
      endif
    endif
    if (emir%setup%polmode.eq.'SINGLE') then
      do it=1,emir%rec%n_tunings
        if (emir%rec%desc%bandname(emir%rec%tune(it)%iband).eq.'E330'.or.                 &
            emir%rec%desc%bandname(emir%rec%tune(it)%iband).eq.'E230')            then
          emir%setup%pol_code(it) = polv_code
          emir%setup%polar(it) = emir%rec%desc%polname(emir%setup%pol_code(it))(1:1)
        else if (emir%rec%desc%bandname(emir%rec%tune(it)%iband).eq.'E090') then
          emir%setup%pol_code(it) = polh_code
          emir%setup%polar(it) = emir%rec%desc%polname(emir%setup%pol_code(it))(1:1)
        else if (emir%rec%desc%bandname(emir%rec%tune(it)%iband).eq.'E150') then
          if (it.eq.1) then 
            iother = 2
          else if (it.eq.2) then
            iother = 1
          else
            call astro_message(seve%e,rname,'Problem with Band identification')
            error = .true.
            return
          endif
          if (emir%rec%desc%bandname(emir%rec%tune(iother)%iband).eq.'E330') then
            emir%setup%pol_code(it) = polh_code
            emir%setup%polar(it) = emir%rec%desc%polname(emir%setup%pol_code(it))(1:1)
          else if (emir%rec%desc%bandname(emir%rec%tune(iother)%iband).eq.'E090') then
            emir%setup%pol_code(it) = polv_code
            emir%setup%polar(it) = emir%rec%desc%polname(emir%setup%pol_code(it))(1:1)
          endif
        else
          call astro_message(seve%e,rname,'Problem with Band identification')
          error = .true.
          return
        endif
      enddo
    endif
  else if (emir%rec%n_tunings.eq.1) then
    emir%setup%polmode='DUAL'
    emir%setup%polar(1) = 'H+V'
    emir%setup%sb_mode = '2SB'
    emir%setup%sb_code(1) = 0
  else
    call astro_message(seve%e,rname,'Problem with the number of tunings')
    error = .true.
    return
  endif
  !Define what goes through the cables - default is INNER for cable 1 to 4  !
  do it=1,emir%rec%n_tunings
    if (emir%setup%sb_mode.eq.'2SB') then
      n_sidebands = 2
      sb_code(1) = usb_code
      sb_code(2) = lsb_code
    else if (emir%setup%sb_mode.eq.'SSB') then
      n_sidebands = 1
      sb_code(1) = emir%setup%sb_code(it)
    else
      call astro_message(seve%e,rname,'Problem with sidebands')
      error = .true.
      return
    endif
    if (emir%setup%polmode.eq.'DUAL') then
      n_polar = 2
      polname(1) = 'H'
      polname(2) = 'V'
      polcode(1) = polh_code
      polcode(2) = polv_code
    else if (emir%setup%polmode.eq.'SINGLE') then
      n_polar = 1
      polname(1) = emir%setup%polar(it)
      if (polname(1).eq.'H') then
        polcode(1) = polh_code
      else if (polname(1).eq.'V') then
        polcode(1) = polv_code
      else
        call astro_message(seve%e,rname,'Problem with polarization determination')
        error = .true.
        return
      endif
    else
      call astro_message(seve%e,rname,'Problem with number of polars')
      error=.true.
      return
    endif
    do is=1,n_sidebands
      do ip=1,n_polar
        do ib=1,emir%rec%desc%n_bbands
          write (cablecode,'(i0,a,i0,i0)') emir%rec%tune(it)%iband,polname(ip),sb_code(is),bbcode(ib)
          ! by default outer goes only to cable 5 to 8 - cable 1 to 4 takes inner
          select case (cablecode)
          case ('1V22','4V22','2V12','3V12')
            icable = 1
            !
          case ('1V21','4V21','2V11','3V11')
            icable = 5
            !
          case ('1V12','4V12','2V22','3V22')
            icable = 2
            !
          case ('1V11','4V11','2V21','3V21')
            icable = 6
            !
          case ('1H22','4H22','2H12','3H12')
            icable = 3
            !
          case ('1H21','4H21','2H11','3H11')
            icable = 7
            !
          case ('1H12','4H12','2H22','3H22')
            icable = 4
            !
          case ('1H11','4H11','2H21','3H21')
            icable = 8
            !
          case default
            call astro_message(seve%e,rname,'Problem defining the switch box setup')
            error = .true.
            return
          end select
          emir%switch%ifc(icable)%iband = emir%rec%tune(it)%iband
          emir%switch%ifc(icable)%sb_code = sb_code(is)
          emir%switch%ifc(icable)%bb_code = bbcode(ib)
          emir%switch%ifc(icable)%pol_code = polcode(ip)
          write (emir%switch%ifc(icable)%label,'(a,a,a,a)') emir%rec%desc%bandname(emir%rec%tune(it)%iband)(1:2),            &
                  polname(ip)(1:1),sideband(sb_code(is))(1:1),emir%rec%desc%bbname(ib)(1:1)
        enddo
      enddo
    enddo
  enddo
  !
end subroutine emir_switch_autosetup
!
subroutine emir_switch_listsetup(emir,cablecode,error)
  use gbl_message
  use gkernel_interfaces
  use astro_interfaces, except_this=>emir_switch_listsetup
  use astro_types
  !-----------------------------------------------------------------------
  ! @ private
  ! assign user defined IF cables - user provides 4 codes, we deduce 8 IF cables
  !-----------------------------------------------------------------------
  type(emir_t), intent(inout)   :: emir
  character(len=*), intent(inout)  :: cablecode(emir%switch%m_usercables)
  logical, intent(inout)        :: error
  ! Local
  character(len=*), parameter :: rname = 'EMIR'
  character(len=2) :: urec
  character(len=1) :: upol
  character(len=1) :: uside
  character(len=1) :: ubb
  logical :: found,assigned(emir%switch%m_usercables)
  character(len=12)      :: polname(2)
  character(len=200)      :: mess
  integer(kind=4) :: ic,it,is,ip,ib,icable,icode
  integer(kind=4) :: bbcode(emir%rec%desc%n_bbands),sb_code(m_sideband),polcode(emir%rec%desc%n_polar)
  integer(kind=4), parameter :: polh_code = 1
  integer(kind=4), parameter :: polv_code = 2
  !
  if (emir%rec%desc%n_polar.eq.2) then
    polcode(1) = polh_code
    polcode(2) = polv_code
  else
    polname(1) = emir%rec%desc%polname(1)
    if  (polname(1)(1:1).eq.'H') then
      polcode(1) = polh_code
    else if  (polname(1)(1:1).eq.'V') then
      polcode(1) = polv_code
    else
      call astro_message(seve%e,rname,'Problem with polarization determination')
      error = .true.
      return
    endif
  endif
  !
  bbcode(1) = outer_code !outer
  bbcode(2) = inner_code !inner
  !
  emir%setup%polmode = 'USER'
  emir%setup%sb_mode = ''
  !
  do ic=1,emir%switch%m_usercables
    assigned(ic) = .false.
  enddo
  do icode=1,emir%switch%m_usercables
    found = .false.
    call sic_upper(cablecode(icode))
    urec = cablecode(icode)(1:2)
    upol = cablecode(icode)(3:3)
    uside = cablecode(icode)(4:4)
    ubb = cablecode(icode)(5:5)
    do it=1,emir%rec%n_tunings
      if (urec.ne.emir%rec%desc%bandname(emir%rec%tune(it)%iband)(1:2)) cycle
      if (emir%rec%desc%n_sbands.eq.2) then
        sb_code(1) = usb_code
        sb_code(2) = lsb_code
      else
        sb_code(1) = emir%rec%tune(it)%sb_code
      endif
      do is=1,emir%rec%desc%n_sbands
        if (uside.ne.sideband(sb_code(is))(1:1)) cycle
        do ip=1,emir%rec%desc%n_polar
          if (upol.ne.emir%rec%desc%polname(ip)(1:1)) cycle
          do ib=1,emir%rec%desc%n_bbands
            if (ubb.ne.emir%rec%desc%bbname(ib)(1:1)) cycle
            select case (cablecode(icode))
            case ('E0VLI','E3VLI','E1VUI','E2VUI','E0VLO','E3VLO','E1VUO','E2VUO')
              icable = 1
              if (assigned(icable)) then
                call astro_message(seve%e,rname,'The same cable cannot be used several times')
                error = .true.
                return
              endif
              assigned(icable) = .true.
              found = .true.
            case ('E0VUI','E3VUI','E1VLI','E2VLI','E0VUO','E3VUO','E1VLO','E2VLO')
              icable = 2
              if (assigned(icable)) then
                call astro_message(seve%e,rname,'The same cable cannot be used several times')
                error = .true.
                return
              endif
              assigned(icable) = .true.
              found = .true.
            case ('E0HLI','E3HLI','E1HUI','E2HUI','E0HLO','E3HLO','E1HUO','E2HUO')
              icable = 3
              if (assigned(icable)) then
                call astro_message(seve%e,rname,'The same cable cannot be used several times')
                error = .true.
                return
              endif
              assigned(icable) = .true.
              found = .true.
            case ('E0HUI','E3HUI','E1HLI','E2HLI','E0HUO','E3HUO','E1HLO','E2HLO')
              icable = 4
              if (assigned(icable)) then
                call astro_message(seve%e,rname,'The same cable cannot be used several times')
                error = .true.
                return
              endif
              assigned(icable) = .true.
              found = .true.
            case default
              call astro_message(seve%e,rname,'Code was not understood')
              error = .true.
              return
            end select
            emir%switch%ifc(icable)%iband = emir%rec%tune(it)%iband
            emir%switch%ifc(icable)%sb_code = is
            emir%switch%ifc(icable)%bb_code = bbcode(ib)
            emir%switch%ifc(icable)%pol_code = polcode(ip)
            emir%switch%ifc(icable)%label = cablecode(icode)
            ! corresponding cable 4-8
            emir%switch%ifc(icable+emir%switch%m_usercables)%iband = emir%rec%tune(it)%iband
            emir%switch%ifc(icable+emir%switch%m_usercables)%sb_code = is
            emir%switch%ifc(icable+emir%switch%m_usercables)%bb_code = bbcode(1) !outer is forced
            emir%switch%ifc(icable+emir%switch%m_usercables)%pol_code = polcode(ip)
            write(emir%switch%ifc(icable+emir%switch%m_usercables)%label,'(a,a)')     &
                    cablecode(icode)(1:4),emir%rec%desc%bbname(1)(1:1)
          enddo ! baseband
        enddo !polar
      enddo ! sidebands
    enddo ! receivers
    if (.not.found) then
      write (mess,'(a,1x,a)') 'Code provided by the user does not match',cablecode(icode)
      call astro_message(seve%e,rname,mess)
      error = .true.
      return
    endif
  enddo ! user input
  !
end subroutine emir_switch_listsetup
!
subroutine pico_switch_plot(emir,cata,cplot,drawaxis,error)
  use gbl_message
  use gkernel_interfaces
  use astro_interfaces, except_this=>pico_switch_plot
  use astro_types
  !-----------------------------------------------------------------------
  ! @ private
  ! identifies the polarizations and sideband available with the current emir setup
  !-----------------------------------------------------------------------
  type(emir_t), intent(inout) :: emir
  type(plot_molecules_t), intent(in) :: cata
  type(current_boxes_t), intent(inout) :: cplot
  type(frequency_axis_t), intent(in) :: drawaxis
  logical, intent(inout) :: error
  ! local
  character(len=*), parameter :: rname='EMIR'
  integer(kind=4) :: i,j,k,sb_code(m_sideband),ip,ib,ic,izoom,it,iband
  character(len=200) :: comm,defchar,smallchar,molchar
  character(len=5) :: cablecode
  real(kind=8) :: fif1,frf,frest,yt,l1,l2,l3,l4,b1,b2,b3,b4
  type(draw_rect_t)     :: sbrect
  type(draw_line_t)     :: linebb
  real(kind=4), parameter :: sdefchar = 0.4
  logical       :: nobb
  !
  sb_code(1) = usb_code
  sb_code(2) = lsb_code
  !
  !Clear and redraw in case the frequency axis were changed since last EMIR command
  call gr_execl('CLEAR DIRECTORY')  
  !
  select case (cplot%desc%plotmode)
  case (pm_allbands)
    call rec_plot_mbands(emir%rec%desc,emir%rec%source, &
                        cata,emir%comm%fixed_scale,cplot,drawaxis,error)
    if (error) return
    if (emir%rec%n_tunings.ne.0) then
      do it=1,emir%rec%n_tunings
        call rec_plot_tuned(emir%rec%desc,emir%rec%source,emir%rec%tune(it), &
                        cata,cplot,drawaxis,error)
        if (error) return
      enddo
    endif
  case (pm_tunedbands)
    call rec_plot_nbands(emir%rec,cata,emir%comm%fixed_scale,cplot,drawaxis,error)
    if (error) return
  case (pm_receiver)
    call rec_get_itune(emir%rec,cplot%box(1)%iband,izoom,error)
    if (error) return
    call rec_plot_sidebands(emir%rec%desc,emir%rec%source,emir%rec%tune(izoom),cplot,cata,drawaxis,error)
    if (error) return
  case (pm_zoom)
    call astro_message(seve%i,rname,'Leaving the zoom mode to show baseband coverage')
    call gr_execl('CLEAR DIRECTORY')
    call rec_plot_mbands(emir%rec%desc,emir%rec%source, &
                        cata,emir%comm%fixed_scale,cplot,drawaxis,error)
    if (error) return
    if (emir%rec%n_tunings.ne.0) then
      do it=1,emir%rec%n_tunings
        call rec_plot_tuned(emir%rec%desc,emir%rec%source,emir%rec%tune(it), &
                        cata,cplot,drawaxis,error)
        if (error) return
      enddo
    endif
  end select
  if (.not.(gtexist('<GREG<BOX1'))) then
    call gr_execl('CLEAR DIRECTORY')
    call rec_plot_mbands(emir%rec%desc,emir%rec%source, &
                        cata,emir%comm%fixed_scale,cplot,drawaxis,error)
    if (error) return
    if (emir%rec%n_tunings.ne.0) then
      do it=1,emir%rec%n_tunings
        call rec_plot_tuned(emir%rec%desc,emir%rec%source,emir%rec%tune(it), &
                        cata,cplot,drawaxis,error)
        if (error) return
      enddo
    endif
  endif
  !
  write (defchar,'(a,1x,f0.3)') 'SET CHARACTER',cplot%desc%defchar
  write (smallchar,'(a,1x,f0.3)') 'SET CHARACTER',cplot%desc%smallchar
  write (molchar,'(a,1x,f0.3)') 'SET CHARACTER',cplot%desc%molchar
  call gr_exec1(defchar)
  call gr_pen(colour=adefcol,error=error)
  if (error) return
  !
  write (comm,'(a)') 'CHANGE DIRECTORY'
  call gr_execl(comm)
  if (gtexist('IFPROC')) then
    write (comm,'(a)') 'DESTROY DIRECTORY IFPROC'
    call gr_execl(comm)
  endif
  write (comm,'(a)') 'CREATE DIRECTORY IFPROC'
  call gr_execl(comm)
  do i=1,cplot%nbox
    if (cplot%desc%plotmode.eq.pm_receiver.and.i.eq.2) cycle
    write (comm,'(a,i0)') 'CHANGE DIRECTORY <GREG<BOX',i
    call gr_execl(comm)
    l1 = cplot%box(i)%rest%xmin
    l2 = cplot%box(i)%rest%xmax
    l3 = cplot%box(i)%rest%ymin
    l4 = cplot%box(i)%rest%ymax
    b1 = cplot%box(i)%phys%xmin
    b2 = cplot%box(i)%phys%xmax
    b3 = cplot%box(i)%phys%ymin
    b4 = cplot%box(i)%phys%ymax
    write (comm,'(a)') 'CHANGE DIRECTORY'
    call gr_execl(comm)
    write (comm,'(a)') 'CHANGE DIRECTORY IFPROC'
    call gr_execl(comm)
    write (comm,'(a,4(1x,f0.3))') 'SET BOX_LOCATION',b1,b2,b3,b4
    call gr_exec1(comm)
    write (comm,'(a,4(1x,f0.3))') 'LIMITS',l1,l2,l3,l4
    call gr_exec1(comm)
    if (i.eq.1) then
      if (emir%switch%mode.eq.'LIST') then
        write (comm,'(a,1x,a,1x,a)') 'DRAW TEXT +5 3.5 "USER SELECTION" 5 0 /CHARACTER 7'
        call gr_exec1(comm)
      else if (emir%switch%mode.eq.'AUTO'.or.emir%switch%mode.eq.'SINGLE') then
        call gr_pen(colour=apolcol,error=error)
        if (error) return
        write (comm,'(a,1x,a,1x,a)') 'DRAW TEXT +3 3.5 "',trim(emir%setup%polmode),'" 5 0 /CHARACTER 7'
        call gr_exec1(comm)
        call gr_pen(colour=adefcol,error=error)
        if (error) return
        write (comm,'(a,1x,a,1x,a)') 'DRAW TEXT +7 3.5 "POLAR" 5 0 /CHARACTER 7'
        call gr_exec1(comm)
      else
        call astro_message(seve%e,rname,'Problem with switchbox mode')
        error = .true.
        return
      endif
    endif
    do j=1,emir%rec%n_tunings
      if (emir%rec%tune(j)%iband.ne.cplot%box(i)%iband) cycle
      iband=emir%rec%tune(j)%iband
      do k=1,emir%rec%desc%n_sbands
        ! cycle if the current box does not contain the right sideband
        if (cplot%box(i)%sb_code.ne.k.and.cplot%box(i)%sb_code.ne.0) cycle
!        if (emir%setup%sb_code(j).eq.0.or.emir%setup%sb_code(j).eq.sb_code(k)) then
          !available side band --> loop on baseband and polar
          do ib=1,emir%rec%desc%n_bbands
            nobb = .true.
            do ip=1,emir%rec%desc%n_polar
              write (cablecode,'(a,a,a,a)') emir%rec%desc%bandname(iband)(1:2),            &
                  emir%rec%desc%polname(ip)(1:1),sideband(sb_code(k))(1:1),emir%rec%desc%bbname(ib)(1:1)
              do ic=1,emir%switch%n_ifcables
                if (emir%switch%ifc(ic)%label.eq.cablecode) then
                  nobb = .false.
                  !available baseband --> write name
                  fif1 = (emir%rec%desc%bblim(2,ib)+emir%rec%desc%bblim(1,ib))/2d0
                  yt = l3+((l4-l3)/6)*ip
                  call if1torf(emir%rec%tune(j)%flo1,fif1,sb_code(k),frf,error)
                  if (error) return
                  call rftorest(emir%rec%source%dopshift,frf,frest,error)
                  if (error) return
                  call gr_pen(colour=abbifproccol,error=error)
                  if (error) return
                  call gr_exec1(smallchar)
                  write (comm,'(a,1x,f0.6,1x,f0.3,1x,a,a,1x,a)')               &
                    'DRAW TEXT',frest,yt,'"',trim(cablecode),'" 5 0 /USER /CLIP'
                  call gr_exec1(comm)
                  !draw the limit of the baseband
                  call if1torf(emir%rec%tune(j)%flo1,emir%rec%desc%bblim(1,ib),sb_code(k),frf,error)
                  if (error) return
                  call rftorest(emir%rec%source%dopshift,frf,linebb%xmin,error)
                  if (error) return
                  call if1torf(emir%rec%tune(j)%flo1,emir%rec%desc%bblim(2,ib),sb_code(k),frf,error)
                  if (error) return
                  call rftorest(emir%rec%source%dopshift,frf,linebb%xmax,error)
                  if (error) return
                  linebb%ymin = cplot%box(i)%rest%ymin+(cplot%box(i)%rest%ymax-cplot%box(i)%rest%ymin)/10
                  linebb%ymax = linebb%ymin
                  linebb%col   = abbifproccol
                  linebb%dash  = 1
                  call rec_draw_arrow(linebb,cplot%box(i)%rest,error)
                  if (error) return
                  frest = linebb%xmin
                  linebb%xmin = linebb%xmax
                  linebb%xmax = frest
                  call rec_draw_arrow(linebb,cplot%box(i)%rest,error)
                  if (error) return
                  call gr_pen(colour=adefcol,error=error)
                  if (error) return
                  call gr_exec1(defchar)
                endif
              enddo ! cable
            enddo ! polar
            !
            !unavailable base band --> filled in rectangle
            if (nobb) then
              call if1torf(emir%rec%tune(j)%flo1,emir%rec%desc%bblim(1,ib),sb_code(k),frf,error)
              if (error) return
              call rftorest(emir%rec%source%dopshift,frf,sbrect%xmin,error)
              if (error) return
              call if1torf(emir%rec%tune(j)%flo1,emir%rec%desc%bblim(2,ib),sb_code(k),frf,error)
              if (error) return
              call rftorest(emir%rec%source%dopshift,frf,sbrect%xmax,error)
              if (error) return
              sbrect%ymin=cplot%box(i)%rest%ymin
              sbrect%ymax=cplot%box(i)%rest%ymax
              sbrect%col=anotselcol
              call rec_draw_frect(sbrect,cplot%box(i)%rest,error)
              if (error) return
              !
              call rec_draw_fbox(cplot,i,drawaxis,error)
              if (error) return
              !
              if (cplot%box(i)%rest%xmin.le.emir%rec%tune(j)%frest.and.cplot%box(i)%rest%xmax.ge.emir%rec%tune(j)%frest) then
                call rec_draw_linetune(emir%rec%tune(j),cplot%box(i)%rest,error)
                if (error) return
              endif
              !plot again molecules
              call gr_exec1(molchar)
              call rec_draw_molecules(cata,cplot%box(i)%rest,error)
              if (error) return
              call gr_exec1(defchar)
            endif
          enddo !baseband
!        endif
      enddo !sideband
      write (comm,'(a)') 'CHANGE DIRECTORY'
      call gr_execl(comm)
    enddo !tuning
    write (comm,'(a)') 'CHANGE DIRECTORY'
    call gr_execl(comm)
  enddo ! boxes
  call gr_pen(colour=adefcol,error=error)
  if (error) return
  call gr_exec1(defchar)
  !
end subroutine pico_switch_plot
