!
subroutine diagonal(m,n,r,c)
  integer :: m                      !! First dimension
  integer :: n                      !! Second dimension (=< M)
  real(kind=8) :: r(m,n)            !! Matrix
  real(kind=8) :: c(n)              !! Diagonal vector
  ! Local
  integer :: i
  do i=1, n
    c(i) = r(i,i)
  enddo
end subroutine diagonal
!
subroutine outfit(nc,ic,ncol,y,rms,vit,nbpar,par,epar)
  use gildas_def
  use uvfit_data
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for UV_FIT
  !
  ! Store the fitted parameters into the output table Y
  !
  ! Format of table is, for each channel:  
  ! 1-4  RMS of fit, number of functions, number of parameters, velocity
  ! then for each function, 3+mpin*2 columns:  
  !        Function number, type of function, number of parameters
  !        then 6 times (parameter, error)
  !!
  !---------------------------------------------------------------------
  integer, intent(in) :: nc         !! Number of channels
  integer, intent(in) :: ic         !! Current channel
  integer, intent(in) :: ncol       !! Size of Y
  real, intent(out) :: y(nc,ncol)   !! Output table
  real(8), intent(in) :: rms        !! RMS of fit
  real, intent(in) :: vit           !! Velocity
  integer, intent(in) :: nbpar      !! Number of parameters
  real(8), intent(in) :: par(nbpar) !! Parameters
  real(8), intent(in) :: epar(nbpar)!! Errors
  !
  ! Local ---
  integer :: if, ip, k, kcol
  !
  ! Code ----
  y(ic,1) = rms
  y(ic,2) = nf
  y(ic,3) = nbpar
  y(ic,4) = vit
  kcol = 5
  k = 1
  do if=1, nf
    kcol = 5+(if-1)*(3+2*mpin)
    y(ic,kcol) = if
    y(ic,kcol+1) = ifunc(if)
    y(ic,kcol+2) = npfunc(if)
    kcol = kcol+3
    do ip=1, npfunc(if)
      y(ic,kcol) = par(k)
      y(ic,kcol+1) = epar(k)
      k = k+1
      kcol = kcol+2
    enddo
  enddo
end subroutine outfit
!
subroutine load_data(ndata,nx,ic,fact,visi,np,uvriw,uv_min,uv_max)
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for UV_FIT
  !
  ! Load Data of channel IC from the input UV table into array UVRIW.
  !---------------------------------------------------------------------
  integer, intent(in) :: ndata        !! Number of visibilities
  integer, intent(in) :: nx           !! Size of a visibility
  integer, intent(in) :: ic           !! Channel number
  real, intent(in) :: fact            !! Conversion factor of baselines
  real, intent(in) :: visi(nx,ndata)  !! Visibilities
  integer, intent(out) :: np          !! Number of non zero visibilities
  real, intent(out) :: uvriw(5,ndata) !! Output array
  real, intent(in) :: uv_min          !! Min UV
  real, intent(in) :: uv_max          !! Max UV
  !
  ! Local ---
  integer :: i, irc, iic, iwc
  real :: uv1, uv2, uv
  !
  ! Code ----
  irc = 5 + 3*ic
  iic = irc + 1
  iwc = iic + 1
  np = 0
  if (uv_min.eq.0.0 .and. uv_max.eq.0.0) then
    do i = 1, ndata
      if (visi(iwc,i).gt.0) then
        np = np + 1
        uvriw(1,np) = visi(1,i) * fact
        uvriw(2,np) = visi(2,i) * fact
        uvriw(3,np) = visi(irc,i)
        uvriw(4,np) = visi(iic,i)
        uvriw(5,np) = visi(iwc,i) * 1e6
      endif
    enddo
  else
    uv1 = uv_min**2
    if (uv_max.ne.0) then
      uv2 = uv_max**2
    else
      uv2 = huge(1.0)
    endif
    do i = 1, ndata
      if (visi(iwc,i).gt.0) then
        uv = visi(1,i)**2+visi(2,i)**2
        if (uv.ge.uv1 .and. uv.lt.uv2) then
          np = np + 1
          uvriw(1,np) = visi(1,i) * fact
          uvriw(2,np) = visi(2,i) * fact
          uvriw(3,np) = visi(irc,i)
          uvriw(4,np) = visi(iic,i)
          uvriw(5,np) = visi(iwc,i) * 1e6
        endif
      endif
    enddo
  endif
  return
end subroutine load_data
!
subroutine model_data(huv,nd,nx,nc,ic1,ic2,ncol,vin,vy,if,subtract)
  use image_def
  use uvfit_data
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --Support routine for UV_FIT
  !
  ! Subtract the model uv data for component function number IF
  ! from the input visibility data.
  !!
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: huv  !! Input UV Table header
  integer, intent(in) :: nd         !! Number of visibilities
  integer, intent(in) :: nx         !! Size of a visbility
  integer, intent(in) :: nc         !! Number of channels in Fit...
  integer, intent(in) :: ic1        !! First channel
  integer, intent(in) :: ic2        !! Last channel
  integer, intent(in) :: ncol       !! Size of VY
  real, intent(inout) :: vin(nx,nd) !! Visibilities
  real, intent(in) :: vy(nc,ncol)   !! Model parameters
  integer, intent(in) :: if         !! Function number
  logical, intent(in) :: subtract   !! Subtract (Residual) or Add (Model)
  !
  ! Constants
  real(8), parameter :: pi = 3.14159265358979323846d0
  real(8), parameter :: clight = 299792458.d-6   ! in meter.mhz
  !
  ! Local ---
  real :: fact 
  integer :: j, i, k, iif, npf, kcol, ic, jc
  real(8) :: y(2), dy(2,7), paris(7), uu, vv
  !
  ! Code:
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP & SHARED(vin,vy,if,ic1,ic2,ncol,nx,nc,nd,huv,subtract) &
  !$OMP & PRIVATE(i,j,k, ic, jc, kcol,fact, uu,vv,iif,npf,paris,y,dy)
  !$OMP DO
  do j=1, nd
    !
    ! Kcol is the first column number in result table VY for function IF
    kcol = 5+(if-1)*(3+2*mpin)
    do ic = ic1, ic2
      ! We should use gdf_uv_frequency here ?
      fact = huv%gil%val(1) * &
     &        (1.d0+huv%gil%fres/huv%gil%freq*(ic-huv%gil%ref(1)))/clight   &
     &        *pi/180.d0/3600.d0
      uu = vin(1,j)*fact
      vv = vin(2,j)*fact
      !
      ! IIF is the function type and NPF its number of parameters.
      jc = min(ic,nc)
      iif = nint(vy(jc,kcol+1))
      npf = nint(vy(jc,kcol+2))
      do i=1, npf
        paris(i) = vy(jc,kcol+3+2*(i-1))
      enddo
      call uvfit_model(iif,npf,uu,vv,paris,y,dy)
      k = 8 + 3*(ic-1)
      if (subtract) then
        vin(k,j) = vin(k,j) - y(1)
        vin(k+1,j) = vin(k+1,j) - y(2)
      else
        vin(k,j) = vin(k,j) + y(1)
        vin(k+1,j) = vin(k+1,j) + y(2)
      endif
    enddo
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
end subroutine model_data
!
subroutine fitfcn(iflag,m,nvpar,x,f,fjac,ljc)
  use gildas_def
  use uvfit_data
  use gbl_message
  use imager_interfaces, only : map_message
  !$ use omp_lib
  !---------------------------------------------------------------------
  !! IMAGER -- Support routine for UV_FIT  
  !! FITFCN is called by DNLS1E
  !---------------------------------------------------------------------
  integer, intent(in) :: iflag          !! Code for print out
  integer, intent(in) :: m              !! Number of data points
  integer, intent(in) :: nvpar          !! Number of variables
  real(8), intent(in) :: x(nvpar)       !! Variable parameters
  real(8), intent(out) :: f(m)          !! Function value at each point
  integer, intent(in) :: ljc            !! First dimension of FJAC
  real(8), intent(out) :: fjac(ljc,nvpar) !! Partial derivatives
  !
  real(8), external :: denorm
  character(len=*), parameter :: rname='UV_FIT'
  !
  ! Local ---
  integer :: k, i, l, j, kpar, iif, kvpar, kf, kl
  integer :: ithread, nthread, ier
  real(8) :: uu, vv, rr, ii, ww, fact, y(2), dy(2,mpar), fa, fb
  real(8), allocatable :: swi(:)
  real(8), allocatable :: fone(:), ftwo(:)
  real(8) :: elapsed_s, elapsed_e, elapsed
  real(8), save :: elapsem 
  character(len=80) :: chain
  !
  ! Code ----
  !$ elapsed_s = omp_get_wtime()
  if (ncall.eq.0) elapsem = 0.
  if (iflag.ne.0) then
    elapsed_e = 0.
    elapsed_s = 0.
    elapsed = 0.
    ncall = ncall+1
  endif
  !  
  k = 1
  sw = 0
  !
  ! Put the variable parameters in PARS (already including the fixed ones)
  kvpar = 1
  do j=1, npar
    if (nstart(j).ge.0) then
      pars(j) = x(kvpar)
      kvpar = kvpar+1
    endif
  enddo
  !
  nthread = 1
  !$ nthread = omp_get_max_threads()
  allocate(swi(nthread),fone(nvpar),ftwo(nvpar),stat=ier)
  if (ier.ne.0) then
    write(*,*) 'Memory allocation error in FITCN'
    return
  endif
  swi = 0.0
  !
  !$OMP PARALLEL DEFAULT(none)  &
  !$OMP & SHARED(uvriw) &  ! Input Visibility array
  !$OMP & SHARED(f,fjac) & ! Ouput arrays
  !$OMP & SHARED(npuvfit,nf,nvpar,npfunc,iflag,pars,ifunc,nstart, swi) &
  !$OMP & PRIVATE(i,uu,vv,rr,ii,ww,kf,kl,fact,kpar,kvpar,j,l)  &
  !$OMP & PRIVATE(ithread, iif, y, dy, fone, ftwo, fa, fb)
  !
  ithread = 1
  !$ ithread = omp_get_thread_num()+1
  !$OMP DO
  do i=1, npuvfit
    kf = 2*i-1
    kl = 2*i
    !
    ! Get real and imaginary part of visibility
    call getvisi(npuvfit,uvriw,i,uu,vv,rr,ii,ww)
    !
    ! Initialize F and derivatives.
    ! the weights are 1/sigma**2 (within a factor 2)
    fact = ww
    !
    ! Compute F and FJAC from model
    kpar  = 1
    kvpar = 1
    if (iflag.eq.1) then
      fa = -rr
      fb = -ii
      do j = 1, nf
        iif = ifunc(j)
        call uvfit_model(iif,npfunc(j),uu,vv,pars(kpar),y,dy)
        fa = fa + y(1)
        fb = fb + y(2)
        kpar = kpar + npfunc(j)
      enddo
      f(kf) = fa*fact
      f(kl) = fb*fact
      !
    else if (iflag.eq.2) then
      fone = 0.d0
      ftwo = 0.d0
      do j = 1, nf
        iif = ifunc(j)
        call uvfit_model(iif,npfunc(j),uu,vv,pars(kpar),y,dy)
        do l = 1, npfunc(j)
          if (nstart(kpar).ge.0) then
            fone(kvpar) = fone(kvpar) + dy(1,l)
            ftwo(kvpar) = ftwo(kvpar) + dy(2,l)
            kvpar = kvpar+1
          endif
          kpar = kpar + 1
        enddo
      enddo
      do l=1, nvpar
        fjac(kf,l) = fone(l)*fact
        fjac(kl,l) = ftwo(l)*fact
      enddo
      !
    else if (iflag.eq.0) then
      continue
    endif
    !
    ! Weight appropriately:
    swi(ithread) = swi(ithread) + fact
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  sw = 0.0
  do i=1,nthread
    sw = sw+swi(i)
  enddo
  !
  ! In the end: normalize by the sum of weights.
  k = 1
  if (iflag.eq.1) then
    do k = 1, 2*npuvfit
      f(k) = f(k)/sw
    enddo
  else if (iflag.eq.2) then
    !$OMP PARALLEL DEFAULT(none)  &
    !$OMP & SHARED(fjac, npuvfit, nvpar, sw) &  
    !$OMP & PRIVATE(l,k)
    !$OMP DO COLLAPSE(2)
    do l=1, nvpar
      do k=1,2*npuvfit
        fjac(k,l) = fjac(k,l)/sw
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  endif
  if (iflag.eq.0) then
    write(*,1000) (x(i), i=1, nvpar), denorm(2*npuvfit,f)
    1000     format (10(1pg19.12))
  else
    !$ elapsed_e = omp_get_wtime()
    !$ elapsed = elapsed_e - elapsed_s
    !$ elapsem = elapsem + elapsed
    if (elapsem.ne.0) then
      write(chain,'(A,F8.3,A,I0)') 'Elapsed ',elapsem/ncall,' sec #',iflag
      call map_message(seve%d,rname,chain)
    endif
  endif
  !!  print *,'Done FITFCN'
end subroutine fitfcn
!
subroutine getvisi(n,uvriw,k,u,v,r,i,w)
  !---------------------------------------------------------------------
  !*
  ! IMAGER --  Support routine for UV_FIT
  !
  !     Obtain U, V, and the visibility from the array UVRIW.
  !!
  !---------------------------------------------------------------------
  integer, intent(in) :: n         !! Number of visibilities
  real, intent(in) :: uvriw(5,n)   !! Visibilities
  integer, intent(in) :: k         !! Desired visibility number
  real(8), intent(out) ::  u       !! U coordinate
  real(8), intent(out) ::  v       !! V coordinate
  real(8), intent(out) ::  r       !! Real part
  real(8), intent(out) ::  i       !! Imaginary part
  real(8), intent(out) ::  w       !! Weight
  !
  u = uvriw(1,k)
  v = uvriw(2,k)
  r = uvriw(3,k)
  i = uvriw(4,k)
  w = uvriw(5,k)
end subroutine getvisi
!
subroutine outpar(id,kfunc,pars,errs)
  !---------------------------------------------------------------------
  !*
  ! IMAGER -- Support routine for UV_FIT
  !
  ! Process fitted parameters to be saved, according to fitted functions
  !!
  !---------------------------------------------------------------------
  integer, intent(in) :: id    !! Function code
  integer, intent(in) :: kfunc !! Number of parameters
  real(8), intent(inout) :: pars(kfunc)  !! Parameters
  real(8), intent(inout) :: errs(kfunc)  !! Uncertainties
  ! Local -
  real(8) :: dummy, factor
  !  integer :: ipoint, icgauss, iegauss, icdisk, iedisk, iexpo
  !  parameter (ipoint=1,iegauss=2,icgauss=3,icdisk=4,iexpo=6,iedisk=9)
  !
  ! Elliptical structures:  Reorder the axes, and change the P. Angle accordingly
  ! Make sure the axes are positive.
  select case (id)
  case (2,9,13,14)
    ! E_GAUSS, E_DISK, E_SPERGEL, E_EXPO
    pars(5) = abs(pars(5))
    pars(4) = abs(pars(4))
    if (pars(4).lt.pars(5)) then
      pars(6) = pars(6)+90d0
      dummy = pars(4)
      pars(4) = pars(5)
      pars(5) = dummy
      dummy = errs(4)
      errs(4) = errs(5)
      errs(5) = dummy
    endif
    pars(6) = -90d0+mod(pars(6)+90d0,180d0) ! Main determination of PA
  case(11)
    ! E_RING 
    !    'R.A.','Dec.','Flux','Outer','Inner','Pos.Ang.','Ratio', &
    ! Swap Inner and Outer if needed
    if (pars(5).gt.pars(4)) then
      dummy = pars(4)
      pars(4) = pars(5)
      pars(5) = dummy
      dummy = errs(4)
      errs(4) = errs(5)
      errs(5) = dummy
    endif
    ! Ratio and Pos.Ang are more subtle
    ! Bring the aspect ratio < 1 to have the proper size...
    if (pars(7).gt.1.0) then
      factor = pars(7)
      pars(4) = pars(4)*factor
      pars(5) = pars(5)*factor
      errs(4) = errs(4)*factor
      errs(5) = errs(5)*factor
      pars(6) = 90.d0+pars(6) 
      pars(7) = 1./factor
      errs(7) = errs(7)/factor**2
    endif
    pars(6) = -90d0+mod(pars(6)+90d0,180d0) ! Main determination of PA
  case (3,4,6,7,8,10,12)
    ! C_GAUSS, C_DISK, EXPO, POWER-2, POWER-3, U_RING, SPERGEL
    pars(4) = abs(pars(4))     
  case (5)
    ! RING  
    pars(4) = abs(pars(4))
    pars(5) = abs(pars(5))
    if (pars(5).lt.pars(4)) then
      dummy = pars(4)
      pars(4) = pars(5)
      pars(5) = dummy
      dummy = errs(4)
      errs(4) = errs(5)
      errs(5) = dummy
    endif
  end select
end subroutine outpar
