program reproject
  use gildas_def
  use image_def
  use gbl_format
  use gbl_constant
  use phys_const
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! GDF Stand alone program
  !  Resample an input image to a different projection system. Now
  ! accepts EPOCH conversion for Equatorials. Forced interpolation to
  ! bilinear.
  !---------------------------------------------------------------------
  ! Local
  character(len=*), parameter :: pname = 'REPROJECT'
  character(len=filename_length) :: namein,namete,nameout
  character(len=80) :: center_1,center_2
  logical :: error
  integer(kind=4) :: nkey,ier,sys_code
  integer(kind=8) :: space_gildas
  integer(kind=4), parameter :: msvoc=3
  character(len=16) :: pvocab(0:mproj),svocab(msvoc),key,argproj,argsyst,newsystem
  character(len=40) :: systchain
  character(len=132) :: chain
  type(gildas) :: in,tem,out
  integer(kind=4) :: n, dim(2), il, ib
  integer(kind=size_length) :: melem
  real(kind=4) :: arr(2),newepoch
  real(kind=8) :: center(2),angle,conv(6), convertx(3,4), converty(3,4)
  logical :: change,template
  real(kind=8), allocatable :: work1(:,:),work2(:,:)
  character(len=256) :: mess
  ! Data
  data conv/6*0/
  data svocab/'UNCHANGED','EQUATORIAL','GALACTIC'/
  !
  call gildas_open
  call gildas_char('Z_NAME$',namein)
  call gildas_char('X_NAME$',nameout)
  call gildas_logi('TEMPLATE$',template,1)
  if (template) then
    call gildas_char('Y_NAME$',namete)
  else
    call gildas_char('PROJECTION$',argproj)
    call gildas_char('SYSTEM$',systchain)
    call gildas_char('CENTER_1$',center_1)
    call gildas_char('CENTER_2$',center_2)
    call gildas_dble('ANGLE$',angle,1)
    call gildas_inte('DIMENSIONS$',dim,2)
    call gildas_dble('AXIS_1$',conv(1:3),3)
    call gildas_dble('AXIS_2$',conv(4:6),3)
  endif
  call gildas_logi('CHANGE$',change,1)
  if (change) call gildas_real('BLANKING$',arr,2)
  call gildas_close
  !
  call gildas_null(in)
  call gildas_null(tem)
  call gildas_null(out)
  !
  in%gil%ndim = 0
  in%gil%form = fmt_r4
  call gdf_read_gildas(in,namein,'.gdf',error,rank=0)
  if (error) then
    call gagout('F-'//pname//',  Cannot read input file')
    goto 100
  endif
  call sanity_check(in,error)
  if (error)  goto 100
  !
  ! Copy input header into output X header
  call gdf_copy_header(in,out,error)
  !
  ! Now define output
  if (template) then
    ! Whole header taken from template
    call gdf_read_gildas(tem,namete,'.gdf',error,data=.false.)
    if (error) then
      call gagout('F-'//pname//',  Cannot read template file')
      goto 100
    endif
    call sanity_check(tem,error)
    if (error)  goto 100
    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
    out%char%code(out%gil%xaxi) = tem%char%code(tem%gil%xaxi)
    out%char%code(out%gil%yaxi) = tem%char%code(tem%gil%yaxi)
    out%gil%dim(out%gil%xaxi) = tem%gil%dim(tem%gil%xaxi)
    out%gil%dim(out%gil%yaxi) = tem%gil%dim(tem%gil%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
    call r8tor8 (out%gil%convert,convertx,12)
    call r8tor8 (tem%gil%convert,converty,12)
    convertx(:,out%gil%xaxi) = converty(:,tem%gil%xaxi)
    convertx(:,out%gil%yaxi) = converty(:,tem%gil%yaxi)
    call r8tor8 (convertx,out%gil%convert,12) 
    call r8tor8 (converty,tem%gil%convert,12) 
    !
    call get_sys_code(in,out,sys_code)
  endif  ! template
  !
  n = lenc(nameout)
  call sic_parsef(nameout(1:n),out%file,' ','.gdf')
  if (.not.template) then
    ! Header copied from input file, and modified according to inputs
    call gdf_copy_header(in,tem,error)
    !
    if (argproj.ne.'UNCHANGED') then
      call sic_upper(argproj)
      n = lenc(argproj)
      if (n.ne.0) then
        call projnam_list(pvocab)  ! Get all projection names
        call sic_ambigs('PROJECTION',argproj,key,nkey,pvocab,1+mproj,error)
        if (error) goto 98
        out%gil%ptyp = nkey-1
      endif
    endif
    !
    ! Coordinate system
    ! Test presence of an epoch
    newepoch=tem%gil%epoc  ! Default is to reuse old epoch
    il = lenc(systchain)
    call sic_blanc(systchain,il)
    ib = index(systchain,' ')
    if (ib.ne.0.and.il.gt.ib) then
       read(systchain(ib+1:il),*,iostat=ier) newepoch
       if (ier.ne.0) then
          call gagout('W-'//pname//', Error decoding Epoch')
          newepoch=tem%gil%epoc
       endif
       argsyst=systchain(1:ib-1)
    else
       argsyst=systchain(1:il)
    endif
    ! Decode system string
    call sic_upper(argsyst)
    call sic_ambigs('SYSTEM',argsyst,newsystem,nkey,svocab,msvoc,error)
    if (error) goto 99
    if (newsystem.ne.'UNCHANGED') then
      out%char%syst = newsystem
      out%gil%epoc = newepoch
      call get_sys_code(tem,out,sys_code)
    else
      sys_code = 0
    endif
    !
    ! Apply new system on projection center:
    call sic_upper(center_1)
    call sic_upper(center_2)
    if (center_1.eq.'UNCHANGED'.or.center_2.eq.'UNCHANGED')  then
      if (out%char%syst.eq.'ICRS') then
        if (tem%char%syst.eq.'ICRS') then  ! From ICRS to ICRS
          continue  ! Nothing to be done
        else
          call gagout('F-'//pname//',  Converting system to ICRS is not implemented')
          goto 100
        endif
      elseif (out%char%syst.eq.'EQUATORIAL') then
        if (tem%char%syst.eq.'ICRS') then  ! From ICRS to Equatorial
          call gagout('F-'//pname//',  Converting system from ICRS is not implemented')
          goto 100
        elseif (tem%char%syst.eq.'EQUATORIAL') then  ! From Equatorial to Equatorial
          call equ_equ(tem%gil%a0,tem%gil%d0,tem%gil%epoc,out%gil%a0,out%gil%d0,out%gil%epoc,error)
          if (error)  goto 100
        elseif (tem%char%syst.eq.'GALACTIC') then  ! From Galactic to Equatorial
          call gal_equ(tem%gil%a0,tem%gil%d0,out%gil%a0,out%gil%d0,out%gil%epoc,error)
          if (error)  goto 100
        else
          call gagout('F-'//pname//',  UNCHANGED Center not permitted here')
          goto 100
        endif
      elseif (out%char%syst.eq.'GALACTIC')then
        if (tem%char%syst.eq.'ICRS') then  ! From ICRS to Galactic
          call gagout('F-'//pname//',  Converting system from ICRS is not implemented')
          goto 100
        elseif (tem%char%syst.eq.'EQUATORIAL') then  ! From Equatorial to Galactic
          call equ_gal(tem%gil%a0,tem%gil%d0,tem%gil%epoc,out%gil%a0,out%gil%d0,error)
          if (error)  goto 100
        elseif (tem%char%syst.eq.'GALACTIC') then  ! From Galactic to Galactic
          continue  ! Nothing to be done
        else
          call gagout('F-'//pname//',  UNCHANGED Center not permitted here')
          goto 100
        endif
      endif
    else
      if (out%char%syst.eq.'EQUATORIAL' .or. out%char%syst.eq.'ICRS') then
        call sic_decode(center_1,center(1),24,error)
        if (error) goto 101
      else
        call sic_decode(center_1,center(1),360,error)
        if (error) goto 101
      endif
      call sic_decode(center_2,center(2),360,error)
      if (error) goto 101
      out%gil%a0 = center(1)
      out%gil%d0 = center(2)
    endif
    !
    ! Apply new system on source position
    if (out%char%syst.eq.'ICRS')then  ! From any to ICRS
      ! No recomputation of ra-dec and lii-bii (they should already be
      ! consistant)
      continue  ! Nothing to be done
    elseif (out%char%syst.eq.'EQUATORIAL') then
      if (tem%char%syst.eq.'ICRS') then  ! From ICRS to Equatorial
        call gagout('F-'//pname//',  Converting system from ICRS is not implemented')
        goto 100
      elseif (tem%char%syst.eq.'EQUATORIAL') then  ! From Equatorial to Equatorial
        ! Equatorial epoch may have changed. Compute ra-dec new epoch from
        ! ra-dec old epoch
        call equ_equ(tem%gil%ra,tem%gil%dec,tem%gil%epoc,out%gil%ra,out%gil%dec,out%gil%epoc,error)
        if (error)  goto 100
        ! Do not recompute lii-bii, should be unchanged
      elseif (tem%char%syst.eq.'GALACTIC')then  ! From Galactic to Equatorial
        ! Equatorial epoch may have changed. Compute ra-dec new epoch from
        ! lii-bii
        call gal_equ(tem%gil%lii,tem%gil%bii,out%gil%ra,out%gil%dec,out%gil%epoc,error)
        if (error)  goto 100
      endif
    elseif (out%char%syst.eq.'GALACTIC')then  ! From Equ|Gal to Galactic
      ! No recomputation of ra-dec and lii-bii (they should already be
      ! consistant, and equatorial epoch is unchanged)
      continue  ! Nothing to be done
    endif
    !
    ! Check angle
    if (angle.ne.0.d0 .and. (out%gil%ptyp.eq.p_radio .or.  &
                             out%gil%ptyp.eq.p_aitoff)) then
      chain = 'E-'//pname//',  Angle not supported in projection RADIO or AITOFF'
      call gagout(chain)
      chain = 'E-'//pname//',  Projection AZIMUTHAL can be prefered instead'
      call gagout(chain)
      call sysexi(fatale)
    endif
    out%gil%pang = angle*pi/180.d0
    !
    if (dim(1).eq.0 .or. dim(2).eq.0 .or. conv(3).eq.0 .or. conv(6).eq.0) then
      allocate(work1(in%gil%dim(1),in%gil%dim(2)),  &
               work2(in%gil%dim(1),in%gil%dim(2)),  &
               stat=ier)
      if (ier.ne.0) goto 103
      if (in%gil%blan_words.eq.0) then
        in%gil%bval = 0.0
        in%gil%eval = -1.0
      endif
      call findgrid(  &
        in%r1d,in%gil%dim(1),in%gil%dim(2),in%gil%dim(3)*in%gil%dim(4),  &
        in%gil%convert,in%gil%ptyp,in%gil%a0,in%gil%d0,in%gil%pang,in%gil%epoc,  &
        in%gil%bval,in%gil%eval,out%gil%ptyp,out%gil%a0,out%gil%d0,out%gil%pang,  &
        out%gil%epoc,sys_code, work1, work2, conv,dim)
      deallocate(work1,work2)
      !
      ! Check size so that we do not allocate more than SPACE_GILDAS
      ! (see allocations below: r1d (R4), work1 (R8), work2 (R8)
      space_gildas = 256
      ier = sic_getlog('SPACE_GILDAS',space_gildas)
      melem = space_gildas*1024*256/(max(1,out%gil%dim(3))*max(1,out%gil%dim(4)) + 2*2)
      if (dim(1)*dim(2).gt.melem) then
        write (mess,'(A,I0,A,I0,A,I0,A,I0,A)')  &
          'Computed Output Image size (',dim(1),'x',dim(2),  &
          ') has too many pixels (limit ',int(sqrt(real(melem))),'x',int(sqrt(real(melem))),').'
        call gagout(mess)
        call gagout('Increase SPACE_GILDAS or specify Output Image Header. STOP.')
        goto 100
      endif
    endif
    out%gil%dim(1) = dim(1)
    out%gil%dim(2) = dim(2)
    out%gil%dim(3) = max(1,out%gil%dim(3))
    out%gil%dim(4) = max(1,out%gil%dim(4))
    out%loca%size = out%gil%dim(1)*out%gil%dim(2)*out%gil%dim(3)*out%gil%dim(4)
    ! in case everything is not present in the input file:
    call r8tor8 (conv,out%gil%convert,6)
    out%gil%coor_words = 6*gdf_maxdims
    out%gil%blan_words = 2
    out%gil%extr_words = 6
    out%gil%desc_words = 18
    out%gil%posi_words = 12
    out%gil%proj_words = 9
  endif
  if (in%gil%blan_words.eq.0) then
    out%gil%blan_words = 2
    in%gil%bval = 0.0
    in%gil%eval = -1.0
    out%gil%bval = arr(1)
    out%gil%eval = arr(2)
  elseif (change) then
    out%gil%blan_words = 2
    out%gil%bval = arr(1)
    out%gil%eval = arr(2)
  endif
  !
  ! Method of solution
  call gagout('I-'//pname//',  Using bilinear gridding method')
  if (in%gil%eval.lt.0.0) then
    call gagout('              with no input blanking...')
  else
    call gagout('              taking input blanking in account')
  endif
  !
  ! Create output image
  if (out%char%syst.eq.'GALACTIC') then
     out%char%code(1) = 'LII'
     out%char%code(2) = 'BII'
  else if (out%char%syst.eq.'EQUATORIAL' .or. out%char%syst.eq.'ICRS') then
     out%char%code(1) = 'RA'
     out%char%code(2) = 'DEC'
  endif
  call gdf_create_image(out,error)
  if (error) then
    call gagout('F-'//pname//',  Cannot create out file:')
    call gagout(out%file)
    goto 100
  endif
  !
  allocate(out%r1d(out%loca%size), stat=ier)
  if (ier.ne.0) goto 103
  allocate(work1(out%gil%dim(1),out%gil%dim(2)),  &
           work2(out%gil%dim(1),out%gil%dim(2)),  &
           stat=ier)
  if (ier.ne.0) goto 103
  !
  call gagout ('Start computing')
  call gridlin(                                                  &
     in%r1d,in%gil%dim(1),in%gil%dim(2),in%gil%dim(3)*in%gil%dim(4),  &
     in%gil%convert,in%gil%ptyp,in%gil%a0,in%gil%d0,in%gil%pang,      &
     in%gil%epoc,in%gil%bval,in%gil%eval,      &
     out%r1d,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,    &
     sys_code,work1,work2)
  !
  deallocate(work1,work2)
  call gdf_write_data(out,out%r1d,error)
  !
  call gagout('S-'//pname//',  Successful completion')
  call sysexi(1)
  !
  ! Errors:
  !
100 call sysexi (fatale)
  !
98 call gagout('F-'//pname//',  Invalid projection system')
  call sysexi (fatale)
  !
99 call gagout('F-'//pname//',  Invalid coordinate system')
  call sysexi (fatale)
  !
101 call gagout('F-'//pname//',  Bad syntax in center coordinates')
  call sysexi (fatale)
  !
103 call gagout('F-'//pname//', Allocation error')
  call sysexi (fatale)
  !
contains
  subroutine sanity_check(x,error)
    use image_def
    !-------------------------------------------------------------------
    ! Sanity check for input or template file
    !-------------------------------------------------------------------
    type(gildas), intent(in)    :: x
    logical,      intent(inout) :: error
    !
    ! 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 gagout('F-'//pname//', Spatial dimensions must be first and second dimensions')
      error = .true.
      return
    endif
    !
  end subroutine sanity_check
end program reproject
!
subroutine get_sys_code(in,out,sys_code)
  use gbl_format
  use image_def
  !---------------------------------------------------------------------
  ! Get old-system to new-system conversion code
  ! Trap illegal/impossible conversions.
  !---------------------------------------------------------------------
  type(gildas),    intent(in)  :: in        ! Input header
  type(gildas),    intent(in)  :: out       ! Desired output header
  integer(kind=4), intent(out) :: sys_code  ! Conversion code
  ! Local
  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
  !
  select case (out%char%syst)
  case ('ICRS')
    if (in%char%syst.eq.'ICRS') then
      sys_code = conv_none
    else
      goto 102
    endif
    !
  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
      goto 102
    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 gagout('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
      goto 102
    endif
    !
  case ('UNKNOWN')
    if (in%char%syst.eq.'ICRS') then
      goto 102
    elseif (in%char%syst.eq.'GALACTIC') then
      goto 102
    elseif (in%char%syst.eq.'EQUATORIAL') then
      goto 102
    else
      sys_code = conv_none
    endif
    !
  case default
    call gagout('W-'//pname//', Unknown system '//out%char%syst//', no conversion applied')
    sys_code = conv_none
    !
  end select
  return
  !
102 continue
  call gagout('F-'//pname//', Cannot convert from '//in%char%syst//' to '//out%char%syst)
  call sysexi(fatale)
  !
contains
  function equinox_name(equinox)
    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 findgrid(a,mx,my,mz,aconv,atype,aa0,ad0,aangle,aepoc,abval,aeval,  &
                    btype,ba0,bd0,bangle,bepoc,code,dxd,dyd,bconv,bdim)
  use gildas_def
  use gbl_constant
  use gkernel_interfaces
  use gkernel_types
  !---------------------------------------------------------------------
  ! CONV(1) = Xref, CONV(2)=Xval, CONV(3)=Xinc
  ! CODE:   (-1) GAL --> EQU
  !         ( 1) EQU --> GAL
  !         (-2) EQU --> EQU
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in)    :: mx           ! Size of pseudo-map
  integer(kind=index_length), intent(in)    :: my           !
  integer(kind=index_length), intent(in)    :: mz           !
  real(kind=4),               intent(in)    :: a(mx,my,mz)  ! Pseudo-map
  real(kind=8),               intent(in)    :: aconv(6)     ! Pixel conversion formulae
  integer(kind=4),            intent(in)    :: atype        ! Type of projection
  real(kind=8),               intent(in)    :: aa0          ! Input projection A0
  real(kind=8),               intent(in)    :: ad0          ! Input projection D0
  real(kind=8),               intent(in)    :: aangle       ! Input projection Angle
  real(kind=4),               intent(in)    :: aepoc        ! Epoch if Needed
  real(kind=4),               intent(in)    :: abval        ! Blank val
  real(kind=4),               intent(in)    :: aeval        ! Blank errval
  integer(kind=4),            intent(in)    :: btype        ! Type of projection
  real(kind=8),               intent(in)    :: ba0          ! Output projection A0
  real(kind=8),               intent(in)    :: bd0          ! Output projection D0
  real(kind=8),               intent(in)    :: bangle       ! Output projection Angle
  real(kind=4),               intent(in)    :: bepoc        ! Epoch if Needed
  integer(kind=4),            intent(in)    :: code         ! Conversion code
  real(kind=8)                              :: dxd(*)       ! X work array
  real(kind=8)                              :: dyd(*)       ! Y work array
  real(kind=8),               intent(inout) :: bconv(6)     ! Output best conv
  integer(kind=4),            intent(inout) :: bdim(2)      ! Output best DIM
  ! Global
  real(kind=8), parameter :: pi=3.14159265358979323846d0
  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=8) :: boundary
  integer(kind=index_length) :: i,j
  integer(kind=4) :: ndp, ier
  real(kind=8) :: axref,axval,axinc, ayref,ayval,ayinc
  real(kind=8) :: dxmin,dxmax,dymin,dymax
  real(kind=8), allocatable :: adxd(:),adyd(:),bdxd(:),bdyd(:)
  real(kind=4) :: sizx,sizy,ratio
  character(len=80) :: chain
  logical :: warn,doxinc,doyinc
  type(projection_t) :: proj
  logical :: error
  !
  ! Preliminary processing
  axref = aconv(1)
  axval = aconv(2)
  axinc = aconv(3)
  ayref = aconv(4)
  ayval = aconv(5)
  ayinc = aconv(6)
  !
  ! Load X,Y,Z arrays
  !
  ! Setup Input projection
  error = .false.
  call gwcs_projec(aa0,ad0,aangle,atype,proj,error)
  !
  ! Convert Input projection to Absolute coordinates and load data points
  ndp=0
  do j=1,my
    do i=1,mx
      if (abs(a(i,j,1)-abval).gt.aeval) then
        ndp = ndp+1
        dxd(ndp) = (i-axref)*axinc + axval
        dyd(ndp) = (j-ayref)*ayinc + ayval
      endif
    enddo
  enddo
  call gagout('I-REPROJECT,  Evaluating Output Image Header...')
  write(chain,1000) ndp
  call gagout(chain)
  if (ndp.eq.0) then
    call gagout('No valid data points in input image')
    call sysexi(fatale)
  endif
  !
  if (code.ne.conv_none) then
    allocate(adxd(ndp),adyd(ndp),bdxd(ndp),bdyd(ndp),stat=ier)  
    if (ier.ne.0) then
      call gagout('Memory allocation error 1')
      call sysexi(fatale)
    endif
    call rel_to_abs(proj,dxd,dyd,bdxd,bdyd,ndp)
    !
    ! Change coordinate system. use new epoch also
    if (code.eq.1) then
      call equ_gal(bdxd,bdyd,aepoc,adxd,adyd,ndp,error)
    elseif (code.eq.-1) then
      call gal_equ(bdxd,bdyd,adxd,adyd,bepoc,ndp,error)
    elseif (code.eq.-2) then
      call equ_equ(bdxd,bdyd,aepoc,adxd,adyd,bepoc,ndp,error)
    endif
    if (error)  call sysexi(fatale)
  else
    allocate(adxd(ndp),adyd(ndp),stat=ier)  
    if (ier.ne.0) then
      call gagout('Memory allocation error 2')
      call sysexi(fatale)
    endif
    call rel_to_abs(proj,dxd,dyd,adxd,adyd,ndp)
  endif
  !
  ! Setup Output projection
  call gwcs_projec(ba0,bd0,bangle,btype,proj,error)
  !
  ! Convert Absolute coordinates to input projection
  call abs_to_rel(proj,adxd,adyd,dxd,dyd,ndp)
  !
  call bestbox(dxd,dyd,ndp,dxmin,dxmax,dymin,dymax)
  ! Test extreme cases of unbound projections:
  if (btype.eq.p_gnomonic) then    ! GNOMONIC
    boundary=1.5d0
  elseif (btype.eq.p_stereo) then  ! STEREOGRAPHIC
    boundary=1.0d0
  endif
  if (btype.eq.p_gnomonic .or. btype.eq.p_stereo) then
    if (dxmin.lt.-boundary) then
      warn=.true.
      dxmin=-boundary
    endif
    if (dymin.lt.-boundary) then
      warn=.true.
      dymin=-boundary
    endif
    if (dxmax.gt.boundary) then
      warn=.true.
      dxmax=boundary
    endif
    if (dymax.gt.boundary) then
      warn=.true.
      dymax=boundary
    endif
    if (warn) then
      call gagout('W-REPROJECT, Output Projection is unbound')
      call gagout('Will be limited to one hemisphere')
    endif
  endif
  !
  sizx=dxmax-dxmin
  sizy=dymax-dymin
  ratio=sizx/sizy
  doxinc = bconv(3).eq.0.d0
  doyinc = bconv(6).eq.0.d0
  ! If user gave number of pixels, use it
  if (bdim(2).eq.0)  bdim(2) = nint(sqrt(float(mx*my)*2.0/ratio))
  if (bdim(1).eq.0)  bdim(1) = nint(float(bdim(2))*ratio)
  ! If user gave increments, override BDIM
  if (.not.doxinc)  bdim(1) = sizx/abs(bconv(3))+1
  if (.not.doyinc)  bdim(2) = sizy/abs(bconv(6))+1
  !
  ! Compute increments from BDIM if requested
  if (doxinc)  bconv(3) = sizx/(bdim(1)-1)  ! Xinc is automatic
  if (doyinc)  bconv(6) = sizy/(bdim(2)-1)  ! Yinc is automatic
  if (doxinc.and.doyinc) then  ! Both Xinc and Yinc are automatic
    ! At this stage the automatic increments may be slightly different because
    ! bdim(1)/bdim(2) differs slightly from sizx/sizy (nint() rounding). Prefer
    ! equal increments. Select the one which ensures no loss of map coverage.
    if (bconv(3).gt.bconv(6)) then
      bconv(6) = bconv(3)
    else
      bconv(3) = bconv(6)
    endif
  endif
  ! Keep input map conventions, if any.
  if (doxinc .and. aconv(3).lt.0.d0)  bconv(3) = -bconv(3)
  if (doyinc .and. aconv(6).lt.0.d0)  bconv(6) = -bconv(6)
  !
  ! VAL(1)=bconv(2) is left unmodified. 0 means aligned on projection center.
  ! REF(1)=bconv(1):
  if (bconv(1).eq.0.d0) then
    ! Automatic mode: set REFerence pixel so that 1st pixel is aligned on image boundary
    if (bconv(3).gt.0.d0) then  ! inc(1)
      bconv(1) = 1.d0-(dxmin-bconv(2))/bconv(3)  ! ref(1) so that 1st pixel (1.0) is aligned on dxmin
    else
      bconv(1) = 1.d0-(dxmax-bconv(2))/bconv(3)  ! ref(1) (same, at dxmax)
    endif
    ! Round ref(1) to an integer value so that the projection center at the
    ! middle of a pixel. Use nearest value towards Nx/2+1 so that we stay as
    ! near as possible to the Fourier Transform solution.
    if (bconv(1).lt.bdim(1)/2.d0+1.d0) then
      bconv(1) = ceiling(bconv(1))
    else
      bconv(1) = floor(bconv(1))
    endif
  else
    ! Leave user defined REF(1)
    continue
  endif
  !
  ! VAL(2)=bconv(5) is left unmodified. 0 means aligned on projection center.
  ! REF(2)=bconv(4):
  if (bconv(4).eq.0.d0) then
    ! Automatic mode: set REFerence pixel so that 1st pixel is aligned on image boundary
    if (bconv(6).gt.0.d0) then  ! inc(2)
      bconv(4) = 1.d0-(dymin-bconv(5))/bconv(6)  ! ref(2) so that 1st pixel (1.0) is aligned on dymin
    else
      bconv(4) = 1.d0-(dymax-bconv(5))/bconv(6)  ! ref(2) (same, at dymax)
    endif
    ! Round ref(2) to an integer value so that the projection center at the
    ! middle of a pixel. Use nearest value towards Ny/2+1 so that we stay as
    ! near as possible to the Fourier Transform solution.
    if (bconv(4).lt.bdim(2)/2.d0+1.d0) then
      bconv(4) = ceiling(bconv(4))
    else
      bconv(4) = floor(bconv(4))
    endif
  else
    ! Leave user defined REF(2)
    continue
  endif
  !
  write(*,100)
  write(*,101) bdim(1),(bconv(j),j=1,3)
  write(*,102) bdim(2),(bconv(j),j=4,6)
  !
  return
100 format ('Output Image header values:',   &
          /,'Axis Npix     Ref          Val            Inc')
101 format ('  1 ',i4,1x,3(g12.5e2,1x))
102 format ('  2 ',i4,1x,3(g12.5e2,1x))
1000 format ('              Found ',i8,' Valid points')
end subroutine findgrid
!
subroutine bestbox(dxd,dyd,ndp,dxmin,dxmax,dymin,dymax)
  real(kind=8) :: dxd(*)                  !
  real(kind=8) :: dyd(*)                  !
  integer(kind=4) :: ndp                    !
  real(kind=8) :: dxmin                   !
  real(kind=8) :: dxmax                   !
  real(kind=8) :: dymin                   !
  real(kind=8) :: dymax                   !
  ! Local
  integer(kind=4) :: i
  !
  dxmin=dxd(1)
  dxmax=dxd(1)
  dymin=dyd(1)
  dymax=dyd(1)
  do i=2,ndp
    dxmin=min(dxmin,dxd(i))
    dymin=min(dymin,dyd(i))
    dxmax=max(dxmax,dxd(i))
    dymax=max(dymax,dyd(i))
  enddo
  !
end subroutine bestbox
!
subroutine gridlin(a,mx,my,mz,aconv,atype,aa0,ad0,aangle,aepoc,abval,aeval,  &
                   b,nx,ny,   bconv,btype,ba0,bd0,bangle,bepoc,bbval,  &
                   code,xb,yb)
  use gildas_def
  use gkernel_interfaces, no_interface1=>abs_to_rel_1dn4,  &
                          no_interface2=>rel_to_abs_1dn4
  use gkernel_types
  !---------------------------------------------------------------------
  ! 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  ! Size of A
  integer(kind=index_length), intent(in) :: my  ! Size of A
  integer(kind=index_length), intent(in) :: mz  ! Size of A and B
  real(kind=4)    :: a(mx,my,mz)  ! Input map of dimensions MX MY MZ
  real(kind=8)    :: aconv(6)     ! Pixel conversion formulae: CONV(1) = Xref, CONV(2)=Xval, CONV(3)=Xinc
  integer(kind=4) :: atype        ! Type of projection
  real(kind=8)    :: aa0          ! Input projection A0
  real(kind=8)    :: ad0          ! Input projection D0
  real(kind=8)    :: aangle       ! Input projection angle
  real(kind=4)    :: aepoc        ! Epoch if Needed
  real(kind=4)    :: abval        !
  real(kind=4)    :: aeval        !
  integer(kind=index_length), intent(in) :: nx  ! Size of B
  integer(kind=index_length), intent(in) :: ny  ! Size of B
  real(kind=4)    :: b(nx,ny,mz)  ! Output map of dimensions NX,NY,MZ
  real(kind=8)    :: bconv(6)     !
  integer(kind=4) :: btype        !
  real(kind=8)    :: ba0          ! Output projection A0
  real(kind=8)    :: bd0          ! Output projection D0
  real(kind=8)    :: bangle       ! Output projection angle
  real(kind=4)    :: bepoc        ! Epoch if Needed
  real(kind=4)    :: bbval        ! Blanking value
  integer(kind=4) :: code         ! Galactic to Equatorial (-1) or Equatorial to Galactic (1)
  real(kind=8)    :: xb(nx,ny)    ! Work arrays of dimension MX,MY
  real(kind=8)    :: yb(nx,ny)    ! Work arrays of dimension MX,MY
  !
  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
  integer(kind=index_length) :: ia,ja,k
  integer(kind=4) :: ib,jb,ier,n4
  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
  real(kind=8), allocatable :: axb(:),ayb(:),bxb(:),byb(:)
  type(projection_t) :: proj
  logical :: error
  !
  ! JP TEST
  ! print *,"a",aproj
  ! print *,"b",bproj
  ! aproj(3) = 0
  ! bproj(3) = 0
  !
  ! 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.0                  ! was ACONV(1)
  axval = (1.0-aconv(1))*aconv(3)+aconv(2)
  axinc = aconv(3)
  ayref = 1.0                  ! was ACONV(4)
  ayval = (1.0-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(ba0,bd0,bangle,btype,proj,error)
  !
  ! 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
    allocate(axb(nx*ny),ayb(nx*ny),bxb(nx*ny),byb(nx*ny),stat=ier)
    call rel_to_abs_1dn4(proj,xb,yb,bxb,byb,nx*ny)
    !
    ! Change coordinate system. use new epoch also. Warning: codes are
    ! reversed since we start form output map!
    n4 = nx*ny
    if (code.eq.1) then
      call gal_equ(bxb,byb,axb,ayb,aepoc,n4,error)
    elseif (code.eq.-1) then
      call equ_gal(bxb,byb,bepoc,axb,ayb,n4,error)
    elseif (code.eq.-2) then
      call equ_equ(bxb,byb,bepoc,axb,ayb,aepoc,n4,error)
    endif
    if (error)  call sysexi(fatale)
  else
    allocate(axb(nx*ny),ayb(nx*ny),stat=ier)
    call rel_to_abs_1dn4(proj,xb,yb,axb,ayb,nx*ny)
  endif
  !
  ! Setup Input projection
  call gwcs_projec(aa0,ad0,aangle,atype,proj,error)
  !
  ! Convert Absolute coordinates to input projection
  call abs_to_rel_1dn4(proj,axb,ayb,xb,yb,nx*ny)
  !
  ! Interpolate
  !
  ! Take Blanking into account, version #1
  if (aeval.lt.0.0) then
    ! Loop over Output data points
    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)
          xr = xr-float(ia)
          yr = yr-float(ja)
          !
          ! Avoid edges
          if (ia.lt.1 .or. ia.ge.mx .or. ja.lt.1 .or. ja.ge.my) then
            b(ib,jb,k) = bbval
          else
            ! Interpolate
            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
  else
    ! Loop over Output data points
    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)
          xr = xr-float(ia)
          yr = yr-float(ja)
          if (ia.lt.1 .or. ia.ge.mx .or. ja.lt.1 .or. ja.ge.my) then
            b(ib,jb,k) = bbval
          elseif (abs(a(ia,ja,k)-abval).le.aeval) then
            b(ib,jb,k) = bbval
          elseif (abs(a(ia+1,ja,k)-abval).le.aeval) then
            b(ib,jb,k) = bbval
          elseif (abs(a(ia,ja+1,k)-abval).le.aeval) then
            b(ib,jb,k) = bbval
          elseif (abs(a(ia+1,ja+1,k)-abval).le.aeval) then
            b(ib,jb,k) = bbval
          else
            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
  endif
  !
end subroutine gridlin
