!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefield_rotate
  use cubetools_parameters
  use cube_types
  use cubetools_structure
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubeadm_ancillary_cube_types
  use cubefield_messaging
  ! 
  public :: rotate
  private
  !
  type :: rotate_comm_t
     type(option_t),     pointer :: comm
     type(cubeid_arg_t), pointer :: fx
     type(cubeid_arg_t), pointer :: fy
     type(cube_prod_t),  pointer :: fu
     type(cube_prod_t),  pointer :: fv
     type(ancillary_cube_comm_t) :: angle
   contains
     procedure, public  :: register => cubefield_rotate_register
     procedure, private :: parse    => cubefield_rotate_parse
     procedure, private :: main     => cubefield_rotate_main
  end type rotate_comm_t
  type(rotate_comm_t) :: rotate
  !
  type rotate_user_t
     type(cubeid_user_t)         :: fx
     type(cubeid_user_t)         :: fy
     type(ancillary_cube_user_t) :: angle
   contains
     procedure, private :: toprog => cubefield_rotate_user_toprog
  end type rotate_user_t
  !
  type rotate_prog_t
     type(ancillary_cube_prog_t) :: angle
     type(cube_t), pointer       :: fx
     type(cube_t), pointer       :: fy
     type(cube_t), pointer       :: fu
     type(cube_t), pointer       :: fv
   contains
     procedure, private :: header => cubefield_rotate_prog_header
     procedure, private :: data   => cubefield_rotate_prog_data
     procedure, private :: loop   => cubefield_rotate_prog_loop
     procedure, private :: act    => cubefield_rotate_prog_act
  end type rotate_prog_t
  !
contains
  !
  subroutine cubefield_rotate_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(rotate_user_t) :: user
    character(len=*), parameter :: rname='ROTATE>COMMAND'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call rotate%parse(line,user,error)
    if (error) return
    call rotate%main(user,error)
    if (error) continue
  end subroutine cubefield_rotate_command
  !
  subroutine cubefield_rotate_register(comm,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(rotate_comm_t), intent(inout) :: comm
    logical,              intent(inout) :: error
    !
    type(cubeid_arg_t) :: incube
    type(cube_prod_t)  :: oucube
    character(len=*), parameter :: rname='ROTATE>REGISTER'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'ROTATE','[fxid fyid]',&
         'Locally rotate a vector field according to an angle field',&
         'Rotate the FX and FY vector components locally by the negative&
         & of the selected angle field and write FU and FV outputs. Use&
         & /ANGLE to select the scalar angle cube for each pixel. The&
         & current runtime expects /ANGLE to resolve to a valid angle&
         & cube even though the syntax keeps it optional.',&
         cubefield_rotate_command,&
         comm%comm,error)
    if (error) return
    call incube%register(&
         'FXID',&
         'x component of the input vector field',&
         'Use the X component of the input vector field. If omitted, use&
         & the last matching cube (*dx*) in the default index (DAG by&
         & default; see SET\INDEX).',&
         code_arg_optional,&
         [flag_dx],&
         code_read,&
         code_access_imaset,&
         comm%fx,&
         error)
    call incube%register(&
         'FYID',&
         'y component of the input vector field',&
         'Use the Y component of the input vector field. If omitted, use&
         & the last matching cube (*dy*) in the default index (DAG by&
         & default; see SET\INDEX).',&
         code_arg_optional,&
         [flag_dy],&
         code_read,&
         code_access_imaset,&
         comm%fy,&
         error)
    if (error) return
    call comm%angle%fully_register(&
         'ANGLE','[angleid]',&
         'Scalar field of rotation angles',strg_emp,&
         'ANGLE','Rotation angle',&
         [flag_angle],&
         code_arg_optional,&
         code_read,&
         code_access_imaset,&
         error,&
         cubehelp='Use the angle field. If omitted, use the last matching&
         & cube (*angle*) in the default index (DAG by default; see&
         & SET\INDEX).')
    if (error) return
    !
    ! Product
    call oucube%register(&
         'FU',&
         'Rotated x component of the output vector field',&
         strg_emp,&
         [flag_rotated,flag_dx],&
         comm%fu,&
         error)
    if (error) return
    call oucube%register(&
         'FV',&
         'Rotated y component of the output vector field',&
         strg_emp,&
         [flag_rotated,flag_dy],&
         comm%fv,&
         error)
    if (error) return
  end subroutine cubefield_rotate_register
  !
  subroutine cubefield_rotate_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! ROTATE fxid fyid
    !----------------------------------------------------------------------
    class(rotate_comm_t), intent(in)    :: comm
    character(len=*),     intent(in)    :: line
    type(rotate_user_t),  intent(out)   :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ROTATE>PARSE'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,comm%comm,user%fx,error)
    if (error) return
    call cubeadm_cubeid_parse(line,comm%comm,user%fy,error)
    if (error) return
    call comm%angle%parse(line,user%angle,error)
    if (error) return
  end subroutine cubefield_rotate_parse
  !
  subroutine cubefield_rotate_main(comm,user,error) 
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(rotate_comm_t), intent(in)    :: comm
    type(rotate_user_t),  intent(inout) :: user
    logical,              intent(inout) :: error
    !
    type(rotate_prog_t) :: prog
    character(len=*), parameter :: rname='ROTATE>MAIN'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call user%toprog(comm,prog,error)
    if (error) return
    call prog%header(comm,error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubefield_rotate_main
  !
  !------------------------------------------------------------------------
  !
  subroutine cubefield_rotate_user_toprog(user,comm,prog,error)
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(rotate_user_t), intent(in)    :: user
    type(rotate_comm_t),  intent(in)    :: comm
    type(rotate_prog_t),  intent(out)   :: prog
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ROTATE>USER>TOPROG'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    ! *** JP: there should be a check that the input cubes are consistent
    call cubeadm_get_header(comm%fx,user%fx,prog%fx,error)
    if (error) return
    call cubeadm_get_header(comm%fy,user%fy,prog%fy,error)
    if (error) return
    call user%angle%toprog(comm%angle,prog%angle,error)
    if (error) return
  end subroutine cubefield_rotate_user_toprog
  !
  !------------------------------------------------------------------------
  !
  subroutine cubefield_rotate_prog_header(prog,comm,error)
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(rotate_prog_t), intent(inout) :: prog
    type(rotate_comm_t),  intent(in)    :: comm
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='ROTATE>PROG>HEADER'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(comm%fu,prog%fx,prog%fu,error)
    if (error) return
    call cubeadm_clone_header(comm%fv,prog%fy,prog%fv,error)
    if (error) return
  end subroutine cubefield_rotate_prog_header
  !
  subroutine cubefield_rotate_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(rotate_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='ROTATE>PROG>DATA'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP PARALLEL DEFAULT(none) SHARED(prog,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error) exit
       !$OMP TASK SHARED(prog,error) FIRSTPRIVATE(iter)
       if (.not.error) &
         call prog%loop(iter,error)
       !$OMP END TASK
    enddo ! iter
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubefield_rotate_prog_data
  !   
  subroutine cubefield_rotate_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(rotate_prog_t),     intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(image_t) :: angle,fx,fy,fu,fv
    character(len=*), parameter :: rname='ROTATE>PROG>LOOP'
    !
    call angle%associate('angle',prog%angle%cube,iter,error)
    if (error) return
    call fx%associate('fx',prog%fx,iter,error)
    if (error) return
    call fy%associate('fy',prog%fy,iter,error)
    if (error) return
    call fu%allocate('fu',prog%fu,iter,error)
    if (error) return
    call fv%allocate('fv',prog%fv,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
      call prog%act(iter%ie,angle,fx,fy,fu,fv,error)
      if (error) return
    enddo
  end subroutine cubefield_rotate_prog_loop
  !   
  subroutine cubefield_rotate_prog_act(prog,ie,angle,fx,fy,fu,fv,error)
    use cubetools_nan
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(rotate_prog_t), intent(inout) :: prog
    integer(kind=entr_k), intent(in)    :: ie
    type(image_t),        intent(inout) :: angle
    type(image_t),        intent(inout) :: fx
    type(image_t),        intent(inout) :: fy
    type(image_t),        intent(inout) :: fu
    type(image_t),        intent(inout) :: fv
    logical,              intent(inout) :: error
    !
    integer(kind=pixe_k) :: ix,iy
    real(kind=dble_k) :: ang,cosang,sinang
    character(len=*), parameter :: rname='ROTATE>PROG>ACT'
    !
    call angle%get(ie,error)
    if (error) return
    call fx%get(ie,error)
    if (error) return
    call fy%get(ie,error)
    if (error) return
    do iy=1,angle%ny
       do ix=1,angle%nx
          ang = -angle%val(ix,iy)
          cosang = cos(ang)
          sinang = sin(ang)
          fu%val(ix,iy) = fx%val(ix,iy)*cosang-fy%val(ix,iy)*sinang
          fv%val(ix,iy) = fx%val(ix,iy)*sinang+fy%val(ix,iy)*cosang
       enddo ! ix
    enddo ! iy
    call fu%put(ie,error)
    if (error) return
    call fv%put(ie,error)
    if (error) return
  end subroutine cubefield_rotate_prog_act
end module cubefield_rotate
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
