subroutine 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)
  !$  use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS  MAP_FAST
  !   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 :: iv_block, iv_first, iv_last
  integer my,kx,ky
  integer ier, ithread, nthread, mthread, lchunk, it
  character(len=4) :: chain
  real(4), allocatable :: mpa(:,:,:,:)
  real(8) :: elapsed_s,elapsed_e,elapsed
  real :: b_wait
  integer :: n_wait
  logical :: error
  !
  n_wait = 0
#ifndef GAG_USE_STATICLINK
  !$  call sic_get_inte('MY_WAIT',n_wait,error)
#endif
  !
  mthread = 1
  !$  mthread = omp_get_max_threads()
  write(*,'(A)') 'I-DOFFT,  Pseudo Parallel V ',mthread
  mthread = min(mthread,4)
  !$  elapsed_s = omp_get_wtime()
  !
  ! 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
  allocate(mpa(2*nc+2,nx,my,mthread),stat=ier)
  if (ier.ne.0) then
    write(*,'(A,I10)') 'E-DOFFT,  Memory allocation error ',ier
    return
  endif
  mpa = 0.0
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished initializing -- Elapsed ',elapsed
  !
  do ithread=1,mthread
  !
  ! Start with loop on observed visibilities
  iv_block = (nv+mthread-1)/mthread
  iv_first = 1+(ithread-1)*iv_block
  iv_last  = min(ithread*iv_block,nv)
  staper = 1.0
  !
  do i=iv_first,iv_last
    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))
!!    write(2,'(A,I6,A,I2,4F10.2,A,I6,I6,I6,I6)') 'Visi ',i,' **Pseudo** ',ithread &
!!      & ,u,v,sup,' bound ',ixm,ixp,iym,iyp
    !
    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
      if (iyp.gt.my) then
        Print *,'IYP ',iyp,' > MY ',my
        iyp = my
      endif
      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
                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                  visi(iin,i)*result*res
                iou = iou+1
                iin = iin+1
                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                  visi(iin,i)*resima*res
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
               mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
     &                res*result
            endif
            call big_wait(n_wait,b_wait)
          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
                  mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
     &                    visi(iin,i)*result*res
                  iou = iou+1
                  iin = iin+1
                  mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
     &                    visi(iin,i)*resima*res
                  iou = iou+1
                  iin = iin+2
                enddo
                ! Beam
                mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
     &                  res*result
              endif
            enddo
            call big_wait(n_wait,b_wait)
          endif
        enddo
      endif
    endif
  enddo
  !
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2,A,I2)') 'I-DOFFT, Finished Gridding -- Elapsed ',elapsed,' Bloc ',ithread
  !
  enddo
  !
  ! Fill Map array
  do iy=1,my
    map(:,:,iy) = mpa(:,:,iy,1)
    do it=2,mthread
      map(:,:,iy) = map(:,:,iy) + mpa(:,:,iy,it)
    enddo
  enddo
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Filling -- Elapsed ',elapsed
  !
  ! 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
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Symmetry -- Elapsed ',elapsed
  !
  ! 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_parallel_v_pseudo_out
!
subroutine 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)
  !$  use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS  MAP_FAST
  !   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 :: iv_block, iv_first, iv_last
  integer my,kx,ky
  integer ier, ithread, nthread, mthread, lchunk, it
  character(len=4) :: chain
  real(4), allocatable :: mpa(:,:,:,:)
  real(8) :: elapsed_s,elapsed_e,elapsed
  real :: b_wait
  integer :: n_wait
  logical :: error
  n_wait = 0
#ifndef GAG_USE_STATICLINK
  !$  call sic_get_inte('MY_WAIT',n_wait,error)
#endif
  !
  mthread = 1
  !$  mthread = omp_get_max_threads()
  write(*,'(A)') 'I-DOFFT,  True Parallel V ',mthread
  mthread = min(mthread,4)
  !$  elapsed_s = omp_get_wtime()
  !
  ! 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
  allocate(mpa(2*nc+2,nx,my,mthread),stat=ier)
  if (ier.ne.0) then
    write(*,'(A,I10)') 'E-DOFFT,  Memory allocation error ',ier
    return
  endif
  mpa = 0.0
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished initializing -- Elapsed ',elapsed
  !
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP   & SHARED(nc,nv,nx,my,mapx,mapy,ny) &
  !$OMP   & SHARED(jx,jy,cx,sx,cy,sy,etaper,do_taper,io) &
  !$OMP   & SHARED(xinc,xref,yinc,yref,sup,ubias,vbias,ufac,vfac) &
  !$OMP   & SHARED(ubuff,vbuff,visi,we) SHARED(mpa) &
  !$OMP   & PRIVATE(i,u,v,staper,result,resima,ixp,ixm,iyp,iym) &
  !$OMP   & PRIVATE(dv,iv,du,iu,res,iin,iou,iy,ix,ic) &
  !$OMP   & PRIVATE(ithread,lchunk,nthread) &
  !$OMP   & PRIVATE(it,kx,ky) SHARED(mthread,b_wait,n_wait) &
  !$OMP   & FIRSTPRIVATE(elapsed_s) PRIVATE(elapsed_e,elapsed) &
  !$OMP   & PRIVATE(iv_block, iv_first, iv_last)
  !
  !$OMP DO
  do ithread=1,mthread
  !
  ! Start with loop on observed visibilities
  iv_block = (nv+mthread-1)/mthread
  iv_first = 1+(ithread-1)*iv_block
  iv_last  = min(ithread*iv_block,nv)
  staper = 1.0
  !
  do i=iv_first,iv_last
    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))
!!    write(2,'(A,I6,A,I2,4F10.2,A,I6,I6,I6,I6)') 'Visi ',i,' **Pseudo** ',ithread &
!!      & ,u,v,sup,' bound ',ixm,ixp,iym,iyp
    !
    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
      if (iyp.gt.my) then
        Print *,'IYP ',iyp,' > MY ',my
        iyp = my
      endif
      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
                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                  visi(iin,i)*result*res
                iou = iou+1
                iin = iin+1
                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                  visi(iin,i)*resima*res
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
              mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
     &                res*result
            endif
            call big_wait(n_wait,b_wait)
          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
                  mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                    visi(iin,i)*result*res
                  iou = iou+1
                  iin = iin+1
                  mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                    visi(iin,i)*resima*res
                  iou = iou+1
                  iin = iin+2
                enddo
                ! Beam
                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                  res*result
              endif
            enddo
            call big_wait(n_wait,b_wait)
          endif
        enddo
      endif
    endif
  enddo
  !
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2,A,I2,A,I2)') 'I-DOFFT, Finished Gridding -- Elapsed ',elapsed, &
    ' Bloc ',ithread,' Thread ',ithread
  !
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  ! Fill Map array
  do iy=1,my
    map(:,:,iy) = mpa(:,:,iy,1)
    do it=2,mthread
      map(:,:,iy) = map(:,:,iy) + mpa(:,:,iy,it)
    enddo
  enddo
  !$ elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Filling -- Elapsed ',elapsed
  !
  ! 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
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Symmetry -- Elapsed ',elapsed
  !
  ! 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_parallel_v_true_out
!
subroutine 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)
  !$  use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS  MAP_FAST
  !   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
  integer ier, ithread, nthread, mthread, lchunk, it
  character(len=4) :: chain
  real(4), allocatable :: mpa(:,:,:,:)
  real(8) :: elapsed_s,elapsed_e,elapsed
  real :: b_wait
  integer :: n_wait
  logical :: error
  !
  n_wait = 0
#ifndef GAG_USE_STATICLINK
  !$  call sic_get_inte('MY_WAIT',n_wait,error)
#endif
  !
  mthread = 1
  !$  mthread = omp_get_max_threads()
  write(*,'(A)') 'I-DOFFT,  Pseudo Parallel V ',mthread
  mthread = min(mthread,4)
  !$  elapsed_s = omp_get_wtime()
  !
  ! 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
  !
  ! Use symmetry
  my = ny/2+1
  allocate(mpa(mthread,2*nc+2,nx,my),stat=ier)
  if (ier.ne.0) then
    write(*,'(A,I10)') 'E-DOFFT,  Memory allocation error ',ier
    return
  endif
  mpa = 0.0
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished initializing -- Elapsed ',elapsed
  !
  do ithread=1,mthread
  staper = 1.0
  !
  ! Start with loop on observed visibilities
  do i=ithread,nv,mthread
    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))
!!    write(2,'(A,I6,A,I2,4F10.2,A,I6,I6,I6,I6)') 'Visi ',i,' **Pseudo** ',ithread &
!!      & ,u,v,sup,' bound ',ixm,ixp,iym,iyp
    !
    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
      if (iyp.gt.my) then
        Print *,'IYP ',iyp,' > MY ',my
        iyp = my
      endif
      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
!                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
                mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                  visi(iin,i)*result*res
                iou = iou+1
                iin = iin+1
!                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
                 mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                  visi(iin,i)*resima*res
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
!              mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
               mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                res*result
            endif
            call big_wait(n_wait,b_wait)
          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
                  mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                    visi(iin,i)*result*res
                  iou = iou+1
                  iin = iin+1
                  mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                    visi(iin,i)*resima*res
                  iou = iou+1
                  iin = iin+2
                enddo
                ! Beam
                mpa (ithread,iou,ix,iy) = mpa(ithread,iou,ix,iy) +   &
     &                  res*result
              endif
            enddo
            call big_wait(n_wait,b_wait)
          endif
        enddo
      endif
    endif
  enddo
  !
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2,A,I2A,I2)') 'I-DOFFT, Finished Gridding -- Elapsed ',elapsed, &
    & ' Bloc ',ithread,' Single Thread '
  !
  enddo
  !
  ! Fill Map array
  do iy=1,my
    map(:,:,iy) = mpa(1,:,:,iy)
    do it=2,mthread
      map(:,:,iy) = map(:,:,iy) + mpa(it,:,:,iy)
    enddo
  enddo
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Filling -- Elapsed ',elapsed
  !
  ! 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
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Symmetry -- Elapsed ',elapsed
  !
  ! 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_parallel_v_pseudo
!
subroutine 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)
  !$  use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS  MAP_FAST
  !   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
  integer ier, ithread, nthread, mthread, lchunk, it
  character(len=4) :: chain
  real(4), allocatable :: mpa(:,:,:,:)
  real(8) :: elapsed_s,elapsed_e,elapsed
  real :: b_wait
  integer :: n_wait, jthread
  logical :: error
  n_wait = 0
#ifndef GAG_USE_STATICLINK
  !$  call sic_get_inte('MY_WAIT',n_wait,error)
#endif
  !
  mthread = 1
  !$  mthread = omp_get_max_threads()
  write(*,'(A)') 'I-DOFFT,  True Parallel V ',mthread
  !$  mthread = min(mthread,4)
  !$  elapsed_s = omp_get_wtime()
  !
  ! 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
  allocate(mpa(mthread,2*nc+2,nx,my),stat=ier)
  if (ier.ne.0) then
    write(*,'(A,I10)') 'E-DOFFT,  Memory allocation error ',ier
    return
  endif
  mpa = 0.0
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished initializing -- Elapsed ',elapsed
  !
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP   & SHARED(nc,nv,nx,my,mapx,mapy,ny) &
  !$OMP   & SHARED(jx,jy,cx,sx,cy,sy,etaper,do_taper,io) &
  !$OMP   & SHARED(xinc,xref,yinc,yref,sup,ubias,vbias,ufac,vfac) &
  !$OMP   & SHARED(ubuff,vbuff,visi,we) SHARED(mpa) &
  !$OMP   & PRIVATE(i,u,v,staper,result,resima,ixp,ixm,iyp,iym) &
  !$OMP   & PRIVATE(dv,iv,du,iu,res,iin,iou,iy,ix,ic) &
  !$OMP   & PRIVATE(ithread,jthread,lchunk,nthread) &
  !$OMP   & PRIVATE(it,kx,ky) SHARED(mthread,b_wait,n_wait) &
  !$OMP   & FIRSTPRIVATE(elapsed_s) PRIVATE(elapsed_e,elapsed)
  !
  !$OMP DO
  do ithread=1,mthread
  staper = 1.0
  !
  ! Start with loop on observed visibilities
  do i=ithread,nv,mthread
    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))
!!    write(2,'(A,I6,A,I2,4F10.2,A,I6,I6,I6,I6)') 'Visi ',i,' **Pseudo** ',ithread &
!!      & ,u,v,sup,' bound ',ixm,ixp,iym,iyp
    !
    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
      if (iyp.gt.my) then
        Print *,'IYP ',iyp,' > MY ',my
        iyp = my
      endif
      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
!                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
                mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                  visi(iin,i)*result*res
                iou = iou+1
                iin = iin+1
!                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
                 mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                  visi(iin,i)*resima*res
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
!              mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
               mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                res*result
            endif
            call big_wait(n_wait,b_wait)
          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
                  mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                    visi(iin,i)*result*res
                  iou = iou+1
                  iin = iin+1
                  mpa (ithread,iou,ix,iy) = mpa (ithread,iou,ix,iy) +   &
     &                    visi(iin,i)*resima*res
                  iou = iou+1
                  iin = iin+2
                enddo
                ! Beam
                mpa (ithread,iou,ix,iy) = mpa(ithread,iou,ix,iy) +   &
     &                  res*result
              endif
            enddo
            call big_wait(n_wait,b_wait)
          endif
        enddo
      endif
    endif
  enddo
  !
  !$  elapsed_e = omp_get_wtime()
  !$  jthread = omp_get_thread_num()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2,A,I2,I2)') 'I-DOFFT, Finished Gridding -- Elapsed ',elapsed, &
    ' Bloc ',ithread, jthread
  !
  enddo
  !$OMP END DO
  !$OMP END PARALLEL
  !
  ! Fill Map array
  do iy=1,my
    map(:,:,iy) = mpa(1,:,:,iy)
    do it=2,mthread
      map(:,:,iy) = map(:,:,iy) + mpa(it,:,:,iy)
    enddo
  enddo
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Filling -- Elapsed ',elapsed
  !
  ! 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
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Symmetry -- Elapsed ',elapsed
  !
  ! 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_parallel_v_true
!
!
subroutine dofft_parallel_v_true2 (np,nv,visi,jx,jy,jo   &
     &    ,nc,nx,ny,map,mapx,mapy,sup,cell,taper,we,vv,   &
     &    ubias,vbias,ubuff,vbuff)
  !$  use omp_lib
  !----------------------------------------------------------------------
  ! @ private
  !
  ! GILDAS  MAP_FAST
  !   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
  !
  real usup,vsup
  integer my,kx,ky
  integer ier, ithread, nthread, mthread, lchunk, it
  character(len=4) :: chain
  real(4), allocatable :: mpa(:,:,:,:)
  real(8) :: elapsed_s,elapsed_e,elapsed
  !
  mthread = 1
  !$  mthread = omp_get_max_threads()
  write(*,'(A,I3)') 'I-DOFFT,  True Parallel V - Threads',mthread
  !
  ! Compute IO from first channel number
  io = 7+3*jo-2
  ufac = 100.d0/cell(1)
  vfac = 100.d0/cell(2)
  usup = sup(1)
  vsup = sup(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
  allocate(mpa(2*nc+2,nx,my,mthread),stat=ier)
  if (ier.ne.0) then
    write(*,'(A,I12)') 'E-DOFFT,  Memory allocation error ',ier
    return
  endif
  mpa = 0.0
  !
  ! Start with loop on observed visibilities
  !$OMP PARALLEL DEFAULT(none) &
  !$OMP   & SHARED(nc,nv,nx,my,mapx,mapy,ny) &
  !$OMP   & SHARED(jx,jy,cx,sx,cy,sy,etaper,do_taper,io) &
  !$OMP   & SHARED(xinc,xref,yinc,yref,usup,vsup,ubias,vbias,ufac,vfac) &
  !$OMP   & SHARED(ubuff,vbuff,visi,we) SHARED(mpa) &
  !$OMP   & PRIVATE(i,u,v,staper,result,resima,ixp,ixm,iyp,iym) &
  !$OMP   & PRIVATE(dv,iv,du,iu,res,iin,iou,iy,ix,ic) &
  !$OMP   & PRIVATE(ithread,lchunk,nthread) &
  !$OMP   & PRIVATE(it,kx,ky) SHARED(map,mthread) PRIVATE(elapsed_s,elapsed_e,elapsed)
  nthread = 1
  !$  elapsed_s = omp_get_wtime()
  !$  nthread = omp_get_num_threads()
  lchunk = (nv+nthread-1)/nthread
  if (lchunk.gt.64) lchunk = lchunk/8
  Print *,'LCHUNK ',lchunk
  !! ithread = omp_get_thread_num() + 1
  if (.not.do_taper) staper = 1.0
  !$OMP DO      !! SCHEDULE(STATIC,lchunk)
  do ithread=1,mthread
    !$  Print *,'Thread ',ithread,omp_get_thread_num()
  !
  do i=ithread,nv,mthread
    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-usup)/xinc+xref+1.0)
    ixm = int((u+usup)/xinc+xref)
    iym = int((v-vsup)/yinc+yref)
    iyp = min(my,int((v+vsup)/yinc+yref+1.0))
!!    write(3,'(A,I6,A,I2,4F10.2,A,I6,I6,I6,I6)') 'Visi ',i,' **thread** ',ithread &
!!      & ,u,v,usup,vsup,' bound ',ixm,ixp,iym,iyp
    !
    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
      if (iyp.gt.my) then
        Print *,'IYP ',iyp,' > MY ',my
        iyp = my
      endif
      do iy=iym,iyp
        dv = v-mapy(iy)
        if (abs(dv).le.vsup) then
          iv = nint(dv*vfac+vbias)
          do ix=ixm,ixp
            du = u-mapx(ix)
            if (abs(du).le.usup) then
              iu = nint(du*ufac+ubias)
              res = ubuff(iu)*vbuff(iv)
              iou = 1
              iin = io
              do ic=1,nc
                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                  visi(iin,i)*result*res
                iou = iou+1
                iin = iin+1
                mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                  visi(iin,i)*resima*res
                iou = iou+1
                iin = iin+2
              enddo
              ! Beam
              mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
     &                res*result
            endif
          enddo
        endif
      enddo
    endif
    !
    ! Borderline case: use symmetry
    u = -u
    v = -v
    resima = -resima
    if (v.le.vsup) then
      ixp = int((u-usup)/xinc+xref+1.0)
      ixm = int((u+usup)/xinc+xref)
      iym = int((v-vsup)/yinc+yref)
      iyp = min(my,int((v+vsup)/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
        if (iyp.gt.my) then
          Print *,'IYP ',iyp,' > MY ',my
          iyp = my
        endif
        do iy=iym,iyp
          dv = v-mapy(iy)
          if (abs(dv).le.vsup) then
            iv = nint(dv*vfac+vbias)
            do ix=ixm,ixp
              du = u-mapx(ix)
              if (abs(du).le.usup) then
                iu = nint(du*ufac+ubias)
                res = ubuff(iu)*vbuff(iv)
                iou = 1
                iin = io
                do ic=1,nc
                  mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                    visi(iin,i)*result*res
                  iou = iou+1
                  iin = iin+1
                  mpa (iou,ix,iy,ithread) = mpa (iou,ix,iy,ithread) +   &
     &                    visi(iin,i)*resima*res
                  iou = iou+1
                  iin = iin+2
                enddo
                ! Beam
                mpa (iou,ix,iy,ithread) = mpa(iou,ix,iy,ithread) +   &
     &                  res*result
              endif
            enddo
          endif
        enddo
      endif
    endif
  enddo
  !
  enddo
  !$OMP END DO
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Gridding -- Elapsed ',elapsed
  !
  ! Fill Map array
  !$OMP DO
  do iy=1,my
    map(:,:,iy) = mpa(:,:,iy,1)
    do it=2,mthread
      map(:,:,iy) = map(:,:,iy) + mpa(:,:,iy,it)
    enddo
  enddo
  !$OMP END DO
  !
  ! Apply symmetry
  !$OMP DO
  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
  !$OMP END DO
  !$  elapsed_e = omp_get_wtime()
  elapsed = elapsed_e - elapsed_s
  write(*,'(A,F9.2)') 'I-DOFFT, Finished Gridding -- Elapsed ',elapsed
  !$OMP END PARALLEL
  !
  ! 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_parallel_v_true2
!
subroutine big_wait(n,b)
  real, intent(inout) :: b
  integer, intent(in) :: n
  integer i
  real a
  logical error
  !
  integer, save :: j=0
  !
  real(8), parameter :: pi=3.141592653589793d0
  !
  b = 0
  do i=1,n
    a = i*pi/n
    b = b+cos(a)
  enddo
  if (j.ne.n) print *,'MY_wait ',n,b
  j = n
end subroutine big_wait
