!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module uv_residual
  use gbl_message
  !
  public :: uv_residual_comm,uv_residual_main
  private
  !
contains
  !
  subroutine uv_residual_comm(line,error)
    use gkernel_interfaces
    use file_buffers
    use uv_buffers
    use clean_buffers
    use uvmap_buffers, only: uvmap_prog
    !$ use omp_lib
    !------------------------------------------------------------------------
    ! Support routine for command UV_RESIDUAL
    !     Remove all Clean Components from a UV Table
    !
    ! Input :
    !     a precessed UV table
    !     a list of Clean Components, in DCCT format
    !      i.e. (x,y,v)(iplane,icomponent)
    !     this organisation is not efficient, and one may need to switch to
    !           (x,y,v,)(icomponent,iplane)
    !     which is more easily transmitted
    ! Output :
    !     a precessed, rotated, shifted UV table, sorted in V,
    !     ordered in (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
    !------------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    real, pointer :: duv_previous(:,:),duv_next(:,:)
    character(len=*), parameter :: rname='UV_RESIDUAL'
    !
    if (uvmap_prog%nfields.ne.0) then
       call map_message(seve%w,rname,'UV data is a Mosaic - UNDER TESTS !!!')
    endif
    !
    nullify(duv_previous,duv_next)
    !
    call uv_residual_main(rname,line,duv_previous,duv_next,.false.,error)
    if (error) return
    !
    ! Clean the allocated stuff here to keep only the residual...
    call uv_clean_buffers(duv_previous, duv_next,error)
    if (error) return
    !
    if (allocated(uvtb%data)) deallocate (uvtb%data)            ! UV data not plotted
    uv_plotted = .false.
    !
    ! Indicate optimization and save status
    optimize(code_save_uv)%change = optimize(code_save_uv)%change + 1
    save_data(code_save_uv) = .true.
    !
    ! Not needed here: weights are unchanged
    ! do_weig = .true.  ! Recompute weight 
    !
    ! Resize UV data and redefine SIC variables 
    huv%gil%nvisi = ubound(duv,2)
    huv%gil%dim(2) = huv%gil%nvisi
    !
    call sic_delvariable ('UV',.false.,error)
    call sic_def_real ('UV',duv,huv%gil%ndim,huv%gil%dim,.true.,error)
  end subroutine uv_residual_comm
  !
  subroutine uv_residual_main(rname,line,duv_previous,duv_next,do_clean,error)
    use phys_const, only: pi
    use image_def
    use gkernel_interfaces
    use mapping_primary
    use uvmap_tool
    use uvmosaic_tool, only: mosaic_sort
    use uv_buffers
    use uvmap_buffers
    use clean_buffers
    !$ use omp_lib
    !------------------------------------------------------------------------
    ! Remove all Clean Components from a UV Table
    !
    ! Input :
    !     a precessed UV table
    !     a list of Clean Components, in DCCT format
    !      i.e. (x,y,v)(iplane,icomponent)
    !     this organisation is not efficient, and one may need to switch to
    !           (x,y,v,)(icomponent,iplane)
    !     which is more easily transmitted
    ! Output :
    !     a precessed, rotated, shifted UV table, sorted in V,
    !     ordered in (U,V,W,D,T,iant,jant,nchan(real,imag,weig))
    !------------------------------------------------------------------------
    character(len=*), intent(in)    :: rname
    character(len=*), intent(in)    :: line
    real, pointer,    intent(out)   :: duv_previous(:,:)
    real, pointer,    intent(out)   :: duv_next(:,:)
    logical,          intent(in)    :: do_clean
    logical,          intent(inout) :: error
    !
    real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
    !
    real(8) :: freq
    real :: cpu0, cpu1
    integer :: ier,nu,nv,nchan
    !
    real, pointer :: duv_in(:,:),duv_out(:,:)
    real, allocatable :: ccou(:,:,:),lduv(:,:)
    integer, allocatable :: mic(:)
    integer :: maxic,ic,lc,icmax,oic,olc,istep,iv,ichan
    integer :: othread,nthread,ithread,sblock
    logical :: fast
    real(8) :: elapsed_s,elapsed_e,elapsed
    real(4) :: rmega
    ! For mosaics
    real(4) :: beamp(3),bsize
    integer :: ifield, jfield,nfields ! Field number & Number of fields
    real, allocatable :: doff(:,:)    ! Field offsets
    integer, allocatable :: ivoff(:)  ! Input Visibility pointers
    integer, allocatable :: jvoff(:)  ! Output Visibility pointers
    integer :: mv ! Maximum number of Visibilities per field
    integer :: ivstart,ivend,kvstart,kvend
    logical :: sorted,shift
    real(8) :: new(3)
    real(4) :: uvmin,uvmax
    logical, parameter :: fromressection=.true.
    !
    character(len=message_length) :: mess
    !
    nu = huv%gil%dim(1)
    nv = huv%gil%dim(2)
    nchan = huv%gil%nchan !! (nu-7)/3
    ic = 1
    lc = nchan
    ithread = 1
    nthread = 1
    elapsed_e = 0.
    elapsed_s = 0.
    elapsed = 0.
    error = .false.
    !
    beamp(:) = 0.
    !
    ! Subtract all Clean Components
    if (.not.associated(duv)) then
       call map_message(seve%e,rname,'DUV is NOT allocated')
       error = .true.
       return
    endif
    if (.not.allocated(cct%data)) then
       call map_message(seve%e,rname,'DCCT is NOT allocated')
       error = .true.
       return
    endif
    !
    maxic = cct%head%gil%dim(3)
    call sic_i4(line,0,1,maxic,.false.,error)
    if (error) return
    if (maxic.lt.0) maxic = cct%head%gil%dim(3)
    maxic = min(cct%head%gil%dim(3),maxic)
    if (maxic.eq.0) return ! Nothing to do then...
    !
    allocate (mic(nchan),stat=ier)
    if (ier.ne.0) then
       call map_message(seve%e,rname,'Memory allocation error')
       error = .true.
       return
    endif
    !
    ! Compact the Clean components first
    cct%head%r3d => cct%data
    call uv_clean_sizes(cct%head,cct%head%r3d,mic,ic,lc)
    icmax = maxval(mic)
    !
    ! Nothing to do if not Clean component
    if (icmax.eq.0) then
       call map_message(seve%w,rname,'No valid Clean Component')
       return
    endif
    !
    fast = .true.
    call sic_get_logi('FAST',fast,error)
    error = .false.
    !
    call gag_cpu(cpu0)
    !
    if (uvmap_prog%nfields.ne.0) then
       shift = .false.
       sorted = .false.
       error = .false.
       call mosaic_sort(error,sorted,shift,new,uvmax,uvmin, &
            & huv%gil%column_pointer(code_uvt_xoff), &
            & huv%gil%column_pointer(code_uvt_yoff), &
            & nfields,doff,ivoff)
       if (error) return
       allocate(jvoff(nfields+1),stat=ier)
       if (ier.ne.0) then
          call map_message(seve%e,rname,'Memory allocation error')
          error = .true.
          return
       endif
       !
       ! Compute max number of visibilities per field
       mv = 0
       do ifield=1,nfields
          mv  = max(mv,ivoff(ifield+1)-ivoff(ifield))
       enddo
       !
       ! Get primary beam size
       call get_bsize(huv,rname,' ',fromressection,bsize,error)
       !
       if (selected_fieldsize.ne.0) then
          if (.not.allocated(selected_fields)) then
             call map_message(seve%f,rname, &
                  & 'Programming error, Selected_Fields not allocated')
             error = .true.
             return
          endif
          nv = 1
          do jfield=1,selected_fieldsize
             ifield = selected_fields(jfield)
             jvoff(jfield) = nv
             nv = nv + ivoff(ifield+1)-ivoff(ifield)
             jvoff(jfield+1) = nv
          enddo
          nv = nv-1
          nfields = selected_fieldsize
       else
          jvoff = ivoff
       endif
    else
       nfields = 1
       allocate(doff(2,1),ivoff(2),jvoff(2),stat=ier)
       doff = 0.0
       bsize = 0.
       ivoff(1) = 1
       ivoff(2) = nv+1
       jvoff = ivoff
       mv = nv
    endif
    !
    ! Prepare appropriate array...
    nullify (duv_previous, duv_next)
    call uv_find_buffers(rname,nu,nv,duv_previous, duv_next,error)
    if (error) then
       call map_message(seve%e,rname,'Cannot set buffer pointers')
       return
    endif
    !
    ! Redo that by block - At this stage NFIELDS is the actual number
    ! of selected fields.
    !
    oic = ic    ! This must be 1
    olc = lc    ! This must be nchan
    !
    ! Divide in as many blocks as threads
    othread = 1
    !$  othread = omp_get_max_threads()
    nthread = min(othread,nchan)
    !
    ! Parallelism is most appropriate per plane
    if (nthread.gt.nfields .and. fast) then
       !$  call omp_set_num_threads(nthread)
       !
       ! The code here is for Mosaics
       !   - identification of the Visiblity Ranges 
       !   - Loop over all fields
       !   - Replaced loop over 1,NV  by  IvStart,IvEnd for each range    !
       !   - Multiply the CCT Table by appropriate primary beam,
       !     after squeezing of course - This is done in the
       !     uv_removes and uv_removes_clean routines, by 
       !     additional arguments (0 if no beam),
       !     as the values of CCT are used there only.
       ! 
       ! The loop is done by using Pointers
       !     DUV_IN  => DUV(:,IvStart:IvEnd)
       ! and DUV_OUT => DUV_NEXT(:,IvStart:IvEnd)
       deallocate(mic)
       !
       ! With this formula, we need as much work space as the original
       ! UV data set - That may be huge...
       istep = (nchan+nthread-1)/nthread      
       ! Here we limit to SPACE_MAPPING per thread
       ! The FFT size is not accounted for, however, in either case...
       ier = sic_ramlog('SPACE_MAPPING',rmega)
       sblock = max(int(256.0*rmega*1024.0)/(3*(nv+icmax)),1)
       istep = min(istep,sblock)
       !
       ! Allocate to Max number of visibilities...
       allocate(mic(istep),ccou(3,icmax,istep),lduv(1:7+3*istep,mv),stat=ier)
       if (ier.ne.0) then
          call map_message(seve%e,rname,'Memory allocation error')
          error = .true.
          return
       endif
       !
       do jfield=1,nfields
          ifield = selected_fields(jfield)
          ivstart = ivoff(ifield)      ! Starting Visibility of field
          ivend   = ivoff(ifield+1)-1  ! Ending Visibility of field
          kvstart = jvoff(jfield)      ! Starting Visibility of field
          kvend   = jvoff(jfield+1)-1  ! Ending Visibility of field
          write(mess,'(A,I0,A)') 'Processing field # ',ifield
          call map_message(seve%i,rname,mess)
          nv = ivend-ivstart+1
          duv_in => duv(:,ivstart:ivend)
          duv_out => duv_next(:,kvstart:kvend)
          beamp(1) = bsize
          beamp(2) = doff(1,ifield)
          beamp(3) = doff(2,ifield)
          !
          !$OMP PARALLEL DEFAULT(NONE) &
          !$OMP SHARED(oic,olc,istep,nchan,nthread,fast, beamp) &
          !$OMP SHARED(nv,elapsed_s,elapsed_e,elapsed) &
          !$OMP SHARED(dirty,huv,cct,duv_next,duv) PRIVATE(ccou,lduv) &
          !$OMP PRIVATE(iv,ic,lc,ichan,icmax,mic,freq,ithread) &
          !$OMP SHARED(duv_in,duv_out,ifield) &
          !$OMP SHARED(clean,do_clean)
          !
          !$ ithread = omp_get_thread_num()+1
          !$ elapsed_s = omp_get_wtime()
          !$OMP DO SCHEDULE(DYNAMIC)
          do ic=oic,olc,istep
             lc = min(ic+istep-1,nchan)
             ichan = lc-ic+1
             call uv_clean_sizes(cct%head,cct%head%r3d,mic,ic,lc)
             icmax = maxval(mic(1:ichan))
             !
             if (icmax.ne.0) then
                call uv_squeeze_clean(ichan,cct%head%r3d,ccou, mic(1:ichan),ic,lc)
                freq = gdf_uv_frequency(huv,0.5d0*(ic+lc))
                if (.not.fast) then
                   call uv_removes_clean(huv,duv_in,lduv,lc-ic+1,mic(1:ichan), &
                        ccou,freq,ic,lc,beamp)
                else
                   call uv_removef_clean(dirty%head,duv_in,lduv,lc-ic+1,mic(1:ichan), &
                        ccou,freq,ic,lc,beamp)
                endif
                !
                ! Plunge it in the output UV data
                do iv=1,nv
                   duv_out(8+3*(ic-1):10+3*(lc-1),iv) = lduv(8:10+3*(lc-ic),iv)
                enddo
                !
                ! Compute the CLEAN image
                if (do_clean) then
                   call generate_clean(clean%head,oic,olc,ccou,mic)
                endif
             else
                do iv=1,nv
                   duv_out(8+3*(ic-1):10+3*(lc-1),iv) = duv_in(8+3*(ic-1):10+3*(lc-1),iv) 
                enddo
             endif
             !
          enddo
          !$OMP END DO
          !$OMP END PARALLEL
          !
          ! Put trailing columns if any
          if (huv%gil%lcol.lt.huv%gil%dim(1)) then
             do iv=1,nv
                ! Already done !          duv_out(1:7,iv) = duv_in(1:7,iv)
                duv_out(huv%gil%lcol+1:huv%gil%dim(1),iv) = &
                     & duv_in(huv%gil%lcol+1:huv%gil%dim(1),iv)  
             enddo
          endif
       enddo ! Loop on fields
       !$  call omp_set_num_threads(othread)
       !$  elapsed_e = omp_get_wtime()
       !$  elapsed = elapsed_e - elapsed_s
    else
       !
       ! Simple sequential stuff - parallelism is inside the
       !   uv_remove_...  subroutines to avoid memory issues
       allocate(ccou(3,icmax,nchan),stat=ier)
       if (ier.ne.0) then
          call map_message(seve%e,rname,'Memory allocation error')
          error = .true.
          return
       endif
       call uv_squeeze_clean(nchan,cct%head%r3d,ccou, mic,ic,lc)
       freq = gdf_uv_frequency(huv,0.5d0*(ic+lc))
       !
       do jfield=1,nfields
          ifield = jfield
          if (selected_fieldsize.ne.0) ifield = selected_fields(jfield)
          ivstart = ivoff(ifield)      ! Starting Visibility of field
          ivend   = ivoff(ifield+1)-1  ! Ending Visibility of field
          kvstart = jvoff(jfield)      ! Starting Visibility of field
          kvend   = jvoff(jfield+1)-1  ! Ending Visibility of field
          write(mess,'(A,I0,A)') 'Processing field # ',ifield
          call map_message(seve%i,rname,mess)
          nv = ivend-ivstart+1
          duv_in => duv(:,ivstart:ivend)
          duv_out => duv_next(:,kvstart:kvend)
          beamp(1) = bsize
          beamp(2) = doff(1,ifield)
          beamp(3) = doff(2,ifield)
          !
          if (.not.fast) then
             call uv_removes_clean(huv,duv_in,duv_out,lc-ic+1,mic, &
                  & ccou,freq,ic,lc,beamp)
          else
             call uv_removef_clean(dirty%head,duv_in,duv_out,lc-ic+1,mic, &
                  & ccou,freq,ic,lc,beamp)
          endif
          !
          ! Add trailing data if any
          if (huv%gil%lcol.lt.huv%gil%dim(1)) then
             do iv=1,nv
                duv_out(huv%gil%lcol+1:huv%gil%dim(1),iv) = &
                     & duv_in(huv%gil%lcol+1:huv%gil%dim(1),iv)  
             enddo
          endif
       enddo
       !
       ! Compute the CLEAN image
       if (do_clean) then
          call generate_clean(clean%head,oic,olc,ccou,mic)
       endif
    endif
    !
    call gag_cpu(cpu1)
    if (elapsed.eq.0) then
       write(mess,102) 'Finished Residual CPU ',cpu1-cpu0
    else
       write(mess,102) 'Finished Residual Elapsed ',elapsed,'; CPU ',cpu1-cpu0
    endif
    call map_message(seve%i,rname,mess)
    !
    if (allocated(lduv)) deallocate(lduv)
    if (allocated(ccou)) deallocate(ccou)
    !
102 format(a,f9.2,a,f9.2)
  end subroutine uv_residual_main
  !
  subroutine generate_clean(hmap,first,last,ccou,mic)
    use image_def
    use clean_buffers
    use cct_types
    !------------------------------------------------------------------------------
    ! 
    !-----------------------------------------------------------------
    type(gildas), intent(inout) :: hmap
    integer,      intent(in) :: first
    integer,      intent(in) :: last
    real,         intent(in) :: ccou(:,:,:)  ! (x,y,value),Component,Plane
    integer,      intent(in) :: mic(:)       ! niter per plane
    !
    integer :: iplane,jplane,niter,miter,i,ier
    real, pointer :: p_clean(:,:)
    type (cct_par), allocatable :: p_cct(:)
    !
    logical :: error
    !
    miter = maxval(mic)
    allocate (p_cct(miter),stat=ier)
    !
    do iplane = first, last
       clean_prog%iplane = iplane
       p_clean =>  hmap%r3d(:,:,iplane)
       !
       ! Recover the component list in pixels
       jplane = iplane-first+1
       niter = mic(jplane) 
       do i=1,niter
          if (ccou(3,i,jplane).eq.0) then
             p_cct(i)%value = 0 ! Required
             niter = i-1
             exit
          else
             !
             ! The NINT is required because of rounding errors
             p_cct(i)%ix = nint( (ccou(1,i,jplane)-hmap%gil%convert(2,1)) /  &
                  &        hmap%gil%convert(3,1) + hmap%gil%convert(1,1))
             p_cct(i)%iy = nint( (ccou(2,i,jplane)-hmap%gil%convert(2,2)) /  &
                  &        hmap%gil%convert(3,2) + hmap%gil%convert(1,2))
             p_cct(i)%value = ccou(3,i,jplane)
          endif
       enddo
       ! Stupid test
       if (niter.gt.0) then
          clean_prog%n_iter = niter
          call clean_make(clean_prog,hmap,p_clean,p_cct)
       else
          p_clean = 0
       endif
    enddo
    deallocate(p_cct)
    hmap%file = 'toto.lmv-clean'
    call gdf_write_image(hmap,hmap%r3d,error)
  end subroutine generate_clean
end module uv_residual
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
