!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_poly2mask
  use gkernel_types ! To import the polygon_t type
  use cube_types
  use cubetools_structure
  use cubeadm_cubeid_types
  use cubemain_messaging
  !
  public :: poly2mask
  public :: cubemain_poly2mask_command
  private
  !
  type :: poly2mask_comm_t
     type(option_t), pointer :: comm
     type(option_t), pointer :: file      
     type(option_t), pointer :: variable
   contains
     procedure, public  :: register   => cubemain_poly2mask_register
     procedure, private :: parse      => cubemain_poly2mask_parse
     procedure, private :: parse_poly => cubemain_poly2mask_parse_poly
     procedure, private :: main       => cubemain_poly2mask_main
  end type poly2mask_comm_t
  type(poly2mask_comm_t) :: poly2mask 
  !
  integer(kind=4), parameter :: icube = 1
  type poly2mask_user_t
     type(cubeid_user_t)   :: cubeids
     character(len=file_l) :: polyname
     logical               :: polyisfile
   contains
     procedure, private :: toprog => cubemain_poly2mask_user_toprog
  end type poly2mask_user_t
  !
  type poly2mask_prog_t
     type(cube_t), pointer :: cube
     type(cube_t), pointer :: mask
     type(polygon_t) :: poly
   contains
     procedure, private :: header => cubemain_poly2mask_prog_header
     procedure, private :: data   => cubemain_poly2mask_prog_data
     procedure, private :: loop   => cubemain_poly2mask_prog_loop
     procedure, private :: act    => cubemain_poly2mask_prog_act
  end type poly2mask_prog_t
  !
contains
  !
  subroutine cubemain_poly2mask_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(poly2mask_user_t) :: user
    character(len=*), parameter :: rname='POLY2MASK>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call poly2mask%parse(line,user,error)
    if (error) return
    call poly2mask%main(user,error)
    if (error) continue
  end subroutine cubemain_poly2mask_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_poly2mask_register(poly2mask,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(poly2mask_comm_t), intent(inout) :: poly2mask
    logical,                 intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: comm_abstract = &
         'Transfer a polygon onto a 2D mask'
    character(len=*), parameter :: comm_help = &
         'Create a 2D mask with the L and M properties of cubename,&
         & based on the shape of a polygon. The polygon is read&
         & from either a polygon file (/FILE) or from a SIC variable&
         & (/VARIABLE)'
    character(len=*), parameter :: rname='POLY2MASK>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'POLY2MASK','[cube]',&
         comm_abstract,&
         comm_help,&
         cubemain_poly2mask_command,&
         poly2mask%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Signal cube',  &
         strg_id,&
         code_arg_optional,  &
         [flag_cube], &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FILE','filename',&
         'Polygon is fetched from a file',&
         strg_id,&
         poly2mask%file,error)
    if (error) return
    call stdarg%register( &
         'filename',  &
         'Name of the file containing the polygon', &
         strg_id,&
         code_arg_mandatory, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'VARIABLE','varname',&
         'Polygon is fetched from a SIC variable',&
         'The SIC varaible can be created by using the command GREG2&
         &\POLYGON or by hand using a SIC structure. For a&
         & description of the SIC structure to be used see: HELP&
         & GREG2\POLYGON',&
         poly2mask%variable,error)
    if (error) return
    call stdarg%register( &
         'varname',  &
         'Name of the variable containing the polygon', &
         strg_id,&
         code_arg_mandatory, &
         error)
    if (error) return
  end subroutine cubemain_poly2mask_register
  !
  subroutine cubemain_poly2mask_parse(poly2mask,line,user,error)
    !----------------------------------------------------------------------
    ! POLY2MASK cubname
    ! /FILE     filename
    ! /VARIABLE varname
    !----------------------------------------------------------------------
    class(poly2mask_comm_t), intent(in)    :: poly2mask
    character(len=*),        intent(in)    :: line
    type(poly2mask_user_t),  intent(out)   :: user
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='POLY2MASK>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,poly2mask%comm,user%cubeids,error)
    if (error) return
    call poly2mask%parse_poly(line,user,error)
    if (error) return
  end subroutine cubemain_poly2mask_parse
  !
  subroutine cubemain_poly2mask_parse_poly(poly2mask,line,user,error)
    !----------------------------------------------------------------------
    ! /FILE     filename
    ! /VARIABLE varname
    !----------------------------------------------------------------------
    class(poly2mask_comm_t), intent(in)    :: poly2mask
    character(len=*),        intent(in)    :: line
    type(poly2mask_user_t),  intent(inout) :: user
    logical,                 intent(inout) :: error
    !
    logical :: dofile,dovari
    character(len=*), parameter :: rname='POLY2MASK>PARSE>POLY'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call poly2mask%variable%present(line,dovari,error)
    if (error) return
    call poly2mask%file%present(line,dofile,error)
    if (error) return 
    if (.not.(dovari.or.dofile)) then
       call cubemain_message(seve%e,rname,'At least one option must be given')
       error =.true.
       return
    else if (dovari.and.dofile) then
       call cubemain_message(seve%e,rname,'Options /FILE and /VARIABLE are mutually exclusive')
       error =.true.
       return
    else if (dofile) then
       call cubetools_getarg(line,poly2mask%file,1,user%polyname,mandatory,error)
       if (error) return
       user%polyisfile = .true.
    else
       call cubetools_getarg(line,poly2mask%variable,1,user%polyname,mandatory,error)
       if (error) return
       user%polyisfile = .false.
    endif
  end subroutine cubemain_poly2mask_parse_poly
  !
  subroutine cubemain_poly2mask_main(comm,user,error)
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(poly2mask_comm_t), intent(in)    :: comm
    type(poly2mask_user_t),  intent(in)    :: user
    logical,                 intent(inout) :: error
    !
    type(poly2mask_prog_t) :: prog
    character(len=*), parameter :: rname='POLY2MASK>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(comm,prog,error)
    if (error) return
    call prog%header(error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubemain_poly2mask_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_poly2mask_user_toprog(user,comm,prog,error)
    use gkernel_interfaces
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(poly2mask_user_t), intent(in)    :: user
    class(poly2mask_comm_t), intent(in)    :: comm
    type(poly2mask_prog_t),  intent(out)   :: prog
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='POLY2MASK>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! We only need the header from the input cube => It can be accessed in any order
    call cubeadm_cubeid_get_header(comm%comm,icube,user%cubeids,&
         code_access_imaset_or_speset,code_read_head,prog%cube,error)
    if (error) return
    call greg_poly_load(rname,user%polyisfile,user%polyname,prog%poly,error)
    if (error) return
  end subroutine cubemain_poly2mask_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_poly2mask_prog_header(prog,error)
    use cubetools_header_methods
    use cubedag_allflags
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(poly2mask_prog_t), intent(inout) :: prog
    logical,                 intent(inout) :: error
    !
    integer(kind=chan_k), parameter :: one = 1
    character(len=*), parameter :: rname='POLY2MASK>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Output cube must be imaset!
    call cubeadm_clone_header(prog%cube,flag_mask,prog%mask,error,&
         access=code_cube_imaset)
    if (error) return
    call cubetools_header_put_nchan(one,prog%mask%head,error)
    if (error) return
  end subroutine cubemain_poly2mask_prog_header
  !
  subroutine cubemain_poly2mask_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! This one is not parallelized because only one mask image is output!
    !----------------------------------------------------------------------
    class(poly2mask_prog_t), intent(inout) :: prog
    logical,                 intent(inout) :: error
    !
    character(len=*), parameter :: rname='POLY2MASK>PROG>DATA'
    type(cubeadm_iterator_t) :: iter
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    do while (cubeadm_dataiterate_all(iter,error))
       if (.not.error) &
         call prog%loop(iter,error)
    enddo ! iter
  end subroutine cubemain_poly2mask_prog_data
  !
  subroutine cubemain_poly2mask_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(poly2mask_prog_t),  intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(image_t) :: mask
    character(len=*), parameter :: rname='POLY2MASK>PROG>LOOP'
    !
    call mask%allocate('mask',prog%mask,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
       call prog%act(iter%ie,mask,error)
       if (error) return
    enddo ! ie
  end subroutine cubemain_poly2mask_prog_loop
  !
  subroutine cubemain_poly2mask_prog_act(prog,ie,mask,error)
    use gkernel_interfaces
    use cubetools_nan
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(poly2mask_prog_t), intent(inout) :: prog
    integer(kind=entr_k),    intent(in)    :: ie
    type(image_t),           intent(inout) :: mask
    logical,                 intent(inout) :: error
    !
    logical, parameter :: inside = .true.
    character(len=*), parameter :: rname='POLY2MASK>PROG>ACT'
    !
    mask%val(:,:) = gr4nan
    call greg_poly2mask(&
         1.0,inside,prog%poly,&
         int(mask%nx,kind=4),&
         int(mask%ny,kind=4),&
         prog%mask%head%spa%l%conv,&
         prog%mask%head%spa%m%conv,&
         mask%val)
    call mask%put(ie,error)
    if (error) return
  end subroutine cubemain_poly2mask_prog_act
end module cubemain_poly2mask
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
