subroutine map_reproject_comm(line,error)
  use image_def
  use imager_interfaces, except_this => map_reproject_comm 
  use gkernel_interfaces, no_interface1 => gdf_copy_header
  use gkernel_types
  use gbl_message
  use clean_arrays
  use iso_c_binding
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for command MAP_REPROJECT
  !
  ! MAP_REPROJECT Out In   
  !   /BLANKING Bval Eval  
  !   /LIKE Template  
  !   /PROJECTION Type Cx Cy [Unit] [Angle]  
  !   /SYSTEM Type [Equinox]  
  !   /X_AXIS Nx Ref Val Inc  
  !   /Y_AXIS Ny Ref Val Inc
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line
  logical, intent(out) :: error         !! Logical error flag
  !
  ! Constants
  integer, parameter :: o_blank=1
  integer, parameter :: o_like=2
  integer, parameter :: o_proj=3
  integer, parameter :: o_syst=4
  integer, parameter :: o_xaxis=5
  integer, parameter :: o_yaxis=6
  real(8), parameter :: pi=3.141592653589793d0
  character(len=1), parameter :: question_mark='?'
  character(len=*), parameter :: rname='REPROJECT'
  integer(kind=4), parameter :: msys=5
  character(len=13) :: system(msys)
  data system /'UNKNOWN','EQUATORIAL','GALACTIC','HORIZONTAL','ICRS'/
  integer, parameter :: munit=5
  character(len=12) :: units(munit)
  data units/'ABSOLUTE','DEGREE','MINUTE','SECOND','RADIAN'/
  real(8), parameter :: vunit(munit)=[0.d0,pi/180.d0,pi/180.d0/60.d0,pi/180.d0/3600.d0,1.0d0]
  !
  ! Local ---
  character(len=13) :: argum,keywor,projnam_array(0:mproj)
  character(len=64) :: args
  real(8) :: funit, x0, y0, rr
  type (projection_t) :: gin_proj
  integer :: ier, iangle
  !
  type(gildas) :: gin, gout, gtemp
  character(len=filename_length) :: fich
  integer :: nsys, nkey, nunit
  integer :: sys_code, i
  integer :: n, rank, type, istart, length, nc
  real(kind=4) :: equinox
  real(kind=8) :: ra, dec, ang, convert(3)
  type(sic_descriptor_t) :: desc
  type(c_ptr) :: cptr
  logical :: found, is_image, in_image, out_image, rdonly, match
  !
  ! Code ---
  x0 = 0.d0
  y0 = 0.d0
  call gildas_null(gin)
  !
  call sic_ch(line,0,2,fich,n,.true.,error)
  in_image = .false.
  call sub_readhead (rname,fich,gin,in_image,error,rdonly,fmt_r4)
  if (error) return
  !
  rank=3
  call gdf_trim_header(gin,rank,error)  
  if (error) return
  !
  ! Template can be a SIC variable or a Gildas file...  !
  if (sic_present(o_like,0)) then
    if (sic_present(o_proj,0).or.sic_present(o_xaxis,0).or. &
        & sic_present(o_yaxis,0).or.sic_present(o_syst,0)) then
      call map_message(seve%e,rname,'/FILE option is incompatible ' &
        & //'with /PROJECTION, /SYSTEM, /X_AXIS and /Y_AXIS')
      error = .true.
      return
    endif
    ! Get shape from Template
    call sic_ch(line,o_like,1,fich,n,.true.,error)
    is_image = .false.
    call sub_readhead(rname,fich,gtemp,is_image,error)
  else
    ! Get shape from Input file, modified by other options
    call gildas_null(gtemp)
    call gdf_copy_header(gin,gtemp,error)
    if (error) return
    !
    if (sic_present(o_proj,0)) then
      call sic_ke(line,o_proj,1,argum,n,.true.,error)
      if (argum.ne.'*') then
        ! Solve the Ambiguity
        ! Set the projection type
        call projnam_list(projnam_array)
        call sic_ambigs(rname,argum,keywor,nkey,projnam_array,mproj+1,error)
        if (error) return
        gtemp%gil%ptyp = nkey-1
      endif
      !
      argum = '*'
      call sic_ke(line,o_syst,1,argum,n,.false.,error)
      if (argum.ne.'*') then
        call sic_ambigs(rname,argum,keywor,nsys,system,msys,error)
        if (error) return
        gtemp%char%syst = keywor
        !
        if (nsys.eq.type_eq) then
          equinox = 2000.0
          call sic_r4(line,o_syst,1,equinox,.false.,error)
          if (error)  return
          gtemp%gil%epoc = equinox
        endif
      endif
      !
      type = gtemp%gil%ptyp
      !
      ! Find input projection center
      funit = 0
      if (type.ne.p_none) then
        ! Check if UNIT keyword is present
        if (sic_present(o_proj,4)) then
          argum = '*'
          call sic_ke(line,o_proj,4,argum,n,.false.,error)
          if (.not.sic_present(o_proj,5)) then
            read(argum,*,iostat=ier) rr
          else
            ier = 1
          endif
          if (ier.ne.0) then            
            call sic_ambigs(rname,argum,keywor,nunit,units,munit,error)
            if (error) return
            funit = vunit(nunit)
          endif
          !
        endif
        !
        if (type.ne.p_aitoff) then
          if (sic_present(o_proj,3)) then
            if (funit.eq.0) then
              call sic_ke(line,o_proj,3,args,n,.false.,error)
              istart = sic_start(o_proj,3)
              length = sic_len(o_proj,3)
              if (line(istart:istart+2).ne.'*') then
                call sic_sexa(line(istart:),length,dec,error)
                if (error)  return
                gtemp%gil%d0 = dec*pi/180.0d0
              endif
            else
              call sic_r8(line,o_proj,3,y0,.false.,error)
              if (error) return
            endif
          endif
        elseif (sic_present(o_proj,2)) then
          call map_message(seve%w,rname,'Declination ignored in AITOFF')
          gtemp%gil%d0 = 0.0d0
        endif
        !
        if (sic_present(o_proj,2)) then
          if (funit.eq.0) then
            call sic_ke(line,o_proj,2,args,n,.false.,error)
            istart = sic_start(o_proj,2)
            length = sic_len(o_proj,2)
            ra = gtemp%gil%a0
            if (line(istart:istart+2).ne.'*') then
              call sic_sexa(line(istart:),length,ra,error)
              if (error)  return
              if (gtemp%char%syst.eq.'EQUATORIAL'.or.gtemp%char%syst.eq.'ICRS') then
                ra = ra*pi/12.0d0
              else
                ra = ra*pi/180.0d0
              endif
            endif
            gtemp%gil%a0 = ra
          else
            call sic_r8(line,o_proj,2,x0,.false.,error)
            if (error) return            
          endif
        endif
        !
        iangle = 4   ! Pointer to Rotation Angle argument
        if (funit.ne.0) then
          ! Setup Input projection
          call gwcs_projec(gin%gil%a0,gin%gil%d0,gin%gil%pang,gin%gil%ptyp,gin_proj,error)
          if (error) return
          !
          x0 = x0*funit
          y0 = y0*funit
          call rel_to_abs(gin_proj,x0,y0,gtemp%gil%a0,gtemp%gil%d0,1)
          iangle = 5    ! Pointer to Rotation Angle argument
        endif
        !
        ! Angle
        if (sic_present(o_proj,iangle)) then
          if (type.eq.p_aitoff) then
            call map_message(seve%w,rname,'Angle ignored in AITOFF')
            ang = 0.d0
          elseif (type.eq.p_radio) then
            call map_message(seve%w,rname,'Angle ignored in RADIO')
            ang = 0.d0
          else
            istart = sic_start(o_proj,iangle)
            length = sic_len(o_proj,iangle)
            call sic_sexa(line(istart:),length,ang,error)
            if (error)  return
            ang = ang*pi/180.0d0
          endif
          gtemp%gil%pang = ang
        endif
      elseif (sic_present(o_proj,1)) then
        call map_message(seve%w,rname,'Projection center ignored in /TYPE NONE')
      endif
      !
    endif
    !
    ! /X_AXIS N Ref Val Inc
    if (sic_present(o_xaxis,0)) then
      call sic_i4(line,o_xaxis,1,nc,.true.,error)
      if (error) return
      ! Set default resampling
      convert = gtemp%gil%convert(:,1)
      !
      call sic_r8(line,o_xaxis,2,convert(1),.false.,error)
      if (error) return
      call sic_r8(line,o_xaxis,3,convert(2),.false.,error)
      if (error) return
      call sic_r8(line,o_xaxis,4,convert(3),.false.,error)
      if (error) return
      gtemp%gil%convert(:,1) = convert
      gtemp%gil%dim(1) = nc
    endif
    ! /Y_AXIS N Ref Val Inc
    if (sic_present(o_yaxis,0)) then
      call sic_i4(line,o_yaxis,1,nc,.true.,error)
      if (error) return
      ! Set default resampling
      convert = gtemp%gil%convert(:,2)
      !
      call sic_r8(line,o_yaxis,2,convert(1),.false.,error)
      if (error) return
      call sic_r8(line,o_yaxis,3,convert(2),.false.,error)
      if (error) return
      call sic_r8(line,o_yaxis,4,convert(3),.false.,error)
      if (error) return
      gtemp%gil%convert(:,2) = convert
      gtemp%gil%dim(2) = nc
    endif
    !
  endif
  !
  call gildas_null(gout)
  call gdf_copy_header(gin,gout,error)
  call s_reproject_init(gin,gtemp,gout,sys_code,error)
  if (error) return
  !
  call sic_ch(line,0,1,fich,n,.true.,error)
  if (error) return
  !
  ! Test matching positions to avoid useless resampling
  call position_check(rname,gin,gout,match)
  !
  ! Now handle the Output 
  out_image = .false.
  if (index(fich,'.').eq.0) then 
    out_image = .true.
    ! This must be an existing SIC Image variable
    rdonly = .false.
    call sub_readhead (rname,fich,gtemp,out_image,error,rdonly,fmt_r4)
    if (error) return
    do i=gtemp%gil%ndim+1,gout%gil%ndim
      gtemp%gil%dim(i) = 1
    enddo
    !
    !TEST!Print *,'OUT ',gout%gil%ndim,gout%gil%dim(1:4)
    !TEST!Print *,'Existing ',gtemp%gil%ndim,gtemp%gil%dim(1:4)
    !
    ! With a conforming shape with GOUT slot 
    do i=1,max(gtemp%gil%ndim,gout%gil%ndim) 
      if (gout%gil%dim(i).ne.gtemp%gil%dim(i)) then
        call map_message(seve%e,rname,'Output SIC variable does not match Template data shape')
        error = .true.
        return
      endif
    enddo
    !
    ! OK, the shapes are conforming
    call adtoad(gtemp%loca%addr,cptr,1)
    call c_f_pointer(cptr,gout%r3d,gtemp%gil%dim(1:3))
  else
    out_image = .false.
    ! This is  a file, we must create it
    call sic_parsef(fich,gout%file,' ','.gdf')
    call gdf_allocate(gout,error)
    if (error) return
  endif
  !
  ! Get the IN data pointer
  if (in_image) then
    call adtoad(gin%loca%addr,cptr,1)
    call c_f_pointer(cptr,gin%r3d,gin%gil%dim(1:3))
  else
    call gdf_allocate(gin,error)
    if (error) return
    call gdf_read_data(gin,gin%r3d,error)
    if (error) return
    call gdf_close_image(gin,error) ! not needed it anymore
  endif
  !
  if (match) then
    ! There are 3 cases of useless copy implied here, but it is
    ! much simpler than testing combinations of in_image / out_image
    gout%r3d = gin%r3d
  else
    call s_reproject_do(gin,gin%r3d,gout,gout%r3d,sys_code,error)
    if (error) return
  endif
  !
  if (.not.out_image) then
    call gdf_write_image(gout,gout%r3d,error)
  else  
    ! We need the descriptor as output in this case...
    call sic_descriptor(fich,desc,found)      
    call gdf_copy_header(gout,desc%head,error)
  endif
  !  
end subroutine map_reproject_comm
!
subroutine s_reproject_init(in,tem,out,sys_code,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for MAP_REPROJECT
  !
  !     Prepare Spatial resampling of a data cube as specified by 
  !       a Template.
  !     Prepare the Ouput header and Code
  !!
  !---------------------------------------------------------------------  
  type(gildas), intent(in) :: in        !! Input data cube
  type(gildas), intent(in) :: tem       !! Grid template
  type(gildas), intent(inout) :: out    !! Output data cube
  integer, intent(out) :: sys_code      !! Reprojection code
  logical, intent(out) :: error         !! Logical error code
  !
  character(len=*), parameter :: pname='REPROJECT'
  !
  ! Local ---
  integer :: o_xaxi,o_yaxi,t_xaxi,t_yaxi
  !
  ! Code ----
  sys_code = 0
  call sanity_check(pname,tem,error)
  if (error) return
  !
  ! Copy part of header of Template, but NOT the Resolution section !...
  out%char%syst = tem%char%syst
  out%gil%ra   = tem%gil%ra
  out%gil%dec  = tem%gil%dec
  out%gil%lii  = tem%gil%lii
  out%gil%bii  = tem%gil%bii
  out%gil%epoc = tem%gil%epoc
  out%gil%ptyp = tem%gil%ptyp
  out%gil%a0   = tem%gil%a0
  out%gil%d0   = tem%gil%d0
  out%gil%pang = tem%gil%pang
  ! Beware of the projection axis (default 1,2)
  o_xaxi = out%gil%xaxi
  if (o_xaxi.eq.0) o_xaxi = 1
  o_yaxi = out%gil%yaxi
  if (o_yaxi.eq.0) o_yaxi = 2
  t_xaxi = tem%gil%xaxi
  if (t_xaxi.eq.0) t_xaxi = 1
  t_yaxi = tem%gil%yaxi
  if (t_yaxi.eq.0) t_yaxi = 2
  out%char%code(o_xaxi) = tem%char%code(t_xaxi)
  out%char%code(o_yaxi) = tem%char%code(t_yaxi)
  out%gil%dim(o_xaxi) = tem%gil%dim(t_xaxi)
  out%gil%dim(o_yaxi) = tem%gil%dim(t_yaxi)
  out%loca%size = out%gil%dim(1)*out%gil%dim(2)*out%gil%dim(3)*out%gil%dim(4)
  out%gil%proj_words = tem%gil%proj_words
  out%gil%convert(:,o_xaxi) = tem%gil%convert(:,t_xaxi)
  out%gil%convert(:,o_yaxi) = tem%gil%convert(:,t_yaxi)
  !
  call get_sys_code(in,out,sys_code, error)
  if (error) return
  !
end subroutine s_reproject_init
!
subroutine s_reproject_do(in,din,out,dout,sys_code,error)
  use image_def
  use gkernel_interfaces
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for MAP_REPROJECT
  !
  !     Spatial resampling of a data cube, according to Header and Code
  !     Use s_reproject_init to prepare the Output header
  !!
  !---------------------------------------------------------------------  
  type(gildas), intent(in) :: in      !! Input Header
  type(gildas), intent(inout) :: out  !! Output Header
  real, intent(in) :: din(in%gil%dim(1),in%gil%dim(2),in%gil%dim(3))  !! Input data
  real, intent(out) :: dout(out%gil%dim(1),out%gil%dim(2),out%gil%dim(3))  !! Output data
  integer, intent(in) :: sys_code     !! Reprojection code
  logical, intent(inout) :: error     !! Logical error flag
  !
  character(len=*), parameter :: rname='REPROJECT'
  !
  ! Local ---
  real :: in_blank(2)  ! Input blanking
  logical :: doblank
  !
  ! Code ----
  !
  ! Set blanking
  in_blank = [in%gil%bval,in%gil%eval] 
  out%gil%blan_words = 2
  if (in%gil%blan_words.eq.0) then
    in_blank = [0.,-1.]
  endif
  !
  ! Method of solution
  if (in_blank(2).lt.0.0) then
    call map_message(seve%i,rname, &
    & 'Using bilinear gridding method with no input blanking')
  else
    call map_message(seve%i,rname, &
    & 'Using bilinear gridding method with input blanking')
  endif
  !
  call gridlin(                                                     &
    din,in%gil%dim(1),in%gil%dim(2),in%gil%dim(3),                  &
    in%gil%convert,in%gil%ptyp,[in%gil%a0,in%gil%d0,in%gil%pang],in%gil%epoc,in_blank,      &
    dout,out%gil%dim(1),out%gil%dim(2),                             &
    out%gil%convert,out%gil%ptyp,[out%gil%a0,out%gil%d0,out%gil%pang],out%gil%epoc,out%gil%bval, &
    doblank,sys_code,error)
  if (doblank) out%gil%eval = 0.
  !
end subroutine s_reproject_do
!
subroutine sanity_check(rname,x,error)
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !-------------------------------------------------------------------
  ! @ private
  !*
  !  IMAGER -- Sanity check for input or template file usage in the
  !   MAP_REPROJECT command context
  !!
  !-------------------------------------------------------------------
  character(len=*), intent(in) :: rname  !! Caller name
  type(gildas), intent(in)    :: x       !! Data eader
  logical,      intent(inout) :: error   !! Logical error flag
  !
  if (x%gil%ptyp.eq.p_none) return
  !
  ! Check if the 2 first dimensions are spatial. We could support any
  ! order but this is not implemented (and would be unefficient)
  if (x%gil%xaxi*x%gil%yaxi.ne.2) then
    call map_message(seve%e,rname,'Spatial dimensions must be first and second dimensions')
    error = .true.
    return
  endif
  !
end subroutine sanity_check
!
subroutine position_check(rname,x,y,result)
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !-------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Position check for input and template files usaage in
  ! the MAP_REPROJECT command context
  !!
  !-------------------------------------------------------------------
  character(len=*), intent(in) :: rname   !! Caller name
  type(gildas), intent(in)    :: x,y      !! Input and Template headers
  logical,      intent(inout) :: result   !! Logical error flag
  !
  ! Check whether the 2 first dimensions match, and the projection also
  result = .false.
  if (any(x%gil%dim(1:2).ne.y%gil%dim(1:2))) return
  if (any(x%gil%convert(:,1:2).ne.y%gil%convert(:,1:2))) return
  if (x%char%syst.ne.y%char%syst) return
  if (x%char%syst.eq.'EQUATORIAL') then
    if (x%gil%epoc.ne.y%gil%epoc) return
  endif
  if (x%gil%a0.ne.y%gil%a0) return
  if (x%gil%d0.ne.y%gil%d0) return
  if (x%gil%pang.ne.y%gil%pang) return
  if (x%gil%ptyp.ne.y%gil%ptyp) return
  result = .true.
  call map_message(seve%i,rname,'Input images match spatially')
end subroutine position_check
!
subroutine get_sys_code(in,out,sys_code,error)
  use gbl_format
  use image_def
  use gbl_message
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  !*
  ! GILDAS  Utility
  !
  ! Get old-system to new-system conversion code.
  ! Trap illegal/impossible conversions.
  !
  ! Caution: ICRS not yet supported here
  !---------------------------------------------------------------------
  type(gildas),    intent(in)  :: in          !! Input header
  type(gildas),    intent(in)  :: out         !! Desired output header
  integer(kind=4), intent(out) :: sys_code    !! Conversion code
  logical,         intent(out) :: error       !! Logical error flag
  !
  ! Constants
  character(len=*), parameter :: pname='REPROJECT'
  integer(kind=4), parameter :: conv_none   = 0
  integer(kind=4), parameter :: conv_equ2gal= 1
  integer(kind=4), parameter :: conv_gal2equ=-1
  integer(kind=4), parameter :: conv_equ2equ=-2
  !
  error = .false.
  select case (out%char%syst)
  case ('GALACTIC')
    if (in%char%syst.eq.'EQUATORIAL') then
      sys_code = conv_equ2gal
    elseif (in%char%syst.eq.'GALACTIC') then
      sys_code = conv_none
    else
      error = .true.
    endif
    !
  case ('EQUATORIAL')
    if (in%char%syst.eq.'EQUATORIAL') then
      if (in%gil%epoc.ne.out%gil%epoc) then
        ! Both Equatorial, not same equinox
        call map_message(seve%i,pname, &
          & 'Converting from equinox '//trim(equinox_name(in%gil%epoc))//  &
          &                     ' to '//trim(equinox_name(out%gil%epoc)))
        sys_code = conv_equ2equ
      else
        ! Both Equatorial, same equinox
        sys_code = conv_none
      endif
    elseif (in%char%syst.eq.'GALACTIC') then
      sys_code = conv_gal2equ
    else
      error = .true.
    endif
    !
  case ('UNKNOWN')
    if (in%char%syst.eq.'GALACTIC') then
      error = .true.
    elseif (in%char%syst.eq.'EQUATORIAL') then
      error = .true.
    else
      sys_code = conv_none
    endif
    !
  case default
    call map_message(seve%w,pname,'Unknown system '//out%char%syst//', no conversion applied')
    sys_code = conv_none
    !
  end select
  !
  if (error) then
    call map_message(seve%e,pname,'Cannot convert from '//in%char%syst//' to '//out%char%syst)
  endif
  return
  !
contains
  function equinox_name(equinox)
    !! Returns printable name of Equinox number
    real(kind=4), intent(in) :: equinox
    character(len=10) :: equinox_name
    if (equinox.eq.equinox_null) then
      equinox_name = 'Unknown'
    else
      write(equinox_name,'(F0.2)') equinox
    endif
  end function equinox_name
  !
end subroutine get_sys_code
!
subroutine gridlin(a,mx,my,mz,aconv,atype,aproj,aepoc,ablank,  &
                   b,nx,ny,   bconv,btype,bproj,bepoc,bblank,  &
                   doblank, code,error)
  use gildas_def
  use gkernel_interfaces, no_interface1=>abs_to_rel_1dn4,  &
                          no_interface2=>rel_to_abs_1dn4
  use gkernel_types
  !$ use omp_lib
  !---------------------------------------------------------------------
  ! @ private
  !
  !   IMAGER -- Regrid a map on a different grid and projection system.
  !
  !     Extracted from GREG Stand alone subroutine.
  !  Regrid an input map in a given projection to an output map in
  !  another projection, bilinear interpolation
  !!
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in) :: mx    !! X Size of A
  integer(kind=index_length), intent(in) :: my    !! Y Size of A
  integer(kind=index_length), intent(in) :: mz    !! 3rd dimension of A
  real(kind=4), intent(in)    :: a(mx,my,mz)      !! Input map of dimensions MX MY MZ
  real(kind=8), intent(in)    :: aconv(6)         !! Pixel conversion 
  !! formulae: CONV(1) = Xref, CONV(2)=Xval, CONV(3)=Xinc
  integer(kind=4), intent(in) :: atype            !! Type of projection
  real(kind=8), intent(in)    :: aproj(3)         !! Projection constants 
  !! PROJ(1)=A0, PROJ(2)=D0, PROJ(3)=Angle
  real(kind=4), intent(in)    :: aepoc            !! Epoch if Needed
  real(kind=4), intent(in)    :: ablank(2)        !! Blanking values
  integer(kind=index_length), intent(in) :: nx    !! X Size of B
  integer(kind=index_length), intent(in) :: ny    !! Y Size of B
  real(kind=4), intent(out)   :: b(nx,ny,mz)      !! Output map 
  real(kind=8), intent(in)    :: bconv(6)         !! Pixel conversion 
  !! formulae: CONV(1) = Xref, CONV(2)=Xval, CONV(3)=Xinc
  integer(kind=4), intent(in) :: btype            !! Type of projection
  real(kind=8), intent(in)    :: bproj(3)         !! Projection constants 
  real(kind=4), intent(in)    :: bepoc            !! Epoch if Needed
  real(kind=4), intent(in)    :: bblank           !! Blanking value
  integer(kind=4), intent(in) :: code             !! Sytem conversion code
  !! Galactic to Equatorial (-1) or Equatorial to Galactic (1) or 0 (none)
  logical, intent(out) :: doblank                 !! Was blanking applied ?
  logical, intent(out) :: error                   !! Logical error flag
  !
  ! Constants
  integer(kind=4), parameter :: conv_none   = 0
  integer(kind=4), parameter :: conv_equ2gal= 1
  integer(kind=4), parameter :: conv_gal2equ=-1
  integer(kind=4), parameter :: conv_equ2equ=-2
  !
  ! Local ---
  real(kind=4) :: bval,eval
  integer(kind=index_length) :: ia,ja,k
  integer(kind=4) :: ib,jb,ier
  real(kind=8) :: axref,axval,axinc, ayref,ayval,ayinc
  real(kind=8) :: bxref,bxval,bxinc, byref,byval,byinc
  real(kind=8) :: xa,ya
  real(kind=4) :: xr,yr
  ! Work arrays to handle the coordinates conversion
  real(kind=8), allocatable :: axb(:),ayb(:),bxb(:),byb(:)
  real(kind=8), allocatable :: xb(:,:), yb(:,:)
  type(projection_t) :: proj
  integer :: ithread,nthread
  integer :: nxy, nblank
  integer, allocatable :: blanked(:)
  !
  ! Code ----
  error = .false.
  !
  ! Preliminary processing
  bval=ablank(1)
  eval=ablank(2)
  nxy = nx*ny
  !
  ! I force the conversion formula for input to be adapted to the
  ! NINT function that will be used below. Now Xref=1.0
  axref = 1.0d0                ! was ACONV(1)
  axval = (1.0d0-aconv(1))*aconv(3)+aconv(2)
  axinc = aconv(3)
  ayref = 1.0d0                ! was ACONV(4)
  ayval = (1.0d0-aconv(4))*aconv(6)+aconv(5)
  ayinc = aconv(6)
  ! the output is unchanged.
  bxref = bconv(1)
  bxval = bconv(2)
  bxinc = bconv(3)
  byref = bconv(4)
  byval = bconv(5)
  byinc = bconv(6)
  !
  ! Setup Output projection
  error = .false.
  call gwcs_projec(bproj(1),bproj(2),bproj(3),btype,proj,error)
  if (error) return
  !
  if (code.ne.conv_none) then
    allocate(xb(nx,ny),yb(nx,ny),axb(nxy),ayb(nxy),bxb(nxy),byb(nxy),stat=ier)
  else
    allocate(xb(nx,ny),yb(nx,ny),axb(nxy),ayb(nxy),stat=ier)
  endif
  if (ier.ne.0) then
    error = .true.
    return
  endif    
  ! Convert Output projection to Absolute coordinates
  do jb=1,ny
    do ib=1,nx
      xb(ib,jb) = (ib-bxref)*bxinc + bxval
      yb(ib,jb) = (jb-byref)*byinc + byval
    enddo
  enddo
  !
  if (code.ne.conv_none) then
    call rel_to_abs_1dn4(proj,xb,yb,bxb,byb,nxy)
    !
    ! Change coordinate system. use new epoch also. Warning: codes are
    ! reversed since we start form output map!
    if (code.eq.1) then
      call gal_equ(bxb,byb,axb,ayb,aepoc,nxy,error)
    elseif (code.eq.-1) then
      call equ_gal(bxb,byb,bepoc,axb,ayb,nxy,error)
    elseif (code.eq.-2) then
      call equ_equ(bxb,byb,bepoc,axb,ayb,aepoc,nxy,error)
    endif
    if (error) return
  else
    call rel_to_abs_1dn4(proj,xb,yb,axb,ayb,nxy)
  endif
  !
  ! Setup Input projection
  call gwcs_projec(aproj(1),aproj(2),aproj(3),atype,proj,error)
  if (error) return
  !
  ! Convert Absolute coordinates to input projection
  call abs_to_rel_1dn4(proj,axb,ayb,xb,yb,nxy)
  !
  ! Interpolate
  !
  ! Take Blanking into account, version #1
  if (eval.lt.0.0) then
    nthread = 1
    !$ nthread = omp_get_max_threads()
    allocate(blanked(nthread))
    blanked = 0
    ! Loop over Output data points
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP &  SHARED(xb,yb,b,a, mz,mx,my,nx,ny, blanked) &
    !$OMP &  SHARED(axinc, axval, axref, ayinc, ayval, ayref,bblank) &
    !$OMP &  PRIVATE(k,ib,jb,xa,ya,xr,yr,ia,ja, nthread, ithread)
    ithread = 1
    !$ ithread = omp_get_thread_num()+1
    !$OMP DO COLLAPSE (2)
    do k = 1,mz
      do jb = 1,ny
        do ib = 1,nx
          !
          ! Find pixel coordinate in input map
          xa = xb(ib,jb)
          ya = yb(ib,jb)
          xr = (xa-axval)/axinc+axref
          yr = (ya-ayval)/ayinc+ayref
          ia = int(xr)
          ja = int(yr)
          !
          ! Avoid edges
          if (ia.lt.1 .or. ia.gt.mx .or. ja.lt.1 .or. ja.gt.my) then
            b(ib,jb,k) = bblank
            blanked(ithread) = blanked(ithread)+1
          else
            if (ia.eq.mx) ia = ia-1
            if (ja.eq.my) ja = ja-1
            ! Interpolate
            xr = xr-dble(ia)
            yr = yr-dble(ja)
            b(ib,jb,k) = (1-xr)*(1-yr)*a(ia,ja,k)+   &
                         xr*(1-yr)*a(ia+1,ja,k)+   &
                         xr*yr*a(ia+1,ja+1,k)+   &
                         (1-xr)*yr*a(ia,ja+1,k)
          endif
        enddo
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
    nblank = sum(blanked)/mz
    doblank = nblank.ne.0
  else
    doblank = .true.
    ! Loop over Output data points
    !$OMP PARALLEL DEFAULT(NONE) &
    !$OMP &  SHARED(xb,yb,b,a, mz,mx,my,nx,ny) &
    !$OMP &  SHARED(axinc, axval, axref, ayinc, ayval, ayref, bblank, bval, eval) &
    !$OMP &  PRIVATE(k,ib,jb,xa,ya,xr,yr,ia,ja)
    !$OMP DO COLLAPSE (2)
    do k = 1,mz
      do jb = 1,ny
        do ib = 1,nx
          xa = xb(ib,jb)
          ya = yb(ib,jb)
          xr = (xa-axval)/axinc+axref
          yr = (ya-ayval)/ayinc+ayref
          ia = int(xr)
          ja = int(yr)
          if (ia.lt.1 .or. ia.gt.mx .or. ja.lt.1 .or. ja.gt.my) then
            b(ib,jb,k) = bblank
          else
            if (ia.eq.mx) ia = ia-1
            if (ja.eq.my) ja = ja-1
            if (abs(a(ia,ja,k)-bval).le.eval) then
              b(ib,jb,k) = bblank
            elseif (abs(a(ia+1,ja,k)-bval).le.eval) then
              b(ib,jb,k) = bblank
            elseif (abs(a(ia,ja+1,k)-bval).le.eval) then
              b(ib,jb,k) = bblank
            elseif (abs(a(ia+1,ja+1,k)-bval).le.eval) then
              b(ib,jb,k) = bblank
            else
              xr = xr-float(ia)
              yr = yr-float(ja)
              b(ib,jb,k) = (1-xr)*(1-yr)*a(ia,ja,k)+  &
                           xr*(1-yr)*a(ia+1,ja,k)+   &
                           xr*yr*a(ia+1,ja+1,k)+   &
                           (1-xr)*yr*a(ia,ja+1,k)
            endif
          endif
        enddo
      enddo
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
  endif
  !
end subroutine gridlin
