program fill_cube
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! GILDAS	Stand alone program
  !	Resample a partially filled input cube to a different
  !	finer filled one...
  ! Subroutines
  !	(IMAGE),(SIC)
  !	REGRID
  !---------------------------------------------------------------------
  ! Local
  real(8), parameter :: pi=3.141592653589793d0
  !
  character(len=filename_length) :: namey,namex
  character(len=4) :: method
  integer(kind=index_length) :: i,j,ndp
  integer :: n,ier
  logical :: error,auto,extrapol,logran(7)
  real(8) :: conv(3,2)
  integer :: dim(2),nxy
  real, allocatable :: xd(:),yd(:),zd(:),ipw(:)
  integer, allocatable :: ia(:),ja(:), ipi(:)
  type(gildas) :: x,y
  !
  data logran/7*.false./
  !
  call gildas_open
  call gildas_char('Y_NAME$',namey)
  call gildas_char('X_NAME$',namex)
  call gildas_inte('PIXELS$',dim,2)
  call gildas_logi('MODE$',auto,1)
  if (.not.auto) then
    call gildas_dble('AXIS_1$',conv(:,1),3)
    call gildas_dble('AXIS_2$',conv(:,2),3)
  endif
  call gildas_char('METHOD$',method)
  call gildas_logi('EXTRAPOLATE$',extrapol,1)
  call gildas_close
  !
  n = len_trim(namey)
  call gildas_null(y)
  y%gil%form = fmt_r4
  call gdf_read_gildas(y, namey, '.gdf', error, rank=4, data=.false.)
  !
  ! Now define output
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  n = len_trim(namex)
  call sic_parsef(namex(1:n),x%file,' ','.gdf')
  if (dim(1).lt.1 .or. dim(2).lt.1) then
    write(6,*) 'F-FILL_CUBE,  Invalid dimensions'
    goto 100
  else
    x%gil%dim(1) = dim(1)
    x%gil%dim(2) = dim(2)
  endif
  if (auto) then
    write(6,*) 'W-FILL_CUBE,  Computing conversion formulae'
    x%gil%ref(1) = 0.5d0
    x%gil%val(1) = (0.5d0-y%gil%ref(1))*y%gil%inc(1) + y%gil%val(1)  ! Pixel 0.5 of input
    x%gil%inc(1) = y%gil%dim(1)*y%gil%inc(1)/x%gil%dim(1)  ! Total scale
    x%gil%ref(2) = 0.5d0
    x%gil%val(2) = (0.5d0-y%gil%ref(2))*y%gil%inc(2) + y%gil%val(2)  ! Pixel 0.5 of input
    x%gil%inc(2) = y%gil%dim(2)*y%gil%inc(2)/x%gil%dim(2)  ! Total scale
  else
    x%gil%convert(:,1:2) = conv
  endif
  !
  ! Create the image
  call gdf_create_image(x,error)
  !
  allocate(x%r2d(x%gil%dim(1),x%gil%dim(2)),y%r2d(y%gil%dim(1),y%gil%dim(2)),stat=ier)
  !
  ! Method of solution
  if (method.eq.'SLOW') then
    write(6,*) 'W-FILL_CUBE,  Using SLOW general method'
  else
    method = 'FAST'
    write(6,*) 'W-FILL_CUBE,  Using FAST method, input blanking ignored'
  endif
  !
  !
  if (method.eq.'FAST') then
    do j=1,x%gil%dim(4)
      x%blc(4) = j
      x%trc(4) = j
      do i=1,x%gil%dim(3)
        x%blc(3) = i
        x%trc(3) = i
        !
        y%blc = x%blc
        y%trc = x%trc
        call gdf_read_data(y,y%r2d,error)
        call fill_cube_fast (   &
     &          y%r2d,y%gil%dim(1),y%gil%dim(2),y%gil%convert,   &
     &          x%r2d,x%gil%dim(1),x%gil%dim(2),x%gil%convert,   &
     &          x%gil%bval)
        call gdf_write_data(x,x%r2d,error)
      enddo
    enddo
  else
    nxy = y%gil%dim(1)*y%gil%dim(2)
    allocate (xd(nxy),yd(nxy),zd(nxy),ia(nxy),ja(nxy),stat=ier)
    if (ier.ne.0) goto 99
    x%gil%eval = max(x%gil%eval,abs(x%gil%bval*1e-7))
    !
    y%blc(4) = max(1,y%gil%dim(4)/2)
    y%trc(4) = y%blc(4)
    y%blc(3) = max(1,y%gil%dim(3)/2)
    y%trc(3) = y%blc(3)
    call gdf_read_data(y,y%r2d,error)
    if (error) goto 100
    !
    call init_cube_slow (y%r2d,   &
     &      y%gil%dim(1),y%gil%dim(2),y%gil%convert,   &
     &      x%gil%dim(1),x%gil%dim(2),x%gil%convert,   &
     &      x%gil%bval,x%gil%eval,   &
     &      xd,yd,zd,ia,ja,          &
     &      ndp,error)
    if (error) goto 100
    logran(3) = .false.
    logran(7) = extrapol
    !
    allocate (ipw(13*ndp), ipi(35*ndp), stat=ier)
    if (ier.ne.0) goto 99
    !
    do j=1,y%gil%dim(4)
      x%blc(4) = j
      x%trc(4) = j
      do i=1,y%gil%dim(3)
        x%blc(3) = i
        x%trc(3) = i
        x%r2d = 0.0
        y%blc = x%blc
        y%trc = x%trc
        call gdf_read_data(y,y%r2d,error)
        if (error) goto 100
        call fill_cube_slow (   &
     &          y%r2d,y%gil%dim(1),y%gil%dim(2),   &
     &          x%r2d,x%gil%dim(1),x%gil%dim(2),   &
     &          x%gil%bval,   &
     &          xd,yd,zd,ia,ja,  &
     &          ipi, ipw, ndp,   &
     &          logran,error)
        if (error) goto 100
        call gdf_write_data(x,x%r2d,error)
      enddo
    enddo
  endif
  stop 'E-FILL_CUBE,  Successful completion'
  !
99 write(6,*) 'F-FILL_CUBE,  Memory allocation failure'
100 call sysexi(fatale)
end program fill_cube
!
subroutine init_cube_slow (a,mx,my,aconv,   &
     &    nx,ny,bconv,blank,eblank,   &
     &    xd,yd,zd,ia,ja,ndp,error)
  use gildas_def
  !---------------------------------------------------------------------
  ! GILDAS	Stand alone subroutine
  !	Regrid an input cube with blanking values to an output
  !	regular cube on a finer grid.
  ! Arguments
  !	A		R*4(*)	Input map of dimensions MX MY
  !	MX,MY		I
  !	ACONV		R*8(6)	Pixel conversion formulae
  !			CONV(1) = Xref, CONV(2)=Xval, CONV(3)=Xinc
  !	NX,NY		I	Output dimensions
  !	BCONV		R*8(6)
  !	BLANK		R*4	Blanking value
  !	EBLANK		R*4	Blanking tolerance
  !	XD,YD,ZD	R*4	Work arrays of dimension MX*MY
  !	IA,JA		I*4	Work arrays of dimensions MX*MY
  !	NDP		I*4	Number of selected points
  !---------------------------------------------------------------------
  integer(kind=index_length) :: mx                     !
  integer(kind=index_length) :: my                     !
  real(4) :: a(mx,my)                !
  real(8) :: aconv(6)                !
  integer(kind=index_length) :: nx                     !
  integer(kind=index_length) :: ny                     !
  real(8) :: bconv(6)                !
  real(4) :: blank                   !
  real(4) :: eblank                  !
  real(4) :: xd(nx*ny)               !
  real(4) :: yd(nx*ny)               !
  real(4) :: zd(nx*ny)               !
  integer :: ia(mx*my)              !
  integer :: ja(mx*my)              !
  integer(kind=index_length) :: ndp                    !
  logical :: error                  !
  ! Local
  integer :: i,j,ncp
  real(8) :: axref,axval,axinc, ayref,ayval,ayinc
  real(8) :: bxref,bxval,bxinc, byref,byval,byinc
  !
  ! Preliminary processing
  ncp = 4
  axref = aconv(1)
  axval = aconv(2)
  axinc = aconv(3)
  ayref = aconv(4)
  ayval = aconv(5)
  ayinc = aconv(6)
  bxref = bconv(1)
  bxval = bconv(2)
  bxinc = bconv(3)
  byref = bconv(4)
  byval = bconv(5)
  byinc = bconv(6)
  !
  ! Load XD,YD,ZD arrays with current plane (or mask array)
  ndp = 0
  do j=1,my
    do i=1,mx
      if (abs(a(i,j)-blank).gt.eblank) then
        ndp = ndp +1
        xd(ndp) = (i-axref)*axinc + axval
        yd(ndp) = (j-ayref)*ayinc + ayval
        zd(ndp) = a(i,j)
        ia(ndp) = i
        ja(ndp) = j
      endif
    enddo
  enddo
  if (ndp.le.0) then
    write(6,*) 'F-SLOW,  No data point in input'
    error = .true.
    return
  endif
  !
  ! Initialize Gridding
  call gridini(nx,bxref,bxval,bxinc, ny,byref,byval,byinc)
end subroutine init_cube_slow
!
subroutine fill_cube_slow (a,mx,my,   &
     &    b,nx,ny,blank,   &
     &    xd,yd,zd,ia,ja,   &
     &    ipi,ipw,ndp,   &
     &    logran,error)
  use gildas_def
  !---------------------------------------------------------------------
  ! GILDAS	Stand alone subroutine
  !	Regrid an input cube with blanking values to an output
  !	regular cube on a finer grid.
  ! Arguments
  !	A		R*4(*)	Input map of dimensions MX MY
  !	MX,MY		I
  !	B		R*4(*)	Output map of dimensions NX,NY
  !	NX,NY		I
  !	BLANK		R*4	Blanking value
  !	XD,YD,ZD	R*4	Work arrays of dimension MX*MY
  !	IA,JA		I*4	Work arrays of dimensions MX*MY
  !	IPI		I*4	Work arrays
  !	IPW		I*4	Work arrays
  !	NDP		I*4	Number of good points
  !	LOGRAN		L(7)	Control interpolation behaviour
  !---------------------------------------------------------------------
  integer(kind=index_length) :: mx                     !
  integer(kind=index_length) :: my                     !
  real(4) :: a(mx,my)                !
  integer(kind=index_length) :: nx                     !
  integer(kind=index_length) :: ny                     !
  real(4) :: b(nx,ny)                !
  real(4) :: blank                   !
  real(4) :: xd(nx*ny)               !
  real(4) :: yd(nx*ny)               !
  real(4) :: zd(nx*ny)               !
  integer :: ia(mx*my)              !
  integer :: ja(mx*my)              !
  integer :: ipi(*)                 !
  real(4) :: ipw(*)                 !
  integer(kind=index_length) :: ndp                    !
  logical :: logran(7)              !
  logical :: error                  !
  ! Local
  external :: dummy
  integer :: i,ncp
  !
  ncp = 4
  call gridset (ncp,blank,logran)
  !
  ! Process plane
  do i=1,ndp
    zd(i) = a(ia(i),ja(i))
  enddo
  call gridran (xd,yd,zd,ndp,ipw,ipi,b   &
     &    ,dummy,dummy,dummy,error)
  if (error) then
    write(6,*) 'F-FILL_CUBE_SLOW,  Failure in GRIDRAN ...'
    return
  endif
  logran(3) = .true.           ! Repeat for next one
end subroutine fill_cube_slow
!
subroutine dummy
end subroutine dummy
!
subroutine fill_cube_fast (a,mx,my,aconv,   &
     &    b,nx,ny,bconv,blank)
  use gildas_def
  !---------------------------------------------------------------------
  ! GILDAS 	Stand alone subroutine
  !	Regrid an input data cube on a finer one for the 2 first input
  !	dimensions.
  ! Arguments
  !	A		R*4(*)	Input map of dimensions MX MY
  !	MX,MY		I
  !	ACONV		R*8(6)	Pixel conversion formulae
  !			CONV(1) = Xref, CONV(2)=Xval, CONV(3)=Xinc
  !	B		R*4(*)	Output map of dimensions NX,NY
  !	NX,NY		I
  !	BCONV		R*8(6)
  !	BLANK	R*4	Blanking value
  !---------------------------------------------------------------------
  integer(kind=index_length) :: mx                     !
  integer(kind=index_length) :: my                     !
  real(4) :: a(mx,my)                !
  real(8) :: aconv(6)                !
  integer(kind=index_length) :: nx                     !
  integer(kind=index_length) :: ny                     !
  real(4) :: b(nx,ny)                !
  real(8) :: bconv(6)                !
  real(4) :: blank                   !
  ! Local
  integer :: ib,jb,ia,ja
  real(8) :: axref,axval,axinc, ayref,ayval,ayinc
  real(8) :: bxref,bxval,bxinc, byref,byval,byinc
  real(8) :: xa,ya
  real(4) :: aplus,amoin,azero,xr,yr
  !
  ! Preliminary processing
  axref = aconv(1)
  axval = aconv(2)
  axinc = aconv(3)
  ayref = aconv(4)
  ayval = aconv(5)
  ayinc = aconv(6)
  bxref = bconv(1)
  bxval = bconv(2)
  bxinc = bconv(3)
  byref = bconv(4)
  byval = bconv(5)
  byinc = bconv(6)
  !
  ! Loop over Output data points
  do jb = 1,ny
    do ib = 1,nx
      !
      ! Find pixel coordinate in input map
      xa = (ib-bxref)*bxinc + bxval
      ya = (jb-byref)*byinc + byval
      xr = (xa-axval)/axinc + axref
      yr = (ya-ayval)/ayinc + ayref
      ia = nint (xr)
      ja = nint (yr)
      xr = xr - ia
      yr = yr - ja
      !
      ! Avoid edges
      if (ia.le.1 .or. ia.ge.mx .or. ja.le.1 .or. ja.ge.my) then
        b(ib,jb) = blank
      else
        !
        ! Interpolate (X or Y first, does not matter in this case)
        aplus = ( (a(ia+1,ja+1)+a(ia-1,ja+1)-2.*a(ia,ja+1))   &
     &          *xr + a(ia+1,ja+1)-a(ia-1,ja+1) )*xr*0.5   &
     &          + a(ia,ja+1)
        azero = ( (a(ia+1,ja)+a(ia-1,ja)-2.*a(ia,ja))   &
     &          *xr + a(ia+1,ja)-a(ia-1,ja) )*xr*0.5   &
     &          + a(ia,ja)
        amoin = ( (a(ia+1,ja-1)+a(ia-1,ja-1)-2.*a(ia,ja-1))   &
     &          *xr + a(ia+1,ja-1)-a(ia-1,ja-1) )*xr*0.5   &
     &          + a(ia,ja-1)
        ! Then Y (or X)
        b(ib,jb) = ( (aplus+amoin-2.*azero)   &
     &          *yr + aplus-amoin )*yr*0.5 + azero
      endif
    enddo
  enddo
end subroutine fill_cube_fast
