!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module uv_shift
  use gbl_message
  !
  public :: uv_shift_comm,uv_shift_header,uv_shift_data
  public :: map_get_radecang
  private
  !
contains
  !
subroutine uv_shift_comm(line,error)
  use phys_const
  use gkernel_types
  use gkernel_interfaces
  use mapping_read, only: check_uvdata_type
  use uv_buffers
  use uvmap_buffers, only: uvmap_prog
  !-------------------------------------------------------------------
  !  MAPPING
  !   Support routine for command
  !       UV_SHIFT  [Offx Offy [Angle]]
  !
  !   Phase shift a Mosaic or Single Dish UV Table to a new
  !   common phase center and orientation
  !     Offx OffY are offsets in ArcSec 
  !               (default 0,0)
  !     Angle     is the final position angle from North in Degree
  !               (default: no change)
  !
  !   Also called implicitely (with no command line arguments, i.e.
  !   no change of Phase Center unless the UV Table is with
  !   Phase Offsets )
  !   by command UV_MAP for Mosaics
  !-------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='UV_SHIFT'
  character(len=message_length) :: mess
  real(kind=8) :: abso(2),rela(2),freq,angnew,angold
  real(kind=4) :: cs(2), costheta, sintheta, oldoffx, oldoffy
  real(kind=8), allocatable :: rpos(:,:)
  logical, parameter :: precise=.true.
  integer(kind=4) :: nc,nu,nv,i,iv,ier,loff,moff
  character(len=14) :: cra
  character(len=15) :: cdec
  !
  if (uvmap_prog%nfields.eq.0) then
    mess = 'UV table is a single field'
  elseif (uvmap_prog%nfields.lt.0) then
    write(mess,'(A,I0,A)')  &
      'UV table is an observed mosaic of ',-uvmap_prog%nfields,' fields, phase shifting...'
  elseif (uvmap_prog%nfields.gt.0) then
    write(mess,'(A,I0,A)')  &
      'UV table is already a phase-shifted mosaic of ',uvmap_prog%nfields,' fields, recentering...'
  endif
  call map_message(seve%i,rname,mess)
  !
  call uv_shift_center(line,abso,rela,angnew,error)
  if (error)  return
  ! Feedback
  call rad2sexa(abso(1),24,cra)
  call rad2sexa(abso(2),360,cdec)
  write(mess,'(5A,2(F6.2,A))')  'New phase center ',  &
    cra,' ',cdec,' (offsets ',rela(1)*sec_per_rad,' ',rela(2)*sec_per_rad,')'
  call map_message(seve%i,rname,mess)
  !
  if (uvmap_prog%nfields.ge.0) then
    ! Single field, or mosaic already in pointing offsets
    if (huv%gil%a0.eq.abso(1) .and. huv%gil%d0.eq.abso(2) .and. angnew.eq.huv%gil%pang) then
      call map_message(seve%w,rname,  &
        'UV table has already the desired phase center, nothing done')
      return
    endif
  endif
  !
  ! Store new absolute positions
  huv%gil%a0 = abso(1)
  huv%gil%d0 = abso(2)
  if (uvmap_prog%nfields.ne.0) then
    ! For mosaics, i.e. UVT with offset columns, these offsets (pointing offsets,
    ! and phase offsets if relevant) are relative to (a0,d0). (ra,dec) is purely
    ! informative => synced with (a0,d0) for clarity
    huv%gil%ra = huv%gil%a0
    huv%gil%dec = huv%gil%d0
    ! For non-mosaics, i.e. UVT without offset columns, (a0,d0) is the phase center,
    ! (ra,dec) is the pointing position => must not change
  endif
  !
  ! Compute observing frequency, and new phase center in wavelengths
  if (precise) then
    nc = huv%gil%nchan
    allocate(rpos(2,nc),stat=ier)
    do i=1,huv%gil%nchan
      freq = gdf_uv_frequency(huv,dble(i))
      rpos(1:2,i) = - freq * f_to_k * rela(1:2)
    enddo
  else
    nc = 1
    allocate(rpos(2,1),stat=ier)
    freq = gdf_uv_frequency(huv)
    rpos(1:2,1) = - freq * f_to_k * rela(1:2)
  endif
  !
  ! Define the rotation
  angold = huv%gil%pang
  huv%gil%pang = angnew
  !
  ! The minus in cs(2) follows from the definition of the postion angle in GILDAS
  ! For the Cosine no change in signal, for the Sine the sign must be reversed.
  cs(1) =  cos(huv%gil%pang-angold)
  cs(2) = -sin(huv%gil%pang-angold)
  !
  ! Recenter all channels, Loop over line table
  ! We work in place - We do not play with UV buffers
  nu = huv%gil%dim(1)
  nv = huv%gil%nvisi
  call uv_shift_data(huv,nu,nv,duv,cs,nc,rpos)
  !
  if (uvmap_prog%nfields.eq.0) then
    ! Done if Single Field
    return
    !
  elseif (uvmap_prog%nfields.lt.0) then
    ! Phase offsets mosaics
    !
    ! Offset columns description: convert columns kind
    loff = huv%gil%column_pointer(code_uvt_loff)
    moff = huv%gil%column_pointer(code_uvt_moff)
    !
    huv%gil%column_pointer(code_uvt_xoff) = loff
    huv%gil%column_pointer(code_uvt_yoff) = moff
    huv%gil%column_size(code_uvt_xoff) = 1
    huv%gil%column_size(code_uvt_yoff) = 1
    !
    huv%gil%column_pointer(code_uvt_loff) = 0
    huv%gil%column_pointer(code_uvt_moff) = 0
    huv%gil%column_size(code_uvt_loff) = 0
    huv%gil%column_size(code_uvt_moff) = 0
    !
    ! Offset columns data:
    do iv=1,nv
      duv(loff,iv) = duv(loff,iv) - rela(1)
      duv(moff,iv) = duv(moff,iv) - rela(2)
    enddo
    !
  elseif (uvmap_prog%nfields.gt.0) then
    ! Pointing offsets mosaics
    !
    ! Offset columns description: does not change
    loff = huv%gil%column_pointer(code_uvt_xoff)
    moff = huv%gil%column_pointer(code_uvt_yoff)
    !
    ! Offset columns data: shifted to new (a0,d0)
    do iv=1,nv
      duv(loff,iv) = duv(loff,iv) - rela(1)
      duv(moff,iv) = duv(moff,iv) - rela(2)
    enddo
    !
  endif
  !
  ! The correct thing to do is a reprojection, this rotation is just an approximation.
  costheta = cs(1)
  sintheta = cs(2)
  if (abs(cs(1)-1.).gt.1e-6) then
     do iv=1,nv
        oldoffx = duv(loff,iv)
        oldoffy = duv(moff,iv)
        duv(loff,iv) = costheta*oldoffx - sintheta*oldoffy
        duv(moff,iv) = sintheta*oldoffx + costheta*oldoffy
     enddo
  endif
  !
  ! Recompute the 'uvmap_prog' structure
  call check_uvdata_type(huv,duv,uvmap_prog,error)
end subroutine uv_shift_comm
!
subroutine uv_shift_center(line,abso,rela,angle,error)
  use phys_const
  use gkernel_types
  use gkernel_interfaces
  use uv_buffers
  use uvmap_buffers, only: uvmap_prog
  !---------------------------------------------------------------------
  ! Get relative and absolute positions from user inputs
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line     !
  real(kind=8),     intent(out)   :: abso(2)  ! [rad] New absolute position
  real(kind=8),     intent(out)   :: rela(2)  ! [rad] New relative position from old absolute position
  real(kind=8),     intent(out)   :: angle    ! [rad] New angle
  logical,          intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='UV_SHIFT'
  character(len=24) :: argum
  integer(kind=4) :: nc
  real(kind=8) :: vars(3),mean(2)
  logical :: dorela,found(3)
  type(projection_t) :: proj
  logical, parameter :: domean=.false.
  !
  ! ZZZ why -pang??? Seems it comes from this comment:
  !  "note Position Angle convention differ in GreG and astronomy"
  call gwcs_projec(huv%gil%a0,huv%gil%d0,-huv%gil%pang,huv%gil%ptyp,proj,error)
  if (error)  return
  !
  if (uvmap_prog%nfields.eq.0) then
    ! Not a mosaic
    mean(:) = 0.d0  ! Unused
  else
    ! Mosaic
    if (domean) then
      ! Use mean of all fields
      mean(:) = sum(uvmap_prog%offxy,dim=2)/abs(uvmap_prog%nfields)
    else
      ! Use center of all fields (center of map which contains all fields)
      mean(:) = (minval(uvmap_prog%offxy,dim=2) + maxval(uvmap_prog%offxy,dim=2))/2.d0
    endif
  endif
  !
  ! Get inputs from command line
  if (sic_present(0,1)) then
    ! Rigth ascension
    call sic_ch(line,0,1,argum,nc,.true.,error)
    if (error)  return
    if (index(argum,':').ne.0) then
      ! A sexagesimal string: asbolute RA position
      call sic_decode(argum,abso(1),24,error)
      if (error)  return
      dorela = .true.
    else
      ! Assume relative offset
      call sic_math_dble(argum,nc,rela(1),error)
      if (error)  return
      rela(1) = rela(1)*rad_per_sec
      ! In case of single field or pointing offset mosaic, offsets are
      ! relative to [A0,D0] => no additional correction
      ! In case of phase offset mosaic, offsets are relative from the mean
      ! mosaic center. This makes UV_SHIFT 0 0 behaves like UV_SHIFT (without
      ! arguments) => correct them as offsets relative to [A0,D0]
      if (uvmap_prog%nfields.lt.0)  rela(1) = rela(1)+mean(1)
      dorela = .false.
    endif
    !
    ! Declination
    call sic_ch(line,0,2,argum,nc,.true.,error)
    if (error)  return
    if (index(argum,':').ne.0) then
      ! A sexagesimal string: asbolute DEC position
      call sic_decode(argum,abso(2),360,error)
      if (error)  return
    else
      ! Assume relative offset
      call sic_math_dble(argum,nc,rela(2),error)
      if (error)  return
      rela(2) = rela(2)*rad_per_sec
      ! See comments for RA offsets
      if (uvmap_prog%nfields.lt.0)  rela(2) = rela(2)+mean(2)
    endif
    !
    if (dorela) then
      call abs_to_rel(proj,abso(1),abso(2),rela(1),rela(2),1)
    else
      call rel_to_abs(proj,rela(1),rela(2),abso(1),abso(2),1)
    endif
    !
    ! Angle (optional)
    angle = huv%gil%pang*deg_per_rad
    call sic_r8(line,0,3,angle,.false.,error)
    if (error)  return
    angle = angle*rad_per_deg
    !
    return
  endif
  !
  ! Get inputs from MAP_RA, MAP_DEC, MAP_ANGLE
  call sic_get_char('MAP_RA',argum,nc,error)
  if (error)  return
  if (argum.ne.' ') then
    call map_get_radecang(rname,found,vars,error)
    if (error)  return
    if (.not.all(found)) then
      call map_message(seve%e,rname,'MAP_RA and MAP_DEC are not all defined')
      error = .true.
      return
    endif
    !
    abso(1) = vars(1)
    abso(2) = vars(2)
    angle   = vars(3)
    call abs_to_rel(proj,abso(1),abso(2),rela(1),rela(2),1)
    !
    return
  endif
  !
  ! Define automatic inputs from data
  if (uvmap_prog%nfields.eq.0) then
    call map_message(seve%w,rname,'No automatic shift for single field') 
    ! No shift nor rotation by default
    abso(1) = huv%gil%a0
    abso(2) = huv%gil%d0
    rela(1) = 0.d0
    rela(2) = 0.d0
    angle   = huv%gil%pang
    !
  elseif (uvmap_prog%nfields.gt.0) then
    ! Already a common phase center: do not change it by default
    call map_message(seve%w,rname,'Mosaic already in pointing offsets, no automatic shift applied')
    ! No shift nor rotation by default
    abso(1) = huv%gil%a0
    abso(2) = huv%gil%d0
    rela(1) = 0.d0
    rela(2) = 0.d0
    angle   = huv%gil%pang
    !
  elseif (uvmap_prog%nfields.lt.0) then
    ! Compute the mean offset as common phase center position
    call map_message(seve%w,rname,'Phase offset mosaic shifted to mean offset')
    rela(:) = mean(:)
    call rel_to_abs(proj,rela(1),rela(2),abso(1),abso(2),1)
    angle = huv%gil%pang*deg_per_rad
    !
  endif
end subroutine uv_shift_center
!
subroutine map_get_radecang(rname,found,values,error)
  use phys_const
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Decode user inputs found in the Sic variables
  !   MAP_RA    [sexagesimal hour angle]
  !   MAP_DEC   [sexagesimal degrees]
  !   MAP_ANGLE [deg]
  ! Returned values are all radians. Also return a status indicating if
  ! the values were set or not.
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: rname      !
  logical,          intent(out)   :: found(3)   !
  real(kind=8),     intent(out)   :: values(3)  !
  logical,          intent(inout) :: error      !
  ! Local
  character(len=24) :: ra_c,dec_c
  integer(kind=4) :: n
  !
  found(:) = .false.
  values(:) = 0.d0
  !
  call sic_get_char('MAP_RA',ra_c,n,error)
  if (error)  return
  found(1) = ra_c.ne.''
  if (found(1)) then
    call sic_decode(ra_c,values(1),24,error)
    if (error) then
      call map_message(seve%e,rname,'Error evaluating MAP_RA')
      return
    endif
  endif
  !
  call sic_get_char('MAP_DEC',dec_c,n,error)
  if (error)  return
  found(2) = dec_c.ne.''
  if (found(2)) then
    call sic_decode(dec_c,values(2),360,error)
    if (error) then
      call map_message(seve%e,rname,'Error evaluating MAP_DEC')
      return
    endif
  endif
  !
  call sic_get_dble('MAP_ANGLE',values(3),error)
  if (error)  return
  found(3) = .true.
  values(3) = values(3)*rad_per_deg
end subroutine map_get_radecang
!
subroutine uv_shift_header(new,ra,dec,ang,off,doit)
  use gkernel_interfaces
  use gkernel_types
  !-------------------------------------------------
  ! Compute shift parameters
  !-------------------------------------------------
  real(kind=8), intent(inout) :: new(3)   ! New phase center and angle
  real(kind=8), intent(in) :: ra,dec,ang  ! Old center and angle
  real(kind=8), intent(out) :: off(3)     ! Required Offsets and Angle
  logical, intent(inout) :: doit          ! Do shift
  !
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: sec=(pi/180d0/3600d0)
  type(projection_t) :: proj
  logical :: error
  !
  if (.not.doit) return
  !
  ! Check phase center agreement to 0.001" and angle to 1"
  ! These should be customizable in MAPPING
  !
  if ( abs(new(1)-ra).lt.1d-3*sec .and.   &
     &    abs(new(2)-dec).lt.1d-3*sec .and.   &
     &    abs(new(3)-ang).lt.sec ) then
    new(1) = ra
    new(2) = dec
    new(3) = ang
    doit  = .false.
    return
  endif
  !
  off(1) = ra
  off(2) = dec
  off(3) = -ang                ! GreG convention
  error = .false.
  call gwcs_projec(ra,dec,-ang,3,proj,error)  ! Previous projection system
  call abs_to_rel (proj,new(1),new(2),off(1),off(2),1)  ! Offsets of new center
  off(3) = new(3)-ang          ! Additional rotation required
  if (abs(off(3)).lt.sec) off(3) = 0.d0
end subroutine uv_shift_header
!
subroutine uv_shift_data(hx,nu,nv,visi,cs,nc,xy)
  use phys_const
  use image_def
  use gkernel_interfaces
  use gkernel_types
  !$ use omp_lib
  !-------------------------------------------------------------------
  ! Shift phase center and apply U,V coordinates rotation if needed
  !-------------------------------------------------------------------
  type(gildas), intent(inout) :: hx   ! Input UV header
  integer, intent(in) :: nu           ! Size of a visibility
  integer, intent(in) :: nv           ! Number of visibilities
  real, intent(inout) :: visi(nu,nv)  ! Visibilities
  real, intent(in) :: cs(2)           ! Cos/Sin of Rotation
  integer, intent(in) :: nc           ! Number of Channels
  real(8), intent(in) :: xy(2,nc)     ! Position Shift per channel
  !
  integer(kind=index_length) :: i
  integer :: ix, iu, iv, jc, loff, moff
  real(8) :: phi, sphi, cphi, freq, x, y
  real :: u, v, reel, imag
  real(8), allocatable :: lm_uv(:)
  !
  iu = hx%gil%column_pointer(code_uvt_u)
  iv = hx%gil%column_pointer(code_uvt_v)
  !
  ! If there is a Phase offset column, use it
  !  integer(kind=4), parameter :: code_uvt_loff = 10 ! Phase center Offset
  !  integer(kind=4), parameter :: code_uvt_moff = 11 ! Phase center Offset
  loff = hx%gil%column_pointer(code_uvt_loff)
  moff = hx%gil%column_pointer(code_uvt_moff)
  !
  if (loff.ne.0 .or. moff.ne.0) then
    !
    ! Shift and Rotation of a per-field phase center to a common one
    !
    allocate(lm_uv(nc))
    if (nc.eq.1) then
      freq = gdf_uv_frequency(hx)
      lm_uv(1) = freq * f_to_k
    else
      do i=1,hx%gil%nchan
        freq = gdf_uv_frequency(hx,dble(i))
        lm_uv(i) = freq * f_to_k
      enddo
    endif
    !
    !$OMP PARALLEL DEFAULT(none) &
    !$OMP SHARED(hx,nv,nc,cs,xy,loff,moff,lm_uv,visi,iu,iv) &
    !$OMP PRIVATE(i,u,v,x,y,phi,cphi,sphi,jc,ix,reel,imag)
    !
    !$OMP DO
    do i = 1,nv
      u = visi(iu,i)
      v = visi(iv,i)
      visi(iu,i) = cs(1)*u - cs(2)*v
      visi(iv,i) = cs(2)*u + cs(1)*v
      !
      if (nc.eq.1) then
        x = xy(1,1) + lm_uv(1) * visi(loff,i)
        y = xy(2,1) + lm_uv(1) * visi(moff,i)
        phi = x*u + y*v
        cphi = cos(phi)
        sphi = sin(phi)
      endif
      !
      do jc=1,hx%gil%nchan
        ix = hx%gil%fcol+(jc-1)*hx%gil%natom
        if (nc.gt.1) then
          x = xy(1,jc) + lm_uv(jc) * visi(loff,i)
          y = xy(2,jc) + lm_uv(jc) * visi(moff,i)
          phi = x*u + y*v
          cphi = cos(phi)
          sphi = sin(phi)
        endif
        reel = visi(ix,i) * cphi - visi(ix+1,i) * sphi
        imag = visi(ix,i) * sphi + visi(ix+1,i) * cphi
        visi(ix,i) = reel
        visi(ix+1,i) = imag
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
    !
  else if (xy(1,1).eq.0. .and. xy(2,1).eq.0.) then
    !
    ! No shift, only rotation of U,V coordinates
    !
    if (cs(1).eq.1.0) return  ! No rotation either
    !
    !$OMP PARALLEL DEFAULT(none) &
    !$OMP SHARED(nv,cs,visi,iu,iv) &
    !$OMP PRIVATE(i,u,v)
    !
    !$OMP DO
    do i = 1,nv
      u = visi(iu,i)
      v = visi(iv,i)
      visi(iu,i) = cs(1)*u - cs(2)*v
      visi(iv,i) = cs(2)*u + cs(1)*v
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  else
    !
    ! Shift and rotation of a common phase center
    !
    !$OMP PARALLEL DEFAULT(none) &
    !$OMP SHARED(hx,nv,nc,cs,xy,visi,iu,iv) &
    !$OMP PRIVATE(i,u,v,x,y,phi,cphi,sphi,jc,ix,reel,imag)
    !
    !$OMP DO
    do i = 1,nv
      u = visi(iu,i)
      v = visi(iv,i)
      visi(iu,i) = cs(1)*u - cs(2)*v
      visi(iv,i) = cs(2)*u + cs(1)*v
      !
      if (nc.eq.1) then
        phi = xy(1,1)*u + xy(2,1)*v
        cphi = cos(phi)
        sphi = sin(phi)
      endif
      !
      do jc=1,hx%gil%nchan
        ix = hx%gil%fcol+(jc-1)*hx%gil%natom
        if (nc.gt.1) then
          phi = xy(1,jc)*u + xy(2,jc)*v
          cphi = cos(phi)
          sphi = sin(phi)
        endif
        reel = visi(ix,i) * cphi - visi(ix+1,i) * sphi
        imag = visi(ix,i) * sphi + visi(ix+1,i) * cphi
        visi(ix,i) = reel
        visi(ix+1,i) = imag
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  endif
end subroutine uv_shift_data
end module uv_shift
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
