subroutine map_convolve_comm(line,error)
  use gildas_def
  use gbl_format
  use phys_const
  use image_def
  use gbl_message
  use gkernel_types
  use gkernel_interfaces
  use imager_interfaces, only : map_message
  !$ use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command  
  !       MAP_CONVOLVE In Out GAUSS  Major Minor PA  
  !       MAP_CONVOLVE In Out BOX  
  !       MAP_CONVOLVE In Out HANNING  
  !       MAP_CONVOLVE In Out KGAUSS Width  
  !       MAP_CONVOLVE In Out USER K_1 .. K_6  
  !       MAP_CONVOLVE In Out NOISE  Threshold Length  
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line  !! Command line
  logical, intent(inout) :: error          !! Logical error flag
  !
  ! Constants
  character(len=*), parameter :: rname = 'MAP_CONVOLVE'
  logical, parameter :: new=.true.
  logical, parameter :: old=.false.
  integer, parameter :: mvoc=6
  character(len=12) :: vocab(mvoc)
  data vocab/'BOX','GAUSS','HANNING','KGAUSS','NOISE','USER'/
  !
  ! Local ---
  character(len=24) :: argum
  character(len=12) :: key, cunit
  character(len=filename_length) :: cinp, cout
  type(gildas) :: hinp, hout
  real(kind=8) :: bmaj,bmin,pa
  real(kind=4) :: bmaj4,bmin4,pa4,thre
  integer(kind=4) :: mpix, ikey
  integer(kind=4) :: i, k, l, n, nx, ny, nxy, ndim, dim(2), mx, my, ier, rank
  complex(kind=4), allocatable :: cdata(:,:)
  real(kind=4), allocatable :: work(:)
  real(kind=4), pointer :: rdata(:,:)
  real(kind=4), allocatable :: rwork(:,:)
  real(kind=4) :: width, weight(6), fact 
  character(len=message_length) :: mess
  type (sic_descriptor_t) :: desc
  logical :: found, inp_image, out_image
  !
  ! Code ----
  call sic_ke(line,0,3,argum,n,.true.,error)
  if (error) return
  call sic_ambigs (rname,argum,key,ikey,vocab,mvoc,error)
  if (error) return
  !
  call sic_ch(line,0,1,cout,n,.true.,error)
  if (error) return
  call sic_ch(line,0,2,cinp,n,.true.,error)
  if (error) return
  !
  ! Method of Smoothing
  select case (key)
  case ('GAUSS')
    key = 'GAUSS'
    !
    call sic_r8(line,0,4,bmaj,.true.,error)
    if (error) return
    bmin = bmaj
    call sic_r8(line,0,5,bmin,.false.,error)
    if (error) return
    pa = 0
    call sic_r8(line,0,6,pa,.false.,error)
    if (error) return
    !
    ! Bmaj & Bmin must be in User units
    !bmaj = bmaj*pi/180/3600
    !bmin = bmin*pi/180/3600
  case ('HANNING')
    weight(1) = 3.
    weight(2) = 2.
    weight(3) = 2.
    weight(4) = 1.
    weight(5) = 1.
    weight(6) = 1.
  case ('KGAUSS')
    call sic_r4(line,0,4,width,.true.,error)
    if (error) return
    fact=-(1.665109/width)**2
    weight(1) = 1.
    weight(2) = exp(fact)
    weight(3) = exp(2.*fact)
    weight(4) = exp(4.*fact)
    weight(5) = exp(5.*fact)
    weight(6) = exp(16.*fact)
  case ('BOX')
    weight(1:6) = 1.
  case ('USER')
    do i=1,6
      call sic_r4(line,0,i+3,weight(i),.true.,error)
      if (error) return
    enddo
  case ('NOISE')
    call sic_r4(line,0,4,thre,.true.,error)
    if (error) return
    call sic_i4(line,0,5,mpix,.true.,error)
    if (error) return
  end select
  !
  ! Now get the data arrays
  ! Input data
  fact = 1.0
  call gildas_null(hinp)
  call get_3d_from_name(rname,cinp,hinp,old,inp_image,error)
  if (error) return
  !
  ! Output data
  call gildas_null(hout)
  hout%gil%ndim = 3
  hout%gil%dim(1:3) = hinp%gil%dim(1:3)
  call get_3d_from_name(rname,cout,hout,new,out_image,error)
  if (error) return
  !
  ! Prepare the output header
  call gdf_copy_header(hinp,hout,error)
  hout%gil%extr_words = 0  ! Disable extrema section
  !
  if (key.eq.'GAUSS') then
    fact = 1.0
    !
    ! Resolution section if present
    if ((hinp%gil%reso_words.gt.0).and.(hinp%gil%majo.gt.0)) then
      if (bmaj.eq.bmin) then
        ! Assume we want to get to this resolution in fact
        call map_message(seve%i,rname,'Attempting to reach User specified resolution')
        if (hinp%gil%majo.gt.bmaj) then
          call map_message(seve%e,rname,'Desired resolution better than available')
          error = .true.
          return
        endif
        !
        ! Adjust the convolving Gaussian
        bmaj = sqrt(bmaj**2-hinp%gil%majo**2)
        bmin = sqrt(bmin**2-hinp%gil%mino**2)
        pa = hinp%gil%posa/rad_per_deg
      else
        call map_message(seve%i,rname,'Convolving by a User specified elliptical Gaussian')
      endif
      !
      ! Verify effective resolution
      bmaj4 = bmaj
      bmin4 = bmin
      pa4 = pa*rad_per_deg
      call gdf_gauss2d_convolution(hout,bmaj4,bmin4,pa4,error)
      if (error)  return
      write(mess,'(A,3(1PG14.7,A))')  &
        'Smoothed beam is ', &
        hout%gil%majo*sec_per_rad,' x ',  &
        hout%gil%mino*sec_per_rad,' sec (PA ', &
        hout%gil%posa*deg_per_rad,' deg)'
      call map_message(seve%i,rname,mess)
      !
      fact = hout%gil%majo*hout%gil%mino/(hinp%gil%majo*hinp%gil%mino)
      !
    else
      cunit = hout%char%unit
      call sic_upper(cunit)
      if (cunit.eq.'JY/BEAM'.or.cunit.eq.'K') then
        call map_message(seve%i,rname,'Convolving to a User specified elliptical Gaussian')
        ! If we start from a Brightness unit, specify spatial resolution
        hout%gil%reso_words = def_reso_words
        hout%gil%majo = bmaj
        hout%gil%mino = bmin
        hout%gil%posa = pa*rad_per_deg
      else
        ! If not, prefer the No Resolution case, as units can be anything
        call map_message(seve%i,rname,'Convolving by a User specified elliptical Gaussian')
        hout%gil%reso_words = 0  ! No valid angular resolution
      endif
    endif
  else
    hout%gil%reso_words = 0    ! No well defined angular resolution
  endif
  !
  ! Convert to a defined brightness unit if the smoothing does not 
  !   preserve a well defined angular resolution
  if (hout%gil%reso_words.eq.0) then
    !
    ! If unit is Jy/beam, convert to Jy/pixel
    cunit = hinp%char%unit
    call sic_upper(cunit)
    if (cunit.eq."JY/BEAM") then
      if (hinp%gil%reso_words.ne.0) & 
        & fact = abs(hinp%gil%inc(1)*hinp%gil%inc(2))/(pi*hinp%gil%majo*hinp%gil%mino)
      hout%char%code = "Jy/pixel"
    endif
  endif
  !
  ! Create output image only if using Block Mode (not yet coded)
  !  if (.not.out_image) then
  !    call gdf_create_image (hout,error)
  !    if (error) return
  !  endif
  !
  mx = hinp%gil%dim(1)
  my = hinp%gil%dim(2)
  !
  nx = 2*mx
  ny = 2*my
  ndim = 2
  dim(1) = nx
  dim(2) = ny
  nxy = nx * ny 
  !
  select case(key)
  case ('GAUSS')
    allocate (work(2*max(nx,ny)), cdata(nx, ny), stat=ier)
    if (ier.ne.0) then
      error = .true.
      return
    endif
    !
    call fourt_plan (cdata,dim,ndim,1,0)
    call fourt_plan (cdata,dim,ndim,-1,1)
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP & SHARED(hinp,hout,dim,ndim,nx,ny,bmin,bmaj,pa,mx,my,fact) &
    !$OMP & PRIVATE(rdata,cdata,work,i,k,l)
    !$OMP DO
    do i=1,hinp%gil%dim(3)
      if (hinp%gil%eval.ge.0) then
        rdata => hout%r3d(:,:,i)
        do k=1,my
          do l=1,mx
            if (abs(hinp%r3d(l,k,i)-hinp%gil%bval).le.hinp%gil%eval) then
              rdata(l,k) = 0.0
            else
              rdata(l,k) = hinp%r3d(l,k,i)
            endif
          enddo
        enddo
      else
        rdata => hinp%r3d(:,:,i)
      endif
      !
      call copyc (mx,my,rdata,nx,ny,cdata)
      call fourt (cdata,dim,ndim,1,0,work)
      call sm_mulgau(cdata,nx,ny,   &
     &        bmaj,bmin,pa,hinp%gil%inc(1),hinp%gil%inc(2))
      call fourt (cdata,dim,ndim,-1,+1,work)
      call copyn (nx,ny,cdata,mx,my,hout%r3d(:,:,i))
      if (fact.ne.1) hout%r3d(:,:,i) = fact*hout%r3d(:,:,i)
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  case ('NOISE')
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP & SHARED(hinp,hout,thre,mpix)  &
    !$OMP & PRIVATE(i)
    !$OMP DO
    do i=1,hinp%gil%dim(3)
        call smo002 (hinp%r3d(:,:,i),        &   ! Input image
   &        hinp%gil%dim(1),hinp%gil%dim(2), &   ! Size
   &        hout%r3d(:,:,i),                 &   ! Output image
   &        thre,                            &   ! Threshold
   &        mpix,      & ! Radius (in pixel) of smoothing disk
   &        hinp%gil%bval,hinp%gil%eval)     ! Blanking values
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  case default
    allocate(rwork(hinp%gil%dim(1),hinp%gil%dim(2)),stat=ier)
    if (ier.ne.0) then
      error = .true.
      return
    endif
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP & SHARED(hinp,hout,weight)  &
    !$OMP & PRIVATE(rwork,i)
    !$OMP DO
    do i=1,hinp%gil%dim(3)
      call smoo001 (hinp%r3d(:,:,i),          &   !Input image
   &        hinp%gil%dim(1),hinp%gil%dim(2),  &   !Size
   &        hout%r3d(:,:,i),                  &   !Output image
   &        hout%gil%bval,hout%gil%eval,      &   !Blanking values
   &        weight,   &              !Smoothing weights
   &        rwork)                   !Work space
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  end select
  !
  if (.not.out_image) then
    call gdf_write_image(hout,hout%r3d,error)
  else
    ! Update the original SIC variable header, including Extrema
    error = .false. 
    hout%loca%addr = locwrd(hout%r3d)   ! Define the address
    hout%loca%size = product(hout%gil%dim(1:3))
    call gdf_get_extrema (hout,error)
    call sic_upper(cout)
    call sic_descriptor(cout,desc,found)
    call gdf_copy_header(hout,desc%head,error)  
  endif
contains
!
subroutine copyc(mx,my,r,nx,ny,c)
  !---------------------------------------------------------------------
  !! IMAGER -- Utility routine  
  !!    Insert Real array R(NX,NY) into Complex array C(MX,MY)
  !!    Only a shift, and NaN set to zero.
  !---------------------------------------------------------------------
  integer :: mx                       !! X size of real array
  integer :: my                       !! Y size of real array
  real :: r(mx,my)                    !! Real array
  integer :: nx                       !! X size of complex array
  integer :: ny                       !! Y size of complex array
  complex :: c(nx,ny)                 !! Complex output array
  !
  ! Local
  integer :: i,j,i0,j0
  !
  c = 0.0
  !
  i0 = nx/2-mx/2
  j0 = ny/2-my/2
  !
  do j=1,my
    do i=1,mx
      ! Avoid NaN
      if (r(i,j).eq.r(i,j)) then
        c(i+i0,j+j0) = r(i,j)
      endif
    enddo
  enddo
end subroutine copyc
!
subroutine copyn(nx,ny,c,mx,my,r)
  !---------------------------------------------------------------------
  !! IMAGER -- Utility routine   
  !!     Extract Real array R(NX,NY) from Complex array C(MX,MY)  
  !!     and normalize it.
  !---------------------------------------------------------------------
  integer :: mx                       !! X size of real array
  integer :: my                       !! Y size of real array
  real :: r(mx,my)                    !! Real output array
  integer :: nx                       !! X size of complex array
  integer :: ny                       !! Y size of complex array
  complex :: c(nx,ny)                 !! Complex input array
  !
  ! Local
  integer :: i,j,i0,j0
  real :: w
  !
  i0 = nx/2-mx/2
  j0 = ny/2-my/2
  !
  w = 1.0/(nx*ny)
  do j=1,my
    do i=1,mx
      r(i,j) = real(c(i+i0,j+j0)) * w
    enddo
  enddo
end subroutine copyn
!
subroutine sm_mulgau(data,nx,ny,bmaj,bmin,pa,x_inc1,x_inc2)
  !---------------------------------------------------------------------
  !*
  ! IMAGER -- Utility routine
  !      Multiply the FT of an image by the FT of
  !       a convolving gaussian function. BMAJ and BMIN are the
  !       widths of the original gaussian. PA is the position angle of major
  !       axis (from north towards east)
  !!
  !---------------------------------------------------------------------
  integer :: nx                       !! X size of complex array
  integer :: ny                       !! Y size of complex array
  complex :: data(nx,ny)              !! Complex array
  real(8) :: bmaj                     !! Major axis
  real(8) :: bmin                     !! Minor axis
  real(8) :: pa                       !! Position angle
  real(8) :: x_inc1                   !! Increment along X
  real(8) :: x_inc2                   !! Increment along Y
  !
  ! Constants
  real(8), parameter :: pi=3.141592653589793d0
  real(4), parameter :: eps=1.e-7
  ! Local ---
  integer :: i,j,nx1,nx2
  real :: amaj,amin,fact,cx,cy,sx,sy
  logical :: norot,rot90
  real(8) :: rpa
  !
  ! Code ---
  norot = ( abs(mod(pa,180.d0)).le.eps)
  rot90 = ( abs(mod(pa,180.d0)-90.d0).le.eps)
  amaj = bmaj*pi/(2.*sqrt(log(2.)))
  amin = bmin*pi/(2.*sqrt(log(2.)))
  rpa = pa*pi/180.d0
  !
  cx = cos(rpa)/nx*amin
  cy = cos(rpa)/ny*amaj
  sx = sin(rpa)/nx*amaj
  sy = sin(rpa)/ny*amin
  !
  ! Convert map units to pixels
  cx = cx / x_inc1
  cy = cy / x_inc2
  sx = sx / x_inc1
  sy = sy / x_inc2
  nx2 = nx/2
  nx1 = nx2+1
  !
  ! Optimised code for Position Angle 0 degrees
  if (norot) then
    do j=1,ny/2
      do i=1,nx2
        fact = (float(j-1)*cy)**2 + (float(i-1)*cx)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
      do i=nx1,nx
        fact = (float(j-1)*cy)**2 + (float(i-nx-1)*cx)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
    enddo
    do j=ny/2+1,ny
      do i=1,nx2
        fact = (float(j-ny-1)*cy)**2 + (float(i-1)*cx)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
      do i=nx1,nx
        fact = (float(j-ny-1)*cy)**2 + (float(i-nx-1)*cx)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
    enddo
    !
    ! Optimised code for Position Angle 90 degrees
  elseif (rot90) then
    do j=1,ny/2
      do i=1,nx2
        fact = (float(i-1)*sx)**2 +(float(j-1)*sy)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
      do i=nx1,nx
        fact = (float(i-nx-1)*sx)**2 + (float(j-1)*sy)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
    enddo
    do j=ny/2+1,ny
      do i=1,nx2
        fact = (float(i-1)*sx)**2 + (float(j-ny-1)*sy)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
      do i=nx1,nx
        fact = (float(i-nx-1)*sx)**2 + (float(j-ny-1)*sy)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
    enddo
    !
    ! General case of a rotated elliptical gaussian
  else
    do j=1,ny/2
      do i=1,nx2
        fact = (float(i-1)*sx + float(j-1)*cy)**2 +   &
     &          (-float(i-1)*cx + float(j-1)*sy)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
      do i=nx1,nx
        fact = (float(i-nx-1)*sx + float(j-1)*cy)**2 +   &
     &          ( -float(i-nx-1)*cx + float(j-1)*sy)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
    enddo
    do j=ny/2+1,ny
      do i=1,nx2
        fact = (float(i-1)*sx + float(j-ny-1)*cy)**2 +   &
     &          ( -float(i-1)*cx + float(j-ny-1)*sy)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
      do i=nx1,nx
        fact = (float(i-nx-1)*sx   &
     &          + float(j-ny-1)*cy)**2 +   &
     &          ( -float(i-nx-1)*cx + float(j-ny-1)*sy)**2
        if (fact.lt.80.) then
          fact = exp (-fact)
          data(i,j) = data(i,j)*fact
        else
          data(i,j) = 0.
        endif
      enddo
    enddo
  endif
end subroutine sm_mulgau
!!
subroutine smoo001(v,mi,mj,a,bval,eval,table,w)
  use gildas_def
  !---------------------------------------------------------------------
  !! IMAGER -- Utility routine  
  !! 	2-D Smoothing wit a kernel, handling blanking values
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: mi    !! First dimension
  integer(kind=index_length), intent(in) :: mj    !! Second dimension
  real, intent(in) :: v(mi,mj)                    !! Initial array
  real, intent(out) :: a(mi,mj)                   !! Smoothed array
  real, intent(in) :: bval                        !!  Blanking value
  real, intent(in) :: eval                        !! Blanking tolerance
  real, intent(in) :: table(6)                    !! Smoothing coefficient
  real, intent(inout) :: w(mi,mj)                 !! Work array
  !
  ! Local
  integer :: i,j
  real :: x,sum,s00,s10,s11,s20,s21,s22
  real :: a00,a10,a11,a20,a21,a22
  !
  ! Load smoothing coefficients
  s00 = table(1)
  s10 = table(2)
  s11 = table(3)
  s20 = table(4)
  s21 = table(5)
  s22 = table(6)
  a00 = abs(s00)
  a10 = abs(s10)
  a11 = abs(s11)
  a20 = abs(s20)
  a21 = abs(s21)
  a22 = abs(s22)
  sum = a00 + 4.0*(a10+a11+a20+2.0*a21+a22)
  !
  ! Initialise arrays
  do j=1,mj
    do i=1,mi
      a(i,j) = 0.0
      w(i,j) = 0.0
    enddo
  enddo
  !
  ! Check for blanking first
  if (eval.ge.0.0) then
    !
    ! Slow method for blanked maps
    do j=3,mj-2
      do i=3,mi-2
        x = v(i,j)
        if (abs(x-bval).gt.eval) then
          ! Central pixel
          a(i,j) = a(i,j) + s00*x
          w(i,j) = w(i,j) + a00
          ! Second pixels
          a(i-1,j-1) = a(i-1,j-1) + s11*x
          a(i-1,j  ) = a(i-1,j )  + s10*x
          a(i-1,j+1) = a(i-1,j+1) + s11*x
          a(i  ,j-1) = a(i  ,j-1) + s10*x
          a(i  ,j+1) = a(i  ,j+1) + s10*x
          a(i+1,j-1) = a(i+1,j-1) + s11*x
          a(i+1,j  ) = a(i+1,j  ) + s10*x
          a(i+1,j+1) = a(i+1,j+1) + s11*x
          ! and weights
          w(i-1,j-1) = w(i-1,j-1) + a11
          w(i-1,j  ) = w(i-1,j  ) + a10
          w(i-1,j+1) = w(i-1,j+1) + a11
          w(i  ,j-1) = w(i  ,j-1) + a10
          w(i  ,j+1) = w(i  ,j+1) + a10
          w(i+1,j-1) = w(i+1,j-1) + a11
          w(i+1,j  ) = w(i+1,j  ) + a10
          w(i+1,j+1) = w(i+1,j+1) + a11
          !
          ! Third pixels
          a(i-2,j-2) = a(i-2,j-2)  + s22*x
          a(i-2,j-1) = a(i-2,j-1)  + s21*x
          a(i-2,j  ) = a(i-2,j  )  + s20*x
          a(i-2,j+1) = a(i-2,j+1)  + s21*x
          a(i-2,j+2) = a(i-2,j+2)  + s22*x
          a(i-1,j-2) = a(i-1,j-2)  + s21*x
          a(i-1,j+2) = a(i-1,j+2)  + s21*x
          a(i  ,j-2) = a(i  ,j-2)  + s20*x
          a(i  ,j+2) = a(i  ,j+2)  + s20*x
          a(i+1,j-2) = a(i+1,j-2)  + s21*x
          a(i+1,j+2) = a(i+1,j+2)  + s21*x
          a(i+2,j-2) = a(i+2,j-2)  + s22*x
          a(i+2,j-1) = a(i+2,j-1)  + s21*x
          a(i+2,j  ) = a(i+2,j  )  + s20*x
          a(i+2,j+1) = a(i+2,j+1)  + s21*x
          a(i+2,j+2) = a(i+2,j+2)  + s22*x
          !
          ! and weights
          w(i-2,j-2) = w(i-2,j-2)  + a22
          w(i-2,j-1) = w(i-2,j-1)  + a21
          w(i-2,j  ) = w(i-2,j  )  + a20
          w(i-2,j+1) = w(i-2,j+1)  + a21
          w(i-2,j+2) = w(i-2,j+2)  + a22
          w(i-1,j-2) = w(i-1,j-2)  + a21
          w(i-1,j+2) = w(i-1,j+2)  + a21
          w(i  ,j-2) = w(i  ,j-2)  + a20
          w(i  ,j+2) = w(i  ,j+2)  + a20
          w(i+1,j-2) = w(i+1,j-2)  + a21
          w(i+1,j+2) = w(i+1,j+2)  + a21
          w(i+2,j-2) = w(i+2,j-2)  + a22
          w(i+2,j-1) = w(i+2,j-1)  + a21
          w(i+2,j  ) = w(i+2,j  )  + a20
          w(i+2,j+1) = w(i+2,j+1)  + a21
          w(i+2,j+2) = w(i+2,j+2)  + a22
        endif
      enddo
    enddo
    !
    ! Set blanked pixels
    do j=1,mj
      do i=1,mi
        if (w(i,j).eq.0.0) then
          a(i,j) = bval
        else
          a(i,j) = a(i,j)/w(i,j)
        endif
      enddo
    enddo
    !
    ! Optimise for no blanking
  else
    !
    do j=3,mj-2
      do i=3,mi-2
        a(i,j) =   &
     &          s00 * v(i,j)   &
     &          + s11 * (v(i-1,j+1)+v(i+1,j+1)+v(i+1,j-1)+v(i-1,j-1))   &
     &          + s10 * (v(i,j+1)+v(i+1,j)+v(i-1,j)+v(i,j-1))   &
     &          + s22 * (v(i-2,j+2)+v(i+2,j+2)+v(i-2,j-2)+v(i+2,j-2))   &
     &          + s21 * (v(i-1,j+2)+v(i+1,j+2)+v(i+2,j+1)+v(i+2,j-1)   &
     &          +v(i+1,j-2)+v(i-1,j-2)+v(i-2,j-1)+v(i-2,j+1))   &
     &          + s20 * (v(i,j+2)+v(i+2,j)+v(i,j-2)+v(i-2,j))
        a(i,j) = a(i,j)/sum
      enddo
    enddo
    !
  endif
end subroutine smoo001
!
subroutine smo002(imagein, ncolumns, nlines, imageout, flux,   &
     &    maxpoint, blank, eblank)
  use gildas_def
  !!
  !! IMAGER -- Utility routine 
  !!  "Noise" smoothing up to Maxpoint pixels and specified Flux
  !!
  integer(kind=index_length), intent(in) :: ncolumns  !! X size                  !
  integer(kind=index_length), intent(in) :: nlines    !! Y size
  real(4), intent(in) :: imagein(ncolumns,nlines)     !! Original image
  real(4), intent(out) :: imageout(ncolumns,nlines)   !! Smoothed image
  real(4), intent(in) :: flux       !! Flux limit to stop smoothing
  integer, intent(in) :: maxpoint   !! Maximum number of pixels included in smoothing
  real(4), intent(in) :: blank      !! Blanking value
  real(4), intent(in) :: eblank     !! Tolerance
  !                   !
  ! Local --
  integer :: iline,icolumn,k,np,ic,ic1,ic2,il,il1,il2
  real(4) :: x, xx
  !
  ! Code
  do iline=1,nlines
    do icolumn=1,ncolumns
      k=0
      x=imagein(icolumn,iline)
      if (abs(x-blank).le.eblank) then
        x = 0.
        np = 0
      else
        np = 1
      endif
      do while (x.lt.flux .and. k.lt.maxpoint)
        k=k+1
        il1=max(1,iline-k)
        il2=min(nlines,iline+k)
        ic1=max(icolumn-k,1)
        ic2=min(icolumn+k,ncolumns)
        do ic=ic1,ic2
          xx = imagein(ic,il1)
          if (abs(xx-blank).gt.eblank) then
            x = x + xx
            np= np+1
          endif
          xx = imagein(ic,il2)
          if (abs(xx-blank).gt.eblank) then
            x = x + xx
            np= np+1
          endif
        enddo
        il1=max(iline-k+1,1)
        il2=min(iline+k-1,nlines)
        do il=il1,il2
          xx = imagein(ic1,il)
          if (abs(xx-blank).gt.eblank) then
            x = x + xx
            np= np+1
          endif
          xx = imagein(ic2,il)
          if (abs(xx-blank).gt.eblank) then
            x = x + xx
            np= np+1
          endif
        enddo
      enddo
      if (np.ne.0) then
        imageout(icolumn,iline)=x/float(np)
      else
        imageout(icolumn,iline)=blank
      endif
    enddo
  enddo
end subroutine smo002
!
!<FF>
!
subroutine get_3d_from_name(rname,arg,head,new,is_image,error)
  use image_def
  use iso_c_binding
  use gkernel_interfaces
  use imager_interfaces, only : sub_readhead, map_message
  !-------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER  -- GILDAS general routine
  !
  !   From a string, which can be a SIC variable or a Data file
  ! name, return the data array in the appropriate  3D Pointer 
  !!
  !-------------------------------------------------------------------
  character(len=*), intent(in) :: rname  !! Caller name
  character(len=*), intent(in) :: arg    !! Input name (SIC variable or Filename)
  type(gildas), intent(inout) :: head    !! Gildas Header for entity
  logical, intent(in) :: new             !! Should it exist or not ?
  logical, intent(inout) :: is_image     !! Is it a SIC variable, or a file ?
  logical, intent(out) :: error          !! Logical error file
  !
  ! Local ---
  character(len=512) :: chain
  integer :: dims(3)
  logical :: rdonly
  type (c_ptr) :: cptr
  !
  ! Code ----
  is_image = index(arg,'.').eq.0
  dims = head%gil%dim(1:3)
  call gildas_null(head)
  error = .false.
  !
  if (new) then
    !
    ! It is an Output result
    if (is_image) then
      ! It must be an Image
      if (.not.sic_varexist(arg)) then
        !
        ! If not, create it - One would like to use directly the SIC routines
        !   call sic_define_image (name,filename,status,global,therank,error)
        ! here, with 
        !   filename = "*"
        !   name = trim(arg)//"[dim1,dim2,dim3]" 
        !   status = "READ"
        !   global = .true.
        !   therank = 3 (a variable, though)
        ! but it is a "private" routine
        !
        ! So we use a command line, but it may break the caller if its line
        ! parsing has not been completed.
        write(chain,'(A,I0,A,I0,A,I0,A)') 'DEFINE IMAGE '//trim(arg)//'[', &
          & dims(1),',',dims(2),',',dims(3),'] * REAL /GLOBAL'
        call exec_command(chain,error)
        if (error) return
      endif
      !
      rdonly = .false.
      call sub_readhead (rname,arg,head,is_image,error,rdonly,fmt_r4)
      if (error) return
      !
      ! If it exists, verify it matches the appropriate Header in size
      if (any(dims.ne.head%gil%dim(1:3))) then
        call map_message(seve%e,rname,'Output SIC variable does not match Input data shape')
        error = .true.
        return
      endif
      !
      ! Set the appropriate pointer to the data area
      call adtoad(head%loca%addr,cptr,1)
      call c_f_pointer(cptr,head%r3d,head%gil%dim(1:3))
      !
    else
      !
      ! It must be a Data File, create it with the appropriate size
      call gildas_null(head)
      head%file = arg
      head%gil%ndim = 3
      head%gil%dim(1:3) = dims
      allocate(head%r3d(dims(1),dims(2),dims(3)),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Output Image allocation error')
        error = .true.
        return
      endif
    endif
  else
    !
    ! It is an input data set. Find it  
    call gildas_null(head)
    call sub_readhead (rname,arg,head,is_image,error,rdonly,fmt_r4)
    if (error) return
    !
    ! Trim it to 3-D
    rank=3
    call gdf_trim_header(head,rank,error)  
    if (error) return
    !
    if (is_image) then
      !
      ! Set the appropriate pointer to the data area
      call adtoad(head%loca%addr,cptr,1)
      call c_f_pointer(cptr,head%r3d,head%gil%dim(1:3))
    else
      dims = head%gil%dim(1:3)
      ! Allocate the appropriate pointer 
      allocate(head%r3d(dims(1),dims(2),dims(3)),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Output Image allocation error')
        error = .true.
        return
      endif
      ! And read the data
      call gdf_read_data(head,head%r3d,error)
      if (error) return
      call gdf_close_image(head,error) ! not needed it anymore
    endif
  endif
end subroutine get_3d_from_name
!
end subroutine map_convolve_comm
