subroutine modify(set,line,r,error)
  use gildas_def
  use gbl_message
  use gbl_constant
  use phys_const
  use classcore_dependencies_interfaces
  use classcore_interfaces
  use class_types
  !---------------------------------------------------------------------
  ! @ no-interface (name is too generic, conflicts with local variables)
  ! CLASS Support routine for commande MODIFY
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set    !
  character(len=*),    intent(in)    :: line   ! Command line
  type(observation),   intent(inout) :: r      !
  logical,             intent(inout) :: error  ! Status flag
  ! Local
  character(len=*), parameter :: rname='MODIFY'
  integer(kind=4), parameter :: nterm=20
  character(len=14) :: term(nterm),chain,key
  integer(kind=4) :: iterm,i,nc,iarg
  real(kind=8) :: r8
  real(kind=4) :: newblank
  character(len=80) :: ch
  character(len=24) :: arg,proja0,projd0,projang
  character(len=13) :: projarg,projunit
  data term /'BANDS',         'BEAM_EFF', 'BLANKING',  'DOPPLER', 'FREQUENCY',    &
             'ELEVATION_GAIN','IMAGE',    'LINENAME',  'OFFSETS', 'POSITION',     &
             'PROJECTION',    'RECENTER', 'SCALE',     'SOURCE',  'SWITCH_MODE',  &
             'SYSTEM',        'TELESCOPE','VDIRECTION','VELOCITY','WIDTH'/
  !
  ! Parse for modify kind
  call sic_ke(line,0,1,chain,nc,.true.,error)
  if (error) return
  call sic_ambigs(rname,chain,key,iterm,term,nterm,error)
  if (error) return
  !
  if (sic_present(1,0) .and. key.ne.'BEAM_EFF') then
    call class_message(seve%e,rname,'Option /RUZE is not compatible with '//key)
    error = .true.
    return
  endif
  !
  ! Sanity checks
  if (r%head%xnum.eq.0) then
    call class_message(seve%e,rname,'No spectrum in memory')
    error = .true.
    return
  endif
  !
  select case (key)
  case ('FREQUENCY')
     ! Modify velocity scale according to new rest frequency [MHz]
     call sic_r8(line,0,2,r8,.true.,error)
     if (error) return
     call modify_frequency(r,r8,error)
     if (error) return
     call newdat(set,r,error)
     if (error) return
     !
  case ('VELOCITY')
     ! Modify image and rest frequency according to new reference velocity [km/s]
     call sic_r8(line,0,2,r8,.true.,error)
     if (error) return
     call modify_velocity(r,r8,error)
     if (error)  return
     call newdat(set,r,error)
     if (error) return
     !
  case ('DOPPLER')
     ! Modify the Doppler factor (in the CLASS convention: Dopp = -V/c)
     arg = ''
     call sic_ke(line,0,2,arg,nc,.false.,error)
     if (error) return
     call modify_doppler(set,arg,r%head,error)
     if (error)  return
     !
  case ('RECENTER')
     ! SG: Confidentiel pour corriger erreurs frequences
     call sic_r8(line,0,2,r8,.true.,error)
     if (error) return
     if (r%head%gen%kind.eq.kind_spec) then
        r%head%spe%rchan = r8
     elseif (r%head%gen%kind.eq.kind_cont) then
        r%head%dri%rpoin = r8
     endif
     write(ch,'(A,1PG13.6)') 'Reference channel set to ',r8
     call class_message(seve%w,rname,ch)
     call newdat(set,r,error)
     if (error) return
     !
  case ('BANDS')
     ! Exchange signal and image bands
     if (r%head%spe%image.eq.image_null) then
       call class_message(seve%e,rname,'Spectrum has no image band defined')
       error = .true.
       return
     endif
     r%head%spe%fres = -r%head%spe%fres
     r8 = r%head%spe%image
     r%head%spe%image= r%head%spe%restf
     r%head%spe%restf= r8
     r%head%spe%vres = -clight_kms*r%head%spe%fres/r%head%spe%restf
     call newdat(set,r,error)
     if (error) return
     !
  case ('LINENAME')
     ! Modify line name
     call sic_ch (line,0,2,arg,nc,.true.,error)
     if (error) then
       if (nc.eq.12) then
         call class_message(seve%w,rname,'Line name truncated to 12 char.')
         error = .false.
       else
         return
       endif
     endif
     r%head%spe%line = arg(1:12)
     !
  case ('WIDTH')
     ! Modify channel width [MHz]
     call sic_r8 (line,0,2,r8,.true.,error)
     if (error) return
     if (r%head%gen%kind.eq.kind_spec) then
        r%head%spe%fres = r8
        ! The velocity resolution should actually be computed from the sky frequency
        ! (not available in present header; will have to be added).
        r%head%spe%vres = -clight_kms*r%head%spe%fres/r%head%spe%restf
     elseif (r%head%gen%kind.eq.kind_cont) then
        r%head%dri%tres = r8*r%head%dri%tres/r%head%dri%ares
        r%head%dri%ares = r8
     endif
     call newdat(set,r,error)
     if (error) return
     !
  case ('IMAGE')
     ! Modify the velocity scale corresponding to a new rest frequency [MHz]
     call sic_r8 (line,0,2,r8,.true.,error)
     if (error) return
     r%head%spe%image = r8
     write (ch,'(A,1X,F19.6)') 'Image frequency set to ',r%head%spe%image
     call class_message(seve%i,rname,ch)
     call newdat(set,r,error)
     if (error) return
     !
  case ('TELESCOPE')
     ! Modify telescope name
     call sic_ch (line,0,2,arg,nc,.true.,error)
     if (error) then
       if (nc.eq.12) then
         call class_message(seve%w,rname,'Telescope name truncated to 12 char.')
         error = .false.
       else
         return
       endif
     endif
     r%head%gen%teles = arg(1:12)
     !
  case ('BEAM_EFF')
     ! Modified the beam efficiency.
     call modify_beeff(set,line,r,error)
     if (error)  return
     !
  case ('SOURCE')
     ! Modify source name
     call sic_ch (line,0,2,arg,nc,.true.,error)
     if (error) then
       if (nc.eq.12) then
         call class_message(seve%w,rname,'Source name truncated to 12 char.')
         error = .false.
       else
         return
       endif
     endif
     r%head%pos%sourc = arg(1:12)
     !
  case ('SYSTEM')
     ! Change the System in which the center of projection has  been defined
     call sic_ke(line,0,2,arg,nc,.true.,error)
     if (error) return
     if (arg(1:2).eq.'GA') then
        r%head%pos%system = sign(type_ga,r%head%pos%system)
     elseif (arg(1:2).eq.'EQ') then
        r%head%pos%system = sign(type_eq,r%head%pos%system)
     elseif (arg(1:2).eq.'HO') then
        r%head%pos%system = sign(type_ho,r%head%pos%system)
     elseif (arg(1:2).eq.'IC') then
        r%head%pos%system = sign(type_ic,r%head%pos%system)
     elseif (arg(1:2).eq.'UN') then
        r%head%pos%system = sign(type_un,r%head%pos%system)
     else
        call class_message(seve%e,rname,'Unknown SYSTEM')
        error = .true.
        return
     endif
     !
  case ('OFFSETS') ! MODIFY OFFSET O1 O2 [Unit]
     arg = ' '  ! Default current angle unit
     call sic_ke(line,0,4,arg,nc,.false.,error)
     if (error) return
     call sic_ch(line,0,2,ch,nc,.true.,error)
     if (error) return
     call coffse(set,rname,ch,arg,r%head%pos%lamof,error)
     if (error) return
     call sic_ch(line,0,3,ch,nc,.true.,error)
     if (error) return
     call coffse(set,rname,ch,arg,r%head%pos%betof,error)
     if (error) return
     r%head%pos%rx_off = set%fangle*r%head%pos%lamof
     r%head%pos%ry_off = set%fangle*r%head%pos%betof
     write(ch,'(A,1X,2(1PG10.3,1X),A)') 'Offsets set to ',  &
       r%head%pos%rx_off,r%head%pos%ry_off,obs_system(r%head%pos%system)
     call class_message(seve%i,rname,ch)
     !
  case ('PROJECTION')
     ! Modify the kind of projection (RADIO, AZIMUTHAL, etc) and
     ! optionally the projection center and angle
     call sic_ke(line,0,2,projarg,nc,.true.,error)
     if (error) return
     proja0 = '='  ! Means unchanged by default
     call sic_ch(line,0,3,proja0,nc,.false.,error)
     if (error)  return
     projd0 = '='  ! Means unchanged by default. Must be present if A0 is present
     call sic_ch(line,0,4,projd0,nc,sic_present(0,3),error)
     if (error)  return
     projang = '='  ! Means unchanged by default
     call sic_ch(line,0,5,projang,nc,.false.,error)
     if (error) return
     projunit = 'D'  ! Default degree
     call sic_ke(line,0,6,projunit,nc,.false.,error)
     if (error) return
     !
     call modify_projection(set,r%head,projarg,proja0,projd0,projang,projunit,error)
     if (error)  return
     !
  case ('POSITION')
     ! Modify center of projection
     call sic_ch(line,0,2,proja0,nc,.true.,error)
     if (error)  return
     call sic_ch(line,0,3,projd0,nc,.true.,error)
     if (error)  return
     !
     call modify_projection(set,r%head,'=',proja0,projd0,'=','',error)
     if (error)  return
     !
  case ('SWITCH_MODE')
     ! Modify the description of the switching mode (typically
     ! for foreign data)
     call sic_i4 (line,0,3,nc,.true.,error)
     if (error) return
     if (nc.gt.mxphas) then
        write(chain,'(I2)') mxphas
        ch = 'Too many phases. Only '//chain(1:2)   &
             &        //' supported.'
        call class_message(seve%e,rname,ch)
        error = .true.
        return
     elseif (nc.lt.1) then
        ch = 'Invalid number of phases. Must be positive.'
        call class_message(seve%e,rname,ch)
        error = .true.
        return
     endif
     r%head%swi%nphas = nc
     call sic_ke (line,0,2,chain,nc,.true.,error)
     if (error) return
     if (chain(1:1).eq.'F') then
        do i =1,r%head%swi%nphas
           call sic_r8 (line,0,3*i+1,r%head%swi%decal(i),.true.,error)
           if (error) return
           call sic_r4 (line,0,3*i+2,r%head%swi%duree(i),.true.,error)
           if (error) return
           call sic_r4 (line,0,3*i+3,r%head%swi%poids(i),.true.,error)
           if (error) return
        enddo
        r%head%swi%swmod = mod_freq
        r%head%presec(class_sec_swi_id) = .true.
     elseif (chain(1:1).eq.'P') then
        do i =1,r%head%swi%nphas
           call sic_r4 (line,0,4*i,r%head%swi%ldecal(i),.true.,error)
           if (error) return
           call sic_r4 (line,0,4*i+1,r%head%swi%bdecal(i),.true.,error)
           if (error) return
           call sic_r4 (line,0,4*i+2,r%head%swi%duree(i),.true.,error)
           if (error) return
           call sic_r4 (line,0,4*i+3,r%head%swi%poids(i),.true.,error)
           if (error) return
        enddo
        r%head%swi%swmod = mod_pos
        r%head%presec(class_sec_swi_id) = .true.
     else
        ch = chain//' Switching not yet supported in this command'
        call class_message(seve%e,rname,ch)
        error = .true.
        return
     endif
     !
  case ('BLANKING')
     ! Modify blanking value in both header and data
     call sic_r4 (line,0,2,newblank,.true.,error)
     if (error) return
     call modify_blanking(r,newblank)
     !
  case ('SCALE')  ! MODIFY SCALE ToUnit
     ! Modify Y scale unit (i.e. RY values)
     call sic_ch(line,0,2,chain,nc,.true.,error)
     if (error)  return
     call sic_upper(chain)
     call sic_ambigs(rname,chain,arg,iarg,yunit_keys(1:myunit),myunit,error)
     if (error) return
     call modify_scale(r,iarg,.true.,error)
     if (error)  return
     !
  case ('VDIRECTION')
     call modify_vdirection(set,r%head,error)
     if (error)  return
     !
  case ('ELEVATION_GAIN')
     call modify_elevationgain(r,error)
     if (error)  return
     !
  case default
     call class_message(seve%e,rname,'Keyword '//trim(key)//' not implemented')
     error = .true.
     return
  end select
  !
end subroutine modify
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
subroutine modify_frequency(obs,new_restf,error)
  use phys_const
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Modify velocity scale according to new rest frequency [MHz]
  ! The axes are assumed to be linear in Frequency.
  ! It will also work properly for the RADIO definition of the velocity,
  ! but not for the others
  ! See IRAM Memo "Description of the frequency/velocity axes in CLASS"
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs        !
  real(kind=8),      intent(in)    :: new_restf  !
  logical,           intent(inout) :: error      !
  !
  if (obs%head%spe%restf.eq.new_restf)  return
  !
  ! Update Resolution section
  call modify_resolution(obs,obs%head%spe%restf,new_restf,error)
  if (error)  return
  !
  ! Update Spectroscopic section
  if (obs%head%spe%doppler.ne.-1.d0) then
    obs%head%spe%rchan = obs%head%spe%rchan + &
      (new_restf-obs%head%spe%restf)/obs%head%spe%fres * (1d0+obs%head%spe%doppler)
  else
    obs%head%spe%rchan = obs%head%spe%rchan + &
      (new_restf-obs%head%spe%restf)/obs%head%spe%fres
  endif
  if (obs%head%spe%image.ne.image_null) then
    obs%head%spe%image = (obs%head%spe%image+obs%head%spe%restf) - new_restf
  endif
  obs%head%spe%vres = -clight_kms*obs%head%spe%fres/new_restf
  obs%head%spe%restf = new_restf
  !
end subroutine modify_frequency
!
subroutine modify_velocity(obs,velo_new,error)
  use gbl_message
  use class_types
  use phys_const
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   MODIFY VELOCITY
  ! See IRAM Memo "Description of the frequency/velocity axes in CLASS"
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs       !
  real(kind=8),      intent(in)    :: velo_new  !
  logical,           intent(inout) :: error     !
  ! Local
  character(len=*), parameter :: rname='MODIFY'
  real(kind=8) :: dop_old,dop_new
  !
  if (obs%head%spe%voff.eq.velo_new)  return
  !
  if (obs%head%spe%doppler.eq.-1.d0) then
    call class_message(seve%e,rname,  &
      'Can not compute new Doppler: initial Doppler factor absent')
    call class_message(seve%e,rname,  &
      'You can compute it with MODIFY DOPPLER, see HELP for details')
    error = .true.
    return
  endif
  !
  dop_old = obs%head%spe%doppler
  dop_new = dop_old + (obs%head%spe%voff-velo_new)/clight_kms
  !
  if (obs%head%spe%image.ne.image_null) then
    obs%head%spe%image = obs%head%spe%image*(1.d0+dop_old)/(1.d0+dop_new) -  &
                         obs%head%spe%restf*(dop_new-dop_old)/(1.d0+dop_new)
  endif
  obs%head%spe%rchan   = obs%head%spe%rchan +  &
                         obs%head%spe%restf/obs%head%spe%fres*(dop_new-dop_old)
  obs%head%spe%voff    = velo_new
  obs%head%spe%doppler = dop_new
  !
end subroutine modify_velocity
!
subroutine modify_resolution(obs,old_freq,new_freq,error)
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Recompute the resolution according to the new frequency at
  ! reference channel (= rest frequency)
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs
  real(kind=8),      intent(in)    :: old_freq
  real(kind=8),      intent(in)    :: new_freq
  logical,           intent(inout) :: error
  ! Local
  real(kind=8) :: factor
  !
  if (.not.obs%head%presec(class_sec_res_id))  return
  if (old_freq.eq.new_freq)  return
  !
  factor = old_freq/new_freq
  obs%head%res%major = obs%head%res%major*factor
  obs%head%res%minor = obs%head%res%minor*factor
  !
end subroutine modify_resolution
!
subroutine modify_projection_charval(set,head,newproj_c,newa0_c,newd0_c,  &
  newang_c,newaunit_c,error)
  use gbl_constant
  use phys_const
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>modify_projection_charval
  use class_types
  !---------------------------------------------------------------------
  ! @ private-generic modify_projection
  !   Modify the kind of projection (RADIO, AZIMUTHAL, etc), the
  ! projection center, and the projection angle
  ! ---
  !  Entry point with char*(*) proj, A0, and D0. If head%pos%system is
  ! Equatorial or ICRS, A0 is assumed an hour angle. Arguments with
  ! value '=' mean unchanged.
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set         !
  type(header),        intent(inout) :: head        ! Header to be modified
  character(len=*),    intent(in)    :: newproj_c   ! New projection name
  character(len=*),    intent(in)    :: newa0_c     ! New proj. center A0 (sexagesimal)
  character(len=*),    intent(in)    :: newd0_c     ! New proj. center D0 (sexagesimal)
  character(len=*),    intent(in)    :: newang_c    ! New projection angle
  character(len=*),    intent(in)    :: newaunit_c  ! Projection angle unit
  logical,             intent(inout) :: error       ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='MODIFY'
  character(len=13) :: projkey,projnam_array(0:mproj)
  integer(kind=4) :: newproj
  real(kind=8) :: newa0,newd0,newang
  !
  if (newproj_c.eq.'=') then
    newproj = head%pos%proj
  else
    call projnam_list(projnam_array)  ! Fill with the projection names
    call sic_ambigs(rname,newproj_c,projkey,newproj,projnam_array,mproj+1,error)
    if (error) return
    newproj = newproj-1  ! Because projnam_array numbering starts at 0
  endif
  !
  if (newa0_c.eq.'=') then
    ! Unchanged projection center
    newa0 = head%pos%lam
  else
    ! Decode sexagesimal string
    call sic_sexa(newa0_c,len_trim(newa0_c),newa0,error)
    if (error)  return
    if (head%pos%system.eq.type_eq .or. &
        head%pos%system.eq.type_ic) then
      newa0 = newa0*rad_per_hang
    else
      newa0 = newa0*rad_per_deg
    endif
  endif
  !
  if (newd0_c.eq.'=') then
    ! Unchanged projection center
    newd0 = head%pos%bet
  else
    ! Decode sexagesimal string
    call sic_sexa(newd0_c,len_trim(newd0_c),newd0,error)
    if (error)  return
    newd0 = newd0*rad_per_deg
  endif
  !
  if (newang_c.eq.'=') then
    newang = head%pos%projang
  else
    call sic_math_dble(newang_c,len_trim(newang_c),newang,error)
    if (error)  return
    if (newaunit_c(1:1).eq.'R') then
      continue  ! Unchanged
    elseif (newaunit_c(1:1).eq.'D') then
      newang = newang*rad_per_deg
    else
      call class_message(seve%e,rname,'Angle unit not understood: '//newaunit_c)
      error = .true.
      return
    endif
  endif
  !
  call modify_projection_numval(set,head,newproj,newa0,newd0,newang,error)
  if (error)  return
  !
end subroutine modify_projection_charval
!
subroutine modify_projection_numval(set,head,newproj,newa0,newd0,newang,error)
  use gbl_constant
  use gbl_message
  use gkernel_types
  use classcore_dependencies_interfaces
  use class_types
  !---------------------------------------------------------------------
  ! @ private-generic modify_projection
  !   Modify the kind of projection (RADIO, AZIMUTHAL, etc), the
  ! projection center, and the projection angle
  ! ---
  !  Entry point with integer code for proj, and real*8 a0, d0, pang
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set      !
  type(header),        intent(inout) :: head     !
  integer(kind=4),     intent(in)    :: newproj  ! [code] New proj. code
  real(kind=8),        intent(in)    :: newa0    ! [rad ] New proj. center A0
  real(kind=8),        intent(in)    :: newd0    ! [rad ] New proj. center D0
  real(kind=8),        intent(in)    :: newang   ! [rad ] New proj. angle
  logical,             intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='PROJECTION'
  real(kind=8) :: rxoff,ryoff,axoff,ayoff
  type(projection_t) :: proj
  !
  if (newproj.lt.0 .or. newproj.gt.mproj) then
    call class_message(seve%e,rname,'Invalid projection code')
    error = .true.
    return
  endif
  !
  ! Setup Input projection
  call gwcs_projec(head%pos%lam,head%pos%bet,head%pos%projang,head%pos%proj,  &
    proj,error)
  if (error)  return
  !
  ! Convert to absolute coordinates
  rxoff = head%pos%lamof
  ryoff = head%pos%betof
  call rel_to_abs(proj,rxoff,ryoff,axoff,ayoff,1)
  !
  ! Setup Output projection
  call gwcs_projec(newa0,newd0,newang,newproj,proj,error)
  if (error)  return
  !
  ! Convert to new projection
  call abs_to_rel(proj,axoff,ayoff,rxoff,ryoff,1)
  !
  ! Update header
  head%pos%proj = newproj
  head%pos%lam = newa0
  head%pos%bet = newd0
  head%pos%projang = newang
  head%pos%lamof = rxoff
  head%pos%betof = ryoff
  head%pos%rx_off = set%fangle*rxoff
  head%pos%ry_off = set%fangle*ryoff
  !
end subroutine modify_projection_numval
!
subroutine modify_beeff(set,line,r,error)
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>modify_beeff
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   MODIFY BEAM_EFF Beeff
  !   MODIFY BEAM_EFF /RUZE [B0 Sigma]
  ! The spectrum is rescaled according to the new value only if the beam
  ! efficiency previously was non zero valued
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set    !
  character(len=*),    intent(in)    :: line   ! Input command line
  type(observation),   intent(inout) :: r      !
  logical,             intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='MODIFY'
  integer(kind=4), parameter :: optruze=1
  real(kind=4) :: r4,r5,beeff_old
  character(len=message_length) :: mess
  character(len=24) :: teles
  ! Defaults for 30m
  integer(kind=4), parameter :: dobs1=-5627  ! 01-APR-2009 (rough date for EMIR installation)
  real(kind=4), parameter :: b01=0.863    ! [---] B0 since dobs1
  real(kind=4), parameter :: sigma1=65.6  ! [um] Sigma since dobs1
  !
  beeff_old = r%head%cal%beeff
  if (beeff_old.eq.0.) then
    call class_message(seve%w,rname,  &
      'Former beam efficiency is 0.0, no correction applied to intensities')
  endif
  !
  if (sic_present(optruze,0)) then  ! /RUZE option
    ! Get values
    if (sic_present(optruze,2)) then
      ! User provides the 2 values
      call sic_r4(line,optruze,1,r4,.true.,error)
      if (error)  return
      call sic_r4(line,optruze,2,r5,.true.,error)
      if (error)  return
    elseif (sic_present(optruze,1)) then
      ! 1 value provided
      call class_message(seve%e,rname,'/RUZE option takes 2 values or none')
      error = .true.
      return
    else
      ! 0 values. Use defaults if known, else error
      call my_get_teles(rname,r%head%gen%teles,.true.,teles,error)
      if (error) then
        call class_message(seve%e,rname,'/RUZE option knows no measured values for unknown telescope')
        error = .true.
        return
      endif
      if (teles.ne.'30M') then
        call class_message(seve%e,rname,'/RUZE option knows no measured values for telescope '//teles)
        error = .true.
        return
      endif
      if (r%head%gen%dobs.lt.dobs1) then
        ! Observed before 01-APR-2009
        call class_message(seve%e,rname,'/RUZE knows no measured values for 30M before 01-APR-2009')
        error = .true.
        return
      endif
      r4 = b01
      r5 = sigma1
      write(mess,'(A,F5.3,A,F0.1,A)') 'Using 30M measured values B0=',r4,' and Sigma=',r5,  &
        ' in Ruze''s equation'
      call class_message(seve%i,rname,mess)
    endif
    !
    ! Sanity
    if (r4.le.0. .or. r4.gt.1.) then
        write (mess,'(A,1X,1PG10.3)') 'Invalid B0 in Ruze''s equation: ',r4
        call class_message(seve%e,rname,mess)
        error = .true.
    endif
    if (r5.le.1. .or. r5.gt.1e3) then  ! Sigma in microns
        write (mess,'(A,1X,1PG10.3)')  &
          'Invalid sigma in Ruze''s equation (microns): ',r5
        call class_message(seve%e,rname,mess)
        error = .true.
    endif
    if (error) return
    !
    ! Apply value
    if (r%head%cal%beeff.ne.0.) then
      call modify_beeff_ruze(r,r4,r5)
    else
      r%head%cal%beeff = r4
    endif
    !
  else
    ! No /RUZE option
    call sic_r4 (line,0,2,r4,.true.,error)
    if (error) return
    if (r4.le.0. .or. r4.gt.1.0) then
        write (mess,'(A,1X,1PG10.3)') 'Invalid beam efficiency ',r4
        call class_message(seve%e,rname,mess)
        error = .true.
        return
    endif
    if (r%head%cal%beeff.ne.0.) then
        ! Known beam_eff: rescale
        r5 = r%head%cal%beeff/r4
        call rescale_data (r,r5)
        call rescale_header(r%head,r5)
    else
        ! No known beam_eff: just set the value
    endif
    r%head%cal%beeff = r4
    !
  endif
  !
  write(mess,'(2(A,1X,F6.4))')  &
    'Former beam efficiency:',beeff_old,', new:',r%head%cal%beeff
  call class_message(seve%i,rname,mess)
  !
  call newlimy(set,r,error)
  if (error) return

end subroutine modify_beeff
!
subroutine modify_beeff_ruze(obs,b0,sigma)
  use phys_const
  use gbl_message
  use classcore_interfaces, except_this=>modify_beeff_ruze
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Modify the observation intensities, channel per channel, according
  ! to the Ruze's equation:
  !   Beeff(lambda) = B0*exp(-(4*pi*sigma/lambda)**2)
  !                 = B0*exp(-(4*pi*sigma*freq/c)**2)
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs    !
  real(kind=4),      intent(in)    :: b0     ! [] Scaling factor in Ruze's equation
  real(kind=4),      intent(in)    :: sigma  ! [microns] Width factor in Ruze's equation
  ! Local
  character(len=*), parameter :: rname='MODIFY'
  integer(kind=4) :: ichan
  real(kind=4) :: fact1,fact2,bf,bc,bl
  real(kind=8) :: freq
  character(len=message_length) :: mess
  !
  fact2 = -(4.*pis*sigma/clight)**2  ! Sigma converted to meters (* 1.e-6),
                                     ! freq (hereafter) converted to Hz (* 1.e6)
  !
  ! Rescale DATA
  if (obs%head%cal%beeff.ne.0.) then
    fact1 = obs%head%cal%beeff/b0
    !
    do ichan=1,obs%head%spe%nchan
      if (obs%spectre(ichan).eq.obs%cbad)  cycle
      !
      ! Observatory frequency at channel #ichan
      call abscissa_chan2obsfre(obs%head,real(ichan,kind=8),freq)
      !
      obs%spectre(ichan) = obs%spectre(ichan)*fact1/exp(fact2*freq*freq)
    enddo
    !
  endif
  !
  ! User feedback
  ! At left of spectrum
  call abscissa_obsfre_left(obs%head,freq)
  bf = b0*exp(fact2*freq*freq)
  ! At center channel
  call abscissa_obsfre_middle(obs%head,freq)
  bc = b0*exp(fact2*freq*freq)
  ! At right of spectrum
  call abscissa_obsfre_right(obs%head,freq)
  bl = b0*exp(fact2*freq*freq)
  !
  write (mess,'(A,3(2X,F6.4),A,F4.1,A)')  &
    'Beam efficiencies at first, center, and last channels:',bf,bc,bl,  &
    ' (',abs(bl-bf)/bf*100.,'% variation)'
  call class_message(seve%i,rname,mess)
  !
  ! Rescale HEADER. Use new efficiency at central channel
  call rescale_header(obs%head,obs%head%cal%beeff/bc)
  obs%head%cal%beeff = bc
  !
end subroutine modify_beeff_ruze
!
subroutine modify_blanking_obs(obs,newbad)
  use classcore_interfaces, except_this=>modify_blanking_obs
  use class_types
  !---------------------------------------------------------------------
  ! @ private-generic modify_blanking
  !  Modify blank values (bad and NaN) from the spectrum, and update
  ! the header accordingly
  ! ---
  ! This version for a type(observation) as argument
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs
  real(kind=4),      intent(in)    :: newbad
  ! Local
  real(kind=4) :: oldbad
  integer(kind=4) :: nchan
  !
  oldbad = obs_bad(obs%head)
  nchan = obs_nchan(obs%head)
  call modify_blanking_nv4(obs%data1,nchan,oldbad,newbad)
  !
  call modify_blanking_head(obs,newbad)
  !
end subroutine modify_blanking_obs
!
subroutine modify_blanking_head(obs,newbad)
  use gbl_constant
  use classcore_interfaces, except_this=>modify_blanking_head
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Modify the blank value in a header
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs
  real(kind=4),      intent(in)    :: newbad
  !
  if (obs%head%gen%kind.eq.kind_spec) then
    obs%head%spe%bad = newbad
  else
    obs%head%dri%bad = newbad
  endif
  obs%cbad = newbad
  !
end subroutine modify_blanking_head
!
subroutine modify_blanking_nv4(val,nv4,oldbad,newbad)
  use classcore_interfaces, except_this=>modify_blanking_nv4
  !---------------------------------------------------------------------
  ! @ private-generic modify_blanking
  ! Modify blank values (bad and NaN) from the spectrum
  ! ---
  ! This version for I*4 number of values
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: nv4
  real(kind=4),    intent(inout) :: val(nv4)
  real(kind=4),    intent(in)    :: oldbad
  real(kind=4),    intent(in)    :: newbad
  ! Local
  integer(kind=8) :: nv8
  !
  nv8 = nv4
  call modify_blanking_nv8(val,nv8,oldbad,newbad)
  !
end subroutine modify_blanking_nv4
!
subroutine modify_blanking_nv8(val,nv8,oldbad,newbad)
  !---------------------------------------------------------------------
  ! @ private-generic modify_blanking
  ! Modify blank values (bad and NaN) from the spectrum
  ! ---
  ! This version for I*8 number of values
  !---------------------------------------------------------------------
  integer(kind=8), intent(in)    :: nv8
  real(kind=4),    intent(inout) :: val(nv8)
  real(kind=4),    intent(in)    :: oldbad
  real(kind=4),    intent(in)    :: newbad
  ! Local
  integer(kind=8) :: i
  !
  do i=1,nv8
    if (val(i).ne.val(i)) then
      ! Normal compilers: NaN are not even equal to themselves
      val(i) = newbad
    elseif (val(i).eq.oldbad) then
      ! Patch old bad +
      ! also gfortran -O3 case... NaN are equal to everything
      val(i) = newbad
    endif
  enddo
end subroutine modify_blanking_nv8
!
subroutine modify_scale(obs,tocode,verbose,error)
  use phys_const
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>modify_scale
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  !  Modify the Y scale unit
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs      !
  integer(kind=4),   intent(in)    :: tocode   ! Class internal code for new Y unit
  logical,           intent(in)    :: verbose  ! Verbose warnings and infos?
  logical,           intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='SCALE'
  real(kind=4) :: factor
  character(len=message_length) :: mess
  !
  ! Fast exit
  if (obs%head%gen%yunit.eq.tocode .and. verbose) then
    ! Nothing to be done
    call class_message(seve%w,rname,'Y scale unit is already '//  &
      trim(obs_yunit(tocode))//', nothing done')
    return
  endif
  !
  ! Sanity checks
  if (obs%head%gen%yunit.eq.yunit_unknown) then
    call class_message(seve%e,rname,'Can not modify Y unit from Unknown')
    error = .true.
    return
  endif
  if (tocode.eq.yunit_unknown) then
    call class_message(seve%e,rname,'Can not modify Y unit to Unknown')
    error = .true.
    return
  endif
  !
  if (obs%head%gen%yunit.eq.yunit_Jyperbeam  .or. tocode.eq.yunit_Jyperbeam .or.  &
      obs%head%gen%yunit.eq.yunit_mJyperbeam .or. tocode.eq.yunit_mJyperbeam) then
    ! To/from Jansky
    call modify_scale_jy(factor,error)
  else
    ! Tmb to/from Ta*
    call modify_scale_t(factor,error)
  endif
  if (error)  return
  !
  if (verbose) then
    write(mess,'(5A,F0.3)')  'Scaling factor from ',obs_yunit(obs%head%gen%yunit),  &
      ' to ',obs_yunit(tocode),': ',factor
    call class_message(seve%i,rname,mess)
  endif
  !
  call rescale_header(obs%head,factor)
  call rescale_data(obs,factor)
  obs%head%gen%yunit = tocode
  !
contains
  subroutine modify_scale_jy(factor,error)
    !-------------------------------------------------------------------
    ! Specific conversion to/from Jansky
    !-------------------------------------------------------------------
    real(kind=4), intent(out)   :: factor
    logical,      intent(inout) :: error
    ! Local
    real(kind=8) :: lambda,jyperbeam_per_ktmb
    real(kind=4) :: major,minor
    !
    ! Sanity checks
    if (.not.obs%head%presec(class_sec_res_id)) then
      call class_message(seve%e,rname,'Observation has no Resolution section')
      error = .true.
      return
    endif
    major = obs%head%res%major
    minor = obs%head%res%minor
    if (major.eq.0. .and. minor.eq.0.)  then
      ! Section is defined but resolution is null...
      call class_message(seve%e,rname,'Resolution has null size')
      error = .true.
      return
    endif
    if (major.eq.0. .and. verbose) then
      call class_message(seve%w,rname,'Null major axis resolution defaults to minor axis')
      major = minor
    endif
    if (minor.eq.0. .and. verbose) then
      call class_message(seve%w,rname,'Null minor axis resolution defaults to major axis')
      major = minor
    endif
    !
    lambda = clight_mhz/obs%head%spe%restf  ! [m]
    jyperbeam_per_ktmb = 2.d0*kbolt*1.e26*pi*major*minor/(4.d0*log(2.d0)*lambda**2)
    !
    ! Convert from current scale to K (Tmb)
    select case (obs%head%gen%yunit)
    case (yunit_K_Tmb)
      factor = 1.
    case (yunit_Jyperbeam)
      factor = 1./jyperbeam_per_ktmb
    case (yunit_mJyperbeam)
      factor = 1.e-3/jyperbeam_per_ktmb
    case default
      call modify_scale_notimplemented(error)
      return
    end select
    !
    ! Convert from K (Tmb) to new scale
    select case (tocode)
    case (yunit_K_Tmb)
      continue  ! factor = factor*1.
    case (yunit_Jyperbeam)
      factor = factor*jyperbeam_per_ktmb
    case (yunit_mJyperbeam)
      factor = factor*1.e3*jyperbeam_per_ktmb
    case default
      call modify_scale_notimplemented(error)
      return
    end select
    !
  end subroutine modify_scale_jy
  !
  subroutine modify_scale_t(factor,error)
    !-------------------------------------------------------------------
    ! Specific conversion between temperatures
    !-------------------------------------------------------------------
    real(kind=4), intent(out)   :: factor
    logical,      intent(inout) :: error
    ! Local
    !
    ! Sanity checks
    if (.not.obs%head%presec(class_sec_cal_id)) then
      call class_message(seve%e,rname,'Observation has no Calibration section')
      error = .true.
      return
    endif
    if (obs%head%cal%beeff.le.0.) then
      call class_message(seve%e,rname,'Current beam efficiency is null')
      error = .true.
      return
    endif
    if (obs%head%cal%foeff.le.0.) then
      call class_message(seve%e,rname,'Current forward efficiency is null')
      error = .true.
      return
    endif
    if (obs%head%gen%yunit.ne.yunit_K_Tmb .or.  &
        tocode.ne.yunit_K_Tas) then
      ! Only Tmb to Ta* implemented here
      call modify_scale_notimplemented(error)
      return
    endif
    !
    factor = obs%head%cal%beeff/obs%head%cal%foeff
    !
  end subroutine modify_scale_t
  !
  subroutine modify_scale_notimplemented(error)
    logical, intent(inout) :: error
    call class_message(seve%e,rname,'Modifying Y unit scale from '//  &
      trim(obs_yunit(obs%head%gen%yunit))//' to '//trim(obs_yunit(tocode))//  &
      ' is not implemented')
    error = .true.
  end subroutine modify_scale_notimplemented
  !
end subroutine modify_scale
!
subroutine modify_doppler(set,code,head,error)
  use phys_const
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>modify_doppler
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command:
  !  MODIFY DOPPLER [SIGN|*|Value]
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set    !
  character(len=*),    intent(in)    :: code   !
  type(header),        intent(inout) :: head   ! head%pos%doppler modified in return
  logical,             intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='MODIFY'
  character(len=message_length) :: mess
  real(kind=8) :: dop0,dop1
  logical, save :: doppler_pb
  logical, save :: first = .true.
  !
  dop0 = head%spe%doppler
  select case (code)
  case ('')
    if (first) then
      call sic_def_logi('DOPPLER_PB',doppler_pb,.true.,error)
      first = .false.
    endif
    !*  Test the likelyhood of a sign error for the Doppler factor (-V/c),
    !   by comparing the stored Doppler factor to the computed
    !   Doppler correction in the source direction.
    ! * Compare Doppler factor down to 0.6m/s change in V
    !   (LO precision is 10Hz @ 5GHz)
    ! * SIC variable DOPPLER_PB is created and set to correct state
    ! * Doppler factor is NOT changed
    call compute_doppler(set,head,.true.,error)
    if (error) return
    dop1 = head%spe%doppler
    head%spe%doppler = dop0 ! reset the Doppler correction
    if (abs(dop1-dop0)*clight.gt.6.d-1.and.dop0*dop1.lt.0.d0) then
      write(mess,'(a,g14.8,a,g14.8)') &
          'Sign problem for Doppler factor: Old ',dop0,' New ',dop1
      doppler_pb = .true.
    else
      doppler_pb = .false.
      write(mess,'(a,1pg14.8)') 'Doppler factor agree ',dop0
    endif
    !
  case ('SIGN')
    ! Reverse the sign of the Doppler factor (patch)
    head%spe%doppler = -dop0
    write(mess,*) 'Swap doppler factor sign. New value is: ',head%spe%doppler
    !
  case ('*')
    ! Compute Doppler factor
    call compute_doppler(set,head,.true.,error)
    write(mess,*) 'Doppler factor set to: ',head%spe%doppler
    !
  case default
    ! Change Doppler value from user value
    call sic_math_dble(code,len_trim(code),dop1,error)
    if (error) return
    head%spe%doppler = dop1
    write(mess,*) 'Doppler factor set to: ',head%spe%doppler
  end select
  !
  call class_message(seve%i,rname,mess)
  !
end subroutine modify_doppler
!
subroutine modify_vdirection(set,head,error)
  use gbl_message
  use classcore_interfaces, except_this=>modify_vdirection
  use class_types
  !---------------------------------------------------------------------
  ! @ public (for libclass only)
  ! Support routine for command:
  !  MODIFY VDIRECTION
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set    !
  type(header),        intent(inout) :: head   !
  logical,             intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='MODIFY'
  real(kind=8) :: dop_old,dop_new
  !
  if (head%spe%vdire.eq.vdire_act)  return
  !
  dop_old = head%spe%doppler
  ! write (*,*) ">>> Doppler old : ",dop_old
  !
  ! Recompute Doppler at reference position
  ! call compute_doppler(set,head,.true.,error)
  ! if (error)  return
  ! d1 = head%spe%doppler
  ! write (*,*)  ">>> At reference: ",d1,(dop_old-d1)/dop_old*head%spe%restf
  !
  ! Recompute Doppler at the offset position
  call compute_doppler(set,head,.false.,error)
  if (error)  return
  dop_new = head%spe%doppler
  ! write (*,*)  ">>> At offset   : ",dop_new,(d1-dop_new)/d1*head%spe%restf
  !
  if (head%spe%image.ne.image_null) then
    head%spe%image = head%spe%image*(1.d0+dop_old)/(1.d0+dop_new) -  &
                     head%spe%restf*(dop_new-dop_old)/(1.d0+dop_new)
  endif
  head%spe%rchan   = head%spe%rchan +  &
                     head%spe%restf/head%spe%fres*(dop_new-dop_old)
  !
  head%spe%vdire = vdire_act
  !
end subroutine modify_vdirection
!
subroutine modify_elevationgain(obs,error)
  use phys_const
  use gbl_message
  use classcore_interfaces, except_this=>modify_elevationgain
  use class_types
  !---------------------------------------------------------------------
  ! @ private
  ! Apply elevation gain correction for 30M data (see Juan Penalver memo
  ! 16-Apr-2012).
  !---------------------------------------------------------------------
  type(observation), intent(inout) :: obs
  logical,           intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='ELEVATION_GAIN'
  character(len=24) :: teles
  real(kind=4) :: gain,el,fghz
  character(len=message_length) :: mess
  !
  call my_get_teles(rname,obs%head%gen%teles,.true.,teles,error)
  if (error) then
    call class_message(seve%e,rname,'Can not correct for unknown telescope')
    error = .true.
    return
  endif
  if (teles.ne.'30M') then
    call class_message(seve%e,rname,'Correction is not available for telescope '//teles)
    error = .true.
    return
  endif
  !
  fghz = obs%head%spe%restf/1e3
  el = obs%head%gen%el*deg_per_rad
  gain = elevationgain(fghz,el)
  !
  write(mess,'(A,F5.3,A,F0.3,A,F0.1,A)')  'Applying gain ',gain,  &
    ' at freq ',fghz,' GHz elevation ',el,' deg.'
  call class_message(seve%i,rname,mess)
  !
  call rescale_header(obs%head,1/gain)
  call rescale_data(obs,1/gain)
  !
contains
  function elevationgain(freq,elobs)
    real(kind=4) :: elevationgain
    real(kind=4), intent(in) :: freq   ! [GHz]
    real(kind=4), intent(in) :: elobs  ! [deg]
    ! Local
    real(kind=4) :: lambdamu,elmax
    !
    lambdamu = clight_kms/freq  ! km/s / GHz => microns
    elmax = 1.567e-6*freq**3 - 1.233e-3*freq**2 + 3.194e-1*freq+2.203e+1
    elevationgain = aeff(lambdamu,elobs)/aeff(lambdamu,elmax)
    !
  end function elevationgain
  !
  function aeff(lambdamu,el)
    real(kind=4) :: aeff
    real(kind=4), intent(in) :: lambdamu  ! [microns]
    real(kind=4), intent(in) :: el        ! [deg]
    ! Local
    real(kind=4) :: aeff0,rms
    !
    aeff0 = 8.8466e-6*el**2 - 1.2523e-3*el + 6.9608e-1
    rms   = 2.5523e-2*el**2 - 2.5534*el + 1.1937e+2
    aeff  = aeff0 * exp(-1*((4*pi*rms)/(lambdamu))**2)
    !
  end function aeff
  !
end subroutine modify_elevationgain
