program uv_applyphase
  use image_def
  use gkernel_interfaces
!
! Apply a phase modification
!
  character(len=filename_length) :: nami,namo
  logical :: error, amp_correct
!
  call gildas_open
  call gildas_char('INPUT$',nami)
  call gildas_char('OUTPUT$',namo)
  call gildas_logi('AMP_CORRECT$',amp_correct,1)
  call gildas_close
  call sub_applyphase (nami,namo,amp_correct,error)
  if (error) call sysexi(fatale)
  call gagout('I-UV_APPLYPHASE,  Successful completion')
end program uv_applyphase
!<ff>
subroutine sub_applyphase (nami,namo,amp_correct,error)
  use image_def
  use gkernel_interfaces
  character(len=*) nami,namo
  logical error
!
  type (gildas) :: hin,hout
  real, allocatable :: din(:,:),dout(:,:)
  integer nt,nv,i,j,ier,ii,ir,nc
  real re,im,amp
  logical amp_correct
  character(len=*), parameter :: rname = 'APPLYPHASE'
!
! Read Header of the input UV table
  call sic_parsef (nami,hin%file,' ','.uvt')
  call gdf_read_header (hin,error)
  if (gildas_error(hin,rname,error)) return
  allocate (din(hin%gil%dim(1),hin%gil%dim(2)),stat=ier)
  call gdf_read_data (hin,din,error)
  if (gildas_error(hin,rname,error)) return
  nt = hin%gil%dim(1)
  nv = hin%gil%dim(2)
!
! Read header of the output UV table
  call sic_parsef (namo,hout%file,' ','.uvt')
  call gdf_read_header (hout,error)
  if (gildas_error(hout,rname,error)) return
  allocate (dout(hout%gil%dim(1),hout%gil%dim(2)),stat=ier)
  call gdf_read_data (hout,dout,error)
  if (gildas_error(hout,rname,error)) return
!
  if (nv.ne.hout%gil%dim(2)) then
     call gagout('E-'//rname//',  Inconsistent sizes')
     error = .true.
     return
  endif
!
! Correct amplitude decorrelation?
!
  nc = hout%gil%nchan
  !
  if (amp_correct) then
     do i=1,nv
        amp = sqrt(din(8,i)**2+din(9,i)**2)
        if (amp.ne.0.) then
           din(8,i) = din(8,i)/amp
           din(9,i) = din(9,i)/amp
        endif
     enddo
  endif
!
! Modify table
!
  do i=1,nv
    do j=1,nc
      ir = hout%gil%fcol+3*(j-1)
      ii = ir+1
      re = din(8,i)*dout(ir,i)-din(9,i)*dout(ii,i)
      im = din(8,i)*dout(ii,i)+din(9,i)*dout(ir,i)
      dout(ir,i) = re
      dout(ii,i) = im
    enddo
  enddo
!
! Write result
!
  call gdf_write_image(hout,dout,error)
  if (gildas_error(hout,rname,error)) return
  deallocate (dout)
end subroutine sub_applyphase
