subroutine dofft (np,nv,visi,jx,jy,jo   &
     &    ,nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv   &
     &    ,ubias,vbias,ubuff,vbuff,ctype)
  use gildas_def
  use gkernel_interfaces
  use clean_default
  !$ use omp_lib
  !----------------------------------------------------------------------
  ! @ public
  !
  ! IMAGER    Support for UV_MAP and UV_RESTORE
  !   Compute FFT of image by gridding UV data
  !   Select basic routine according to OMP_MAP%GRID
  !----------------------------------------------------------------------
  integer, intent(in) :: nv                   ! number of values
  integer, intent(in) :: np                   ! Number of "visibilities", normally 7+3*nc
  real, intent(in) :: visi(np,nv)             ! values
  integer, intent(in) :: nc                   ! number of channels
  integer, intent(in) :: jx                   ! X coord location in VISI
  integer, intent(in) :: jy                   ! Y coord location in VISI
  integer, intent(in) :: jo                   ! first channel to map
  integer, intent(in) :: nx                   ! X map size
  integer, intent(in) :: ny                   ! Y map size
  complex, intent(out) :: map(nc+1,nx,ny)     ! gridded visibilities
  real, intent(in) :: mapx(nx)                ! X Coordinates of grid
  real, intent(in) :: mapy(ny)                ! Y Coordinates of grid
  real, intent(in) :: sup(2)                  ! Support of convolving function in Meters
  real, intent(in) :: cell(2)                 ! cell size in Meters
  real, intent(in) :: taper(4)                ! 1/e taper in Meters + Angle in Radians
  real, intent(in) :: we(nv)                  ! Weight array
  real, intent(in) :: vv(nv)                  ! V Values
  real, intent(in) :: ubias                   ! U gridding offset
  real, intent(in) :: vbias                   ! V gridding offset
  real, intent(in) :: ubuff(4096)             ! U gridding buffer
  real, intent(in) :: vbuff(4096)             ! V gridding buffer
  integer, intent(in) :: ctype                ! type of gridding
  !
  integer, external :: ompget_grid_code
  !
  integer :: ipara
  !
  call imager_tree('DOFFT '//char(ctype+ichar('0')))
  !
  ! Initialize
  map = 0.0
  ipara = ompget_grid_code()  
  !
  if (ctype.eq.1) then  ! Simple nearest cell
    call dofft_fast (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv)
  else                  ! Gridding with extended support
    if (ipara.eq.0) then
      !
      ! This is the Default algorithm - Others are for test only.
      !
      ! The OMP version would work for several channels, but the 
      ! required image storage may become quite large. One could
      ! think of adjusting the number of Threads to the Problem size
      !   On the other hand, the number of visibilities is small,
      ! so sequential programming is enough
      if (nc.ne.1) then
        call dofft_quick (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
      else
        ! Continuum images are "small", but number of visibilities
        ! can be large in this case, so OMP is useful
        call dofft_quick_omp (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff,ipara)     
      endif
    else if (ipara.gt.4) then
      !$ Print *,'OMP in parallel ',omp_in_parallel()
      ! This could be the Default algorithm for small number
      ! of channels -- under test.
      Print *,'CASE 42 DOFFT_QUICK_OMP'
      call dofft_quick_omp (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff,ipara)     
    else if (ipara.eq.-1) then
      call dofft_parallel_v_pseudo (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    else if (ipara.eq.-2) then
      call dofft_parallel_v_true (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    else if (ipara.eq.-3) then
      call dofft_quick_para (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    else if (ipara.eq.-4) then
      call dofft_quick_debug (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    else if (ipara.eq.-11) then
      call dofft_parallel_v_pseudo_out (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    else if (ipara.eq.-12) then
      call dofft_parallel_v_true_out (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    else if (ipara.eq.1) then
      call dofft_slow (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    else if (ipara.eq.2) then
      call dofft_parallel_x (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    else if (ipara.eq.3) then
      call dofft_parallel_y (np,nv,visi,jx,jy,jo,   &
     &      nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &      ubias,vbias,ubuff,vbuff)
    endif
  endif
end subroutine dofft
!
subroutine dofft_quick (np,nv,visi,jx,jy,jo   &
     &    ,nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &    ubias,vbias,ubuff,vbuff)
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER    Gridding routine for UV_MAP and UV_RESTORE
  !
  !   Compute FFT of image by gridding UV data
  !   - Taper before gridding
  !   - Gridding with pre-computed support
  !   - Uses symmetry
  !----------------------------------------------------------------------
  integer, intent(in) :: nv                   ! number of values
  integer, intent(in) :: np                   ! Number of "visibilities", normally 7+3*nc
  real, intent(in) :: visi(np,nv)             ! values
  integer, intent(in) :: nc                   ! number of channels
  integer, intent(in) :: jx                   ! X coord location in VISI
  integer, intent(in) :: jy                   ! Y coord location in VISI
  integer, intent(in) :: jo                   ! first channel to map
  integer, intent(in) :: nx                   ! X map size
  integer, intent(in) :: ny                   ! Y map size
  real, intent(out) :: map(2*(nc+1),nx,ny)    ! gridded visibilities
  real, intent(in) :: mapx(nx)                ! X Coordinates of grid
  real, intent(in) :: mapy(ny)                ! Y Coordinates of grid
  real, intent(in) :: sup(2)                  ! Support of convolving function in Meters
  real, intent(in) :: cell(2)                 ! cell size in Meters
  real, intent(in) :: taper(4)                ! 1/e taper in Meters + Angle in Radians
  real, intent(in) :: we(nv)                  ! Weight array
  real, intent(in) :: vv(nv)                  ! V Values
  real, intent(in) :: ubias                   ! U gridding offset
  real, intent(in) :: vbias                   ! V gridding offset
  real, intent(in) :: ubuff(4096)             ! U gridding buffer
  real, intent(in) :: vbuff(4096)             ! V gridding buffer
  ! Global
  real(8), parameter :: pi=3.141592653589793d0
  ! Local
  integer ix,iy,ic,i,iin,iou,io
  integer ixm,ixp,iym,iyp,iu,iv
  real result,resima,staper,etaper,res
  real u,v,du,dv,ufac,vfac
  real cx,cy,sx,sy
  real(8) xinc,xref,yinc,yref
  logical do_taper
  !
  integer my,kx,ky
  !
  ! Compute IO from first channel number
  io = 7+3*jo-2
  ufac = 100.d0/cell(1)
  vfac = 100.d0/cell(2)
  !
  if (taper(1).ne.0. .and. taper(2).ne.0.) then
    do_taper = .true.
    staper = taper(3)*pi/180.0
    if (taper(1).ne.0) then
      cx = cos(staper)/taper(1)
      sy = sin(staper)/taper(1)
    else
      cx = 0.0
      sy = 0.0
    endif
    if (taper(2).ne.0) then
      cy = cos(staper)/taper(2)
      sx = sin(staper)/taper(2)
    else
      cy = 0.0
      sx = 0.0
    endif
    if (taper(4).ne.0.) then
      etaper = taper(4)/2.0
    else
      etaper = 1
    endif
  else
    do_taper = .false.
  endif
  xinc = mapx(2)-mapx(1)
  xref = nx/2+1
  yinc = mapy(2)-mapy(1)
  yref = ny/2+1
  staper = 1.0
  !
  ! Use symmetry
  my = ny/2+1
  !
  ! Start with loop on observed visibilities
  do i=1,nv
    u = visi(jx,i)
    v = visi(jy,i)
    !
    if (do_taper) then
      staper = (u*cx + v*sy)**2 + (-u*sx + v*cy)**2
      if (etaper.ne.1) staper = staper**etaper
      if (staper.gt.64.0) then
        staper = 0.0
      else
        staper = exp(-staper)
      endif
    endif
    !
    ! Weight and taper
    result = staper*we(i)
    if (v.gt.0) then
      u = -u
      v = - v
      resima = -result
    else
      resima = result
    endif
    ! Channels
    ! Define map cell
    ixp = int((u-sup(1))/xinc+xref+1.0)
    ixm = int((u+sup(1))/xinc+xref)
    iym = int((v-sup(2))/yinc+yref)
    iyp = min(my,int((v+sup(2))/yinc+yref+1.0))
    !
    if (ixm.lt.1.or.ixp.gt.nx.or.iym.lt.1.or.iyp.gt.ny) then
      continue
      !            PRINT *,'Visi ',I,' pixels ',IXM,IXP,IYM,IYP
    else
      do iy=iym,iyp
        dv = v-mapy(iy)
        if (abs(dv).le.sup(2)) then
          iv = nint(dv*vfac+vbias)
          do ix=ixm,ixp
            du = u-mapx(ix)
            if (abs(du).le.sup(1)) then
              iu = nint(du*ufac+ubias)
              res = ubuff(iu)*vbuff(iv)
              iou = 1
              iin = io
              do ic=1,nc
                map (iou,ix,iy) = map (iou,ix,iy) +   &
     &                  visi(iin,i)*result*res
                iou = iou+1
                iin = iin+1
                map (iou,ix,iy) = map (iou,ix,iy) +   &
     &                  visi(iin,i)*resima*res
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
              map (iou,ix,iy) = map(iou,ix,iy) +   &
     &                res*result
            endif
          enddo
        endif
      enddo
    endif
    !
    ! Borderline case: use symmetry
    u = -u
    v = -v
    resima = -resima
    if (v.le.sup(2)) then
      ixp = int((u-sup(1))/xinc+xref+1.0)
      ixm = int((u+sup(1))/xinc+xref)
      iym = int((v-sup(2))/yinc+yref)
      iyp = min(my,int((v+sup(2))/yinc+yref+1.0))
      if (ixm.lt.1.or.ixp.gt.nx.or.iym.lt.1.or.iyp.gt.ny) then
        continue
        !               PRINT *,'Visi ',I,' pixels ',IXM,IXP,IYM,IYP
      else
        do iy=iym,iyp
          dv = v-mapy(iy)
          if (abs(dv).le.sup(2)) then
            iv = nint(dv*vfac+vbias)
            do ix=ixm,ixp
              du = u-mapx(ix)
              if (abs(du).le.sup(1)) then
                iu = nint(du*ufac+ubias)
                res = ubuff(iu)*vbuff(iv)
                iou = 1
                iin = io
                do ic=1,nc
                  map (iou,ix,iy) = map (iou,ix,iy) +   &
     &                    visi(iin,i)*result*res
                  iou = iou+1
                  iin = iin+1
                  map (iou,ix,iy) = map (iou,ix,iy) +   &
     &                    visi(iin,i)*resima*res
                  iou = iou+1
                  iin = iin+2
                enddo
                ! Beam
                map (iou,ix,iy) = map(iou,ix,iy) +   &
     &                  res*result
              endif
            enddo
          endif
        enddo
      endif
    endif
  enddo
  !
  ! Apply symmetry
  do iy=my+1,ny
    ky = ny+2-iy
    do ix=2,nx
      kx = nx+2-ix
      iou = 1
      do i=1,nc
        map(iou,ix,iy) = map(iou,kx,ky)
        iou = iou+1
        map(iou,ix,iy) = -map(iou,kx,ky)
        iou = iou+1
      enddo
      map(iou,ix,iy) = map(iou,kx,ky)  ! Beam
    enddo
  enddo
  !
  ! Missing row is left empty (assume proper coverage of the UV plane)
  do iy = 1,ny
    if (map(2*nc-1,1,iy).ne.0) then
      print *,'Invalid beam ',iy
    endif
  enddo
end subroutine dofft_quick
!
subroutine dofft_quick_omp (np,nv,visi,jx,jy,jo   &
     &    ,nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &    ubias,vbias,ubuff,vbuff,ipara)
  !$ use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER    Gridding routine for UV_MAP and UV_RESTORE
  !
  !   Compute FFT of image by gridding UV data
  !   - Taper before gridding
  !   - Gridding with pre-computed support
  !   - Uses symmetry
  !
  !  Parallelized version to be used for Continuum (nc=1) data
  !----------------------------------------------------------------------
  integer, intent(in) :: nv                   ! number of values
  integer, intent(in) :: np                   ! Number of "visibilities", normally 7+3*nc
  real, intent(in) :: visi(np,nv)             ! values
  integer, intent(in) :: nc                   ! number of channels
  integer, intent(in) :: jx                   ! X coord location in VISI
  integer, intent(in) :: jy                   ! Y coord location in VISI
  integer, intent(in) :: jo                   ! first channel to map
  integer, intent(in) :: nx                   ! X map size
  integer, intent(in) :: ny                   ! Y map size
  real, intent(out) :: map(2*(nc+1),nx,ny)    ! gridded visibilities
  real, intent(in) :: mapx(nx)                ! X Coordinates of grid
  real, intent(in) :: mapy(ny)                ! Y Coordinates of grid
  real, intent(in) :: sup(2)                  ! Support of convolving function in Meters
  real, intent(in) :: cell(2)                 ! cell size in Meters
  real, intent(in) :: taper(4)                ! 1/e taper in Meters + Angle in Radians
  real, intent(in) :: we(nv)                  ! Weight array
  real, intent(in) :: vv(nv)                  ! V Values
  real, intent(in) :: ubias                   ! U gridding offset
  real, intent(in) :: vbias                   ! V gridding offset
  real, intent(in) :: ubuff(4096)             ! U gridding buffer
  real, intent(in) :: vbuff(4096)             ! V gridding buffer
  integer, intent(in) :: ipara
  ! Global
  real(8), parameter :: pi=3.141592653589793d0
  ! Local
  integer ix,iy,ic,i,iin,iou,io
  integer ixm,ixp,iym,iyp,iu,iv
  real result,resima,staper,etaper,res
  real u,v,du,dv,ufac,vfac
  real cx,cy,sx,sy
  real(8) xinc,xref,yinc,yref
  logical do_taper
  !
  integer my,kx,ky
  !
  integer :: it,nthread,ier,lchunk
  real, allocatable :: thread_map(:,:,:,:)      ! One MAP per Thread
  !
  ! Compute IO from first channel number
  io = 7+3*jo-2
  ufac = 100.d0/cell(1)
  vfac = 100.d0/cell(2)
  !
  if (taper(1).ne.0. .and. taper(2).ne.0.) then
    do_taper = .true.
    staper = taper(3)*pi/180.0
    if (taper(1).ne.0) then
      cx = cos(staper)/taper(1)
      sy = sin(staper)/taper(1)
    else
      cx = 0.0
      sy = 0.0
    endif
    if (taper(2).ne.0) then
      cy = cos(staper)/taper(2)
      sx = sin(staper)/taper(2)
    else
      cy = 0.0
      sx = 0.0
    endif
    if (taper(4).ne.0.) then
      etaper = taper(4)/2.0
    else
      etaper = 1
    endif
  else
    do_taper = .false.
  endif
  xinc = mapx(2)-mapx(1)
  xref = nx/2+1
  yinc = mapy(2)-mapy(1)
  yref = ny/2+1
  staper = 1.0
  !
  ! Use symmetry
  my = ny/2+1
  !
  nthread = 1
  !$ nthread = omp_get_max_threads()
  allocate(thread_map(2*(nc+1),nx,ny,nthread),stat=ier)
  thread_map = 0.
  lchunk = (nv+nthread-1)/nthread  
  lchunk = min(lchunk,1024)        
  if (ipara.ne.0) lchunk = ipara
  !
  ! Start with loop on observed visibilities
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP & SHARED (nv,jx,jy,nc,nx,ny,do_taper,sx,sy,cx,cy,etaper, io, lchunk) &
  !$OMP & SHARED (xinc,xref,yinc,yref, sup, nthread, my, ubias, vbias, ufac, vfac) &
  !$OMP & SHARED (visi, we, ubuff, vbuff, mapx, mapy, thread_map) &        
  !$OMP & PRIVATE (i,u,v,staper, result, resima, ixp, ixm, iym, iyp) &
  !$OMP & PRIVATE (ix,iy,du,dv,iu,iv, res, iin, iou,ic, it)
  it = 1
  !$ it = omp_get_thread_num()+1
  !$ nthread = omp_get_num_threads()
  !$OMP DO SCHEDULE(STATIC,lchunk)
  do i=1,nv
    u = visi(jx,i)
    v = visi(jy,i)
    !
    if (do_taper) then
      staper = (u*cx + v*sy)**2 + (-u*sx + v*cy)**2
      if (etaper.ne.1) staper = staper**etaper
      if (staper.gt.64.0) then
        staper = 0.0
      else
        staper = exp(-staper)
      endif
    else
      staper = 1.
    endif
    !
    ! Weight and taper
    result = staper*we(i)
    if (v.gt.0) then
      u = -u
      v = - v
      resima = -result
    else
      resima = result
    endif
    ! Channels
    ! Define map cell
    ixp = int((u-sup(1))/xinc+xref+1.0)
    ixm = int((u+sup(1))/xinc+xref)
    iym = int((v-sup(2))/yinc+yref)
    iyp = min(my,int((v+sup(2))/yinc+yref+1.0))
    !
    if (ixm.lt.1.or.ixp.gt.nx.or.iym.lt.1.or.iyp.gt.ny) then
      continue
      !            PRINT *,'Visi ',I,' pixels ',IXM,IXP,IYM,IYP
    else
      do iy=iym,iyp
        dv = v-mapy(iy)
        if (abs(dv).le.sup(2)) then
          iv = nint(dv*vfac+vbias)
          do ix=ixm,ixp
            du = u-mapx(ix)
            if (abs(du).le.sup(1)) then
              iu = nint(du*ufac+ubias)
              res = ubuff(iu)*vbuff(iv)
              iou = 1
              iin = io
              do ic=1,nc
                thread_map (iou,ix,iy,it) = thread_map (iou,ix,iy,it) +   &
     &                  visi(iin,i)*result*res
                iou = iou+1
                iin = iin+1
                thread_map (iou,ix,iy,it) = thread_map (iou,ix,iy,it) +   &
     &                  visi(iin,i)*resima*res
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
              thread_map (iou,ix,iy,it) = thread_map(iou,ix,iy,it) +   &
     &                res*result
            endif
          enddo
        endif
      enddo
    endif
    !
    ! Borderline case: use symmetry
    u = -u
    v = -v
    resima = -resima
    if (v.le.sup(2)) then
      ixp = int((u-sup(1))/xinc+xref+1.0)
      ixm = int((u+sup(1))/xinc+xref)
      iym = int((v-sup(2))/yinc+yref)
      iyp = min(my,int((v+sup(2))/yinc+yref+1.0))
      if (ixm.lt.1.or.ixp.gt.nx.or.iym.lt.1.or.iyp.gt.ny) then
        continue
        !               PRINT *,'Visi ',I,' pixels ',IXM,IXP,IYM,IYP
      else
        do iy=iym,iyp
          dv = v-mapy(iy)
          if (abs(dv).le.sup(2)) then
            iv = nint(dv*vfac+vbias)
            do ix=ixm,ixp
              du = u-mapx(ix)
              if (abs(du).le.sup(1)) then
                iu = nint(du*ufac+ubias)
                res = ubuff(iu)*vbuff(iv)
                iou = 1
                iin = io
                do ic=1,nc
                  thread_map (iou,ix,iy,it) = thread_map (iou,ix,iy,it) +   &
     &                    visi(iin,i)*result*res
                  iou = iou+1
                  iin = iin+1
                  thread_map (iou,ix,iy,it) = thread_map (iou,ix,iy,it) +   &
     &                    visi(iin,i)*resima*res
                  iou = iou+1
                  iin = iin+2
                enddo
                ! Beam
                thread_map (iou,ix,iy,it) = thread_map(iou,ix,iy,it) +   &
     &                  res*result
              endif
            enddo
          endif
        enddo
      endif
    endif
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  ! Sum the Per-Thread maps
  map = 0
  do it=1,nthread
    map = map + thread_map(:,:,:,it)
  enddo
  !
  ! Apply symmetry
  do iy=my+1,ny
    ky = ny+2-iy
    do ix=2,nx
      kx = nx+2-ix
      iou = 1
      do i=1,nc
        map(iou,ix,iy) = map(iou,kx,ky)
        iou = iou+1
        map(iou,ix,iy) = -map(iou,kx,ky)
        iou = iou+1
      enddo
      map(iou,ix,iy) = map(iou,kx,ky)  ! Beam
    enddo
  enddo
  !
  ! Missing row is left empty (assume proper coverage of the UV plane)
  do iy = 1,ny
    if (map(2*nc-1,1,iy).ne.0) then
      print *,'Invalid beam ',iy
    endif
  enddo
end subroutine dofft_quick_omp
!
subroutine dofft_fast (np,nv,visi,jx,jy,jo   &
     &    ,nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv)
  !----------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS  MAP_FAST
  !   Compute FFT of image by gridding UV data
  !   Taper before gridding
  !   Only for "visibility in cell" gridding.
  !   Uses symmetry
  !----------------------------------------------------------------------
  integer, intent(in) :: nv                   ! number of values
  integer, intent(in) :: np                   ! Number of "visibilities", normally 7+3*nc
  real, intent(in) :: visi(np,nv)             ! values
  integer, intent(in) :: nc                   ! number of channels
  integer, intent(in) :: jx                   ! X coord location in VISI
  integer, intent(in) :: jy                   ! Y coord location in VISI
  integer, intent(in) :: jo                   ! first channel to map
  integer, intent(in) :: nx                   ! X map size
  integer, intent(in) :: ny                   ! Y map size
  real, intent(out) :: map(2*(nc+1),nx,ny)    ! gridded visibilities
  real, intent(in) :: mapx(nx)                ! X Coordinates of grid
  real, intent(in) :: mapy(ny)                ! Y Coordinates of grid
  real, intent(in) :: sup(2)                  ! Support of convolving function in Meters
  real, intent(in) :: cell(2)                 ! cell size in Meters
  real, intent(in) :: taper(4)                ! 1/e taper in Meters + Angle in Radians
  real, intent(in) :: we(nv)                  ! Weight array
  real, intent(in) :: vv(nv)                  ! V Values
  ! Global
  real(8), parameter :: pi=3.141592653589793d0
  ! Local
  integer ix,iy,ic,i,iin,iou,io,my,kx,ky
  real result,staper,etaper,resima
  real u,v
  real cx,cy,sx,sy
  real(8) xinc,xref,yinc,yref
  logical do_taper
  !
  ! Compute IO from first channel number
  io = 7+3*jo-2
  my = ny/2+1
  !
  if (taper(1).ne.0. .and. taper(2).ne.0.) then
    do_taper = .true.
    staper = taper(3)*pi/180.0
    if (taper(1).ne.0) then
      cx = cos(staper)/taper(1)
      sy = sin(staper)/taper(1)
    else
      cx = 0.0
      sy = 0.0
    endif
    if (taper(2).ne.0) then
      cy = cos(staper)/taper(2)
      sx = sin(staper)/taper(2)
    else
      cy = 0.0
      sx = 0.0
    endif
    if (taper(4).ne.0.) then
      etaper = taper(4)/2.0
    else
      etaper = 1
    endif
  else
    do_taper = .false.
  endif
  xinc = mapx(2)-mapx(1)
  xref = nx/2+1
  yinc = mapy(2)-mapy(1)
  yref = ny/2+1
  staper = 1.0
  !
  ! Start with loop on observed visibilities
  do i=1,nv
    u = visi(jx,i)
    v = visi(jy,i)
    !
    if (do_taper) then
      staper = (u*cx + v*sy)**2 + (-u*sx + v*cy)**2
      if (etaper.ne.1) staper = staper**etaper
      if (staper.gt.64.0) then
        staper = 0.0
      else
        staper = exp(-staper)
      endif
    endif
    !
    ! Weight and taper
    result = staper*we(i)
    ! Channels
    ! Define map cell
    if (v.gt.0) then
      ix = nint(-u/xinc+xref)
      iy = nint(-v/yinc+yref)
      resima = -result
    else
      ix = nint(u/xinc+xref)
      iy = nint(v/yinc+yref)
      resima = result
    endif
    if (ix.lt.1.or.ix.gt.nx.or.iy.lt.1.or.iy.gt.my) then
      print *,'Visi ',i,' pixels ',ix,iy,my,v
    else
      iou = 1
      iin = io
      do ic=1,nc
        map (iou,ix,iy) = map (iou,ix,iy) +   &
     &          visi(iin,i)*result
        iou = iou+1
        iin = iin+1
        map (iou,ix,iy) = map (iou,ix,iy) +   &
     &          visi(iin,i)*resima
        iou = iou+1
        iin = iin+2
      enddo
      map (iou,ix,iy) = map(iou,ix,iy) + result
    endif
    !
    ix = nint(-u/xinc+xref)
    iy = nint(-v/yinc+yref)
    if (iy.eq.my) then
      iou = 1
      iin = io
      do ic=1,nc
        map (iou,ix,iy) = map (iou,ix,iy) +   &
     &          visi(iin,i)*result
        iou = iou+1
        iin = iin+1
        map (iou,ix,iy) = map (iou,ix,iy) -   &
     &          visi(iin,i)*resima
        iou = iou+1
        iin = iin+2
      enddo
      map (iou,ix,iy) = map(iou,ix,iy) + result
    endif
  enddo
  !
  ! Apply symmetry
  do iy=my+1,ny
    ky = ny+2-iy
    do ix=2,nx
      kx = nx+2-ix
      iou = 1
      do i=1,nc
        map(iou,ix,iy) = map(iou,kx,ky)
        iou = iou+1
        map(iou,ix,iy) = -map(iou,kx,ky)
        iou = iou+1
      enddo
      map(iou,ix,iy) = map(iou,kx,ky)  ! Beam
    enddo
  enddo
  !
  ! Missing row is left empty (assume proper coverage of the UV plane)
  do iy = 1,ny
    if (map(2*nc-1,1,iy).ne.0) then
      print *,'Invalid beam ',iy
    endif
  enddo
end subroutine dofft_fast
!
subroutine dofft_slow (np,nv,visi,jx,jy,jo   &
     &    ,nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &    ubias,vbias,ubuff,vbuff)
  !----------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS  UVMAP
  !   Compute FFT of image by gridding UV data
  !   Taper after gridding
  !   Uses symmetry
  !----------------------------------------------------------------------
  integer, intent(in) :: nv                   ! number of values
  integer, intent(in) :: np                   ! Number of "visibilities", normally 7+3*nc
  real, intent(in) :: visi(np,nv)             ! values
  integer, intent(in) :: nc                   ! number of channels
  integer, intent(in) :: jx                   ! X coord location in VISI
  integer, intent(in) :: jy                   ! Y coord location in VISI
  integer, intent(in) :: jo                   ! first channel to map
  integer, intent(in) :: nx                   ! X map size
  integer, intent(in) :: ny                   ! Y map size
  real, intent(out) :: map(2*(nc+1),nx,ny)    ! gridded visibilities
  real, intent(in) :: mapx(nx)                ! X Coordinates of grid
  real, intent(in) :: mapy(ny)                ! Y Coordinates of grid
  real, intent(in) :: sup(2)                  ! Support of convolving function in Meters
  real, intent(in) :: cell(2)                 ! cell size in Meters
  real, intent(in) :: taper(4)                ! 1/e taper in Meters + Angle in Radians
  real, intent(in) :: we(nv)                  ! Weight array
  real, intent(in) :: vv(nv)                  ! V Values
  real, intent(in) :: ubias                   ! U gridding offset
  real, intent(in) :: vbias                   ! V gridding offset
  real, intent(in) :: ubuff(4096)             ! U gridding buffer
  real, intent(in) :: vbuff(4096)             ! V gridding buffer
  ! Global
  real(8), parameter :: pi=3.141592653589793d0
  ! Local
  real :: taperv(nx,ny)
  integer iu,iv
  integer ifirsp,ilastp,ifirsm,ilastm,my
  integer ix,iy,ic,i,iin,iou,io
  integer kx,ky,fy
  real result,staper,vtaper,utaper,etaper
  real u,v,um,up,vm,vp,ufac,vfac
  real cx,cy,sx,sy
  !
  ! Compute IO from first channel number
  io = 7+3*jo-2
  ufac = 100.d0/cell(1)
  vfac = 100.d0/cell(2)
  taperv = 0.0
  !
  ! Initialize
  !     MY = NY       ! Slow version
  my = ny/2+1                  ! Fast version, using symmetry
  ifirsp = 1
  ilastm = nv
  !
  ! Compute the first valid pixel
  fy = int((vv(1)-sup(2))/(mapy(2)-mapy(1))+ny/2+1)
  !
  ! Precompute the taper
  if (taper(3).ne.0.0) then
    staper = taper(3)*pi/180.0
    if (taper(1).ne.0) then
      cx = cos(staper)/taper(1)
      sy = sin(staper)/taper(1)
    else
      cx = 0.0
      sy = 0.0
    endif
    if (taper(2).ne.0) then
      cy = cos(staper)/taper(2)
      sx = sin(staper)/taper(2)
    else
      cy = 0.0
      sx = 0.0
    endif
  else
    cx = 1.
    sx = 0
    cy = 1.
    sy = 0.
  endif
  !
  if (taper(4).ne.0) then
    etaper = taper(4)/2.0
  else
    etaper = 1.0
  endif
  !
  do iy=fy,my
    v = mapy(iy)
    if (taper(3).ne.0) then
      vtaper = -1.0
    elseif  (taper(2).eq.0) then
      vtaper = 1.0
    else
      vtaper = abs(v/taper(2))**(etaper*2.0)
      if (vtaper.gt.64) then
        vtaper = 0
      else
        vtaper = exp(-vtaper)
      endif
    endif
    if (vtaper.ne.0) then
      do ix=1,nx
        u = mapx(ix)
        if (taper(3).ne.0) then
          ! General rotated case...
          staper = (u*cx + v*sy)**2 +   &
     &            (-u*sx + v*cy)**2
          if (etaper.ne.1) staper = staper**etaper
          if (staper.gt.64.0) then
            staper = 0.0
          else
            staper = exp(-staper)
          endif
        elseif  (taper(1).eq.0) then
          staper = vtaper
        else
          utaper = abs(u/taper(1))**(2.0*etaper)
          if (utaper.gt.64) then
            utaper = 0
          else
            utaper = exp(-utaper)
          endif
          staper = vtaper*utaper
        endif
        if (taper(1).lt.0) then
          staper = 1.0-staper
          if (staper.ne.1.0) print *,u,v,staper
        endif
        !
        taperv(ix,iy) = staper
      enddo
    else
      do ix=1,nx
        taperv(ix,iy) = 0.0
      enddo
    endif
  enddo
  !
  do iy=fy,my
    v = mapy(iy)
    !
    ! Optimized dichotomic search, taking into account the fact that
    !  VV is an ordered array
    !
    ! IFIRSP always increases, ILASTM always decreases
    vm = v-sup(2)
    vp = v+sup(2)
    call findp (nv,vv,vm,ifirsp)
    ilastp = ifirsp
    call findp (nv,vv,vp,ilastp)
    ilastp = ilastp-1
    !
    ilastm = ilastm+1
    vm = -v-sup(2)
    vp = -v+sup(2)
    call findm (nv,vv,vp,ilastm)
    ifirsm = ilastm
    ilastm = ilastm-1
    call findm (nv,vv,vm,ifirsm)
    !
    ! Loop on X cells
    if (ilastp.ge.ifirsp .or. ilastm.ge.ifirsm) then
      do ix=1,nx
        u = mapx(ix)
        staper = taperv(ix,iy)
        !
        ! Do while in X cell for (+U,+V)
        um = u-sup(1)
        up = u+sup(1)
        do i=ifirsp,ilastp
          if (visi(jx,i).ge.um .and. visi(jx,i).le.up) then
            iu = nint((u-visi(jx,i))*ufac+ubias)
            iv = nint((v-visi(jy,i))*vfac+vbias)
            result = ubuff(iu)*vbuff(iv)
            !
            if (result.ne.0.0) then
              if (ix.eq.1) then
                print *,'Unsufficient coverage',iy,ny
              endif
              ! Weight and taper
              result = result*staper*we(i)
              ! Channels
              iou = 1
              iin = io
              do ic=1,nc
                map (iou,ix,iy) = map (iou,ix,iy) +   &
     &                  visi(iin,i)*result
                iou = iou+1
                iin = iin+1
                map (iou,ix,iy) = map (iou,ix,iy) +   &
     &                  visi(iin,i)*result
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
              map (iou,ix,iy) = map(iou,ix,iy) + result
            endif
          endif
        enddo
        !
        ! Do while in X cell for (-U,-V)
        um = -u-sup(1)
        up = -u+sup(1)
        do i=ifirsm,ilastm
          if (visi(jx,i).ge.um .and. visi(jx,i).le.up) then
            iu = nint(-(u+visi(jx,i))*ufac+ubias)
            iv = nint(-(v+visi(jy,i))*vfac+vbias)
            result = ubuff(iu)*vbuff(iv)
            if (result.ne.0.0) then
              if (ix.eq.1) then
                print *,'Unsufficient coverage',-iy,ny
              endif
              ! Weight and taper
              result = result*staper*we(i)
              ! Channels
              iou = 1
              iin = io
              do ic=1,nc
                map (iou,ix,iy) = map (iou,ix,iy) +   &
     &                  visi(iin,i)*result
                iou = iou+1
                iin = iin+1
                map (iou,ix,iy) = map (iou,ix,iy) -   &
     &                  visi(iin,i)*result
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
              map (iou,ix,iy) = map(iou,ix,iy) + result
            endif
          endif
        enddo                  ! Visibility loop
      enddo                    ! IX Loop
    endif
  enddo
  !
  ! Symmetry
  do iy=my+1,ny
    ky = ny+2-iy
    do ix=2,nx
      kx = nx+2-ix
      iou = 1
      do i=1,nc
        map(iou,ix,iy) = map(iou,kx,ky)
        iou = iou+1
        map(iou,ix,iy) = -map(iou,kx,ky)
        iou = iou+1
      enddo
      map(iou,ix,iy) = map(iou,kx,ky)  ! Beam
    enddo
  enddo
  !
  ! Missing row is left empty (assume proper coverage of the UV plane)
end subroutine dofft_slow
