!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module clean_beam_tool
  use gbl_message
  !
  public :: beam_plane,beam_for_channel,get_beam,find_sidelobe
  public :: init_convolve,convolve
  private
  !
contains
  !
  subroutine beam_plane(method,hbeam,hdirty)
    use image_def
    use clean_types
    !----------------------------------------------------------------
    ! Define beam plane and check if fit is required
    !----------------------------------------------------------------
    type(clean_par), intent(inout) :: method
    type(gildas),    intent(in)    :: hbeam
    type(gildas),    intent(in)    :: hdirty ! Used to figure out which plane
    !
    integer :: ibeam
    !
    ! Check if beam parameters must be recomputed
    if (hbeam%gil%dim(4).le.1) then
       method%ibeam = 1
    else
       ! Cannot set method%ibeam  directly ?
       ibeam = beam_for_channel(method%iplane,hdirty,hbeam)
       !!call map_message(seve%w,'CLEAN','Recomputing the beam parameters')
       method%ibeam = ibeam
       !! print *,'IBEAM ',method%ibeam,'... '
    endif
  end subroutine beam_plane
  !
  function beam_for_channel(iplane,hdirty,hbeam)
    use image_def
    !----------------------------------------------------------------
    !
    !----------------------------------------------------------------
    integer                  :: beam_for_channel ! intent(out)
    type(gildas), intent(in) :: hdirty
    type(gildas), intent(in) :: hbeam
    integer,      intent(in) :: iplane
    !
    integer :: ibeam,nstep
    real(8) :: i_freq
    !
    if (hbeam%gil%dim(4).le.1) then
       beam_for_channel = 1
    else
       nstep = hdirty%gil%dim(3) / hbeam%gil%dim(4)
       if (hbeam%gil%dim(4)*nstep.ne.hdirty%gil%dim(3)) nstep = nstep+1
       ibeam = (iplane+nstep-1)/nstep
       !!print *,'Approximate Beam channel ',ibeam,' for ',iplane
       ! This may be the better way of doing it:
       i_freq = (iplane-hdirty%gil%ref(3))*hdirty%gil%fres + hdirty%gil%freq
       ! i_freq = (ibeam-hbeam%gil%ref(4))*hbeam%gil%fres + hbeam%gil%freq
       ibeam = nint((i_freq-hbeam%gil%freq)/hbeam%gil%fres + hbeam%gil%ref(4))
       !!print *,'Nearest Beam channel ',ibeam,' for ',iplane
       ibeam = min(max(1,ibeam),hbeam%gil%dim(4)) ! Just  in case
       !
       beam_for_channel = ibeam
    endif
  end function beam_for_channel
  !
  subroutine get_beam(method,hbeam,hresid,hprim,tfbeam,w_work,w_fft,fhat,error,mask)
    use image_def
    use gkernel_interfaces
    use minmax_tool, only: maxmap
    use clean_types
    !-----------------------------------------------------------------
    ! Get beam related information
    !-----------------------------------------------------------------
    type(clean_par),   intent(inout) :: method
    type(gildas),      intent(in)    :: hbeam
    type(gildas),      intent(in)    :: hresid
    type(gildas),      intent(in)    :: hprim
    real,              intent(inout) :: tfbeam(hbeam%gil%dim(1),hbeam%gil%dim(2),hbeam%gil%dim(3))
    complex,           intent(inout) :: w_work(hbeam%gil%dim(1),hbeam%gil%dim(2))
    real,              intent(inout) :: fhat,w_fft(:)
    logical,           intent(inout) :: error
    logical, optional, intent(inout) :: mask(:,:)
    !
    ! Note that HRESID is unused here...
    logical :: do_fft
    integer :: ip,ib,nx,ny,np,nb
    integer :: ix_min,ix_max,iy_min,iy_max
    real :: beam_min,beam_max,beam_area,f
    real, pointer :: d2beam(:,:)      ! Beam (single field & frequency)
    real, pointer :: d3prim(:,:,:)    ! Primary beams (per frequency)
    real, pointer :: d3beam(:,:,:)    ! Dirty beam (per frequency)
    real, pointer :: weight(:,:,:)
    character(len=message_length) :: chain
    character(len=*), parameter :: rname='GET>BEAM'
    !
    nx = hbeam%gil%dim(1)
    ny = hbeam%gil%dim(2)
    np = hbeam%gil%dim(3)
    nb = hbeam%gil%dim(4)
    !
    weight=> method%weight
    do_fft = method%method.ne.'HOGBOM' .and. method%method.ne.'MX'
    !
    if (method%mosaic) then
       if (.not.present(mask)) then
          call map_message(seve%f,rname,'Programming error: Missing MASK argument with MOSAIC mode')
          error = .true.
          return
       endif
       !
       d3beam => hbeam%r4d(:,:,:,method%ibeam)
       !
       np = hprim%gil%dim(1)
       !
       ! Analyze beam
       do ip = 1,np
          if (method%verbose) then
             write(chain,101) 'Field ',ip,'/',np
             call map_message(seve%i,rname,chain)
          endif
          call maxmap(d3beam(:,:,ip),nx,ny,method%bzone,&
               beam_max,ix_max,iy_max,beam_min,ix_min,iy_min)
          if (method%verbose) then
             write(chain,'(A,1PG10.3,A,I6,I6,A,1PG10.3,A,I6,I6)') &
                  'Beam max. ',beam_max,' at ',ix_max,iy_max,  &
                  ', Min. ',beam_min,' at ',ix_min,iy_min
             call map_message(seve%i,rname,chain)
          endif
          if (do_fft) then
             call init_convolve(ix_max,iy_max,nx,ny,   &
                  d3beam(:,:,ip),w_work,beam_area,w_fft)
             tfbeam(:,:,ip) = real(w_work)
             if (method%verbose) then
                write(chain,102) 'Beam area is ',beam_area
                call map_message(seve%i,rname,chain)
             endif
          endif
          !
          ! Prussian Hat - NOT SUPPORTED HERE
       enddo
       !
       if (method%method.ne.'HOGBOM') then
          call mos_sidelobe(d3beam(:,:,1),nx,ny,ix_max,iy_max,   &
               method%patch(1),method%patch(2),method%bgain,np)
          write(chain,102) 'Sidelobe is ',method%bgain
          call map_message(seve%i,rname,chain)
       endif
       !
       ! Define the weight function and truncate the mask
       do ib=1,nb
          d3prim => hprim%r4d(:,:,:,ib)
          call set_weight(nx,ny,np,weight(:,:,ib),d3prim,mask,   &
               method%search,method%restor,method%trunca)
       enddo
    else
       d2beam  => hbeam%r4d(:,:,1,method%ibeam)
       if (method%verbose) then
          print *,'Beam center ',hbeam%r4d(nx/2+1,ny/2+1,1,method%ibeam)
       endif
       !
       ! Simple case
       call maxmap(d2beam,nx,ny,method%bzone,   &
            beam_max,ix_max,iy_max,   &
            beam_min,ix_min,iy_min)
       if (method%verbose) then
          write(chain,'(A,1PG10.3,A,I6,I6,A,1PG10.3,A,I6,I6)') &
               'Beam max. ',beam_max,' at ',ix_max,iy_max,  &
               ', Min. ',beam_min,' at ',ix_min,iy_min
          call map_message(seve%i,rname,chain)
       endif
       if (beam_max.eq.0.0) then
          call map_message(seve%w,rname,'Beam is empty')
          error = .true.
          return
       endif
       call comshi(d2beam,nx,ny,ix_max,iy_max,method%bshift)
       if (do_fft) then
          call init_convolve(ix_max,iy_max,nx,ny,   &
               d2beam,w_work,beam_area,w_fft)
          tfbeam(:,:,1)  = real(w_work)
          if (method%verbose) then
             write(chain,102) 'Beam area is ',beam_area
             call map_message(seve%i,rname,chain)
          endif
       endif
       !
       ! Prussian Hat
       if (method%phat.ne.0) then
          d2beam(ix_max,iy_max) = d2beam(ix_max,iy_max) + method%phat
          f = 1.0/d2beam(ix_max,iy_max)
          d2beam(:,:) = d2beam*f
       else
          f = 1.0
       endif
       !
       if (method%method.ne.'HOGBOM') then
          call find_sidelobe (d2beam,nx,ny,ix_max,iy_max,   &
               method%patch(1),method%patch(2),method%bgain)
          write(chain,102) 'Sidelobe is ',method%bgain
          call map_message(seve%i,rname,chain)
       endif
    endif
    method%beam0 = (/ix_max,iy_max/)
    if (method%phat.ne.0) fhat = f
    error = .false.
    return
    !
101 format(a,i3,a,i3)
102 format(a,1pg10.3,a,i6,i6)
  end subroutine get_beam
!
subroutine set_weight(nx,ny,np,weight,primary,mask,wsear,wrest,wmin)
  !---------------------------------------------------
  ! Set the mosaic weights
  !---------------------------------------------------
  integer, intent(in) :: nx  ! X size
  integer, intent(in) :: ny  ! Y size 
  integer, intent(in) :: np  ! Number of pointings
  real, intent(out) ::  weight(nx,ny)     ! Weight map
  real, intent(in) ::  primary(np,nx,ny)  ! Primary beams
  real, intent(in) ::  wsear              ! Search threshold
  real, intent(in) ::  wrest              ! Restore threshold   
  real, intent(in) ::  wmin               ! Minimum beal value  
  logical, intent(inout) ::  mask(nx,ny)  ! Search mask
  !
  real wr,ws2,wr2
  integer i,j,ip
  character(len=80) :: chain
  !
  write(chain,'(A,1pg10.3,1x,1pg10.3,1x,1pg10.3)') &
      &   'Thresholds ',wsear,wrest,wmin
  call map_message(seve%i,'CLEAN',chain)
  wr2 = wrest                  !*WREST
  ws2 = wsear
  !
  ! Compute the "weigt" function 1/N
  do j=1,ny
    do i=1,nx
      wr = 0.0
      do ip=1,np
        if (primary(ip,i,j).gt.wmin) then
          wr = wr+primary(ip,i,j)*primary(ip,i,j)
        endif
      enddo
      ! Cut the search mask
      if (wr.le.ws2) mask(i,j) = .false.
      ! Cut the restore area if it is not a search area also
      if (wr.le.wr2 .and. .not.mask(i,j)) wr = 0.0
      ! Convert to the 1/N function
      if (wr.ne.0.0) then
        weight(i,j) = 1.0/sqrt(wr)
      else
        weight(i,j) = 0.0
      endif
    enddo
  enddo
end subroutine set_weight
  !
  subroutine comshi(beam,nx,ny,ix,iy,shift)
    !-----------------------------------------------------
    ! Shift beam if needed
    !-----------------------------------------------------
    integer, intent(in)  :: nx,ny       ! X,Y Size
    integer, intent(in)  :: ix,iy       ! Position of maximum
    real,    intent(in)  :: beam(nx,ny) ! Beam
    integer, intent(out) :: shift(3)    ! Shift information
    !
    real :: tol
    !
    ! Attempt to find where is the true maximum of the (SYMMETRIC) beam
    ! based on a fit by a parabola in 9 points around maximum
    !
    tol = 1e-4*beam(ix,iy)
    shift(3) = 1
    if (abs(beam(ix-1,iy-1)-beam(ix+1,iy+1)).lt.tol) then
       shift(1) = 0
       shift(2) = 0
       shift(3) = 0
    elseif (abs(beam(ix+1,iy+1)-beam(ix,iy)).lt.tol) then
       shift(1) = 1
       shift(2) = 1
    elseif (abs(beam(ix-1,iy-1)-beam(ix,iy)).lt.tol) then
       shift(1) = -1
       shift(2) = -1
    elseif (abs(beam(ix+1,iy-1)-beam(ix,iy)).lt.tol) then
       shift(1) =  1
       shift(2) = -1
    elseif (abs(beam(ix-1,iy+1)-beam(ix,iy)).lt.tol) then
       shift(1) = -1
       shift(2) = 1
    elseif (abs(beam(ix+1,iy-1)-beam(ix,iy+1)).lt.tol) then
       shift(1) = 1
       shift(2) = 0
    elseif (abs(beam(ix-1,iy-1)-beam(ix,iy+1)).lt.tol) then
       shift(1) = -1
       shift(2) = 0
    elseif (abs(beam(ix-1,iy-1)-beam(ix+1,iy)).lt.tol) then
       shift(1) = 0
       shift(2) = -1
    elseif (abs(beam(ix-1,iy+1)-beam(ix+1,iy)).lt.tol) then
       shift(1) = 0
       shift(2) = 1
    else
       call map_message(seve%w,'SHIFT','Unknown beam symmetry')
       shift(1) = 0
       shift(2) = 0
       shift(3) = 0
    endif
  end subroutine comshi
  !
  subroutine find_sidelobe(beam,nx,ny,i0,j0,nxp,nyp,bgain)
    !----------------------------------------------------------------------
    ! Find the maximum sidelobe outside the beam patch defined by the beam
    ! center (I0,J0) and patch size (NXP,NYP)
    !----------------------------------------------------------------------
    integer, intent(in)  :: nx          ! X size
    integer, intent(in)  :: ny          ! Y size
    real,    intent(in)  :: beam(nx,ny) ! Input beam
    integer, intent(in)  :: i0          ! X beam center
    integer, intent(in)  :: j0          ! Y beam center
    integer, intent(in)  :: nxp         ! X beam patch
    integer, intent(in)  :: nyp         ! Y beam patch
    real,    intent(out) :: bgain       ! Maximum sidelobe
    !
    integer :: i,j
    real :: bmax,bmin
    !
    ! Compute maximum sidelobe
    bmax = beam(1,1)
    bmin = beam(1,1)
    do j = 1,j0-nyp
       do i = 1,nx
          if (beam(i,j).gt.bmax) then
             bmax = beam(i,j)
          elseif (beam(i,j).lt.bmin) then
             bmin = beam(i,j)
          endif
       enddo
    enddo
    do j = max(1,j0-nyp+1),min(ny,j0+nyp-1)
       do i = 1,i0-nxp
          if (beam(i,j).gt.bmax) then
             bmax = beam(i,j)
          elseif (beam(i,j).lt.bmin) then
             bmin = beam(i,j)
          endif
       enddo
       do i = i0+nxp,nx
          if (beam(i,j).gt.bmax) then
             bmax = beam(i,j)
          elseif (beam(i,j).lt.bmin) then
             bmin = beam(i,j)
          endif
       enddo
    enddo
    do j = j0+nyp,ny
       do i = 1,nx
          if (beam(i,j).gt.bmax) then
             bmax = beam(i,j)
          elseif (beam(i,j).lt.bmin) then
             bmin = beam(i,j)
          endif
       enddo
    enddo
    bgain = max(abs(bmax),abs(bmin))
    bgain = bgain/abs(beam(i0,j0))
  end subroutine find_sidelobe
  !
  subroutine mos_sidelobe(beam,nx,ny,i0,j0,nxp,nyp,bgain,nf)
    !----------------------------------------------------------------------
    ! Find the maximum sidelobe outside the beam patch defined by the beam
    ! center (I0,J0) and patch size (NXP,NYP)
    !
    ! Adapted for Mosaic
    !----------------------------------------------------------------------
    integer :: nx,ny,i0,j0,nxp,nyp,nf
    real    :: beam(nx,ny,nf),bgain
    !
    integer :: i,j,k
    real :: bmax,bmin
    !
    ! Compute maximum sidelobe
    bmax = 0
    bmin = 0
    do k = 1,nf
       do j = 1,j0-nyp
          do i = 1,nx
             if (beam(i,j,k).gt.bmax) then
                bmax = beam(i,j,k)
             elseif (beam(i,j,k).lt.bmin) then
                bmin = beam(i,j,k)
             endif
          enddo
       enddo
       do j = max(1,j0-nyp+1),min(ny,j0+nyp-1)
          do i = 1,i0-nxp
             if (beam(i,j,k).gt.bmax) then
                bmax = beam(i,j,k)
             elseif (beam(i,j,k).lt.bmin) then
                bmin = beam(i,j,k)
             endif
          enddo
          do i = i0+nxp,nx
             if (beam(i,j,k).gt.bmax) then
                bmax = beam(i,j,k)
             elseif (beam(i,j,k).lt.bmin) then
                bmin = beam(i,j,k)
             endif
          enddo
       enddo
       do j = j0+nyp,ny
          do i = 1,nx
             if (beam(i,j,k).gt.bmax) then
                bmax = beam(i,j,k)
             elseif (beam(i,j,k).lt.bmin) then
                bmin = beam(i,j,k)
             endif
          enddo
       enddo
    enddo
    bgain = max(abs(bmax),abs(bmin))
    bgain = bgain/abs(beam(i0,j0,1))
  end subroutine mos_sidelobe
  !
subroutine init_convolve(i0,j0,nx,ny,beam,fbeam,area,work)
  !----------------------------------------------------------------------
  ! Compute the FT of a beam centered on pixel I0,J0
  !----------------------------------------------------------------------
  integer, intent(in) :: nx,ny          ! Problem size
  integer, intent(in) :: i0,j0          ! Position of peak
  complex, intent(out) :: fbeam(nx,ny)  ! TF of beam
  real, intent(in) :: beam(nx,ny)       ! Beam
  real, intent(inout) :: work(*)        ! Work space
  real, intent(out) :: area             ! Beam area
  !
  integer i,j,nn(2),ndim
  real fact
  !
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  fact = 1.0/float(nx*ny)
  do j=1,j0-1
    do i=1,i0-1
      fbeam(i+nx-i0+1,j+ny-j0+1) = cmplx(beam(i,j)*fact,0.0)
    enddo
    do i=i0, nx
      fbeam(i-i0+1,j+ny-j0+1) = cmplx(beam(i,j)*fact,0.0)
    enddo
  enddo
  do j=j0,ny
    do i=1,i0-1
      fbeam(i+nx-i0+1,j-j0+1) = cmplx(beam(i,j)*fact,0.0)
    enddo
    do i=i0,nx
      fbeam(i-i0+1,j-j0+1) = cmplx(beam(i,j)*fact,0.0)
    enddo
  enddo
  call fourt(fbeam,nn,ndim,-1,0,work)
  area = real(fbeam(1,1))/beam(i0,j0)
end subroutine init_convolve
!
subroutine convolve (image,dirty,nx,ny,fbeam,fcomp,wfft)
  use gkernel_interfaces, only : fourt
  !----------------------------------------------------------------------
  ! Convolve an image by a beam through Fourier Transform
  !----------------------------------------------------------------------
  integer, intent(in) :: nx,ny          ! Problem size
  complex, intent(in) :: fbeam(nx,ny)    ! Beam TF
  complex, intent(inout) :: fcomp(nx,ny) ! TF workspace
  real, intent(in) :: image(nx,ny)      ! Input image
  real, intent(out) :: dirty(nx,ny)     ! Convolved image
  real, intent(inout) :: wfft(*)        ! Work area
  !
  integer :: ndim,nn(2)
  !
  ! Reset
  ndim = 2
  nn(1) = nx
  nn(2) = ny
  fcomp = cmplx(image,0.0)
  !
  ! Direct TF
  call fourt(fcomp,nn,ndim,-1,0,wfft)
  !
  ! Multiplication (note normalisation done in FBEAM)
  fcomp = fcomp*fbeam
  !!do j=1,ny
  !!  do i=1,nx
  !!    reel = fbeam(1,i,j)*fcomp(1,i,j) - fbeam(2,i,j)*fcomp(2,i,j)
  !!    imag = fbeam(2,i,j)*fcomp(1,i,j) + fbeam(1,i,j)*fcomp(2,i,j)
  !!    fcomp(1,i,j) = reel
  !!    fcomp(2,i,j) = imag
  !!  enddo
  !!enddo
  !
  ! Reverse TF
  call fourt(fcomp,nn,ndim,1,1,wfft)
  !
  ! Dirty map
  dirty = real(fcomp)
end subroutine convolve
end module clean_beam_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
