program main_map_expand
  use gbl_format
  use gkernel_interfaces
  !
  logical error
  !
  error = .false.
  call map_expand(error)
  if (error) call sysexi(fatale)
end program
!
subroutine map_expand(error)
  use gildas_def
  use gbl_format
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! GILDAS
  !	Expand a data cube along its TWO first dimensions, by Fourier
  !     Transform
  !---------------------------------------------------------------------
  logical, intent(out) :: error
  ! Local
  real, parameter :: eps = 2.e-7
  character(len=filename_length) :: mapin, mapout
  integer :: i,j,ier,n,nexp, ndim, dim(2)
  complex, allocatable :: ipl(:,:), ips(:,:)
  real, allocatable :: ipw(:)
  type(gildas) :: x,y
  !
  call gildas_open
  call gildas_char('INPUT_MAP$',mapin)
  call gildas_char('OUTPUT_MAP$',mapout)
  call gildas_inte('EXPAND$',nexp,1)
  call gildas_close
  !
  if (nexp.lt.2. .or. nexp.gt.8) then
    write(6,*) 'E-MAP_EXPAND,  Invalid expansion ',nexp
    error = .true.
    return
  endif
  !
  ! Input file
  n = len_trim(mapin)
  call gildas_null(y)
  y%gil%ndim = 3
  call gdf_read_gildas(y,mapin,'.lmv',error, data=.false.)
  if (error) then
    call gagout('F-MAP_EXPAND,  Cannot read input cube')
    error = .true.
    return
  endif
  !
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  call sic_parsef(mapout,x%file,' ','.lmv')
  !
  x%gil%dim(1:2) = y%gil%dim(1:2)*nexp
  !
  allocate(ips(y%gil%dim(1),y%gil%dim(2)), ipl(x%gil%dim(1),x%gil%dim(2)), &
  & ipw(2*max(x%gil%dim(1),x%gil%dim(2))), stat=ier)
  if (ier.ne.0) then
    error = .true.
    return
  endif
  allocate(y%r2d(y%gil%dim(1),y%gil%dim(2)), x%r2d(x%gil%dim(1),x%gil%dim(2)), & 
  & stat=ier)
  if (ier.ne.0) then
    error = .true.
    return
  endif
  !
  ! Transform coordinates (1,1) ---> (1,1)
  x%gil%inc(1:2) = y%gil%inc(1:2)/nexp
  x%gil%ref(1:2) = 1.0d0
  x%gil%val(1:2) = (x%gil%ref(1:2)-y%gil%ref(1:2))*y%gil%inc(1:2)+y%gil%val(1:2)
  !
  ! Create Output file
  call gdf_create_image(x,error)
  if (error) then
    write(6,*) 'F-MAP_EXPAND,  Cannot create output image'
    error = .true.
    return
  endif
  !
  ! Use the NX/2+1 pixel as reference value for convenience
  x%gil%val(1:2)  = (x%gil%dim(1:2)/2+1.d0-x%gil%ref(1:2))*x%gil%inc(1:2) + x%gil%val(1:2)
  x%gil%ref(1:2) = x%gil%dim(1:2)/2+1.d0
  !
  !
  ! Setup FFTW
  ndim = 2
  dim(1) = x%gil%dim(1)
  dim(2) = x%gil%dim(2)
  call fourt_plan(ipl,dim,ndim,-1,0)
  dim(1) = y%gil%dim(1)
  dim(2) = y%gil%dim(2)
  call fourt_plan(ips,dim,ndim,1,1)
  !
  ! Now loop over planes
  do j = 1,x%gil%dim(4)
    y%blc(4) = j
    y%trc(4) = j  
    do i = 1,x%gil%dim(3)
      y%blc(3) = i
      y%trc(3) = i
      x%blc = y%blc
      x%trc = y%trc
      call gdf_read_data(y,y%r2d,error)
      call expand (   &
     &      x%gil%dim(1),x%gil%dim(2),x%r2d,ipl,   &
     &      y%gil%dim(1),y%gil%dim(2),y%r2d,ips,   &
     &      ipw )
      call gdf_write_data(x,x%r2d,error)
    enddo
  enddo
  !
  deallocate(ips,ipl,ipw,x%r2d,y%r2d,stat=ier)
  call gdf_close_image(x,error)
  call gdf_close_image(y,error)
  call gagout ('S-EXPAND,  Successful completion')
  error = .false.
end subroutine map_expand
!
subroutine expand (nx,ny,large,wl,mx,my,small,ws,work)
  use gildas_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  !	Expand an image through FT zero extension
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: nx   ! Large X size
  integer(kind=index_length), intent(in) :: ny   ! Large Y size
  real, intent(out) :: large(nx,ny)              ! Output (expanded) image
  complex, intent(inout) :: wl(nx,ny)            ! Work array
  integer(kind=index_length), intent(in) :: mx   ! Small X size
  integer(kind=index_length), intent(in) :: my   ! Small Y size
  real, intent(in) :: small(mx,my)               ! Input (small) image
  complex, intent(inout) :: ws(mx,my)            ! Work array
  real, intent(inout) :: work(*)                 ! FFT work space
  ! Local
  integer :: j,ndim,dim(2)
  real :: fact
  !
  ws = small
  !
  ndim = 2
  dim(1) = mx
  dim(2) = my
  call fourt(ws,dim,ndim,-1,0,work)
  !
  ! Clear output FT
  wl = 0.0
  ! Load inner quarter
  do j=1,my/2
    call r4tor4 (ws(1,j),wl(1,j),mx)
    call r4tor4 (ws(mx/2+1,j),wl(1+nx-mx/2,j),mx)
  enddo
  do j=my/2+1,my
    call r4tor4 (ws(1,j),wl(1,j+ny-my),mx)
    call r4tor4 (ws(mx/2+1,j),wl(1+nx-mx/2,j+ny-my),mx)
  enddo
  dim(1) = nx
  dim(2) = ny
  call fourt (wl,dim,ndim,1,1,work)
  !
  fact = 1.0/(mx*my)
  large = real(wl)*fact
end subroutine expand
