!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_spaelli_types
  use cubetools_structure
  use cubetools_keyword_arg
  use cube_types
  use cubemain_messaging
  !
  public :: ellipse_opt_t,ellipse_user_t,ellipse_prog_t
  private
  !
  type ellipse_opt_t
     type(option_t),      pointer :: opt
     type(keyword_arg_t), pointer :: unit
     type(keyword_arg_t), pointer :: paunit
   contains
     procedure :: register => cubemain_spaelli_register
     procedure :: parse    => cubemain_spaelli_parse
  end type ellipse_opt_t
  !
  type ellipse_user_t
     character(len=argu_l) :: major  ! In user unit
     character(len=argu_l) :: minor  ! In user unit
     character(len=argu_l) :: unit   ! User unit for major and minor
     character(len=argu_l) :: pang   ! In user unit
     character(len=argu_l) :: paunit ! User unit for pang
     logical               :: do
   contains
     procedure :: toprog => cubemain_spaelli_user_toprog
  end type ellipse_user_t
  !
  type ellipse_prog_t
     real(kind=coor_k) :: major   ! [rad]
     real(kind=coor_k) :: minor   ! [rad] 
     real(kind=coor_k) :: pang    ! [rad]
     type(cube_t), pointer :: cube => null() ! Pointer to cube to which ellipse is part of
   contains
     procedure :: list   => cubemain_spaelli_prog_list
     procedure :: tomask => cubemain_spaelli_prog_tomask
  end type ellipse_prog_t
  !
contains
  !
  subroutine cubemain_spaelli_register(option,name,abstract,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    ! Register an ellipse kind option
    !----------------------------------------------------------------------
    class(ellipse_opt_t), intent(out)   :: option
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: abstract
    logical,              intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    type(keyword_arg_t) :: keyarg
    character(len=*), parameter :: rname = 'SPAELLI>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'major [minor [unit [pang [paunit]]]]',&
         abstract,&
         'If major or minor axis are *, the current beamsize is&
         & assumed.If minor axis is omited it is assumed to be equal&
         & to the major axis, i.e. a circle. If pang is&
         & omited an angle of 0 degrees from north is&
         & assumed.', option%opt,error)
    if (error) return
    call stdarg%register( &
         'major',  &
         'Major axis', &
         strg_id,&
         code_arg_mandatory, &
         error)
    if (error) return
    call stdarg%register( &
         'minor',  &
         'Minor axis', &
         strg_id,&
         code_arg_optional, &
         error)
    if (error) return
    call keyarg%register( &
         'unit', &
         'Axes unit',&
         strg_id,&
         code_arg_optional,&
         unit_fov_name,&
         .not.flexible,&
         option%unit,error)
    if (error) return
    call stdarg%register( &
         'pang',  &
         'Position angle', &
         strg_id,&
         code_arg_optional, &
         error)
    if (error) return
    call keyarg%register( &
         'paunit', &
         'pang unit',&
         strg_id,&
         code_arg_optional,&
         unit_pang_name,&
         .not.flexible,&
         option%paunit,error)
    if (error) return
  end subroutine cubemain_spaelli_register
  !
  subroutine cubemain_spaelli_parse(option,line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(ellipse_opt_t), intent(in)    :: option
    character(len=*),     intent(in)    :: line
    type(ellipse_user_t), intent(out)   :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname = 'SPAELLI>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    user%major  = strg_star
    user%minor  = strg_star
    user%unit   = strg_star
    user%pang   = strg_star
    user%paunit = strg_star
    !
    call option%opt%present(line,user%do,error)
    if (error) return
    !
    if (user%do) then
       call cubetools_getarg(line,option%opt,1,user%major,mandatory,error)
       if (error) return
       user%minor = user%major
       call cubetools_getarg(line,option%opt,2,user%minor,.not.mandatory,error)
       if (error) return
       call cubetools_getarg(line,option%opt,3,user%unit,.not.mandatory,error)
       if (error) return
       call cubetools_getarg(line,option%opt,4,user%pang,.not.mandatory,error)
       if (error) return
       call cubetools_getarg(line,option%opt,5,user%paunit,.not.mandatory,error)
       if (error) return
    endif
  end subroutine cubemain_spaelli_parse
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_spaelli_user_toprog(user,cube,prog,error)
    use cubetools_unit
    use cubetools_user2prog
    use cubetools_header_methods
    use cubetools_beam_types
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(ellipse_user_t), intent(in)    :: user
    type(cube_t), target,  intent(in)    :: cube
    type(ellipse_prog_t),  intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    type(unit_user_t) :: unit,paunit
    real(kind=coor_k) :: defmajor,defminor,defangle
    type(beam_t) :: beam
    character(len=*), parameter :: rname = 'SPAELLI>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    prog%cube => cube
    !
    call cubetools_header_get_spabeam(cube%head,beam,error)
    if (error) return
    defangle = 0d0
    defmajor = beam%major
    defminor = beam%minor
    call cubetools_unit_get(user%unit,code_unit_fov,unit,error)
    if (error) return
    call cubetools_unit_get(user%paunit,code_unit_pang,paunit,error)
    if (error) return
    call cubetools_user2prog_resolve_star(user%major,unit,defmajor,prog%major,error)
    if (error) return
    call cubetools_user2prog_resolve_star(user%minor,unit,defminor,prog%minor,error)
    if (error) return
    call cubetools_user2prog_resolve_star(user%pang,paunit,defangle,prog%pang,error)
    if (error) return
  end subroutine cubemain_spaelli_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_spaelli_prog_list(prog,error)
    use cubetools_unit
    use cubetools_format
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(ellipse_prog_t), intent(in)    :: prog
    logical,               intent(inout) :: error
    !
    character(len=mess_l) :: mess
    type(unit_user_t) :: unitaxes,unitpang
    character(len=*), parameter :: rname = 'SPAELLI>PROG>LIST'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_unit_get(strg_star,code_unit_fov,unitaxes,error)
    if (error) return
    call cubetools_unit_get(strg_star,code_unit_pang,unitpang,error)
    if (error) return
    mess = cubetools_format_stdkey_boldval('Major',prog%major*unitaxes%user_per_prog,'f8.3',22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Minor',prog%minor*unitaxes%user_per_prog,'f8.3',22)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('PA',prog%pang*unitpang%user_per_prog,'f8.3',10)
    call cubemain_message(seve%r,rname,mess)
  end subroutine cubemain_spaelli_prog_list
  !
  subroutine cubemain_spaelli_prog_tomask(prog,center,mask,error)
    use cubetools_axis_types
    use cubetools_nan
    use cubetools_header_methods
    use cubemain_spapos_types
    use cubemain_image_real
    use cubemain_Spatial_coordinates
    !------------------------------------------------------------------------
    ! Produce a mask from an ellipse and a center
    !------------------------------------------------------------------------
    class(ellipse_prog_t), intent(in)    :: prog
    type(spapos_prog_t),   intent(in)    :: center
    type(image_t),         intent(out)   :: mask
    logical,               intent(inout) :: error
    !
    integer(kind=pixe_k) :: il,im,nl,nm
    real(kind=coor_k) :: sinx,siny,cosx,cosy,criterium,diffl,diffm,pang
    logical :: isin
    type(axis_t) :: laxis,maxis
    character(len=*), parameter :: rname = 'SPAELLI>PROG>TOMASK'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    nl = prog%cube%head%arr%n%l
    nm = prog%cube%head%arr%n%m
    call cubemain_spatial_pang_to_fortran(prog%cube,prog%pang,pang,error)
    if (error) return
    call cubetools_header_get_axis_head_l(prog%cube%head,laxis,error)
    if (error) return
    call cubetools_header_get_axis_head_m(prog%cube%head,maxis,error)
    if (error) return
    !
    call mask%reallocate('mask',nl,nm,error)
    if (error) return ! Freeing is taken care by caller
    !
    do im=1,nm
       diffm = maxis%coord(im)-center%rela(2)
       siny  = sin(pang)*diffm
       cosy  = cos(pang)*diffm
       do il=1,nl
          diffl = laxis%coord(il)-center%rela(1)
          sinx  = sin(pang)*diffl
          cosx  = cos(pang)*diffl
          criterium = (cosx+siny)**2/prog%major**2+(sinx-cosy)**2/prog%minor**2
          ! If pixel is outside the aperture, but it is less than half
          ! a pixel from the center of the ellipse include it
          isin = criterium.le.1.or.(abs(diffl).le.abs(laxis%inc/2.).and.abs(diffm).le.abs(maxis%inc/2.))
          if (isin) then
             mask%z(il,im) = 1.0
          else
             mask%z(il,im) = gr4nan
          end if
       end do
    end do
    !
  end subroutine cubemain_spaelli_prog_tomask
end module cubemain_spaelli_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
