program uv_merge
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! TASK  Merge two UV tables;
  !
  ! with calibration factor and weight factor and resampling of
  ! the first one, the second one being used as the reference
  !
  ! Input :
  !   two UV tables
  ! Output :
  !   one new UV table
  !---------------------------------------------------------------------
  ! Local
  integer, parameter :: mw=9  ! Maximum number of files to be merged
  character(len=filename_length) :: table_in(mw), table_ref, table_out
  real :: weight(mw), factor(mw)
  integer :: mode
  real    :: alpha
  logical :: error
  !------------------------------------------------------------------------
  ! Code:
  call gildas_open
  call gildas_char( 'TABLE_IN$', table_in(1))
  call gildas_real( 'WEIGHT$', weight, 1)
  call gildas_real( 'FACTOR$', factor, 1)
  call gildas_char( 'TABLE_REF$', table_ref)
  call gildas_char( 'TABLE_OUT$', table_out)
  call gildas_inte( 'MODE$',mode,1)
  call gildas_real( 'ALPHA$', alpha, 1)
  call gildas_close
  !
  call sub_uv_merge_block(1, table_in, table_ref, table_out, &
    weight, factor, mode, alpha, error)
  if (error) call sysexi(fatale)
!
contains
!
subroutine uvmergel (nv,ncx,x,ncz,z,weight,factor,iwork,rwork &
  & ,xref,xval,xinc,zref,zval,zinc)
  use gildas_def
  use gbl_message
  integer(kind=size_length), intent(in) :: nv   ! Number of visibilities
  integer, intent(in) :: ncx                    ! Number of channels
  real, intent(inout) :: x(:,:)                 ! Merged UV table
  integer, intent(in) :: ncz                    ! Number of channels
  real, intent(in) :: z(:,:)                    ! Input UV table
  real, intent(in) :: weight                    ! Weight scale factor
  real, intent(in) :: factor                    ! Intensity scale factor
  integer, intent(inout) :: iwork(2,*)          ! Work array
  real, intent(inout) :: rwork(4,*)             ! Work array
  real(8), intent(in) :: xref,xval,xinc         ! Input velocity sampling
  real(8), intent(in) :: zref,zval,zinc         ! Output velocity sampling
  !
  real(kind=8),parameter      :: ctol = 0.1     ! Spectral tolerance over all spectrum
  character(len=*), parameter :: rname='UV_MERGE'
  !
  ! Local
  integer :: i, j, k, iv
  real :: poids
  logical :: resample
  !
  ! iwork = imin,imax
  ! rwork = rmin_1, rmin, rmax, rmax_1
  !
  integer imax,imin, ix,iy, jxmin, jymin, jxmax, jymax
  integer :: mcx, mcz, lcx, lcz, mtrail
  real(8) minpix, maxpix, pix, val, expand
  real rmin_1, rmin, rmax_1, rmax, smin, smax
  real scale
  !------------------------------------------------------------------------
  ! Code:
  !
  resample = shouldresample(ncx,xref,xval,xinc,ncz,zref,zval,zinc,ctol)
  !
  if (.not.resample) then
     call map_message(seve%i,rname,'Spectral Sampling of the UV tables is consistent')
     call map_message(seve%i,rname,'Merged table is a simple concatenation')
     do iv=1,nv   
        x(:,iv) = z(:,iv)
     end do
  else
     call map_message(seve%w,rname,'Spectral Sampling of the UV tables is not consistent')
     call map_message(seve%w,rname,'Resampling UV table 1 on the spectral axis of UV table 2')
     !
     ! Interpolate first (Z) Table on X grid
     !
     mcx = ubound(x,1)
     mcz = ubound(z,1)
     lcx = 3*ncx+7
     lcz = 3*ncz+7
     mtrail = mcx-lcx
     ! Setup interpolation scheme
     !
     expand = abs(xinc/zinc)
     scale  = factor/expand
     !
     ! Initialize workspace
     iwork(:,1:ncx) = 0
     rwork(:,1:ncx) = 0.0
     do i = 1, ncx
        !
        ! Compute interval
        val = xval + (i-xref)*xinc
        pix = (val-zval)/zinc + zref
        maxpix = pix + 0.5d0*expand
        minpix = pix - 0.5d0*expand
        imin = int(minpix+1.0d0)
        imax = int(maxpix)
        iwork(1,i) = imin
        iwork(2,i) = imax
        if (imax.eq.imin .and. expand.eq.1.0) then
           ! Shifted grid or not actually
           rwork(1,i) = (imin-pix)
           rwork(2,i) = 1.0-rwork(1,i)
        else if (imax.ge.imin) then
           ! Lower end
           if (imin.gt.1) then
              !
              ! ZMIN = Z(IMIN-1)*(IMIN-MINPIX)+Z(IMIN)*(MINPIX-IMIN+1)
              !     and
              ! X(I) = X(I) + 0.5 * ( (IMIN-MINPIX)*(ZMIN+Z(IMIN)) )
              !
              !     RMIN_1 = 0.5 * (IMIN-MINPIX)*(IMIN-MINPIX)     ! Coefficient de IMIN-1
              !     RMIN   = 0.5 * (MINPIX-IMIN+2)*(IMIN-MINPIX)   ! Coefficient de IMIN
              !
              smin = imin-minpix
              rwork(1,i) = 0.5*smin*smin
              rwork(2,i) = smin-rwork(1,i)
           else
              !     RMIN   = (IMIN-MINPIX)                          ! Coefficient de IMIN
              !     RMIN_1 = 0                                      ! Coefficient de IMIN-1
              rwork(1,i) = 0.0
              rwork(2,i) = imin-minpix
           endif
           ! Upper end
           if (imax.lt.ncz) then
              smax = maxpix-imax
              rwork(4,i) = 0.5*smax*smax
              rwork(3,i) = smax-rwork(4,i)
           else
              rwork(3,i) = maxpix-imax
              rwork(4,i) = 0.0
           endif
           if (imax.eq.imin) then
              ! 3 Point Case
              rwork(2,i) = rwork(2,i)+rwork(3,i)
              rwork(3,i) = 0.0
           else
              ! General Case: Add 1/2 of IMIN & IMAX + 1 of all intermediate channels
              rwork(2,i) = rwork(2,i)+0.5
              rwork(3,i) = rwork(3,i)+0.5
           endif
        else
           if (imin.gt.1) then
              rwork(1,i) = (imin-pix)
              rwork(2,i) = 1.0-rwork(1,i)
           else
              rwork(1,i) = 0.0
              rwork(2,i) = 1.0
           endif
        endif
     enddo
     !
     ! OK, now do it for all visibilities
     do iv=1,nv
        !
        ! Coordinates
        do j=1, 7
           x(j,iv) = z(j,iv)
        enddo
        !
        ! Channels
        do i=1,ncx
           imin = iwork(1,i)
           imax = iwork(2,i)
           jxmin = 5+3*imin
           jymin = jxmin+1
           jxmax = 5+3*imax
           jymax = jxmax+1
           rmin_1 = rwork(1,i)
           rmin   = rwork(2,i)
           rmax   = rwork(3,i)
           rmax_1 = rwork(4,i)
           ix = 5+3*i
           iy = ix+1
           !
           if (imax.ge.imin) then
              ! General Trapezium integration
              if (imin.gt.1) then
                 x(ix,iv) = z(jxmin-3,iv)*rmin_1+z(jxmin,iv)*rmin
                 x(iy,iv) = z(jymin-3,iv)*rmin_1+z(jymin,iv)*rmin
              else
                 x(ix,iv) = z(jxmin,iv)*rmin
                 x(iy,iv) = z(jymin,iv)*rmin
              endif
              if (imax.gt.imin) then
                 do k = 5+3*(imin+1),5+3*(imax-1),3
                    x(ix,iv) = x(ix,iv) + z(k,iv)
                    x(iy,iv) = x(iy,iv) + z(k+1,iv)
                 enddo
              endif
              x(ix,iv) = x(ix,iv) + z(jxmax,iv)*rmax
              x(iy,iv) = x(iy,iv) + z(jymax,iv)*rmax
              if (imax.lt.ncz) then
                 x(ix,iv) = x(ix,iv) + z(jxmax+3,iv)*rmax_1
                 x(iy,iv) = x(iy,iv) + z(jymax+3,iv)*rmax_1
              endif
              x(ix,iv) = x(ix,iv)*scale
              x(iy,iv) = x(iy,iv)*scale
           else
              !
              ! Interpolation
              if (imin.gt.1) then
                 x(ix,iv) = z(jxmin-3,iv)*rmin_1+z(jxmin,iv)*rmin
                 x(iy,iv) = z(jymin-3,iv)*rmin_1+z(jymin,iv)*rmin
              else
                 x(ix,iv) = z(jxmin,iv)
                 x(iy,iv) = z(jymin,iv)
              endif
              x(ix,iv) = x(ix,iv)*factor
              x(iy,iv) = x(iy,iv)*factor
           endif
        enddo
        !
        ! Weight
        ! Same weight for all channels...
        !
        poids = z(10+3*(ncz/2),iv)*weight
        if (poids.eq.0) then  ! May happen with Widex spectra
           poids = z(10+3*(ncz/3),iv)*weight
        endif
        do j=10, 3*ncx+7, 3
           x(j,iv) = poids
        enddo
        !
        ! Trailing columns if any
        do j=1,mtrail
           x(lcx+j,iv) = z(lcz+j,iv)
        enddo
     enddo
  endif
end subroutine uvmergel
!
function shouldresample(xnc,xref,xval,xinc,znc,zref,zval,zinc,ctol)
  integer(kind=4),intent(in) :: xnc
  real(kind=8),   intent(in) :: xref
  real(kind=8),   intent(in) :: xval
  real(kind=8),   intent(in) :: xinc
  integer(kind=4),intent(in) :: znc
  real(kind=8),   intent(in) :: zref
  real(kind=8),   intent(in) :: zval
  real(kind=8),   intent(in) :: zinc
  real(kind=8),   intent(in) :: ctol
  logical :: shouldresample
  !
  real(kind=8) :: xleft,xright,zleft,zright,vtol
  !
  vtol = abs(zinc*ctol)
  !
  if (xnc.ne.znc) then
     shouldresample = .true.
     return
  else if (xinc*zinc.lt.0.d0) then
     shouldresample = .true.
     return
  else
    xleft  = (0.5-xref)*xinc+xval    
    xright = (xnc+0.5-xref)*xinc+xval 
    zleft  = (0.5-zref)*zinc+zval    
    zright = (znc+0.5-zref)*zinc+zval
    !
    if (abs(xleft-zleft).gt.vtol) then
       shouldresample = .true.
       return
    else if (abs(xright-zright).gt.vtol) then
       shouldresample = .true.
       return
    else
       shouldresample = .false.
       return
    endif
  endif
  !
end function shouldresample
!
subroutine uvmergec (nv,ndx,x,ndz,z,weight,factor,scaleuv,alpha)
  use gildas_def
  !
  ! Merge two Continuum Data Set
  !
  integer(kind=size_length), intent(in) :: nv                     ! Number of visibilities
  integer(kind=size_length), intent(in) :: ndx                    !
  real, intent(inout) :: x(ndx,nv)              ! Merged UV table
  integer(kind=size_length), intent(in) :: ndz                    !
  real, intent(in) :: z(ndz,nv)                 ! Input UV table
  real, intent(in) :: weight                    ! Weight scale factor
  real, intent(in) :: factor                    ! Intensity scale factor
  real, intent(in) :: scaleuv                   ! Baseline length scale
  real, intent(in) :: alpha                     ! Spectral index
  ! Local
  integer :: j, iv, n
  real(kind=4) :: scale_flux, scale_w           ! flux and weigh scales in case of a spectral index
  !------------------------------------------------------------------------
  ! Code:
  scale_flux = scaleuv**(-alpha)
  scale_w = scaleuv**(2*alpha)
  n = min(ndx,ndz)
  !
  ! OK, now do it for all visibilities
  do iv=1,nv
    !
    ! Coordinates
    x(1,iv) = scaleuv*z(1,iv)
    x(2,iv) = scaleuv*z(2,iv)
    do j=3, 7
      x(j,iv) = z(j,iv)
    enddo
    !
    ! Visibilities
    x(8,iv) = z(8,iv)*factor*scale_flux
    x(9,iv) = z(9,iv)*factor*scale_flux
    ! Weight
    x(10,iv) = z(10,iv)*weight*scale_w
    ! Other (if any)
    do j=11,n
      x(j,iv) = z(j,iv)
    enddo
  enddo
end subroutine uvmergec
!
subroutine uvmergef (nv,ndx,x,ndz,z,weight,factor,w1,w2)
  use gildas_def
  !
  ! Merge two Continuum Data Set: Average visibilities
  !
  integer(kind=size_length), intent(in) :: nv   ! Number of visibilities
  integer(kind=size_length), intent(in) :: ndx  !
  real, intent(inout) :: x(ndx,nv)              ! Merged UV table
  integer(kind=size_length), intent(in) :: ndz  !
  real, intent(in) :: z(ndz,nv)                 ! Input UV table
  real, intent(in) :: weight                    ! Weight scale factor
  real, intent(in) :: factor                    ! Intensity scale factor
  real(8), intent(out) :: w1,w2                 ! Relative weights
  ! Local
  integer :: iv, n, j
  real :: ww
  !------------------------------------------------------------------------
  ! Code:
  n = min(ndx,ndz)
  w1 = 0.d0
  w2 = 0.d0
  ! OK, now do it for all visibilities
  do iv=1,nv
    !
    ! U and V Coordinates
    if (x(1,iv).ne.z(1,iv)) then
      print *,'U iv ',iv,x(1,iv),z(1,iv), x(10,iv), z(10,iv)
      print *,'Out ',z(1:10,iv)
      goto 99
    endif
    if (x(2,iv).ne.z(2,iv)) then
      print *,'V iv ',iv,x(2,iv),z(2,iv), x(10,iv), z(10,iv)
      goto 99
    endif
    !
    ! Visibilities
    ww = x(10,iv)
    if (x(10,iv).gt.0) w1 = w1+x(10,iv)
    !
    if (z(10,iv).gt.0) then
      w2 = w2+z(10,iv)
      if (x(10,iv).gt.0) then
        ww = x(10,iv)+weight*z(10,iv)
        x(8,iv) = (x(8,iv)*x(10,iv) + z(8,iv)*z(10,iv)*weight*factor ) / ww
        x(9,iv) = (x(9,iv)*x(10,iv) + z(9,iv)*z(10,iv)*weight*factor ) / ww
      else
        ww = weight*z(10,iv)
        x(8,iv) = z(8,iv)*factor
        x(9,iv) = z(9,iv)*factor
      endif
    endif
    ! Weight
    x(10,iv) = ww
    ! Trailing columns if any
    do j=11,n
      x(j,iv) = z(j,iv)
    enddo
  enddo
  return
99  call gagout('E-UV_MERGE,  Continuum tables do not match')
end subroutine uvmergef

!
subroutine sub_uv_merge_block(n_in, table_in, table_ref, table_out, &
     weight, factor, mode, alpha, error)
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! TASK  Merge two UV tables;
  !
  ! with calibration factor and weight factor and resampling of
  ! the first one, the second one being used as the reference
  !
  ! Input :
  ! two UV tables
  ! Output :
  ! one new UV table
  !---------------------------------------------------------------------
  integer, intent(in) :: n_in ! Number of input tables
  character(len=*), intent(in) :: table_in(*), table_ref, table_out
  real, intent(in)  :: weight(*)
  real, intent(in)  :: factor(*)
  integer, intent(in)  :: mode
  real, intent(in)     :: alpha
  logical, intent(out) :: error
  ! Local
  character(len=*), parameter :: rname='UV_MERGE'
  type(gildas) :: in,inref,out
  integer, allocatable :: iwork(:,:)
  real(4), allocatable :: rwork(:,:)
  real :: scale_uv
  real(8) :: w1,w2
  integer :: nblock, i, ier, im
  character(len=80) :: mess
  integer :: code
  integer(kind=size_length) :: in_gil_dim1,in_gil_dim2, nvisi
  integer, parameter :: code_cont=1
  integer, parameter :: code_merge=0
  integer, parameter :: code_stack=2
  !------------------------------------------------------------------------
  ! Code:
  !
  if (n_in.eq.0) goto 999
  if (len_trim(table_ref).eq.0) goto 999
  if (len_trim(table_out).eq.0) goto 999
  !
  ! Input file TABLE_REF  (INREF) is the reference one
  call gildas_null(inref, type = 'UVT')
  call gdf_read_gildas (inref, table_ref, '.uvt', error, data=.false.)
  if (error) then
    call map_message(seve%e,rname,'Cannot read input UV table #2 (Reference)')
    return
  endif
  !
  ! Prepare output table: compute number of visibilities
  call gildas_null(out, type = 'UVT')
  call gdf_copy_header (inref, out, error)
  call sic_parse_file(table_out,' ','.uvt',out%file)
  !
  ! Loop over tables to be merged
  call gildas_null(in, type = 'UVT')
  in_gil_dim1 = 0
  in_gil_dim2 = 0
  !
  do im=1,n_in
    call gdf_read_gildas (in, table_in(im), '.uvt', error, data=.false.)
    if (error) then
      write(mess,*) 'Cannot read input UV table #',im
      call map_message(seve%e,rname,mess)
      return
    endif
    !
    if (mode.eq.code_cont) then
      if (in%gil%dim(2).ne.inref%gil%dim(2) .or. &
        in%gil%nchan.ne.1 .or. inref%gil%nchan.ne.1) then
        call map_message(seve%e,rname,'Mode = 1 only valid for matching continuum UV tables ')
        error = .true.
        return
      endif
    else
      out%gil%dim(2) = in%gil%nvisi + out%gil%nvisi
      out%gil%nvisi = out%gil%dim(2)  ! Set the number of visibilities
    endif
    in_gil_dim1 = max(in_gil_dim1,in%gil%dim(1))
    in_gil_dim2 = max(in_gil_dim2,in%gil%dim(2))
    !
    ! Verify if trailing columns do match
    call gdf_uvmatch_codes(inref,in,code)
    if (code.eq.3) then
      ! Column # 3 has a mismatch - Make sure the Ref is now SCAN
      inref%gil%column_pointer(code_uvt_w) = 0
      inref%gil%column_size(code_uvt_w) = 0
      inref%gil%column_pointer(code_uvt_scan) = 3
      inref%gil%column_size(code_uvt_scan) = 1
     else if (code.lt.0) then
      error = .true. 
      call map_message(seve%e,rname,'Leading or Trailing columns do not match')
      return
    endif
    !
    call gdf_close_image(in,error)
  enddo
  !
  ! Finished preparatory work, and create the OUT table
  call map_message(seve%i,rname,'Creating UV table '//trim(out%file))
  call gdf_create_image(out, error)
  if (error) then
    call map_message(seve%e,rname,'Cannot create output UV table')
    return
  endif
  !
  ! Define blocking factor,
  call gdf_nitems('SPACE_GILDAS',nblock,inref%gil%dim(1)) ! Visibilities at once
  nblock = min(nblock,inref%gil%nvisi)
  allocate (out%r2d(out%gil%dim(1),nblock), stat=ier)
  if (ier.ne.0) then
    write(mess,*) 'Memory allocation error ',inref%gil%dim(1), nblock
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! First pass is to read INREF directly in OUT
  !
  ! Loop over line table
  inref%blc = 0
  inref%trc = 0
  out%blc = 0
  out%trc = 0
  do i=1,inref%gil%nvisi,nblock
    write(mess,*) i,' / ',inref%gil%nvisi,nblock
    call map_message(seve%d,rname,mess)
    inref%blc(2) = i
    inref%trc(2) = min(inref%gil%nvisi,i-1+nblock)
    out%blc(2) = inref%blc(2)
    out%trc(2) = inref%trc(2)
    call gdf_read_data(inref,out%r2d,error)
    if (error) return
    call gdf_write_data(out,out%r2d,error)
    if (error) return
  enddo
  deallocate(out%r2d)
  call gdf_close_image(inref,error)
  !
  ! Define blocking factor
  call gdf_nitems('SPACE_GILDAS',nblock,in_gil_dim1) ! Visibilities at once
  nblock = min(nblock,in_gil_dim2)
  allocate (out%r2d(out%gil%dim(1),nblock), stat=ier)
  if (ier.ne.0) then
    write(mess,*) 'Memory allocation error OUT ',out%gil%dim(1), nblock
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (out%gil%nchan.eq.1 .and. in%gil%nchan.eq.1) then
    call map_message(seve%i,rname,'Merging two continuum tables')
  else
    allocate (iwork(2,out%gil%nchan), rwork(4,out%gil%nchan), stat=ier)
    if (ier.ne.0) then
      write(mess,*) 'Memory allocation error WORK ',6,out%gil%nchan
      call map_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    if (in%gil%freq.ne.out%gil%freq) then
       call map_message(seve%w,rname,'Merging two line tables with different rest frequencies')
    else   
       call map_message(seve%i,rname,'Merging line tables')
    endif
  endif
  !
  ! Append INs to OUT with resampling and rescaling
  do im = 1,n_in
    call gdf_read_gildas (in, table_in(im), '.uvt', error, data=.false.)
    if (error) then
      write(mess,*) 'Cannot read input UV table #',im
      call map_message(seve%e,rname,mess)
      return
    endif
    !
    allocate (in%r2d(in%gil%dim(1),nblock), stat=ier)
    if (ier.ne.0) then
      write(mess,*) 'Memory allocation error IN ',in%gil%dim(1), nblock
      call map_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    !
    if (out%gil%nchan.eq.1 .and. in%gil%nchan.eq.1) then
      scale_uv = in%gil%freq / inref%gil%freq
      if (mode.eq.code_cont) then
        out%blc(2) = 1
      else
        out%blc(2) = out%trc(2)+1
      endif
    else
      if (mode.eq.code_stack) then
        !   In Stacking Mode, Lambda/D is conserved, so the UV length
        ! must be scaled by FreqIn/ FreqRef
        scale_uv = in%gil%freq / inref%gil%freq
      else
        scale_uv = 1.0
      endif
      out%blc(2) = out%trc(2)+1
    endif
    !
    in%blc = 0
    in%trc = 0
    !
    ! Block loop on current input file
    do i=1,in%gil%nvisi,nblock
      write(mess,*) i,' / ',in%gil%nvisi,nblock
      call map_message(seve%d,rname,mess)
      in%blc(2) = i
      in%trc(2) = min(in%gil%nvisi,i-1+nblock)
      nvisi = in%trc(2)-in%blc(2)+1
      out%trc(2) = out%blc(2)+nvisi-1
      call gdf_read_data(in,in%r2d,error)
      !
      if (out%gil%nchan.eq.1 .and. in%gil%nchan.eq.1) then
        if (mode.eq.0) then
          Print *,'    with uvmergeC ',im,' weight ',weight(im)
          call uvmergec (nvisi, out%gil%dim(1), out%r2d,  &
       &       in%gil%dim(1),in%r2d,weight(im),factor(im),      &
       &       scale_uv,alpha)
        else
          call gdf_read_data(out,out%r2d,error)
          Print *,'    with uvmergeF ',im,' weight ',weight(im)
          call uvmergef (nvisi, out%gil%dim(1), out%r2d,  &
       &       in%gil%dim(1),in%r2d,weight(im),factor(im),      &
       &       w1,w2)
          out%gil%freq = (w1*in%gil%freq + w2*inref%gil%freq) / (w1+w2)
        endif
      else
        call uvmergel (nvisi, out%gil%nchan, out%r2d,    &
       &       in%gil%nchan,in%r2d,weight(im),factor(im),      &
       &       iwork, rwork, &
       &       out%gil%ref(1), dble(out%gil%voff), dble(out%gil%vres), &
       &       in%gil%ref(1), dble(in%gil%voff), dble(in%gil%vres) )
      endif
      call gdf_write_data(out,out%r2d,error)
      if (error) return
      out%blc(2) = out%trc(2)+1
    enddo
    !
    call gdf_close_image(in,error)
    deallocate (in%r2d,stat=ier)
  enddo
  !
  call gdf_close_image(out,error)
  deallocate(out%r2d)
  call map_message(seve%i,rname,'Successful completion')
  return
  !
  999   error = .true.
end subroutine sub_uv_merge_block
!
subroutine gdf_uvmatch_codes(a,b,code)
  use image_def
  ! use gio_interfaces, only : gdf_uvcolumn_codes
  !---------------------------------------------------------------------
  ! @ public
  !
  ! GIO     Compare layout of UV tables for description columns
  ! Code = 0    Same layout
  ! Code = -1   Different layout
  ! Code = 3    Similar layout, except that Col.3 is SCAN in one,
  !             and W in the other.
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: a       ! Input Header
  type(gildas), intent(in) :: b       ! Input Header
  integer, intent(out)     :: code    ! Returned code
  !
  integer :: k, nlt, ier
  integer, allocatable :: a_codes(:,:), b_codes(:,:)
  !
  ! If # number of trailing : no match
  code = -1
  if (a%gil%ntrail.ne.b%gil%ntrail) return
  ! If # number of leading : no match
  if (a%gil%nlead.ne.b%gil%nlead) return
  !
  ! Else, compare columns, but make a specific provision
  ! for SCAN and W (both of which may happen in Col 3)
  !
  nlt = a%gil%nlead + a%gil%ntrail
  allocate(a_codes(2,nlt),b_codes(2,nlt),stat=ier)
  call gdf_uvcolumn_codes(a,a_codes)
  call gdf_uvcolumn_codes(b,b_codes)  
  !
  code = 0
  do k = 1,nlt
    if (a_codes(1,k).ne.b_codes(1,k)) then
      if (code.eq.0 .and. k.eq.3) then
        code = 3
        if (a_codes(1,k).eq.code_uvt_scan .and. b_codes(1,k).eq.code_uvt_w) cycle 
        if (b_codes(1,k).eq.code_uvt_scan .and. a_codes(1,k).eq.code_uvt_w) cycle
      endif
      code = -1
    else if (a_codes(2,k).ne.b_codes(2,k)) then
      Print *,'Code length mismatch at Col. ',k
    endif
  enddo
end subroutine gdf_uvmatch_codes
!
subroutine gdf_uvcolumn_codes(h,column_codes)
  use image_def
  !---------------------------------------------------------------------
  ! @ public-mandatory
  !
  ! GIO     Return the column codes and sizes of the Leading and Trailing
  !         columns
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: h                ! Input header
  integer, intent(inout) :: column_codes(:,:)   ! Column codes
  !
  integer :: nlt, i, j, itrail
  !
  nlt = h%gil%nlead + h%gil%ntrail
  !
  do j = 1,nlt
    do i = 1, code_uvt_last
      if (h%gil%column_pointer(i).lt.h%gil%fcol) then
        if (h%gil%column_pointer(i).eq.j) then
          column_codes(1,j) = i
          column_codes(2,j) = h%gil%column_size(i)
          exit
        endif
      else if (h%gil%column_pointer(i).gt.h%gil%lcol) then
         ! A little more vicious if > nlead
        itrail = h%gil%column_pointer(i)-h%gil%lcol+h%gil%nlead
        !! Print *,'Trail ',j,i,itrail
        if (itrail.eq.j) then
          column_codes(1,j) = i
          column_codes(2,j) = h%gil%column_size(i)
          exit
        endif
      else
        Print *,'Inconsistent Column Pointer #',i,' = ', h%gil%column_pointer(i), &
        &   ' in data range',h%gil%fcol,h%gil%lcol
      endif
    enddo
  enddo
end subroutine gdf_uvcolumn_codes

end program uv_merge
