!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetemplate_image2image
  use cubetools_structure
  use cubetemplate_one2one_template
  use cubetemplate_sperange_types
  use cubetemplate_image2image_template
  use cubetemplate_messaging
  !
  public :: image2image
  private
  !
  type, extends(image2image_comm_t) :: ext_image2image_comm_t
     type(option_t), pointer :: factor
     type(sperange_opt_t)    :: range
   contains
     procedure, public :: register => cubetemplate_ext_image2image_register
     procedure, public :: parse    => cubetemplate_ext_image2image_parse
  end type ext_image2image_comm_t
  type(ext_image2image_comm_t) :: image2image
  !
  type, extends(image2image_user_t) :: ext_image2image_user_t
     character(len=argu_l) :: factor
     type(sperange_user_t) :: range
   contains
     procedure, public :: toprog => cubetemplate_ext_image2image_user_toprog
  end type ext_image2image_user_t
  !
  type, extends(image2image_prog_t) :: ext_image2image_prog_t
     real(kind=sign_k)     :: factor
     type(sperange_prog_t) :: range
   contains
     procedure, private :: act    => cubetemplate_ext_image2image_prog_act
  end type ext_image2image_prog_t
  !
contains
  !
  subroutine cubetemplate_image2image_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(ext_image2image_user_t) :: user
    type(ext_image2image_prog_t) :: prog
    character(len=*), parameter :: rname='IMAGE2IMAGE>COMMAND'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call image2image%command(line,user,prog,error)
    if (error) return
  end subroutine cubetemplate_image2image_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetemplate_ext_image2image_register(comm,error)
    use cubedag_allflags
    use cubeadm_cubeid_types
    use cubeadm_cubeprod_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(ext_image2image_comm_t), intent(inout) :: comm
    logical,                       intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(standard_arg_t) :: stdarg
    type(cube_prod_t) :: cubeprod
    character(len=*), parameter :: comm_abstract='Template to access input/output data per image'
    character(len=*), parameter :: comm_help='Input and output cubes are real'
    character(len=*), parameter :: rname='EXT>IMAGE2IMAGE>REGISTER'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'IMAGE2IMAGE','[cube]',&
         comm_abstract,&
         comm_help,&
         cubetemplate_image2image_command,&
         comm%comm,&
         error)
    if (error) return
    call cubearg%register(&
         'CUBE',&
         'Signal cube',&
         strg_id,&
         code_arg_optional,&
         [flag_any],&
         code_read,&
         code_access_imaset,&
         comm%incube,&
         error)
    if (error) return
    !
    call comm%range%register(&
         'RANGE',&
         'Define velocity range(s)',&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FACTOR','factor',&
         'Multiply data by a factor',&
         strg_id,&
         comm%factor,&
         error)
    if (error) return
    call stdarg%register(&
         'factor',&
         'Multiplicative factor',&
         'Default to 1',&
         code_arg_mandatory,&
         error)
    if (error) return
    !
    ! Products
    call cubeprod%register(  &
         'CUBE',  &
         'The result of the command',  &
         strg_id,  &
         [flag_template],  &
         comm%oucube,  &
         error)
    if (error)  return
  end subroutine cubetemplate_ext_image2image_register
  !
  subroutine cubetemplate_ext_image2image_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! IMAGE2IMAGE cubname
    ! /RANGE vfirst vlast
    ! /FACTOR factor
    !----------------------------------------------------------------------
    class(ext_image2image_comm_t), intent(in)    :: comm
    character(len=*),              intent(in)    :: line
    class(one2one_user_t),         intent(out)   :: user
    logical,                       intent(inout) :: error
    !
    type(ext_image2image_user_t), pointer :: iuser
    character(len=*), parameter :: rname='EXT>IMAGE2IMAGE>PARSE'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    iuser => ext_image2image_user_ptr(user,error)
    if (error)  return
    call comm%one2one_comm_t%parse(line,iuser,error)
    if (error) return
    call comm%range%parse(line,iuser%range,error)
    if (error) return
    call cubetemplate_ext_image2image_parse_factor(line,comm%factor,iuser%factor,error)
    if (error) return
  end subroutine cubetemplate_ext_image2image_parse
  !
  subroutine cubetemplate_ext_image2image_parse_factor(line,opt,user,error)
    !----------------------------------------------------------------------
    ! /FACTOR factor
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    type(option_t),   intent(in)    :: opt
    character(len=*), intent(out)   :: user
    logical,          intent(inout) :: error
    !
    logical :: present
    integer(kind=4), parameter :: iarg=1
    character(len=*), parameter :: rname='EXT>IMAGE2IMAGE>PARSE>FACTOR'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call opt%present(line,present,error)
    if (error) return
    if (present) then
       call cubetools_getarg(line,opt,iarg,user,mandatory,error)
       if (error) return
    else
       user = strg_star
    endif
  end subroutine cubetemplate_ext_image2image_parse_factor
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetemplate_ext_image2image_user_toprog(user,comm,prog,error)
    use cubetools_user2prog
    use cubetools_unit
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(ext_image2image_user_t), intent(in)    :: user
    class(one2one_comm_t),         intent(in)    :: comm
    class(one2one_prog_t),         intent(inout) :: prog
    logical,                       intent(inout) :: error
    !
    type(unit_user_t) :: nounit
    real(kind=sign_k), parameter :: default=1.0
    type(ext_image2image_prog_t), pointer :: iprog
    character(len=*), parameter :: rname='EXT>IMAGE2IMAGE>USER>TOPROG'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call user%one2one_user_t%toprog(comm,prog,error)
    if (error) return
    !
    iprog => ext_image2image_prog_ptr(prog,error)
    if (error)  return
    call user%range%toprog(iprog%incube,iprog%range,error)
    if (error) return
    call nounit%get(strg_star,code_unit_unk,error)
    if (error) return
    call cubetools_user2prog_resolve_star(user%factor,nounit,default,iprog%factor,error)
    if (error) return
  end subroutine cubetemplate_ext_image2image_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetemplate_ext_image2image_prog_act(prog,ie,input,output,error)
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(ext_image2image_prog_t), intent(inout) :: prog
    integer(kind=entr_k),          intent(in)    :: ie
    type(image_t),                 intent(inout) :: input
    type(image_t),                 intent(inout) :: output
    logical,                       intent(inout) :: error
    !
    integer(kind=pixe_k) :: ix,iy
    character(len=*), parameter :: rname='EXT>IMAGE2IMAGE>PROG>ACT'
    !
    call input%get(ie,error)
    if (error) return
    do iy=1,input%ny
       do ix=1,input%nx
          output%val(ix,iy) = prog%factor*input%val(ix,iy)
       enddo ! ix
    enddo ! iy
    call output%put(ie,error)
    if (error) return
  end subroutine cubetemplate_ext_image2image_prog_act
  !
  !----------------------------------------------------------------------
  !
  function ext_image2image_user_ptr(user,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(ext_image2image_user_t), and
    ! return a pointer to it if yes.
    !-------------------------------------------------------------------
    type(ext_image2image_user_t), pointer       :: ext_image2image_user_ptr
    class(one2one_user_t),        target        :: user
    logical,                      intent(inout) :: error
    !
    character(len=*), parameter :: rname='EXT>IMAGE2IMAGE>USER>PTR'
    !
    select type(user)
    type is (ext_image2image_user_t)
      ext_image2image_user_ptr => user
    class default
      ext_image2image_user_ptr => null()
      call cubetemplate_message(seve%e,rname,  &
        'Internal error: object is not a ext_image2image_user_t type')
      error = .true.
      return
    end select
  end function ext_image2image_user_ptr
  !
  function ext_image2image_prog_ptr(prog,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(ext_image2image_prog_t), and
    ! return a pointer to it if yes.
    !-------------------------------------------------------------------
    type(ext_image2image_prog_t), pointer       :: ext_image2image_prog_ptr
    class(one2one_prog_t),        target        :: prog
    logical,                      intent(inout) :: error
    !
    character(len=*), parameter :: rname='EXT>IMAGE2IMAGE>PROG>PTR'
    !
    select type(prog)
    type is (ext_image2image_prog_t)
      ext_image2image_prog_ptr => prog
    class default
      ext_image2image_prog_ptr => null()
      call cubetemplate_message(seve%e,rname,  &
        'Internal error: object is not a ext_image2image_prog_t type')
      error = .true.
      return
    end select
  end function ext_image2image_prog_ptr
  !
end module cubetemplate_image2image
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
