subroutine fibeam (name,dirty,nx,ny,nbx,nby,thre,majo,mino,pa,convert,error)
  use gildas_def
  use gkernel_interfaces
  use mapping_interfaces, except_this => fibeam
  use mod_fitbeam
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  !
  ! MAPPING
  !   Find beam parameters for deconvolution
  !   Fit an elliptical gaussian clean beam to main beam
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: name          ! Caller's name
  integer, intent(in) :: nx                     ! X size
  integer, intent(in) :: ny                     ! Y size
  real, intent(in) :: dirty(nx,ny)              ! Dirty beam
  integer, intent(in) :: nbx                    ! X patch
  integer, intent(in) :: nby                    ! Y patch
  real, intent(inout) :: thre                   ! Threshold
  real, intent(inout) :: majo                   ! Major axis
  real, intent(inout) :: mino                   ! Minor axis
  real, intent(inout) :: pa                     ! Position Angle
  real(8), intent(in) :: convert(3,2)           ! Conversion formula
  logical, intent(inout) :: error               ! Error flag
  ! Global
  real(8), parameter :: pi=3.141592653589793d0
  ! Local
  integer, allocatable :: ipl(:), ipk(:), ipw(:)
  character(len=80) :: mess
  integer :: blc(2),trc(2),ml,nf,mx,my,ier
  real :: dmaj,dmin,fact,minor
  real(8) :: xinc
  logical :: liter
  !
  error = .false.
  !
  ! Do nothing if specified
  if (majo.ne.0.0) then
    if (mino.eq.0.0) then
      mino = majo
    endif
    return
  else
    if (mino.ne.0.0) then
      majo = mino
      return
    endif
  endif
  liter = .false.
  mx = min(nbx,nx/6)
  my = min(nby,ny/6)
  mx = max(32,mx)
  my = max(32,my)
  !
  ! Assume beam maximum is near NX/2 NY/2
  blc(1) = nx/2+1-mx
  blc(2) = ny/2+1-my
  mx = 2*mx
  my = 2*my
  trc(1) = blc(1)+mx-1
  trc(2) = blc(2)+my-1
  ! 30 % sidelobes define the main beam
  if (thre.le.0. .or. thre.ge.1.0) thre = 0.30
  !
  ! Load beam patch into work array
  ml = mx*my
  allocate (ip_values(ml), ip_coords(2,ml), ipl(ml), ipk(ml), ipw(ml), stat=ier)
  if (ier.ne.0) then
    write(mess,*) 'Memory allocation error ',ier
    call map_message(seve%e,name,mess)
    error = .true.
    return
  endif
  !
  ! Make a segmentation to define "Main" beam
  ! IPK is used here as a work array...
  call threshold (dirty,nx,ny,blc,trc,ipl,mx,my,   &
     &    nf,ipk,ipw,ml,thre,   &
     &    0.0, -1.0)
  !
  ! Load values and coordinates
  call loadv (dirty,nx,ny,blc,trc,ipl,mx,my,   &
     &    nv,ip_values,ip_coords)
  !
  ! Convert to user coordinates
  xinc = max(abs(convert(3,1)),abs(convert(3,2)))
  call userc (nv,ip_coords,   &
     &    convert(1,1),convert(2,1),convert(3,1)/xinc,   &
     &    convert(1,2),convert(2,2),convert(3,2)/xinc)
  !
  ! Find initial guesses
  call guess (nv,ip_values,ip_coords,spar)
  err(1) = 0.01*spar(1)
  err(2) = 0.5*abs(convert(3,1)/xinc)
  err(3) = 0.5*abs(convert(3,2)/xinc)
  err(4) = 2.0*err(2)
  err(5) = err(4)
  err(6) = 90.0
  spar(5) = 2.0*sqrt(abs(convert(3,1)*convert(3,2)))/xinc
  spar(4) = 1.5*spar(5)
  spar(6) = pa
  !
  liter = .false.
  call fit2d (min2d,liter,error)
  if (par(4).ge.par(5)) then
    majo = par(4)
    mino = par(5)
    dmaj = err(4)
    dmin = err(5)
    pa = 90.0-par(6)
  else
    majo = par(5)
    mino = par(4)
    dmaj = err(5)
    dmin = err(4)
    pa = -par(6)
  endif
  majo = majo*xinc
  mino = mino*xinc
  dmaj = dmaj*xinc
  dmin = dmin*xinc
  deallocate (ip_values, ip_coords, ipl, ipk, ipw, stat=ier)
  !
  if (name.eq.' ') return
  !
  minor = mino*3600*180/pi
  if (minor.gt.10.) then
    write(mess,100) 'Beam is ',majo*3600*180/pi,mino*3600*180/pi,pa
    call map_message(seve%i,name,mess)
    write(mess,101) 'Errors (',dmaj*3600*180/pi,dmin*3600*180/pi,err(6)
    call map_message(seve%i,name,mess)
  else if (minor.gt.0.2) then
    write(mess,110) 'Beam is ',majo*3600*180/pi,mino*3600*180/pi,pa
    call map_message(seve%i,name,mess)
    write(mess,111) 'Errors (',dmaj*3600*180/pi,dmin*3600*180/pi,err(6)
    call map_message(seve%i,name,mess)
  else
    write(mess,120) 'Beam is ',majo*3600*180/pi,mino*3600*180/pi,pa
    call map_message(seve%i,name,mess)
    write(mess,121) 'Errors (',dmaj*3600*180/pi,dmin*3600*180/pi,err(6)
    call map_message(seve%i,name,mess)
  endif
  !
  fact = mino/xinc ! nb of pixels per beam, should be < 2 mx
  if (fact.gt.min(mx,my)/4) then
    call map_message(seve%w,name,'Dubious beam fit, please increase pixel size')
  endif
  !
  100   format (a,f8.2,'" by ',f8.1,'" at PA ',f8.1,' deg.')
  101   format (a,f8.2,')   (',f8.1,')      (',f8.1,')    ')
  110   format (a,f8.2,'" by ',f8.2,'" at PA ',f8.2,' deg.')
  111   format (a,f8.2,')   (',f8.2,')      (',f8.2,')    ')
  120   format (a,f8.2,'" by ',f8.3,'" at PA ',f8.3,' deg.')
  121   format (a,f8.2,')   (',f8.3,')      (',f8.3,')    ')
end subroutine fibeam
!
subroutine guess (nv,values,coords,par)
  !----------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for FIT of beam
  !   Setup starting values for beam fit
  !----------------------------------------------------------------------
  integer, intent(in)  :: nv         ! Number of data
  real, intent(in)  :: values(nv)    ! Data values
  real, intent(in)  :: coords(2,nv)  ! X and Y coordinates of data
  real, intent(out) :: par(6)        ! Guessed parameters
  ! Local
  integer :: ipar,i
  !
  ipar = 1
  do i=2,nv
    if (values(i).gt.values(ipar)) then
      ipar = i
    endif
  enddo
  par(1) = values(ipar)    ! Flux
  par(2) = coords(1,ipar)  ! X position
  par(3) = coords(2,ipar)  ! Y position
end subroutine guess
!
subroutine min2d (npar,g,f,var,iflag)
  use gildas_def
  use mod_fitbeam
  use mapping_interfaces, only : mn2d
  !------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for FIT of beam
  !   minimizing function
  !------------------------------------------------------------------
  integer, intent(in) :: npar        ! Number of parameters
  real(8), intent(out)  :: g(npar)   ! First derivatives
  real(8), intent(out)  :: f         ! Function value
  real(8), intent(in)  :: var(npar)  ! Parameter values
  integer, intent(in)  :: iflag      ! Operation code
  !
  call mn2d (npar,g,f,var,iflag,   &
     &    ip_values, ip_coords, nv,   &
     &    sigbas,sigrai)
end subroutine min2d
!
subroutine mn2d (npar,g,f,var,iflag,values,coords,nv,   &
     &    sigbas,sigrai)
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for FIT of beam
  !---------------------------------------------------------------------
  integer, intent(in) :: npar        ! Number of parameters
  real(8), intent(out)  :: g(npar)   ! First derivatives
  real(8), intent(out)  :: f         ! Function value
  real(8), intent(in)  :: var(npar)  ! Parameter values
  integer, intent(in)  :: iflag      ! Operation code
  integer, intent(in)  :: nv         ! Number of data
  real, intent(in)  :: values(nv)    ! Data values
  real, intent(in)  :: coords(2,nv)  ! X and Y coordinates of data
  real, intent(out)  :: sigbas       ! Baseline noise
  real, intent(out)  :: sigrai       ! On Source noise
  ! Local
  real :: far
  parameter (far=24.0d0)
  logical :: dograd,dosig
  integer :: i,nrai,nbas
  real :: x,y
  real :: i0, x0,y0,a,b,alpha
  real :: dfx0,dfy0,dfa,dfb,dfalp
  real :: dgx0,dgy0,dga,dgb,dgalp
  real :: dt1x0,dt1y0,dt1alp
  real :: dt2x0,dt2y0,dt2alp
  real :: dgt1,dgt2
  real :: t1,t2, gint, gsxy, gd,gg, ca, sa
  real :: frai, fbas
  !
  if (iflag.eq.3) then
    dosig = .true.
    nbas = 0
    nrai = 0
  else
    dosig = .false.
  endif
  dograd = iflag.eq.2
  !
  ! Setup
  i0 = var(1)
  x0 = var(2)
  y0 = var(3)
  a = var(4)
  b = var(5)
  alpha = var(6)
  dfx0 = 0.0
  dfy0 = 0.0
  dfa = 0.0
  dfb = 0.0
  dfalp = 0.0
  !
  ! Constants
  ca = cos(alpha)
  sa = sin(alpha)
  !
  ! Constant intermediate values for derivatives
  if (dograd) then
    dt1y0 = - sa
    dt1x0 = - ca
    dt2x0 = sa
    dt2y0 = - ca
  endif
  !
  ! Preliminaries
  fbas = 0.0
  frai = 0.0
  gsxy = 0.0
  !
  ! Loop on values
  do i = 1,nv
    y = coords(2,i)
    x = coords(1,i)
    t1 = ca * (x - x0) + sa * (y - y0)
    t2 = - sa * (x - x0) + ca * (y - y0)
    gint = (t1/a)**2 + (t2/b)**2
    !
    ! Skip zero values
    if (gint.ge.far) then
      fbas = fbas+values(i)**2
      if (dosig) nbas = nbas+1
    else
      !
      ! Function
      gg = exp(-gint)
      gd = i0*gg-values(i)
      frai = frai + gd*gd      ! sum of squares
      !
      if (dograd) then
        dt1alp = t2
        dt2alp = - t1
        dgt1 = 2*t1/a/a        ! Sign was reversed
        dgt2 = 2*t2/b/b        ! Sign was reversed
        dga = -t1*dgt1/a
        dgb = -t2*dgt2/b
        dgx0 = dgt1 * dt1x0 + dgt2 * dt2x0
        dgy0 = dgt1 * dt1y0 + dgt2 * dt2y0
        dgalp = dgt1 * dt1alp + dgt2 * dt2alp
        !
        gg = 2*gd*gg
        gsxy = gsxy + gg
        gg = i0*gg
        !
        dfx0 = dfx0 + dgx0*gg
        dfy0 = dfy0 + dgy0*gg
        dfalp = dfalp + dgalp*gg
        dfa = dfa + dga*gg
        dfb = dfb + dgb*gg
      endif
      if (dosig) nrai = nrai+1
    endif
  enddo
  !
  if (dosig) then
    if (nbas.ne.0) then
      sigbas = sqrt (fbas/nbas)
      if (nrai.ne.0) then
        sigrai = sqrt (frai/nrai)
      else
        sigrai = sigbas
      endif
    else
      sigrai = sqrt (frai/nrai)
      sigbas = sigrai
    endif
  endif
  f = fbas+frai
  if (.not.dograd) return
  !
  g(1) = gsxy/i0
  g(2) = -dfx0
  g(3) = -dfy0
  g(4) = -dfa
  g(5) = -dfb
  g(6) = -dfalp
end subroutine mn2d
!
subroutine fit2d (fcn,liter,error)
  use gildas_def
  use gkernel_interfaces
  use mapping_interfaces, except_this => fit2d
  use fit_minuit
  use mod_fitbeam
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for FIT of beam
  !   Setup and starts a GAUSS fit minimisation using MINUIT
  !---------------------------------------------------------------------
  external :: fcn                   !   Function to be minimized
  logical, intent(in) :: liter      !   Iterate ?
  logical, intent(out) :: error     !   Error flag
  ! Local
  real(8), parameter :: pi=3.141592653589793d0
  integer :: i,k,l,ifatal,ier
  real(8):: dx, al, ba, du1, du2
  type(fit_minuit_t) :: fit
  !
  error = .false.
  fit%maxext=ntot
  fit%maxint=nvar
  fit%isyswr=6
  fit%verbose = .false.
  fit%owner = gpack_get_id('mapping',.false.,error)  ! .false. because can be called from tasks
  if (error)  return
  !
  ! Initialise values
  call mid2d(fit,ifatal,liter)
  if (ifatal.ne.0) then
    error = .true.
    return
  endif
  call intoex(fit,fit%x)
  call fcn(fit%npar,fit%g,fit%amin,fit%u,3)
  ! write(6,*) 'SIGMAS ',sigbas,sigrai
  fit%up = sigbas**2
  fit%nfcnmx  = 5000
  fit%epsi  = 0.1d0 * fit%up
  fit%newmin  = 0
  fit%itaur  = 0
  fit%isw(1)  = 0
  fit%isw(3)  = 1
  fit%nfcn = 1
  fit%vtest  = 0.04
  call intoex(fit,fit%x)
  call fcn(fit%npar,fit%g,fit%amin,fit%u,1)
  !
  ! Simplex Minimization
  if (.not.liter) then
    call simplx(fit,fcn,ier)
    if (ier.ne.0) then
      error = .true.
      return
    endif
    do k=1,fit%nu
      par(k) = fit%u(k)
    enddo
  endif
  !
  ! Gradient Minimization
  fit%nfcnmx  = 5000
  call intoex(fit,fit%x)
  call fcn(fit%npar,fit%g,fit%amin,fit%u,3)
  ! write(6,*) 'SIGMAS ',sigbas,sigrai
  fit%up = sigbas**2
  fit%epsi  = 0.1d0 * fit%up
  fit%apsi  = fit%epsi
  call hesse(fit,fcn)
  call migrad(fit,fcn,ier)
  if (ier.ne.0) then
    call intoex(fit,fit%x)
    call fcn(fit%npar,fit%g,fit%amin,fit%u,3)
    ! write(6,*) 'SIGMAS ',sigbas,sigrai
    fit%up = sigbas**2
    fit%epsi = 0.1d0 * fit%up
    fit%apsi = fit%epsi
    call hesse(fit,fcn)
    call migrad(fit,fcn,ier)
    error=.false.
  endif
  !
  ! Print Results
  do k=1,fit%nu
    par(k) = fit%u(k)
  enddo
  call intoex(fit,fit%x)
  call fcn(fit%npar,fit%g,fit%amin,fit%u,3)
  fit%up = sigbas**2
  !
  ! Calculate External Errors
  do i=1,fit%nu
    l  = fit%lcorsp(i)
    if (l .eq. 0)  then
      fit%werr(i)=0.
    else
      if (fit%isw(2) .ge. 1)  then
        dx = dsqrt(dabs(fit%v(l,l)*fit%up))
        if (fit%lcode(i) .gt. 1) then
          al = fit%alim(i)
          ba = fit%blim(i) - al
          du1 = al + 0.5d0 *(dsin(fit%x(l)+dx) +1.0d0) * ba - fit%u(i)
          du2 = al + 0.5d0 *(dsin(fit%x(l)-dx) +1.0d0) * ba - fit%u(i)
          if (dx .gt. 1.0d0)  du1 = ba
          dx = 0.5d0 * (dabs(du1) + dabs(du2))
        endif
        fit%werr(i) = dx
      endif
    endif
  enddo
  !
  ! Setup results
  par(1) = fit%u(1)
  err(1) = fit%werr(1)
  par(2) = fit%u(2)
  err(2) = fit%werr(2)
  par(3) = fit%u(3)
  err(3) = fit%werr(3)
  par(4) = 2.0*sqrt(log(2.0))*fit%u(4)
  err(4) = 2.0*sqrt(log(2.0))*fit%werr(4)
  par(5) = 2.0*sqrt(log(2.0))*fit%u(5)
  err(5) = 2.0*sqrt(log(2.0))*fit%werr(5)
  par(6) = fit%u(6)*180.0/pi
  err(6) = fit%werr(6)*180.0/pi
end subroutine fit2d
!
subroutine mid2d(fit,ifatal,liter)
  use gildas_def
  use gkernel_interfaces
  use mod_fitbeam
  use fit_minuit
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for FIT of beam
  !   Start a gaussian fit by building the PAR array and internal
  !   variable used by Minuit
  !---------------------------------------------------------------------
  type(fit_minuit_t), intent(inout) :: fit  ! Fitting variables
  integer, intent(out) :: ifatal            ! Error code
  logical, intent(in) :: liter              ! Iterate ?
  ! Local
  real(8), parameter :: pi=3.141592653589793d0
  integer :: i, nint, k
  real(8) :: sav, sav2, vplu, vminu, xx
  real :: sln2
  !
  sln2 = 2.0*sqrt(log(2.0))
  !
  do i= 1, 7
    fit%isw(i) = 0
  enddo
  fit%sigma = 0.d0
  fit%npfix = 0
  nint = 0
  fit%nu = 0
  fit%npar = 0
  ifatal = 0
  do i= 1, fit%maxext
    fit%u(i) = 0.0d0
    fit%lcode(i) = 0
    fit%lcorsp (i) = 0
  enddo
  fit%isw(5) = 1
  !
  ! Starting values
  par(1) = spar(1)             ! Intensite
  fit%u(1) = par(1)
  if (kpar(1).eq.1) then
    fit%werr(1)=0.
  else
    fit%werr(1) = abs(0.1*fit%u(1))
    ! if (liter) fit%werr(1) = err(1)
    if (fit%u(1).lt.0) then
      fit%alim(1) = 10.*fit%u(1)
      fit%blim(1) = 0.1*fit%u(1)
    else
      fit%blim(1) = 10.*fit%u(1)
      fit%alim(1) = 0.1*fit%u(1)
    endif
  endif
  !
  par(2) = spar(2)             ! X Position
  fit%u(2) = par(2)
  if (kpar(2).eq.1) then
    fit%werr(2)=0.
  else
    fit%werr(2) = err(2)
    fit%alim(2) = fit%u(2) - 40.*fit%werr(2)
    fit%blim(2) = fit%u(2) + 40.*fit%werr(2)
  endif
  !
  par(3) = spar(3)             ! Y Position
  fit%u(3) = par(3)
  if (kpar(3).eq.1) then
    fit%werr(3)=0.
  else
    fit%werr(3) = err(3)
    fit%alim(3) = fit%u(3) - 40.*fit%werr(3)
    fit%blim(3) = fit%u(3) + 40.*fit%werr(3)
  endif
  !
  par(4) = spar(4) / sln2      ! Major axis
  fit%u(4) = par(4)
  if (kpar(4).eq.1) then
    fit%werr(4)=0.
  else
    fit%werr(4) = err(4) / sln2
    fit%alim(4) = fit%werr(4)/ 9.0
    fit%blim(4) = 100.0*err(4)
  endif
  !
  par(5) = spar(5) / sln2      ! Minor axis
  fit%u(5) = par(5)
  if (kpar(5).eq.1) then
    fit%werr(5)=0.
  else
    fit%werr(5) = fit%werr(4)
    fit%alim(5) = fit%alim(4)
    fit%blim(5) = fit%blim(4)
  endif
  !
  par(6) = spar(6)*pi/180.0    ! Position Angle
  fit%u(6) = par(6)
  if (kpar(6).eq.1) then
    fit%werr(6)=0.
  else
    fit%werr(6) = 0.3*err(6)*pi/180.0
    fit%alim(6) = fit%u(6)-1.5*pi
    fit%blim(6) = fit%u(6)+1.5*pi
  endif
  !
  fit%nu = 6
  !
  ! Various checks
  do k= 1, fit%nu
    if (k .gt. fit%maxext)  then
      ifatal = ifatal + 1
    elseif (fit%werr(k) .le. 0.0d0) then
      ! Fixed parameter
      fit%lcode(k) = 0
      write(6,1010) k,' is fixed'
    else
      ! Variable parameter
      nint = nint + 1
      if (fit%lcode(k).ne.1) then
        fit%lcode(k) = 4
        xx = (fit%blim(k)-fit%u(k))*(fit%u(k)-fit%alim(k))
        if (xx.lt.0d0) then
          ifatal = ifatal + 1
          write (fit%isyswr,1011) k,fit%alim(k),fit%blim(k)
        elseif (xx.eq.0d0) then
          if (k.gt.3) write(6,1010) k,' is at limit'
        endif
      endif
    endif
  enddo
  !
  ! End parameter cards
  ! Stop if fatal error
  if (nint .gt. fit%maxint)  then
    write (fit%isyswr,1008)  nint,fit%maxint
    ifatal = ifatal + 1
  endif
  if (nint .eq. 0) then
    write (fit%isyswr,1009)
    ifatal = ifatal + 1
  endif
  if (ifatal .gt. 0)  then
    write (fit%isyswr,1013)  ifatal
    return
  endif
  !
  ! O.K. Start
  ! Calculate step sizes DIRIN
  fit%npar = 0
  do k= 1, fit%nu
    if (fit%lcode(k) .gt. 0)  then
      fit%npar = fit%npar + 1
      fit%lcorsp(k) = fit%npar
      sav = fit%u(k)
      fit%x(fit%npar) = pintf(fit,sav,k)
      fit%xt(fit%npar) = fit%x(fit%npar)
      sav2 = sav + fit%werr(k)
      vplu = pintf(fit,sav2,k) - fit%x(fit%npar)
      sav2 = sav - fit%werr(k)
      vminu = pintf(fit,sav2,k) - fit%x(fit%npar)
      fit%dirin(fit%npar) = 0.5d0 * (dabs(vplu) +dabs(vminu))
    endif
  enddo
  return
  !
  1008  format (' Too many variable parameters.  You request ',i5/,   &
     &    ' This version of MINUIT is only dimensioned for ',i4)
  1009  format (' All input parameters are fixed')
  1010  format (' Warning - Parameter ',i2,' ',a)
  1011  format (' Error - Parameter ',i2,' outside limits ',1pg11.4,1x,   &
     &    1pg11.4)
  1013  format (1x,i3,' Errors on input parameters. ABORT.')
end subroutine mid2d
!
subroutine userc (nv,coords,xref,xval,xinc,yref,yval,yinc)
  integer, intent(in) :: nv                     !
  real(4), intent(out) :: coords(2,nv)          !
  real(8), intent(in) :: xref                   !
  real(8), intent(in) :: xval                   !
  real(8), intent(in) :: xinc                   !
  real(8), intent(in) :: yref                   !
  real(8), intent(in) :: yval                   !
  real(8), intent(in) :: yinc                   !
  ! Local
  integer :: i
  !
  do i=1,nv
    coords(1,i) = (coords(1,i)-xref)*xinc+xval
    coords(2,i) = (coords(2,i)-yref)*yinc+yval
  enddo
end subroutine userc
!
subroutine loadv (image,nx,ny,blc,trc,label,mx,my,   &
     &    nv,values,coords)
!---------------------------------------------------------
! @ private
!
! MAPPING
!   Support for FIT of beam
!   Load the values from the region around the peak
!   of the primary beam (assumed centered).
!---------------------------------------------------------
  integer, intent(in) :: nx               ! X size
  integer, intent(in) :: ny               ! Y size
  real(4), intent(in) :: image(nx,ny)     ! Image
  integer, intent(in) :: blc(2)           ! BLC
  integer, intent(in) :: trc(2)           ! TRC
  integer, intent(in) :: mx               ! Output X size
  integer, intent(in) :: my               ! Output Y size
  integer, intent(in) :: label(mx,my)     ! Field identification
  integer, intent(out) :: nv              ! Number of values
  real(4), intent(out) :: values(mx*my)   ! Selected values
  real(4), intent(out) :: coords(2,mx*my) ! X and Y pixel numbers
  ! Local
  integer :: i,j,ii,jj,label0
  !
  ! Note : since VALUES is loaded sequentially after LABEL is explored
  ! VALUES and LABEL may point to the same address, but it is
  ! not recommended...
  !
  label0 = label(mx/2+1,my/2+1)
  nv = 0
  do j=1,my
    do i=1,mx
      if (label(i,j).eq.label0) then
        nv = nv+1
        ii = blc(1)+i-1
        jj = blc(2)+j-1
        values(nv) = image(ii,jj)
        coords(1,nv) = ii
        coords(2,nv) = jj
      endif
    enddo
  enddo
end subroutine loadv
!
subroutine threshold (image,nx,ny,blc,trc,labelo,mx,my,   &
     &    nf,labeli,labelf,mf,thre,   &
     &    blank, eblank)
  use mapping_interfaces, only : descen
  !---------------------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !   Support for FIT of beam
  !   Divide an image in connex labelled areas above (or below)
  !   a given threshold
  !---------------------------------------------------------------------
  integer, intent(in) :: nx              ! X size
  integer, intent(in) :: ny              ! Y size
  real(4), intent(in) :: image(nx,ny)    ! Image
  integer, intent(in) :: blc(2)          ! BLC
  integer, intent(in) :: trc(2)          ! TRC
  integer, intent(in) :: mx              ! Output X size
  integer, intent(in) :: my              ! Output Y size
  integer, intent(out) :: labelo(mx,my)  ! Field identification
  integer, intent(out) :: nf             ! Number of fields
  integer, intent(in) :: mf              ! Maximum number of fields
  integer, intent(out) :: labeli(mf)     ! work area: intermediate numbers
  integer, intent(out) :: labelf(mf)     ! Final field number
  real(4), intent(in) :: thre            ! Threshold for field id
  real(4), intent(in) :: blank           ! Blanking value
  real(4), intent(in) :: eblank          ! Tolerance on blanking
  ! Local
  integer :: nfi,jj,ii,j,i,l1,l2,la1,la2,la,ifield,jfield
  !
  nfi=0
  j = 0
  l1 = 0
  l2 = 0
  do jj=blc(2),trc(2)
    j = j+1
    i = 0
    do ii=blc(1),trc(1)
      i = i+1
      if (image(ii,jj).lt.thre .and. thre.gt.0) then
        labelo(i,j) = 0
      else if (image(ii,jj).gt.thre .and. thre.lt.0) then
        labelo(i,j) = 0
      else if (abs(image(ii,jj)-blank).le.eblank) then
        labelo(i,j) = 0
      else
        labelo(i,j) = 0
        if (i.ne.1) then
          l1 = labelo(i-1,j)
          if (l1.ne.0) labelo(i,j)=l1
        endif
        if (j.ne.1) then
          l2=labelo(i,j-1)
          if (l1.eq.0) then
            if (l2.eq.0) then
              nfi=nfi+1
              labeli(nfi)=nfi
              labelo(i,j)=nfi
            else
              labelo(i,j)=l2
            endif
          else
            if (l2.ne.0) then
              if (l2.ne.l1) then
                call descen (labeli,l1,la1)
                call descen (labeli,l2,la2)
                la = min(la1,la2)
                labeli(la1)=la
                labeli(la2)=la
                labelo(i,j)=la
              endif
            endif
          endif
        endif
      endif
    enddo
  enddo
  nf=0
  do ifield = 1,nfi
    call descen (labeli,ifield,jfield)
    if (ifield.eq.jfield) then
      nf = nf+1
      labelf(ifield) = nf
    endif
  enddo
  do j=1,my
    do i=1,mx
      l1 = labelo(i,j)
      if (l1.ne.0) then
        call descen (labeli,l1,la1)
        labelo(i,j) = labelf (la1)
      endif
    enddo
  enddo
end subroutine threshold
!
subroutine descen(label,labin,labout)
  !----------------------------------------------------
  ! @ private
  !   Identify connex areas and propagate label
  !----------------------------------------------------
  integer, intent(in) :: label(*)     ! Labels
  integer, intent(in) :: labin        ! Starting label
  integer, intent(out) :: labout      ! Ending label
  ! Local
  integer :: lab
  !
  labout = labin
  do
    lab = label(labout)
    if (lab.eq.labout) return
    labout = lab
  enddo
end subroutine descen
