program uv_merge_many
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! TASK  Merge Many 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
  character(len=filename_length) :: table_ref, table_out
  character(len=filename_length), allocatable :: table_in(:)
  real, allocatable :: weight(:), factor(:)
  integer :: mode, i, nt, ier
  logical :: error
  character(len=60) :: chain
  !------------------------------------------------------------------------
  ! Code:
  call gildas_open
  call gildas_char( 'TABLE_REF$', table_ref)
  call gildas_char( 'TABLE_OUT$', table_out)
  call gildas_inte( 'MODE$',mode,1)
  !
  call gildas_inte( 'NTABLES$',nt,1)
  if (nt.lt.0) then
    Print *,'Invalid number of Tables'
    call sysexi(fatale)
  endif
  !
  allocate (weight(nt), factor(nt), table_in(nt), stat=ier)
  if (ier.ne.0) then
    Print *,'Memory allocation error'
    call sysexi(fatale)
  endif
  !  
  call gildas_real( 'WEIGHT$', weight, nt)
  call gildas_real( 'FACTOR$', factor, nt)
  do i = 1,nt-1
    write(chain,'(A,I0,A)') 'TABLE_',i,'$'
    call gildas_char(chain, table_in(i))
  enddo
  call gildas_close
  !
  call sub_uv_merge_block(nt, table_in, table_ref, table_out, &
    weight, factor, mode, 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
  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
  !
  ! Local
  integer :: i, j, k, iv
  real :: poids
  !
  ! 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:
  ! 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
end subroutine uvmergel
!
subroutine uvmergec (nv,ndx,x,ndz,z,weight,factor,scaleuv)
  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
  ! Local
  integer :: j, iv, n
  !------------------------------------------------------------------------
  ! Code:
  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
    x(9,iv) = z(9,iv)*factor
    ! Weight
    x(10,iv) = z(10,iv)*weight
    ! 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, 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
  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 gag_message(seve%e,rname,'Cannot read input UV table #0 (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-1
    call gdf_read_gildas (in, table_in(im), '.uvt', error, data=.false.)
    if (error) then
      write(mess,*) 'Cannot read input UV table #',im
      call gag_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 gag_message(seve%e,rname,'Mode = 1 only valid for matching continuum UV tables ')
        error = .true.
        return
      endif
    else
      out%gil%dim(2) = in%gil%dim(2) + out%gil%dim(2)
      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 gag_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 gag_message(seve%i,rname,'Creating UV table '//trim(out%file))
  call gdf_create_image(out, error)
  if (error) then
    call gag_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%dim(2))
  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 gag_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%dim(2),nblock
    write(mess,*) i,' / ',inref%gil%dim(2),nblock
    call gag_message(seve%d,rname,mess)
    inref%blc(2) = i
    inref%trc(2) = min(inref%gil%dim(2),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 gag_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (out%gil%nchan.eq.1 .and. in%gil%nchan.eq.1) then
    call gag_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 gag_message(seve%e,rname,mess)
      error = .true.
      return
    endif
    call gag_message(seve%i,rname,'Merging line tables')
  endif
  !
  ! Append INs to OUT with resampling and rescaling
  do im = 1,n_in-1
    Print *,'Reading ',im,n_in-1,table_in(im)
    call gdf_read_gildas (in, table_in(im), '.uvt', error, data=.false.)
    if (error) then
      write(mess,*) 'Cannot read input UV table #',im
      call gag_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 gag_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%dim(2),nblock
      write(mess,*) i,' / ',in%gil%dim(2),nblock
      call gag_message(seve%d,rname,mess)
      in%blc(2) = i
      in%trc(2) = min(in%gil%dim(2),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)
        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 gag_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_many
