program uv_gain
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_format
  use gbl_message
  !---------------------------------------------------------------------
  ! GILDAS
  !     S.Guilloteau & V.Pietu, from R.Lucas CLIC code
  !
  ! Compute Gains by comparing the UVT table and
  !       a UV model file.
  ! Input : a UV table (observed)
  !         a UV model
  ! Output: a UV table, with the gains.
  !         a UV calibrated table
  !---------------------------------------------------------------------
  ! Local
  type(gildas) :: gain,model,raw,cal
  integer, parameter :: mant=256  ! Valid for ALMA, VLA and most others.
  integer, parameter :: mbas=mant*(mant-1)/2
  character(len=*), parameter :: rname='UV_GAIN'
  logical :: error
  integer(4) ::  n, ichan, nvis, ncol, ier
  !
  character(len=filename_length) :: uvdata, uvmodel, uvgain, uvcal, &
    & uvsol, name   ! File names
  real :: tinteg    ! Integration time
  real :: snr       ! Minimum SNR for a solution
  integer :: refant ! Reference antenna (0 = automatic)
  logical :: flag   ! Flag data with no solution
  logical :: do_amp ! Self calibrate amplitude
  logical :: do_pha ! Self calibrate phase
  logical :: antenna_based ! Antenna based self calibration
  !
  integer, allocatable :: index(:)  ! Sorting index (by time)
  real(8), allocatable :: itime(:)  ! Times of observations
  real, allocatable, target :: basegain(:,:), antegain(:,:) ! Gain arrays
  integer :: ntimes   ! Number of different times in data
  integer :: nantes   ! Maximum number of antennas in data
  !
  ! Code
  call gildas_open
  call gildas_char('UVDATA$',uvdata)
  call gildas_char('UVMODEL$',uvmodel)
  call gildas_char('UVGAIN$',uvgain)
  call gildas_char('UVCAL$',uvcal)
  call gildas_real('TINTEG$',tinteg,1)
  call gildas_real('SNR$',snr,1)
  call gildas_logi('FLAG$',flag,1)
  call gildas_inte('CHANNEL$',ichan,1)
  call gildas_logi('DO_AMP$',do_amp,1)
  call gildas_logi('DO_PHA$',do_pha,1)
  call gildas_logi('ANTENNA_BASED$',antenna_based,1)
  call gildas_inte('REFERENCE_A$',refant,1)
  if (antenna_based) call gildas_char('UVSOL$',uvsol)
  call gildas_close
  !
  if (uvdata.eq.uvcal) then
    call map_message(seve%f,rname, &
    & 'Input and Self-calibrated table must differ.')
    error = .true.
    goto 999
  endif
  !
  ! Input file : data, in "raw"
  n = len_trim(uvdata)
  if (n.le.0) goto 999
  name = uvdata(1:n)
  call gildas_null(raw, type = 'UVT')
  call gdf_read_gildas(raw, name, '.uvt', error)
  if (error) then
    call map_message(seve%e,rname,'Cannot read input UV table ')
    goto 999
  endif
  !
  ! Input file : model, in "model"
  n = len_trim(uvmodel)
  if (n.le.0) goto 999
  call gildas_null(model, type = 'UVT')
  name = uvmodel(1:n)
  call gdf_read_gildas(model, name, '.uvt', error)
  if (error) then
    call map_message(seve%e,rname,'Cannot read model UV table ')
    goto 999
  endif
  !
  ! Prepare output gain table : in "gain"
  call gildas_null(gain, type = 'UVT')
  call gdf_copy_header (model, gain, error)
  n = len_trim(uvgain)
  if (n.eq.0) goto 999
  name  = uvgain(1:n)
  call sic_parsef(name,gain%file,' ','.uvt')
  call map_message(seve%i,rname,'Creating UV table '//trim(gain%file))
  call gdf_create_image (gain, error)
  if (error) then
    call map_message(seve%e,rname,'Cannot create Gain Table')
    goto 999
  endif
  !
  nvis = raw%gil%dim(2)
  ncol = raw%gil%dim(1)
  !
  if (antenna_based) then
    allocate (index(nvis), itime(nvis), &
      & basegain(10,nvis),antegain(10,nvis), stat=ier)
  else
    allocate (index(nvis), itime(nvis), &
      & basegain(10,nvis),stat=ier)
  endif
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Cannot allocate gain arrays')
    goto 999
  endif
  !
  ! Get baseline-based gains ...
  call do_base_gain(do_amp,do_pha,nvis,ncol,ichan,itime,   &
     &    index,raw%r2d,model%r2d,basegain)
  !!print *,'Done do_b_gain'
  !
  ! Model table is not needed any more.
  deallocate (model%r2d, stat=ier)
  call gdf_close_image (model, error)
  !
  ! Compute antenna-based gains ...
  if (antenna_based) then
    call do_ante_gain(do_amp,do_pha,nvis,itime,tinteg,snr,   &
     &      basegain, antegain, refant, ntimes, nantes)
    call do_plot_gain(ntimes,nantes,uvsol,refant,error)
    !
    gain%r2d => antegain
  else
    gain%r2d => basegain  
  endif
  !
  ! Prepare output calibrated table
  call gildas_null(cal, type = 'UVT')
  call gdf_copy_header(raw, cal, error)
  n = len_trim(uvcal)
  if (n.eq.0) goto 999
  name  = uvcal(1:n)
  call sic_parsef(name,cal%file,' ','.uvt')
  call map_message(seve%i,rname,'Creating UV table '//trim(cal%file))
  call gdf_create_image (cal,error)
  if (.not.error) call gdf_allocate (cal, error)
  if (error) then
    call map_message(seve%e,rname,'Cannot create Calibrated Table')
    goto 999
  endif
  !
  ! Fill in calibrated table
  call do_apply_cal(ncol,raw%gil%nchan,nvis,raw%r2d,cal%r2d,gain%r2d,flag,index)
  !
  call gdf_write_data (cal, cal%r2d, error)
  call gdf_write_data (gain, gain%r2d, error)
  ! Cleaning
  if (allocated(index))     deallocate(index)
  if (allocated(itime))     deallocate(itime)
  if (allocated(basegain))  deallocate(basegain)
  if (allocated(antegain))  deallocate(antegain)
  !
  call map_message(seve%i,rname,'Successful completion')
  call sysexi(1)
  !
  999   call sysexi (fatale)
end program uv_gain
!
subroutine do_apply_cal(ncol,nch,nvis,data,cal,gain,flag,index)
  use gbl_message
  !---------------------------------------------------------------------
  ! Apply Gain Table to input UV data set
  ! Index is the ordering of the gain. Gain(i) applies to Visi(Index(i))
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)  :: ncol             ! Number of column in visi
  integer(kind=4), intent(in)  :: nvis             ! Number of visibilities
  integer(kind=4), intent(in)  :: nch              ! Number of channels
  real(kind=4),    intent(in)  :: data(ncol,nvis)  ! Raw data
  real(kind=4),    intent(out) :: cal(ncol,nvis)   ! Calibrated data
  real(kind=4),    intent(in)  :: gain(10,nvis)    ! Gain array
  logical,         intent(in)  :: flag             ! Flag data with no solution
  integer(kind=4), intent(in)  :: index(nvis)      ! Visibility order
  ! Local
  character(len=*), parameter :: rname='UV_GAIN'
  character(len=message_length) :: mess
  integer(kind=4) :: iv, jv, k, nflag
  complex(kind=4) :: zdata, zgain, zcal
  !
  nflag = 0
  do iv=1, nvis
    jv = index(iv)
    do k=1, 7
      cal(k,jv) = data(k,jv)
    enddo
    zgain = cmplx(gain(8,iv),gain(9,iv))
    if (gain(10,iv).lt.0) then
      nflag = nflag+1
      zgain = 0
    endif
    do k=8, 5+3*nch, 3
      if (zgain.ne.0) then
        zdata = cmplx(data(k,jv),data(k+1,jv))
        zcal = zdata / zgain
        cal(k,jv) = real(zcal)
        cal(k+1,jv) = aimag(zcal)
        cal(k+2,jv) = data(k+2,jv)*abs(zgain)**2
      else
        cal(k,jv) = data(k,jv)
        cal(k+1,jv) = data(k+1,jv)
        cal(k+2,jv) = data(k+2,jv)
        if (flag) cal(k+2,jv) = -abs(cal(k+2,jv))
      endif
    enddo
    if (8+3*nch.le.ncol) then
      cal(8+3*nch:ncol,jv) = data(8+3*nch:ncol,jv)
    endif
  enddo
  !
  write(mess,'(I0,A)') nflag,' flagged visibilities in gain array'
  if (nflag.eq.0) then
    continue
  elseif (flag) then
    mess = trim(mess)//', flagged in calibrated data (FLAG$ = YES)'
  else
    mess = trim(mess)//', not flagged and no calibration applied in calibrated data (FLAG$ = NO)'
  endif
  call map_message(seve%i,rname,mess)
end subroutine do_apply_cal
!
subroutine do_ante_gain(do_amp,do_pha,nvis,times,tinteg,snr, &
  & basegain,antegain,refant,ntimes,nantes)
  use gildas_def
  use gbl_message
  !---------------------------------------------------------------------
  ! UV_GAIN
  !     S.Guilloteau & V.Pietu, derived from R.Lucas CLIC code
  !
  !   Compute complex gains (antenna-based solution) from a set
  !   of initial Antenna gains, smoothing in time as needed.
  !
  !   The initial Antenna gains must be sorted by increasing time
  !---------------------------------------------------------------------
  logical, intent(in)  :: do_amp                 ! Calibrate amplitude ?
  logical, intent(in)  :: do_pha                 ! Compute phase ?
  integer, intent(in)  :: nvis                   ! Number of visibilities
  real(8), intent(in)  :: times(nvis)            ! Times of visibilities
  real, intent(in)  :: tinteg                    ! Integration time
  real, intent(in)  :: snr                       ! requested Signal to Noise 
  real, intent(in)  :: basegain(10,nvis)         ! Input baseline gain array
  real, intent(inout)  :: antegain(10,nvis)      ! Output antenna gain array
  integer, intent(in) :: refant                  ! Reference antenna
  integer, intent(out) :: ntimes                 ! Number of time steps
  integer, intent(out) :: nantes                 ! Number of antennas
  ! Global
  character(len=*), parameter :: rname='UV_GAIN'
  real(8), parameter :: pi=3.14159265358979323846d0
  ! Maximum Size of problem
  ! ALMA uses stations rather than antennas
  integer, parameter :: mant=256  
  integer, parameter :: mbas=mant*(mant-1)/2
  ! Local
  character(len=256) :: mess
  real(8) ::  t, told
  real :: ampli, phase, ug, vg, d2, dmin, maxsnr,minsnr
  integer ::  iref, iv, jv, ia, ja, ib, i, nant, nbas, j, k, nant_old
  integer ::  lia, lja, igood, isol, iflag
  integer :: ibad, kbad, icount, itest, vgood, vbad
  logical :: error, ok
  !
  integer ::  al(mant)  !Physical number of Sequential number
  integer ::  la(mant)  !Sequential number of Physical number
  real :: ua(mant), va(mant)
  real :: aa(mant), ampsnr(mant)
  real(8) ::  ca(mant), cp(mant), wp(mant)
  real(8) ::  wk2(mant,mant), wk3(mant)
  logical :: isbad(mant)
  integer :: jbad(mant)
  !
  integer ::  iant(mbas), jant(mbas)      ! Start & End antenna of baseline
  real(8) ::  x(mbas), y(mbas), w(mbas), amp(mbas), pha(mbas), wa(mbas), ss(mbas)
  ! For debug only
  integer ::  lpairs(mant), lpair(mant,mant)
  !-----------------------------------------------------------------------
  nbas = 0
  igood = 0
  isol = 0
  vgood = 0
  vbad = 0
  do j=2, mant
    do i=1, j-1
      nbas = nbas+1
      iant(nbas) = i
      jant(nbas) = j
    enddo
  enddo
  !
  ! The algorithm will find a better value for ref antenna,
  ! the one nearest to the array center.
  iref = refant
  !
  ! Loop on visibilities
  !
  told = -1d10  ! An impossibly old time...
  ntimes = 0
  nantes = 0
  do iv=1, nvis
    t = times(iv)
    !
    ! Time change ?
    if (told.ne.t) then
      !
      ! Identify a new time range
      ntimes = ntimes+1
      !print *,'New output time ',iv,told,t,ntimes
      told = t
      nant_old = 0
      jv = iv
      !
      ! Find starting visibility < Told-Tinteg/2
      do while (jv.gt.1 .and. t .ge. told-tinteg/2)
        jv = jv - 1
        t = times(jv)
      enddo
      la = 0
      ca = 0.0
      cp = 0.0
      x = 0.0
      y = 0.0
      w = 0.0
      !
      ! Search how many antennas at this time, and average
      ! over all visibilities which fit the time range
      !
      ok = (jv.lt.nvis .and. t.le.told+tinteg/2.)
      lpairs = 0
      lpair  = 0
      nant = 0
      do while (ok)
        !
        ! Only Select the UN-FLAGGED data
        !
        if (basegain(10,jv).gt.0.0) then
          !
          ! Build the antenna pointer list "la" and "al"
          !
          ! In the end, we use this formula...
          !    ia = la(nint(basegain(6,iv)))
          !    ja = la(nint(basegain(7,iv)))
          ! which figures out which sequence number is each antenna
          !
          ia = nint(basegain(6,jv))
          if (la(ia).eq.0) then
            nant = nant+1
            la(ia) = nant
            al(nant) = ia ! The reverse pointer
          endif
          ja = nint(basegain(7,jv))
          if (la(ja).eq.0) then
            nant = nant+1
            la(ja) = nant
            al(nant) = ja
          endif
          !
          !! Build the antenna pairs (for debug only)
          !! lpairs(la(ia)) = lpairs(la(ia))+1
          !! lpair(lpairs(la(ia)),la(ia)) = la(ja)
          !!
          !! lpairs(la(ja)) = lpairs(la(ja))+1
          !! lpair(lpairs(la(ja)),la(ja)) = la(ia)        

          ! Here we set in UA,VA the "Antenna" U,V coordinate
          ! relative to Antenna #1
          !   Note: we do not average UA,VA over time since it
          !   is only used to determine the Reference antenna,
          !   a nearly irrelevant number.
          lia = la(ia)
          lja = la(ja)
          if (lia.eq.1) then
            ua(lja) = basegain(1,jv)
            va(lja) = basegain(2,jv)
          elseif (lja.eq.1) then
            ua(lia) = -basegain(1,jv)
            va(lia) = -basegain(2,jv)
          endif
          !
          ! Here we average the visibility into the X,Y,W buffer
          ! we also set start antenna < end antenna
          if (lia.eq.lja) then
            print *,'Ignoring autocorrelation for ',lia,al(lia)
          else
            if (lia.lt.lja) then
              ib = (lja-1)*(lja-2)/2+lia
              y(ib) = y(ib) + basegain(9,jv)*basegain(10,jv)        
            else !! if (lja.lt.lia) then
              ib = (lia-1)*(lia-2)/2+lja
              y(ib) = y(ib) - basegain(9,jv)*basegain(10,jv)
            endif
            x(ib) = x(ib) + basegain(8,jv)*basegain(10,jv)
            w(ib) = w(ib) + basegain(10,jv)
          endif
          !
        endif  ! End selection of Un-Flagged data
        !
        jv = jv + 1
        t = times(jv)
        ok = (jv.lt.nvis .and. t.le.told+tinteg/2.)
      enddo
      !
      ! get the reference antenna, by locating the one
      ! with the shortest baselines
      !
      nbas = nant*(nant-1)/2
      !
      ! Compute the centroid of antenna positions (still relative to Antenna #1)
      ug = 0
      vg = 0
      do ia=1, nant
        ug = ug+ua(ia)
        vg = vg+va(ia)
      enddo
      ug = ug/nant
      vg = vg/nant
      dmin = 1e10
      !
      ! Locate the antenna closest to centroid (this is independent of absolute pos.)
      iref = 1
      do ia=1, nant
        d2 = (ua(ia)-ug)**2 + (va(ia)-vg)**2
        if (d2.lt.dmin) then
          dmin = d2
          iref = ia
        endif
      enddo
      !
      ! This is wrong if antenna renumbering occured
      ! It should be 
      !       la(iref) = refant
      if (refant.ne.0) iref = refant
      !
      ! Check if any antenna has no closure 
      ibad = 0
      do lia=1,nant
        icount = 0
        do lja=1,nant
          if (lia.ne.lja) then
            if (lia.lt.lja) then
              ib = (lja-1)*(lja-2)/2+lia
            else !! if (lja.lt.lia) then
              ib = (lia-1)*(lia-2)/2+lja
            endif
            if (w(ib).ne.0) then
              icount = icount+1
            endif
          endif
        enddo
        if (icount.lt.2) then
          print *,'Antenna Seq.',lia,' (Phys. ',al(lia),') has no closure'
          ibad = ibad+1
          jbad(ibad) = lia
          isbad(lia) = .true.
        else
          isbad(lia) = .false.
        endif
      enddo
      !
      if (ibad.eq.nant) then
        print *,'No antenna can be calibrated at this time'
      else if (ibad.ne.0) then
        print *,ibad,' antennas with no solution'
      endif
      !
      ! Normalize the time averaged visibilities
      do ib=1, nbas
        if (w(ib).ne.0) then
          x(ib) = x(ib)/w(ib)
          y(ib) = y(ib)/w(ib)
        endif
      enddo
      !
      ! phases
      if (do_pha) then
        !
        ! Here, normally, each antenna should have at least
        ! 2 baselines, otherwise it is not possible...
        !
        if (ibad.ne.nant) then
          ! Solve for amplitude first to estimate S/N ratio
          ! Use an intermediate weight array "wa" for this
          do ib=1, nbas
            if (w(ib).ne.0) then
              amp(ib) = log(x(ib)**2+y(ib)**2)/2.
              wa(ib)  = w(ib)*(x(ib)**2+y(ib)**2)
            else
              wa(ib) = 0.0
            endif
          enddo
          call gain_ant(1, nbas, iant, jant, iref,   &
       &          nant, amp, wa, wk2, wk3, ss, ca, wp, error)
          !
          do ia = 1, nant
            isol = isol + 1
            aa(ia) = exp(2*ca(ia))
            wa(ia) = wp(ia)/aa(ia)**2
            ampsnr(ia) = aa(ia)*sqrt(wa(ia))*1e3
            if (isbad(ia)) ampsnr(ia) = 0.0 !S.Guilloteau
            !
            ! Reset amplitude to 1 now
            ca(ia) = 0
          enddo
          maxsnr = maxval(ampsnr(1:nant))
          minsnr = maxsnr
          do ia = 1, nant
            if (ampsnr(ia).ne.0) minsnr = min(minsnr,ampsnr(ia))
          enddo
        else
          maxsnr = 0.0
          minsnr = 0.0
        endif
        !
        if (maxsnr.gt.snr) then
          !
          ! If enough SNR, solve for the Phases for the good
          ! antennas. Use the initial weights "w" here.
          do ib=1, nbas
            if (w(ib).ne.0) then
              pha(ib) = atan2(y(ib),x(ib))
              !
              ! 1-Mar-2018 S.Guilloteau
              ! Normally, the phase error in radian is the Noise to Signal ratio,
              ! so the weight of that phase should be  (Signal/Noise)^2
              ! i.e. wa(ib) = (x(ib)^2+y(ib)^2) * w(ib)
              ! since w(ib) is the 1/Noise^2 for the (real, imaginary) parts,
              ! i.e. like used above for the Amplitude
              !
            else
              pha(ib) = 0.0
            endif
          enddo
          call gain_ant(2, nbas, iant, jant, iref,   &
     &            nant, pha, w, wk2, wk3, ss, cp, wp, error)
          iflag = 0
          do ia =1, nant
            !
            ! Keep only antenna solution with required snr
            if (ampsnr(ia).lt.snr) then
              cp(ia) = 0      ! Set phase correction to Zero
              itest = 0
              !
              ! Check whether this antenna was already expected
              ! to be without solution or not.
              do kbad=1,ibad
                if (jbad(kbad).eq.ia) then
                  !!print *,'** OK ** NO Solution for flagged antenna ',ia,al(ia)
                  itest = kbad
                  exit
                endif
              enddo
              if (itest.eq.0) then
                print *,'** Warning *** Flagged one more antenna ',ia,al(ia)
                isbad(ia) = .true.
              endif
              iflag = iflag+1
            else
              ! This was happening when AMPSNR was not set to Zero for
              ! antennas with no closure.
              !do kbad=1,ibad
              !  if (jbad(kbad).eq.ia) then
              !    print *,'** Warning *** Solution for flagged antenna ',ia,al(ia)
              !    print *,' Amp SNR ',ampsnr(ia),snr,aa(ia),wa(ia)
              !    exit
              !  endif
              !enddo
              igood = igood + 1
            endif
          enddo
        else
          iflag = nant
        endif
        if (iflag.ne.0) then
          write(mess,101) told,iref,maxsnr,minsnr,iflag
        else
          write(mess,101) told,iref,maxsnr,minsnr
        endif
101   format('Time ',F16.1,' Ref ',i3,' SNR: Max ',F5.1,' Min ',F5.1,I3,' antennas ignored')
        call map_message(seve%i,rname,mess)
      endif
      !
      ! This is redundant: it has already been done above
      do ia=1,nant
        if (isbad(ia)) then
          cp(ia) = 0.
        endif
      enddo
      !
      ! amplitudes next (because Phase reset CA = 0.0)
      if (do_amp) then
        !
        ! Here, we should check that each antenna should have at least
        ! 3 baselines, otherwise it is not possible...
        !
        ! Here, we use the raw initial weights also, not the SNR weights
        do ib=1, nbas
          if (w(ib).ne.0) then
            amp(ib) = log(x(ib)**2+y(ib)**2)/2.
          endif
        enddo
        call gain_ant(1, nbas, iant, jant, iref,   &
     &          nant, amp, w, wk2, wk3, ss, ca, wp, error)
      endif
      !
      ! Write the Phase on Unit 2, Amplitude on Unit 3
      write(2,*) iref,told,nant  ! Reference antenna
      write(2,102) al(1:nant)    ! Antenna list
102   format(16(1x,i3))
      write(2,100) cp(1:nant)*180.0/pi
      write(2,100) ampsnr(1:nant)
100   format (8(2x,f10.1))
      nantes = max(nantes,nant)
      !
      !!print *,'BAD ',isbad(1:nant)
    endif
    !
    ! Fill in the antenna gains in "antegain"
    do k=1,7
      antegain(k,iv) = basegain(k,iv)
    enddo
    ia = la(nint(basegain(6,iv)))
    ja = la(nint(basegain(7,iv)))
    ampli = 1./exp(ca(ia)+ca(ja)) ! Not sure for this one...
    phase = - cp(ia) + cp(ja)     ! This is THE solution
    !! print *,'IV ',ampli, 180*phase/3.14159
    antegain(8,iv) = ampli * cos(phase)
    antegain(9,iv) = ampli * sin(phase)
    !
    ! Flag data with no solution
    !! print *,'IV ',iv,' IA ',ia,isbad(ia),' JA ',ja,isbad(ja)
    if (isbad(ia).or.isbad(ja)) then
       antegain(10,iv) = -abs(basegain(10,iv))
       vbad = vbad+1
    else
       antegain(10,iv) = basegain(10,iv)
       vgood = vgood+1
    endif
  enddo
  write(mess,'(A,I0,A,I0,A)') "Found ",igood,"/",isol," good solutions"
  call map_message(seve%i,rname,mess)
  write(mess,'(A,I0,A,I0,A)') "Retained ",vgood," valid visibilities, ", &
    vbad," flagged ones"
  call map_message(seve%i,rname,mess)
end subroutine do_ante_gain
!
subroutine do_base_gain(do_amp,do_pha,nvis,ncol,icol,times,index,   &
     &    data,model,gain)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! UV_GAIN
  !     S.Guilloteau & V.Pietu, from R.Lucas CLIC code
  !
  ! do_base_gain
  !   Compute the Baseline-Based Gain by comparing the Data
  !   to the Model, retaining either Amplitude or Phase
  !   (or both, but this is not used by the calling routines so far)
  ! 
  !   We use channel Icol from Data table for the Data.
  !   Model and Gain are assumed to be continuum (i.e. single-channel)
  !   tables.
  !   Gain will contain the observed baseline gains, in an increasing 
  !   time order.
  !   Times is a Real(8) array to sort out date/time 
  !   Index is an integer array yielding the ordering
  !     gain(i) = data/model (Index(i))
  !---------------------------------------------------------------------
  logical, intent(in) :: do_amp                 ! Calibrate amplitude
  logical, intent(in) :: do_pha                 ! Calibrate phase
  integer, intent(in) :: nvis                   ! Number of visibilities
  integer, intent(in) :: ncol                   ! Size of a visibility
  integer, intent(in) :: icol                   ! Reference column
  real(8), intent(out) :: times(nvis)           ! Time stamps of visibilities
  integer, intent(out) :: index(nvis)           ! Index of visibilities
  real, intent(in) :: data(ncol,nvis)           ! Raw visibilities
  real, intent(in) :: model(10,nvis)            ! Modeled visibilities
  real, intent(out) :: gain(10,nvis)            ! Gain solution
  ! Local
  logical :: error
  ! Local:
  integer :: iv, i, jv, k
  complex :: zgain, zdata, zmodel
  real :: wgain, wdata, again, date0
  !-----------------------------------------------------------------------
  !
  ! Get the chronological order:
  date0 = data(4,1)
  do iv=1, nvis
    ! Beware of Real(8) precision ...
    times(iv) = (data(4,iv)-date0)*86400.d0+data(5,iv)  
  enddo
  call gr8_trie (times,index,nvis,error)
  !
  ! Sorted data in gain:
  do iv=1,nvis
    jv = index(iv)
    do i=1, 7
      gain(i,iv) = data(i,jv)
    enddo
    k = (icol-1)*3+7
    zdata = cmplx(data(k+1,jv),data(k+2,jv))
    wdata = data(k+3,jv)
    zmodel = cmplx(model(8,jv),model(9,jv))
    if (zmodel.ne.0) then
      zgain = zdata/zmodel
      wgain = wdata*abs(zmodel)**2
      if (.not.do_amp) then
        again = abs(zmodel)
        ! Here Zgain = Zdata modified by a phase factor .
        ! If we have a good model of the data, Zgain will
        ! have module of order Unity
        zgain = zgain*again 
        wgain = wdata
      elseif (.not.do_pha) then
        ! Here Zgain is just an amplitude factor.
        ! Phases are not modified
        ! Again, if the model is good, Zgain will be close to Unity
        zgain = abs(zgain)  ! Zgain = An amplitude factor
      else  
        ! Normally, we do not do Phase and Amplitude at once
        ! so this section of code is normally Idle
        ! 
        ! Zgain has both the Phase and the Amplitude factor
        ! here, so no change needed
      endif
    else
      zgain = 0. ! It can be anything, since Wgain is Zero
      wgain = 0.
    endif
    gain(8,iv) = real(zgain)
    gain(9,iv) = aimag(zgain)
    gain(10,iv) = wgain
  enddo
end subroutine do_base_gain
!
subroutine gain_ant(iy,nbas,iant,jant,iref,nant,y,w,wk2,wk3,ss,c,wc,error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! UV_GAIN
  !     S.Guilloteau & V.Pietu, from R.Lucas CLIC code
  !
  ! gain_ant 
  !     computes a weighted least-squares approximation
  !     to the antenna amplitudes or phases
  !     for an arbitrary set of baseline data points.
  !---------------------------------------------------------------------
  integer, intent(in) :: iy                ! 1 for log(amplitude), 2 for phase
  integer, intent(in) :: nbas              ! the number of baselines
  integer, intent(in) :: iant(nbas)        ! start antenna for each baseline
  integer, intent(in) :: jant(nbas)        ! end  antenna for each baseline
  integer, intent(in) :: iref              ! Reference antenna for phases
  integer, intent(in) :: nant              ! the number of antennas
  real(8), intent(in) :: y(nbas)           ! the data values
  real(8), intent(in) :: w(nbas)           ! weights
  real(8), intent(inout) :: wk2(nant,nant) ! work space
  real(8), intent(inout) :: wk3(nant)      ! work space
  real(8), intent(out) :: ss(nbas)         ! rms of fit for each baseline
  real(8), intent(out) :: c(nant)          ! the gains
  real(8), intent(out) :: wc(nant)         ! the weights
  logical, intent(out) :: error            !
  ! Global
  integer, external :: zant
  ! Local
  real(8) :: norm, tol
  !
  parameter (tol=1d-14)
  integer :: i, ia, ib, nantm1, ja, l, iter, ier
  real(8) ::  wi, ww, yi
  !------------------------------------------------------------------------
  ! Code
  !
  ss = 0.
  !
  ! Check that the weights are positive.
  !
  error = .false.
  do ib = 1, nbas
    if (w(ib).lt.0.0d0) then
      call gagout('E-GAIN_ANT,  Weights not positive')
      error = .true.
      return
    endif
  enddo
  !
  ! Amplitude case is simple...
  !
  if (iy.eq.1) then
    wk2 = 0.0d0
    wk3 = 0.0d0
    !
    ! store the upper-triangular part of the normal equations in wk2
    ! and the right-hand side in wk3.
    do ib=1,nbas
      wi = w(ib)
      if (wi.gt.0) then
        ia = iant(ib)
        ja = jant(ib)
        wk2(ia,ia) = wk2(ia,ia)+wi
        wk2(ia,ja) = wk2(ia,ja)+wi
        wk2(ja,ia) = wk2(ja,ia)+wi
        wk2(ja,ja) = wk2(ja,ja)+wi
      endif
    enddo
    do ib=1, nbas
      ia = iant(ib)
      ja = jant(ib)
      wi = w(ib)*y(ib)
      wk3(ia) = wk3(ia) + wi
      wk3(ja) = wk3(ja) + wi
    enddo
    !
    ! Solve the system of normal equations by first computing the Cholesky
    ! factorization
    call mth_dpotrf ('GAIN_ANT','U',nant,wk2,nant,error)
    if (error) return
    call mth_dpotrs ('GAIN_ANT','U',nant,1,wk2,nant,wk3,nant,ier)
    if (ier.ne.0) return
    do i=1,nant
      c(i) = wk3(i)
      wc(i) = wk2(i,i)**2
    enddo
    !
    ! Phase is more complicated ...
  elseif (iy.eq.2) then
    nantm1 = nant-1
    do i=1,nant
      c(i) = 0.0d0
      wc(i) = 0.0d0
    enddo
    !
    ! start iterating
    norm = 1e10
    iter = 0
    do while (norm.gt.tol .and. iter.lt.100)
      iter = iter + 1
      do i=1,nantm1
        do l=1,nantm1
          wk2(l,i) = 0.0d0
        enddo
        wk3(i) = 0.0d0
      enddo
      do ib=1,nbas
        wi = w(ib)
        if (wi.gt.0) then
          ia = zant(iant(ib),iref)
          ja = zant(jant(ib),iref)
          if (ia.ne.0) then
            wk2(ia,ia) = wk2(ia,ia)+wi
          endif
          if (ja.ne.0) then
            wk2(ja,ja) = wk2(ja,ja)+wi
          endif
          if (ia.ne.0 .and. ja.ne.0) then
            wk2(ja,ia) = wk2(ja,ia)-wi
            wk2(ia,ja) = wk2(ia,ja)-wi
          endif
        endif
      enddo
      do ib=1, nbas
        if (w(ib).gt.0) then
          yi = y(ib)
          ia = iant(ib)
          ja = jant(ib)
          yi = yi+(c(ia)-c(ja))
        else
          yi = 0
        endif
        yi = sin(yi)
        ia = zant(iant(ib),iref)
        ja = zant(jant(ib),iref)
        wi = w(ib)*yi
        if (ia.ne.0) then
          wk3(ia) = wk3(ia) - wi
        endif
        if (ja.ne.0) then
          wk3(ja) = wk3(ja) + wi
        endif
      enddo
      !
      ! Solve the system of normal equations by first computing the Cholesky
      ! factorization
      call mth_dpotrf('GAIN_ANT','U',nantm1,wk2,nant,error)
      if (error) return
      call mth_dpotrs ('GAIN_ANT','U',nantm1,1,wk2,nant,   &
     &        wk3,nantm1,ier)
      if (ier.ne.0) return
      !  Add the result to c:
      norm = 0
      do ia=1,nant
        i = zant(ia,iref)
        if (i.ne.0) then
          ww = wk3(i)
          c(ia) = c(ia)+ww
          wc(ia) = wk2(i,i)**2
          norm = norm+ww**2
        endif
      enddo
    enddo
  endif
  !
end subroutine gain_ant
!
function zant(i,r)
  !
  ! Return the apparent number of Antenna #i when reference
  ! antenna is #r. Since #r is not in the list of antennas for
  ! which a solution is to be searched, this number
  ! is #i for #i < #r, and #i-1 for #i > #r
  !
  integer :: zant                   ! intent(out)
  integer, intent(in) :: i          !
  integer, intent(in) :: r          !
  if (i.eq.r) then
    zant = 0
  elseif (i.gt.r) then
    zant = i-1
  else
    zant = i
  endif
  return
end function zant
!*
!=========================================================================
! Linear Algebra: use LAPACK routines
!
subroutine mth_dpotrf (name, uplo, n, a, lda, error)
  character(len=*) :: name           !
  character(len=*) :: uplo           !
  integer :: n                       !
  integer :: lda                     !
  real(8) :: a(lda,*)                 !
  logical :: error                   !
  ! Local
  integer :: info
  !
  !  Purpose
  !  =======
  !
  !  DPOTRF computes the Cholesky factorization of a real symmetric
  !  positive definite matrix A.
  !
  !  The factorization has the form
  !     A = U**T * U,  if UPLO = 'U', or
  !     A = L  * L**T,  if UPLO = 'L',
  !  where U is an upper triangular matrix and L is lower triangular.
  !
  !  This is the block version of the algorithm, calling Level 3 BLAS.
  !
  !  Arguments
  !  =========
  !
  !  UPLO    (input) CHARACTER*1
  !          = 'U':  Upper triangle of A is stored;
  !          = 'L':  Lower triangle of A is stored.
  !
  !  N       (input) INTEGER
  !          The order of the matrix A.  N >= 0.
  !
  !  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
  !          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
  !          N-by-N upper triangular part of A contains the upper
  !          triangular part of the matrix A, and the strictly lower
  !          triangular part of A is not referenced.  If UPLO = 'L', the
  !          leading N-by-N lower triangular part of A contains the lower
  !          triangular part of the matrix A, and the strictly upper
  !          triangular part of A is not referenced.
  !
  !          On exit, if INFO = 0, the factor U or L from the Cholesky
  !          factorization A = U**T*U or A = L*L**T.
  !
  !  LDA     (input) INTEGER
  !          The leading dimension of the array A.  LDA >= max(1,N).
  !
  !  INFO    (output) INTEGER
  !          = 0:  successful exit
  !          < 0:  if INFO = -i, the i-th argument had an illegal value
  !          > 0:  if INFO = i, the leading minor of order i is not
  !                positive definite, and the factorization could not be
  !                completed.
  !
  ! Call LAPACK routine
  call dpotrf  (uplo, n, a, lda, info )
  call mth_fail(name,'MTH_DPOTRF',info,error)
end subroutine mth_dpotrf
!
subroutine mth_dpotrs (name,   &
     &    uplo, n, nrhs, a, lda, b, ldb, info )
  character(len=*) :: name           !
  character(len=*) :: uplo           !
  integer :: n                       !
  integer :: nrhs                    !
  integer :: lda                     !
  real(8) :: a(lda,*)                 !
  integer :: ldb                     !
  real(8) :: b(ldb,*)                 !
  ! Local
  integer :: info
  logical :: error
  !
  !  Purpose
  !  =======
  !
  !  DPOTRS solves a system of linear equations A*X = B with a symmetric
  !  positive definite matrix A using the Cholesky factorization
  !  A = U**T*U or A = L*L**T computed by DPOTRF.
  !
  !  Arguments
  !  =========
  !
  !  UPLO    (input) CHARACTER*1
  !          = 'U':  Upper triangle of A is stored;
  !          = 'L':  Lower triangle of A is stored.
  !
  !  N       (input) INTEGER
  !          The order of the matrix A.  N >= 0.
  !
  !  NRHS    (input) INTEGER
  !          The number of right hand sides, i.e., the number of columns
  !          of the matrix B.  NRHS >= 0.
  !
  !  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
  !          The triangular factor U or L from the Cholesky factorization
  !          A = U**T*U or A = L*L**T, as computed by DPOTRF.
  !
  !  LDA     (input) INTEGER
  !          The leading dimension of the array A.  LDA >= max(1,N).
  !
  !  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
  !          On entry, the right hand side matrix B.
  !          On exit, the solution matrix X.
  !
  !  LDB     (input) INTEGER
  !          The leading dimension of the array B.  LDB >= max(1,N).
  !
  !  INFO    (output) INTEGER
  !          = 0:  successful exit
  !          < 0:  if INFO = -i, the i-th argument had an illegal value
  !
  ! Call LAPACK routine
  call dpotrs  (uplo, n, nrhs, a, lda, b, ldb, info )
  call mth_fail(name,'MTH_DPOTRF',info,error)
end subroutine mth_dpotrs
!
subroutine mth_dpbtrf (name, uplo, n, kd, ab, ldab, error)
  character(len=*) :: name             !
  character(len=*) :: uplo             !
  integer :: n                         !
  integer :: kd                        !
  integer :: ldab                      !
  real(8) :: ab(ldab,*)                 !
  logical :: error                     !
  ! Local
  integer :: info
  !
  !  Purpose
  !  =======
  !
  !  DPBTRF computes the Cholesky factorization of a real symmetric
  !  positive definite band matrix A.
  !
  !  The factorization has the form
  !     A = U**T * U,  if UPLO = 'U', or
  !     A = L  * L**T,  if UPLO = 'L',
  !  where U is an upper triangular matrix and L is lower triangular.
  !
  !  Arguments
  !  =========
  !
  !  UPLO    (input) CHARACTER*1
  !          = 'U':  Upper triangle of A is stored;
  !          = 'L':  Lower triangle of A is stored.
  !
  !  N       (input) INTEGER
  !          The order of the matrix A.  N >= 0.
  !
  !  KD      (input) INTEGER
  !          The number of superdiagonals of the matrix A if UPLO = 'U',
  !          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
  !
  !  AB      (input/output) DOUBLE PRECISION array, dimension (LDAB,N)
  !          On entry, the upper or lower triangle of the symmetric band
  !          matrix A, stored in the first KD+1 rows of the array.  The
  !          j-th column of A is stored in the j-th column of the array AB
  !          as follows:
  !          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
  !          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
  !
  !          On exit, if INFO = 0, the triangular factor U or L from the
  !          Cholesky factorization A = U**T*U or A = L*L**T of the band
  !          matrix A, in the same storage format as A.
  !
  !  LDAB    (input) INTEGER
  !          The leading dimension of the array AB.  LDAB >= KD+1.
  !
  !  INFO    (output) INTEGER
  !          = 0:  successful exit
  !          < 0:  if INFO = -i, the i-th argument had an illegal value
  !          > 0:  if INFO = i, the leading minor of order i is not
  !                positive definite, and the factorization could not be
  !                completed.
  !
  !  Further Details
  !  ===============
  !
  !  The band storage scheme is illustrated by the following example, when
  !  N = 6, KD = 2, and UPLO = 'U':
  !
  !  On entry:                       On exit:
  !
  !      *    *   a13  a24  a35  a46      *    *   u13  u24  u35  u46
  !      *   a12  a23  a34  a45  a56      *   u12  u23  u34  u45  u56
  !     a11  a22  a33  a44  a55  a66     u11  u22  u33  u44  u55  u66
  !
  !  Similarly, if UPLO = 'L' the format of A is as follows:
  !
  !  On entry:                       On exit:
  !
  !     a11  a22  a33  a44  a55  a66     l11  l22  l33  l44  l55  l66
  !     a21  a32  a43  a54  a65   *      l21  l32  l43  l54  l65   *
  !     a31  a42  a53  a64   *    *      l31  l42  l53  l64   *    *
  !
  !  Array elements marked * are not used by the routine.
  !
  ! Call LAPACK routine
  call dpbtrf  (uplo, n, kd, ab, ldab, info )
  call mth_fail(name,'MTH_DPBTRF',info,error)
end subroutine mth_dpbtrf
!
subroutine mth_dpbtrs (name,   &
     &    uplo, n, kd, nrhs, ab, ldab, b, ldb, error)
  character(len=*) :: name             !
  character(len=*) :: uplo             !
  integer :: n                         !
  integer :: kd                        !
  integer :: nrhs                      !
  integer :: ldab                      !
  real(8) :: ab(ldab,*)                 !
  integer :: ldb                       !
  real(8) :: b(ldb,*)                   !
  logical :: error                     !
  ! Local
  integer :: info
  !
  !  Purpose
  !  =======
  !
  !  DPBTRS solves a system of linear equations A*X = B with a symmetric
  !  positive definite band matrix A using the Cholesky factorization
  !  A = U**T*U or A = L*L**T computed by DPBTRF.
  !
  !  Arguments
  !  =========
  !
  !  UPLO    (input) CHARACTER*1
  !          = 'U':  Upper triangular factor stored in AB;
  !          = 'L':  Lower triangular factor stored in AB.
  !
  !  N       (input) INTEGER
  !          The order of the matrix A.  N >= 0.
  !
  !  KD      (input) INTEGER
  !          The number of superdiagonals of the matrix A if UPLO = 'U',
  !          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
  !
  !  NRHS    (input) INTEGER
  !          The number of right hand sides, i.e., the number of columns
  !          of the matrix B.  NRHS >= 0.
  !
  !  AB      (input) DOUBLE PRECISION array, dimension (LDAB,N)
  !          The triangular factor U or L from the Cholesky factorization
  !          A = U**T*U or A = L*L**T of the band matrix A, stored in the
  !          first KD+1 rows of the array.  The j-th column of U or L is
  !          stored in the j-th column of the array AB as follows:
  !          if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j;
  !          if UPLO ='L', AB(1+i-j,j)    = L(i,j) for j<=i<=min(n,j+kd).
  !
  !  LDAB    (input) INTEGER
  !          The leading dimension of the array AB.  LDAB >= KD+1.
  !
  !  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
  !          On entry, the right hand side matrix B.
  !          On exit, the solution matrix X.
  !
  !  LDB     (input) INTEGER
  !          The leading dimension of the array B.  LDB >= max(1,N).
  !
  !  INFO    (output) INTEGER
  !          = 0:  successful exit
  !          < 0:  if INFO = -i, the i-th argument had an illegal value
  !
  ! Call LAPACK routine
  call dpbtrs (uplo, n, kd, nrhs, ab, ldab, b, ldb, info )
  call mth_fail(name,'MTH_DPBTRS',info,error)
end subroutine mth_dpbtrs
! End of Linear Algebra
!
subroutine mth_fail (fac,prog,ifail,error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Error handling routine
  !---------------------------------------------------------------------
  character(len=*) :: fac           !
  character(len=*) :: prog          !
  integer :: ifail                  !
  logical :: error                  !
  ! Local
  integer :: l1,l2
  character(len=60) :: chain
  !
  if (ifail.eq.0) then
    error = .false.
  else
    l1=lenc(fac)
    l2=lenc(prog)
    write(chain,'(A,A,A,A,A,I4)')   &
     &      'F-',fac(1:l1),',  ERROR in ',prog(1:l2),', ifail = ',ifail
    call gagout(chain)
    error = .true.
  endif
end subroutine mth_fail
!
subroutine do_plot_gain(ntimes,nantes,uvsol,refant,error)
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! UV_GAIN
  !
  ! Prepare the Solution Table: Amplitude and Phase
  ! corrections per antenna.
  !
  ! Convert the formatted temporary files to a Gildas Table
  !
  !---------------------------------------------------------------------
  integer, intent(in) :: ntimes   ! Number of times
  integer, intent(in) :: nantes   ! Maximum number of antennas
  character(len=*), intent(in) :: uvsol       ! Solution file name
  integer, intent(in) :: refant   ! Reference antenna
  logical, intent(inout) :: error ! Error flag
  !
  character(len=filename_length) :: name
  type(gildas) :: tab
  integer :: iref, nant, ier, i, j
  real(8) :: time, ztime, date, secs
  integer(4) :: jant, kant
  real(4) :: rphase
  ! A few automatic arrays, taken on the stack
  real(4) :: phases(0:nantes) 
  real(4) :: ampsnr(nantes) 
  integer(4) :: al(nantes)  
  ! Larger allocatable arrays (one could use re-allocation instead,
  ! but they are still small anyway)
  integer(4), allocatable :: itmp(:),ialways(:)
  !
  allocate(itmp(ntimes*nantes),ialways(ntimes*nantes),stat=ier)
  if (ier.ne.0) then
   error = .true.
   return
  endif
  !
  call gildas_null(tab)
  !
  name  = uvsol
  call sic_parsef(name,tab%file,' ','.tab')
  call map_message(seve%i,'UV_GAIN','Creating solution table '//trim(tab%file))
  !
  tab%gil%ndim = 2
  tab%gil%dim(1) = ntimes
  tab%gil%dim(2) = 4+2*nantes
  ztime = 0
  phases = 0.
  ampsnr = 0.
  !
  rewind(2)
  !
  ! Find the common antennas
  read(2,*,iostat=ier) iref, time, nant  ! Read the time step
  read(2,*,iostat=ier) al(1:nant)        ! Read the antenna list
  ialways(1:nant) = al(1:nant)
  jant = nant
  read(2,*) phases(1:nant)
  read(2,*) ampsnr(1:nant)
  do i=2,ntimes
    read(2,*,iostat=ier) iref, time, nant  ! Read the time step
    read(2,*,iostat=ier) al(1:nant)        ! Read the antenna list
    call union(ialways,jant,al,nant,itmp,kant)
    jant = kant
    ialways(1:kant) = itmp(1:kant)
    read(2,*) phases(1:nant)
    read(2,*) ampsnr(1:nant)
  enddo
  rewind(2)
  !
  write(*,*) kant,' antennas present:'
  write(*,'(16(1x,I3))') ialways(1:kant)
  !
  ! Normally, here we should use the "absolute" antenna number
  ! and the Table should be of size KANT. To be done...
  !
  allocate(tab%r2d(tab%gil%dim(1),tab%gil%dim(2)), stat=ier)
  !
  tab%r2d = 0
  do i=1,ntimes
    read(2,*,iostat=ier) iref, time, nant  ! Read the time step
    read(2,*,iostat=ier) al(1:nant)        ! Read the antenna list
    if (ztime.eq.0) ztime = time
    time = time-ztime
    secs = mod(time,86400.d0)
    date = (time-secs)/86400.d0 
    tab%r2d(i,1) = secs
    tab%r2d(i,2) = date     
    tab%r2d(i,3) = nant
    tab%r2d(i,4) = iref
    !
    read(2,*) phases(1:nant)
    read(2,*) ampsnr(1:nant)
    rphase = phases(refant)
    do j=1,nant
      tab%r2d(i,3+2*j) = phases(j) - rphase 
      tab%r2d(i,4+2*j) = ampsnr(j) 
    enddo
  enddo
  call gdf_write_image(tab,tab%r2d,error)
  deallocate(tab%r2d)
  close(2)
end subroutine do_plot_gain
!
subroutine overlap(a,n,b,m,c,k)
  !
  ! Find the intersection of ensembles A and B
  !
  integer, intent(in) :: n
  integer, intent(in) :: a(n)
  integer, intent(in) :: m
  integer, intent(in) :: b(m)
  integer, intent(inout) :: k
  integer, intent(inout) ::c(*)
  !
  integer i,j
  !
  k = 0
  do i=1,n
    do j=1,m
      if (a(i).eq.b(j)) then
        k = k+1
        c(k) = a(i)
        exit
      endif
    enddo
  enddo
  !! print *,'Overlap ',n,m,k,' = ',c(1:K)
end subroutine overlap
!
subroutine union(a,n,b,m,c,k)
  !
  ! Find the Union of ensembles A and B
  !
  integer, intent(in) :: n
  integer, intent(in) :: a(n)
  integer, intent(in) :: m
  integer, intent(in) :: b(m)
  integer, intent(inout) :: k
  integer, intent(inout) ::c(*)
  !
  integer i,j
  logical :: found
  !
  k = n
  c(1:k) = a(1:n)
  !
  do j=1,m
    found = .false.
    do i=1,n
      if (c(i).eq.b(j)) then
        found = .true.
        exit
      endif
    enddo
    if (.not.found) then
      k = k+1
      c(k) = b(j)
    endif
  enddo
end subroutine union
