!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefield_gradient
  use cubetools_parameters
  use cube_types
  use cubetools_structure
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubefield_messaging
  ! 
  public :: gradient
  private
  !
  type :: gradient_comm_t
     type(option_t),     pointer :: comm
     type(cubeid_arg_t), pointer :: field
     type(cube_prod_t),  pointer :: df_dx
     type(cube_prod_t),  pointer :: df_dy
     type(cube_prod_t),  pointer :: amp
     type(cube_prod_t),  pointer :: ang
   contains
     procedure, public  :: register => cubefield_gradient_register
     procedure, private :: parse    => cubefield_gradient_parse
     procedure, private :: main     => cubefield_gradient_main
  end type gradient_comm_t
  type(gradient_comm_t) :: gradient
  !
  type gradient_user_t
     type(cubeid_user_t)   :: cubeids
   contains
     procedure, private :: toprog => cubefield_gradient_user_toprog
  end type gradient_user_t
  !
  type gradient_prog_t
     type(cube_t), pointer :: field
     type(cube_t), pointer :: df_dx
     type(cube_t), pointer :: df_dy
     type(cube_t), pointer :: amp
     type(cube_t), pointer :: ang
     integer(kind=pixe_k)  :: nx = 0
     integer(kind=pixe_k)  :: idx = 0
     real(kind=coor_k)     :: dx = 0d0
     integer(kind=pixe_k)  :: ny = 0
     integer(kind=pixe_k)  :: idy = 0
     real(kind=coor_k)     :: dy = 0d0
   contains
     procedure, private :: header => cubefield_gradient_prog_header
     procedure, private :: data   => cubefield_gradient_prog_data
     procedure, private :: loop   => cubefield_gradient_prog_loop
     procedure, private :: act    => cubefield_gradient_prog_act
  end type gradient_prog_t
  !
contains
  !
  subroutine cubefield_gradient_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(gradient_user_t) :: user
    character(len=*), parameter :: rname='GRADIENT>COMMAND'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call gradient%parse(line,user,error)
    if (error) return
    call gradient%main(user,error)
    if (error) continue
  end subroutine cubefield_gradient_command
  !
  subroutine cubefield_gradient_register(gradient,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(gradient_comm_t), intent(inout) :: gradient
    logical,                intent(inout) :: error
    !
    type(cubeid_arg_t) :: incube
    type(cube_prod_t) :: oucube
    character(len=*), parameter :: rname='GRADIENT>REGISTER'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'GRADIENT','[field]',&
         'Compute the gradient of a field',&
         strg_id,&
         cubefield_gradient_command,&
         gradient%comm,error)
    if (error) return
    call incube%register(&
         'FIELD',&
         'Cube of 2D field',&
         strg_id,&
         code_arg_optional,&
         [flag_any],&
         code_read,&
         code_access_imaset,&
         gradient%field,&
         error)
    if (error) return
    !
    ! Product
    call oucube%register(&
         'DF_DX',&
         'Cube of X gradient',&
         strg_id,&
         [flag_gradient,flag_dx],&
         gradient%df_dx,&
         error)
    if (error) return
    call oucube%register(&
         'DF_DY',&
         'Cube of Y gradient',&
         strg_id,&
         [flag_gradient,flag_dy],&
         gradient%df_dy,&
         error)
    if (error) return
    call oucube%register(&
         'AMPLITUDE',&
         'Cube of gradient amplitude',&
         strg_id,&
         [flag_gradient,flag_amplitude],&
         gradient%amp,&
         error)
    if (error) return
    call oucube%register(&
         'ANGLE',&
         'Cube of gradient angle',&
         strg_id,&
         [flag_gradient,flag_angle],&
         gradient%ang,&
         error)
    if (error) return
  end subroutine cubefield_gradient_register
  !
  subroutine cubefield_gradient_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! GRADIENT fieldid
    !----------------------------------------------------------------------
    class(gradient_comm_t), intent(in)    :: comm
    character(len=*),       intent(in)    :: line
    type(gradient_user_t),  intent(out)   :: user
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='GRADIENT>PARSE'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,comm%comm,user%cubeids,error)
    if (error) return
  end subroutine cubefield_gradient_parse
  !
  subroutine cubefield_gradient_main(comm,user,error) 
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(gradient_comm_t), intent(in)    :: comm
    type(gradient_user_t),  intent(inout) :: user
    logical,                intent(inout) :: error
    !
    type(gradient_prog_t) :: prog
    character(len=*), parameter :: rname='GRADIENT>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_gradient_main
  !
  !------------------------------------------------------------------------
  !
  subroutine cubefield_gradient_user_toprog(user,comm,prog,error)
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(gradient_user_t), intent(in)    :: user
    type(gradient_comm_t),  intent(in)    :: comm
    type(gradient_prog_t),  intent(out)   :: prog
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='GRADIENT>USER>TOPROG'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_get_header(comm%field,user%cubeids,prog%field,error)
    if (error) return
  end subroutine cubefield_gradient_user_toprog
  !
  !------------------------------------------------------------------------
  !
  subroutine cubefield_gradient_prog_header(prog,comm,error)
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(gradient_prog_t), intent(inout) :: prog
    type(gradient_comm_t),  intent(in)    :: comm
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='GRADIENT>PROG>HEADER'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubefield_gradient_prog_header_one(prog%df_dx,prog%field,&
         comm%df_dx,prog%field%head%set%il,prog%nx,prog%idx,prog%dx,&
         error)
    if (error) return
    call cubefield_gradient_prog_header_one(prog%df_dy,prog%field,&
         comm%df_dy,prog%field%head%set%im,prog%ny,prog%idy,prog%dy,&
         error)
    if (error) return
    !
    call cubeadm_clone_header(comm%amp,prog%field,prog%amp,error)
    if (error) return
    call cubeadm_clone_header(comm%ang,prog%field,prog%ang,error)
    if (error) return
  end subroutine cubefield_gradient_prog_header
  !
  subroutine cubefield_gradient_prog_header_one(ou,in,prod,iaxis,&
       nx,idx,dx,error)
    use phys_const
    use cubetools_axis_types
    use cubetools_header_methods
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cube_t), pointer, intent(inout) :: ou
    type(cube_t), pointer, intent(inout) :: in
    type(cube_prod_t),     intent(in)    :: prod
    integer(kind=ndim_k),  intent(in)    :: iaxis
    integer(kind=pixe_k),  intent(inout) :: nx
    integer(kind=pixe_k),  intent(inout) :: idx
    real(kind=coor_k),     intent(inout) :: dx
    logical,               intent(inout) :: error
    !
    type(axis_t) :: axis
    character(len=*), parameter :: rname='GRADIENT>PROG>HEADER'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(prod,in,ou,error)
    if (error) return
    call cubetools_header_get_axis_head(iaxis,ou%head,axis,error)
    if (error) return
    nx = axis%n
    idx = 1 ! *** JP: should be customizable depending on the angular resolution
    dx = (2*idx)*axis%inc
    dx = dx*sec_per_rad ! *** JP: should use the current angle unit
  end subroutine cubefield_gradient_prog_header_one
  !
  subroutine cubefield_gradient_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(gradient_prog_t), intent(inout) :: prog
    logical,                intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='GRADIENT>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_gradient_prog_data
  !
  subroutine cubefield_gradient_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(gradient_prog_t),   intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(image_t) :: field,df_dx,df_dy,amp,ang
    character(len=*), parameter :: rname='GRADIENT>PROG>LOOP'
    !
    call field%associate('field',prog%field,iter,error)
    if (error) return
    call df_dx%allocate('df_dx',prog%df_dx,iter,error)
    if (error) return
    call df_dy%allocate('df_dy',prog%df_dy,iter,error)
    if (error) return
    call amp%allocate('amp',prog%amp,iter,error)
    if (error) return
    call ang%allocate('ang',prog%ang,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
      call prog%act(iter%ie,field,df_dx,df_dy,amp,ang,error)
      if (error) return
    enddo ! ie
  end subroutine cubefield_gradient_prog_loop
  !   
  subroutine cubefield_gradient_prog_act(prog,ie,field,df_dx,df_dy,amp,ang,error)
    use cubetools_nan
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(gradient_prog_t), intent(inout) :: prog
    integer(kind=entr_k),   intent(in)    :: ie
    type(image_t),          intent(inout) :: field
    type(image_t),          intent(inout) :: df_dx
    type(image_t),          intent(inout) :: df_dy
    type(image_t),          intent(inout) :: amp
    type(image_t),          intent(inout) :: ang
    logical,                intent(inout) :: error
    !
    integer(kind=pixe_k) :: ix,iy
    character(len=*), parameter :: rname='GRADIENT>PROG>ACT'
    !
    !
    call field%get(ie,error)
    if (error) return
    call df_dx%set_frame(prog%idx,prog%idy,gr4nan,error)
    if (error) return
    call df_dy%set_frame(prog%idx,prog%idy,gr4nan,error)
    if (error) return
    call amp%set_frame(prog%idx,prog%idy,gr4nan,error)
    if (error) return
    call ang%set_frame(prog%idx,prog%idy,gr4nan,error)
    if (error) return
    do iy=prog%idy+1,prog%ny-prog%idy
       do ix=prog%idx+1,prog%nx-prog%idx
          df_dx%val(ix,iy) = (field%val(ix+prog%idx,iy)-field%val(ix-prog%idx,iy))/prog%dx
          df_dy%val(ix,iy) = (field%val(ix,iy+prog%idy)-field%val(ix,iy-prog%idy))/prog%dy
          amp%val(ix,iy) = sqrt(df_dx%val(ix,iy)**2+df_dy%val(ix,iy)**2)
          ang%val(ix,iy) = atan2(df_dy%val(ix,iy),df_dx%val(ix,iy))
       enddo ! ix
    enddo ! iy
    call df_dx%put(ie,error)
    if (error) return
    call df_dy%put(ie,error)
    if (error) return
    call amp%put(ie,error)
    if (error) return
    call ang%put(ie,error)
    if (error) return
  end subroutine cubefield_gradient_prog_act
end module cubefield_gradient
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
