!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_spatial_coordinates
  use cube_types
  use cubemain_messaging
  !
  public :: cubemain_spatial_corners,cubemain_spatial_reprojcoords
  public :: cubemain_spatial_relminrelmax
  public :: cubemain_spatial_pang_to_fortran,cubemain_spatial_fortran_to_pang
  private
  !
contains
  !
  subroutine cubemain_spatial_relminrelmax(cube,rmin,rmax,error)
    use cubetools_axis_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_t),      intent(in)    :: cube
    real(kind=coor_k), intent(out)   :: rmin(2)
    real(kind=coor_k), intent(out)   :: rmax(2)
    logical,           intent(inout) :: error
    !
    type(axis_t) :: desc
    integer(kind=code_k) :: naxis,iax
    character(len=*), parameter :: rname='SPATIAL>RELMINMAX'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    naxis = 2
    !
    do iax=1,naxis
       if (iax.eq.1) then
          call cubetools_header_get_axis_head_l(cube%head,desc,error)
       else
          call cubetools_header_get_axis_head_m(cube%head,desc,error)
       endif
       if(error) return
       !
       if (desc%inc.gt.0) then
          rmin(iax) = desc%inc * (0.5-desc%ref)
          rmax(iax) = desc%inc * (desc%n+0.5-desc%ref)
       else
          rmin(iax) = desc%inc * (desc%n+0.5-desc%ref)
          rmax(iax) = desc%inc * (0.5-desc%ref)
       endif
    enddo
  end subroutine cubemain_spatial_relminrelmax
  !
  subroutine cubemain_spatial_absminmax(cube,absmin,absmax,error)
    use gkernel_interfaces
    use gkernel_types
    use cubetools_spapro_types
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_t),      intent(in)    :: cube
    real(kind=coor_k), intent(out)   :: absmin(2)
    real(kind=coor_k), intent(out)   :: absmax(2)
    logical,           intent(inout) :: error
    !
    type(projection_t) :: gproj
    real(kind=coor_k) :: rmin(2),rmax(2),xdum(2),ydum(2),axdu(2),aydu(2)
    character(len=*), parameter :: rname='SPATIAL>ABSMINMAX'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call  cubemain_spatial_relminrelmax(cube,rmin,rmax,error)
    if(error) return
    !
    call cubetools_spapro_gwcs(cube%head%spa%pro,gproj,error)
    if(error) return
    !
    xdum(1) = rmin(1)
    ydum(1) = rmin(2)
    xdum(2) = rmax(1)
    ydum(2) = rmax(2)
    !
    call rel_to_abs_1dn4(gproj,xdum,ydum,axdu,aydu,2)
    !
    absmin(1) = axdu(1)
    absmin(2) = aydu(1)
    absmax(1) = axdu(2)
    absmax(2) = aydu(2)
  end subroutine cubemain_spatial_absminmax
  !
  subroutine cubemain_spatial_corners(cube,corners,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_t),      intent(in)    :: cube
    real(kind=coor_k), intent(out)   :: corners(2,4)
    logical,           intent(inout) :: error
    !
    real(kind=coor_k) :: rmin(2),rmax(2)
    character(len=*), parameter :: rname='SPATIAL>CORNERS'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_spatial_relminrelmax(cube,rmin,rmax,error)
    if(error) return
    !
    corners(1,1:2) = rmin(1)
    corners(1,3:4) = rmax(1)
    corners(2,1) = rmin(2)
    corners(2,4) = rmin(2)
    corners(2,2:3) = rmax(2)
  end subroutine cubemain_spatial_corners
  !
  subroutine cubemain_spatial_8points(cube,points,error)
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_t),      intent(in)    :: cube
    real(kind=coor_k), intent(out)   :: points(2,8)
    logical,           intent(inout) :: error
    !
    real(kind=coor_k) :: rmin(2),rmax(2),mid(2)
    character(len=*), parameter :: rname='SPATIAL>8POINTS'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_spatial_relminrelmax(cube,rmin,rmax,error)
    if(error) return
    !
    mid(:) = (rmax(:)+rmin(:))/2d0
    points(1,1)   = mid(1)
    points(1,2:4) = rmax(1)
    points(1,5)   = mid(1)
    points(1,6:8) = rmin(1)
    !
    points(2,1:2) = rmin(2)
    points(2,3)   = mid(2)
    points(2,4:6) = rmax(2)
    points(2,7)   = mid(2)
    points(2,8)   = rmin(2)
  end subroutine cubemain_spatial_8points
  !
  subroutine cubemain_spatial_reprojcoords(cube,incoords,refe,n,oucoords,error)
    use gkernel_interfaces
    use gkernel_types
    use cubetools_header_interface
    use cubetools_spapro_types
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_t),        intent(in)    :: cube
    real(kind=coor_k),   intent(in)    :: incoords(2,*)
    type(cube_t),        intent(in)    :: refe
    real(kind=coor_k),   intent(out)   :: oucoords(2,*)
    integer(kind=pixe_k),intent(in)    :: n
    logical,             intent(inout) :: error
    !
    type(projection_t) :: inproj,ouproj
    integer(kind=code_k) :: inframe,ouframe
    real(kind=equi_k) :: inequi,ouequi
    real(kind=coor_k), allocatable :: abscoords(:,:), tmpcoords(:,:)
    integer(kind=4) :: ier
    integer(kind=pixe_k) :: icoord
    character(len=fram_l) :: inframestr,ouframestr
    logical :: converror
    character(len=*), parameter :: rname='SPATIAL>REPROJCOORDS'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    allocate(abscoords(2,n),tmpcoords(2,n),stat=ier)
    if (failed_allocate(rname,'Absolute coordinates arrays',ier,error)) then
       error = .true.
       return
    endif
    !
    call cubetools_spapro_gwcs(cube%head%spa%pro,inproj,error)
    if(error) return
    call cubetools_spapro_gwcs(refe%head%spa%pro,ouproj,error)
    if(error) return
    !
    inframe = cube%head%spa%fra%code
    ouframe = refe%head%spa%fra%code
    inequi  = cube%head%spa%fra%equinox
    ouequi  = refe%head%spa%fra%equinox
    !
    converror = .false.
    select case (inframe)
    case(code_spaframe_equatorial)
       if (ouframe.eq.code_spaframe_equatorial) then
          if (inequi.eq.ouequi) then
             call rel_to_abs(inproj,incoords(1,1:n),incoords(2,1:n),&
                  abscoords(1,1:n),abscoords(2,1:n),n)
             call abs_to_rel(ouproj,abscoords(1,1:n),abscoords(2,1:n),&
                  oucoords(1,1:n),oucoords(2,1:n),n)
          else
             call rel_to_abs(inproj,incoords(1,1:n),incoords(2,1:n),&
                  tmpcoords(1,1:n),tmpcoords(2,1:n),n)
             do icoord=1,n
                call equ_equ(tmpcoords(1,icoord),tmpcoords(2,icoord),inequi,&
                     abscoords(1,icoord),abscoords(2,icoord),ouequi,error)
                if (error)  return
             enddo
             call abs_to_rel(ouproj,abscoords(1,1:n),abscoords(2,1:n),&
                  oucoords(1,1:n),oucoords(2,1:n),n)
          endif
       else if (ouframe.eq.code_spaframe_galactic) then
          call rel_to_abs(inproj,incoords(1,1:n),incoords(2,1:n),&
               tmpcoords(1,1:n),tmpcoords(2,1:n),n)
          do icoord=1,n
             call equ_gal(tmpcoords(1,icoord),tmpcoords(2,icoord),inequi,&
                  abscoords(1,icoord),abscoords(2,icoord),error)
             if (error)  return
          enddo
          call abs_to_rel(ouproj,abscoords(1,1:n),abscoords(2,1:n),&
               oucoords(1,1:n),oucoords(2,1:n),n)
       else
          converror = .true.
       endif
    case(code_spaframe_galactic)
       if (ouframe.eq.code_spaframe_galactic) then
          call rel_to_abs(inproj,incoords(1,1:n),incoords(2,1:n),&
               abscoords(1,1:n),abscoords(2,1:n),n)
          call abs_to_rel(ouproj,abscoords(1,1:n),abscoords(2,1:n),&
               oucoords(1,1:n),oucoords(2,1:n),n)
       else if (ouframe.eq.code_spaframe_equatorial) then
          call rel_to_abs(inproj,incoords(1,1:n),incoords(2,1:n),&
               tmpcoords(1,1:n),tmpcoords(2,1:n),n)
          do icoord=1,n
             call gal_equ(tmpcoords(1,icoord),tmpcoords(2,icoord),&
                  abscoords(1,icoord),abscoords(2,icoord),ouequi,error)
             if (error)  return
          enddo
          call abs_to_rel(ouproj,abscoords(1,1:n),abscoords(2,1:n),&
               oucoords(1,1:n),oucoords(2,1:n),n)
       else
          converror = .true.
       endif
    case  (code_spaframe_icrs)
       if (ouframe.eq.code_spaframe_galactic) then
          call rel_to_abs(inproj,incoords(1,1:n),incoords(2,1:n),&
               abscoords(1,1:n),abscoords(2,1:n),n)
          call abs_to_rel(ouproj,abscoords(1,1:n),abscoords(2,1:n),&
               oucoords(1,1:n),oucoords(2,1:n),n)
       else
          converror = .true.
       endif
    case default
       converror = .true.
    end select
    if (converror) then
       call cubetools_convert_code2spaframe(inframe,inframestr,error)
       if (error) return
       call cubetools_convert_code2spaframe(ouframe,ouframestr,error)
       if (error) return
       call cubemain_message(seve%e,rname,&
            'Cannot convert from '//trim(inframestr)//' to '//trim(ouframestr))
       error = .true.
       return
    endif
  end subroutine cubemain_spatial_reprojcoords
  !
  subroutine cubemain_spatial_compute_sign_shift(cube,sign,shift,error)
    use phys_const
    use cubetools_header_methods
    use cubetools_axis_types
    !----------------------------------------------------------------------
    ! Compute sign and shift for angle convertions
    !----------------------------------------------------------------------
    type(cube_t),      intent(in)    :: cube
    real(kind=coor_k), intent(out)   :: sign
    real(kind=coor_k), intent(out)   :: shift
    logical,           intent(inout) :: error
    !
    type(axis_t) :: laxis,maxis
    character(len=*), parameter :: rname = 'SPATIAL>COMPUTE>SIGN>SHIFT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_header_get_axis_head_l(cube%head,laxis,error)
    if (error) return
    call cubetools_header_get_axis_head_m(cube%head,maxis,error)
    if (error) return
    !
    if (maxis%inc.gt.0.d0) then
       shift = +pi/2.
    else
       shift = -pi/2.
    endif
    if (laxis%inc*maxis%inc.lt.0.d0) then
       sign = +1.
    else
       sign = -1.
    endif
  end subroutine cubemain_spatial_compute_sign_shift
  !
  function cubemain_spatial_restrict_twopi(ang) result(newang)
    use phys_const
    !----------------------------------------------------------------------
    ! Restrict angles between -pi and +pi
    !----------------------------------------------------------------------
    real(kind=coor_k), intent(in) :: ang
    real(kind=coor_k)             :: newang
    !
    newang = modulo(ang+pi,twopi)-pi
  end function cubemain_spatial_restrict_twopi
  !
  subroutine cubemain_spatial_pang_to_fortran(cube,pang,forang,error)
    !----------------------------------------------------------------------
    ! Compute FORTRAN standard angles from position angles relative to
    ! the north, according to the cube spatial increments
    !----------------------------------------------------------------------
    type(cube_t),      intent(in)    :: cube
    real(kind=coor_k), intent(in)    :: pang
    real(kind=coor_k), intent(out)   :: forang
    logical,           intent(inout) :: error
    !
    real(kind=coor_k) :: shift,sign
    character(len=*), parameter :: rname = 'SPATIAL>PANG>TO>FORTRAN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_spatial_compute_sign_shift(cube,sign,shift,error)
    if (error) return
    forang = cubemain_spatial_restrict_twopi(sign*pang+shift)
  end subroutine cubemain_spatial_pang_to_fortran
  !
  subroutine cubemain_spatial_fortran_to_pang(cube,forang,pang,error)
    !----------------------------------------------------------------------
    ! Compute position angles relative to the north from FORTRAN
    ! standard angles, according to the cube spatial increments
    ! ----------------------------------------------------------------------
    type(cube_t),      intent(in)    :: cube
    real(kind=coor_k), intent(in)    :: forang
    real(kind=coor_k), intent(out)   :: pang
    logical,           intent(inout) :: error
    !
    real(kind=coor_k) :: shift,sign
    character(len=*), parameter :: rname = 'SPATIAL>PANG>TO>FORTRAN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_spatial_compute_sign_shift(cube,sign,shift,error)
    if (error) return
    pang = cubemain_spatial_restrict_twopi(sign*(forang-shift))
  end subroutine cubemain_spatial_fortran_to_pang
end module cubemain_spatial_coordinates
! 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
