!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetemplate_twosubc2onesubc
  use cubetools_structure
  use cubetemplate_two2one_template
  use cubetemplate_twosubc2onesubc_template
  use cubetemplate_factor_types
  use cubetopology_cuberegion_types
  use cubetemplate_messaging
  !
  public :: twosubc2onesubc
  public :: cubetemplate_twosubc2onesubc_command
  private
  !
  type, extends(twosubc2onesubc_comm_t) :: ext_twosubc2onesubc_comm_t
     type(factor_comm_t)     :: factor
     type(cuberegion_comm_t) :: region
   contains
     procedure, public :: register => cubetemplate_ext_twosubc2onesubc_comm_register
     procedure, public :: parse    => cubetemplate_ext_twosubc2onesubc_comm_parse
  end type ext_twosubc2onesubc_comm_t
  type(ext_twosubc2onesubc_comm_t) :: twosubc2onesubc
  !
  type, extends(twosubc2onesubc_user_t) :: ext_twosubc2onesubc_user_t
     type(factor_user_t)     :: factor
     type(cuberegion_user_t) :: region
   contains
     procedure, public :: toprog => cubetemplate_ext_twosubc2onesubc_user_toprog
  end type ext_twosubc2onesubc_user_t
  !
  type, extends(twosubc2onesubc_prog_t) :: ext_twosubc2onesubc_prog_t
     type(cuberegion_prog_t) :: region
     type(factor_prog_t)     :: factor
   contains
     procedure, private :: act => cubetemplate_ext_twosubc2onesubc_prog_act
  end type ext_twosubc2onesubc_prog_t
  !
contains
  !
  subroutine cubetemplate_twosubc2onesubc_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(ext_twosubc2onesubc_user_t) :: user
    type(ext_twosubc2onesubc_prog_t) :: prog
    character(len=*), parameter :: rname='TWOSUBC2ONESUBC>COMMAND'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call twosubc2onesubc%command(line,user,prog,error)
    if (error) return
  end subroutine cubetemplate_twosubc2onesubc_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetemplate_ext_twosubc2onesubc_comm_register(comm,error)
    use cubedag_allflags
    use cubeadm_cubeid_types
    use cubeadm_cubeprod_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(ext_twosubc2onesubc_comm_t), intent(inout) :: comm
    logical,                           intent(inout) :: error
    !
    type(cubeid_arg_t) :: incube
    type(cube_prod_t) :: oucube
    character(len=*), parameter :: comm_abstract = 'Template command to access input/output data per subcubes'
    character(len=*), parameter :: comm_help = 'Input and output cubes are real'
    character(len=*), parameter :: rname='TWOSUBC2ONESUBC>COMM>REGISTER'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'TWOSUBC2ONESUBC','[cube1] [cube2]',&
         comm_abstract,&
         comm_help,&
         cubetemplate_twosubc2onesubc_command,&
         comm%comm,error)
    if (error) return
    call incube%register(&
         'FIRST',&
         'First cube',&
         strg_id,&
         code_arg_optional,&
         [flag_any],&
         code_read,&
         code_access_subset,&
         comm%incube1,&
         error)
    if (error) return
    call incube%register(&
         'SECOND',&
         'Second cube',&
         strg_id,&
         code_arg_optional,&
         [flag_any],&
         code_read,&
         code_access_subset,&
         comm%incube2,&
         error)
    if (error) return
    call comm%factor%register(error)
    if (error) return
    call comm%region%register(error)
    if (error) return
    !
    ! Products
    call oucube%register(  &
         'OUTPUT',  &
         'The result of the command',  &
         strg_id,  &
         [flag_template],  &
         comm%oucube,  &
         error)
    if (error)  return
  end subroutine cubetemplate_ext_twosubc2onesubc_comm_register
  !
  subroutine cubetemplate_ext_twosubc2onesubc_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! TWOSUBC2ONESUBC [cubeid1] [cubeid2]
    !----------------------------------------------------------------------
    class(ext_twosubc2onesubc_comm_t), intent(in)    :: comm
    character(len=*),                  intent(in)    :: line
    class(two2one_user_t),             intent(out)   :: user
    logical,                           intent(inout) :: error
    !
    type(ext_twosubc2onesubc_user_t), pointer :: iuser
    character(len=*), parameter :: rname='EXT>TWOSUBC2ONESUBC>COMM>PARSE'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    iuser => ext_twosubc2onesubc_user_ptr(user,error)
    if (error)  return
    call comm%two2one_comm_t%parse(line,iuser,error)
    if (error) return
    call comm%region%parse(line,iuser%region,error)
    if (error) return
    call comm%factor%parse(line,iuser%factor,error)
    if (error) return
  end subroutine cubetemplate_ext_twosubc2onesubc_comm_parse
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetemplate_ext_twosubc2onesubc_user_toprog(user,comm,prog,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(ext_twosubc2onesubc_user_t), intent(in)    :: user
    class(two2one_comm_t),             intent(in)    :: comm
    class(two2one_prog_t),             intent(inout) :: prog
    logical,                           intent(inout) :: error
    !
    type(ext_twosubc2onesubc_prog_t), pointer :: iprog
    character(len=*), parameter :: rname='TWOSUBC2ONESUBC>USER>TOPROG'
    !
    call cubetemplate_message(templateseve%trace,rname,'Welcome')
    !
    call user%two2one_user_t%toprog(comm,prog,error)
    if (error) return
    !
    iprog => ext_twosubc2onesubc_prog_ptr(prog,error)
    if (error)  return
    call user%factor%toprog(iprog%factor,error)
    if (error) return
    call user%region%toprog(iprog%incube1,iprog%region,error)
    if (error) return
    ! User feedback about the interpretation of his command line
    call iprog%factor%list(error)
    if (error) return
    call iprog%region%list(error)
    if (error) return
  end subroutine cubetemplate_ext_twosubc2onesubc_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubetemplate_ext_twosubc2onesubc_prog_act(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_subcube_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(ext_twosubc2onesubc_prog_t), intent(inout) :: prog
    type(cubeadm_iterator_t),          intent(in)    :: iter
    logical,                           intent(inout) :: error
    !
    integer(kind=indx_k) :: ix,iy,iz
    type(subcube_t) :: insub1,insub2,ousub
    character(len=*), parameter :: rname='TWOSUBC2ONESUBC>PROG>ACT'
    !
    ! Subcubes are initialized here as their size (3rd dim) may change from
    ! from one subcube to another.
    call insub1%associate('insub1',prog%incube1,iter,error)
    if (error) return
    call insub2%associate('insub2',prog%incube2,iter,error)
    if (error) return
    call ousub%allocate('ousub',prog%oucube,iter,error)
    if (error) return
    !
    call insub1%get(error)
    if (error) return
    call insub2%get(error)
    if (error) return
    do iz=1,insub1%nz
       do iy=1,insub1%ny
          do ix=1,insub1%nx
             ousub%val(ix,iy,iz) = prog%factor%val*insub1%val(ix,iy,iz)+insub2%val(ix,iy,iz)
          enddo ! ix
       enddo ! iy
    enddo ! iz
    call ousub%put(error)
    if (error) return
  end subroutine cubetemplate_ext_twosubc2onesubc_prog_act
  !
  !----------------------------------------------------------------------
  !
  function ext_twosubc2onesubc_user_ptr(user,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(ext_twosubc2onesubc_user_t), and
    ! return a pointer to it if yes.
    !-------------------------------------------------------------------
    type(ext_twosubc2onesubc_user_t), pointer       :: ext_twosubc2onesubc_user_ptr
    class(two2one_user_t),            target        :: user
    logical,                          intent(inout) :: error
    !
    character(len=*), parameter :: rname='EXT>TWOSUBC2ONESUBC>USER>PTR'
    !
    select type(user)
    type is (ext_twosubc2onesubc_user_t)
      ext_twosubc2onesubc_user_ptr => user
    class default
      ext_twosubc2onesubc_user_ptr => null()
      call cubetemplate_message(seve%e,rname,  &
        'Internal error: object is not a ext_twosubc2onesubc_user_t type')
      error = .true.
      return
    end select
  end function ext_twosubc2onesubc_user_ptr
  !
  function ext_twosubc2onesubc_prog_ptr(prog,error)
    !-------------------------------------------------------------------
    ! Check if the input class is of type(ext_twosubc2onesubc_prog_t), and
    ! return a pointer to it if yes.
    !-------------------------------------------------------------------
    type(ext_twosubc2onesubc_prog_t), pointer       :: ext_twosubc2onesubc_prog_ptr
    class(two2one_prog_t),            target        :: prog
    logical,                          intent(inout) :: error
    !
    character(len=*), parameter :: rname='EXT>TWOSUBC2ONESUBC>PROG>PTR'
    !
    select type(prog)
    type is (ext_twosubc2onesubc_prog_t)
      ext_twosubc2onesubc_prog_ptr => prog
    class default
      ext_twosubc2onesubc_prog_ptr => null()
      call cubetemplate_message(seve%e,rname,  &
        'Internal error: object is not a ext_twosubc2onesubc_prog_t type')
      error = .true.
      return
    end select
  end function ext_twosubc2onesubc_prog_ptr
end module cubetemplate_twosubc2onesubc
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
