!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_polar
  use cubetools_parameters
  use cube_types
  use cubetools_structure
  use cubetopology_spapos_types
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubemain_messaging
  !
  public :: polar
  private
  !
  type :: polar_comm_t
     type(option_t),     pointer :: comm
     type(spapos_comm_t)         :: center
     type(cubeid_arg_t), pointer :: cartesian
     type(cube_prod_t),  pointer :: polar
   contains
     procedure, public  :: register => cubemain_polar_register
     procedure, private :: parse    => cubemain_polar_parse
     procedure, private :: main     => cubemain_polar_main
  end type polar_comm_t
  type(polar_comm_t) :: polar
  !
  type polar_user_t
     type(cubeid_user_t) :: cubeids
     type(spapos_user_t) :: center
   contains
     procedure, private :: toprog => cubemain_polar_user_toprog
  end type polar_user_t
  !
  type polar_prog_t
     type(cube_t), pointer     :: cartesian
     type(cube_t), pointer     :: polar
     type(spapos_prog_t)       :: center
     integer(kind=pixe_k)      :: nx = 0          ! # of x pixels
     integer(kind=pixe_k)      :: ny = 0          ! # of y pixels
     integer(kind=pixe_k)      :: nr = 0          ! # of radii
     integer(kind=pixe_k)      :: na = 0          ! # of angles
     real(kind=4), allocatable :: rindices(:,:,:) ! 
     real(kind=4), allocatable :: aindices(:,:,:) ! 
   contains
     procedure, private :: indices => cubemain_polar_prog_indices
     procedure, private :: header  => cubemain_polar_prog_header
     procedure, private :: data    => cubemain_polar_prog_data
     procedure, private :: loop    => cubemain_polar_prog_loop
     procedure, private :: act     => cubemain_polar_prog_act
  end type polar_prog_t
  !
contains
  !
  subroutine cubemain_polar_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(polar_user_t) :: user
    character(len=*), parameter :: rname='POLAR>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call polar%parse(line,user,error)
    if (error) return
    call polar%main(user,error)
    if (error) continue
  end subroutine cubemain_polar_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_polar_register(comm,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(polar_comm_t), intent(inout) :: comm
    logical,             intent(inout) :: error
    !
    type(cubeid_arg_t) :: incube
    type(cube_prod_t) :: oucube
    character(len=*), parameter :: rname='POLAR>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Syntax
    call cubetools_register_command(&
         'POLAR','[cubeid]',&
         'Reproject data on polar spatial coordinates',&
         strg_emp,&
         cubemain_polar_command,&
         polar%comm,error)
    if (error) return
    call incube%register(&
         'CUBEID',&
         'Signal cube',&
         'If omitted, use the last matching cube (any family/flags) in&
         & the default index (DAG by default; see SET\INDEX).',&
         code_arg_optional,&
         [flag_any],&
         code_read,&
         code_access_imaset,&
         comm%cartesian,&
         error)
    if (error) return
    !
    call polar%center%register('CENTER',&
         'Center of the polar coordinate system',&
         error)
    if (error) return
    !
    ! Product
    call oucube%register(&
         'POLAR',&
         'The polar coordinates cube',&
         strg_emp,&
         [flag_polar],&
         comm%polar,&
         error)
    if (error) return
  end subroutine cubemain_polar_register
  !
  subroutine cubemain_polar_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! POLAR [cubeid]
    ! /CENTER xpos ypos type [unit]
    !----------------------------------------------------------------------
    class(polar_comm_t), intent(in)    :: comm
    character(len=*),    intent(in)    :: line
    type(polar_user_t),  intent(out)   :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='POLAR>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,comm%comm,user%cubeids,error)
    if (error) return
    call comm%center%parse(line,user%center,error)
    if (error) return
  end subroutine cubemain_polar_parse
  !
  subroutine cubemain_polar_main(comm,user,error) 
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(polar_comm_t), intent(in)    :: comm
    type(polar_user_t),  intent(inout) :: user
    logical,             intent(inout) :: error
    !
    type(polar_prog_t) :: prog
    character(len=*), parameter :: rname='POLAR>MAIN'
    !
    call cubemain_message(mainseve%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 cubemain_polar_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_polar_user_toprog(user,comm,prog,error)
    use cubetools_user2prog
    use cubetools_unit
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(polar_user_t), intent(in)    :: user
    type(polar_comm_t),  intent(in)    :: comm
    type(polar_prog_t),  intent(out)   :: prog
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='POLAR>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_get_header(comm%cartesian,user%cubeids,prog%cartesian,error)
    if (error) return
    call user%center%toprog(prog%cartesian,prog%center,error)
    if (error) return
  end subroutine cubemain_polar_user_toprog
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_polar_prog_header(prog,comm,error)
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(polar_prog_t), intent(inout) :: prog
    type(polar_comm_t),  intent(in)    :: comm
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='POLAR>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(comm%polar,prog%cartesian,prog%polar,error)
    if (error) return
    call prog%indices(error)
    if (error) return
  end subroutine cubemain_polar_prog_header
  !
  subroutine cubemain_polar_prog_indices(prog,error)
    use gkernel_interfaces
    use cubetools_axis_types
    use cubetools_header_methods
    use cubetools_header_types
    use cubetools_format
    use cubetools_unit
    !----------------------------------------------------------------------
    ! For each pixel of the original image compute the associated polar
    ! coordinates
    !----------------------------------------------------------------------
    class(polar_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    integer(kind=4) :: ier
    type(axis_t) :: xaxis,yaxis
    type(axis_t) :: raxis,aaxis
    real(kind=coor_k) :: xval,yval,rval,aval
    real(kind=coor_k) :: centeroffset(2),dist(4),angle,dangle(2),rdcorners(2,4)
    integer(kind=pixe_k) :: ix,iy
    integer(kind=pixe_k) :: irmin,irmax
    integer(kind=pixe_k) :: iamin,iamax
    integer(kind=pixe_k) :: ic,icmax
    integer(kind=pixe_k) :: icorners(2,4),idcorners(2,4)
    character(len=*), parameter :: rname='POLAR>PROG>INDICES'
    !
    call cubetools_header_get_axis_head_l(prog%cartesian%head,xaxis,error)
    if (error) return
    call cubetools_header_get_axis_head_m(prog%cartesian%head,yaxis,error)
    if (error) return
    call cubetools_axis_copy(xaxis,raxis,error)
    if (error) return
    call cubetools_axis_copy(yaxis,aaxis,error)
    if (error) return
    !
    prog%nx = xaxis%n
    prog%ny = yaxis%n
    call prog%center%offset(centeroffset,error)
    if (error) return
    xaxis%val = centeroffset(1)
    yaxis%val = centeroffset(2)
    !
    ! Compute minimum angle variation from four image corners
    icorners(:,1) = [1,1]
!!$    icorners(:,2) = [1,prog%ny]
!!$    icorners(:,3) = [prog%nx,prog%ny]
!!$    icorners(:,4) = [prog%nx,1]
    icorners(1,2) = 1
    icorners(2,2) = prog%ny
    icorners(1,3) = prog%nx
    icorners(2,3) = prog%ny
    icorners(1,4) = prog%nx
    icorners(2,4) = 1
    idcorners(:,1) = [+1,+1]
    idcorners(:,2) = [+1,-1]
    idcorners(:,3) = [-1,-1]
    idcorners(:,4) = [-1,+1]
    do ic=1,4
       dist(ic) = mydist(icorners(1,ic),icorners(2,ic))
    enddo ! ic
    icmax = maxloc(dist,1)
    rval = dist(icmax)
    if (rval.eq.0d0) then
       call cubemain_message(seve%e,rname,'Image size is zero!')
       error = .true.
       return
    endif
    angle = myangle(icorners(1,icmax),icorners(2,icmax))
    dangle(1) = angle-myangle(icorners(1,icmax)+idcorners(1,icmax),icorners(2,icmax))
    dangle(2) = angle-myangle(icorners(1,icmax)                   ,icorners(2,icmax)+idcorners(2,icmax))
    aaxis%inc = minval(abs(dangle))
    !
    raxis%inc = sqrt(abs(xaxis%inc*yaxis%inc))
    !
    allocate(prog%rindices(2,prog%nx,prog%ny),prog%aindices(2,prog%nx,prog%ny),stat=ier)
    if (failed_allocate(rname,'indices',ier,error)) return
    !
    rdcorners(:,1) = [+0.5,+0.5]
    rdcorners(:,2) = [+0.5,-0.5]
    rdcorners(:,3) = [-0.5,-0.5]
    rdcorners(:,4) = [-0.5,+0.5]
    rdcorners(1,:) = rdcorners(1,:)*xaxis%inc
    rdcorners(2,:) = rdcorners(2,:)*yaxis%inc
    !
    do iy=1,prog%ny
       yval = (iy-yaxis%ref)*yaxis%inc+yaxis%val
       do ix=1,prog%nx
          xval = (ix-xaxis%ref)*xaxis%inc+xaxis%val
          irmax = -huge(irmax)
          irmin = +huge(irmin)
          iamax = -huge(iamax)
          iamin = +huge(iamin)
          if (((xval+0.5*xaxis%inc)*(xval-0.5*xaxis%inc).le.0d0).and.(yval.gt.yaxis%inc)) then
             if (xval+0.5*xaxis%inc.ge.0.0) then
                call cart2polar(xval+0.5*xaxis%inc,yval-0.5*yaxis%inc,&
                     irmin,irmax,iamin,iamax)
                call cart2polar(xval+0.5*xaxis%inc,yval+0.5*yaxis%inc,&
                     irmin,irmax,iamin,iamax)
             else
                call cart2polar(xval-0.5*xaxis%inc,yval-0.5*yaxis%inc,&
                     irmin,irmax,iamin,iamax)
                call cart2polar(xval-0.5*xaxis%inc,yval+0.5*yaxis%inc,&
                     irmin,irmax,iamin,iamax)
             endif
             call cart2polar(0d0,yval+0.5*yaxis%inc,&
                  irmin,irmax,iamin,iamax)
!             print *,ix,iy,iamin,iamax
          else
             do ic=1,4
                call cart2polar(xval+rdcorners(1,ic),yval+rdcorners(2,ic),&
                     irmin,irmax,iamin,iamax)
             enddo ! ic
          endif
          prog%rindices(1,ix,iy) = irmin
          prog%rindices(2,ix,iy) = irmax
          prog%aindices(1,ix,iy) = iamin
          prog%aindices(2,ix,iy) = iamax
       enddo ! ix
    enddo ! iy
    !
    iamin = minval(prog%aindices)
    iamax = maxval(prog%aindices)
    prog%aindices(:,:,:) = prog%aindices(:,:,:)-iamin+1
    !
    aaxis%n   = iamax-iamin+1
    aaxis%ref = 1
    aaxis%val = 0
    aaxis%name = "THETA"
    aaxis%kind = code_unit_pang
    !
    raxis%n = maxval(prog%rindices)
    raxis%ref = 1
    raxis%val = 0
    raxis%name = "RADIUS"
    !
    prog%nr = raxis%n
    prog%na = aaxis%n
    !
    call cubetools_header_update_axset_l(aaxis,prog%polar%head,error)
    if (error) return
    call cubetools_header_update_axset_m(raxis,prog%polar%head,error)
    if (error) return
    !
  contains
    !
    function mydist(ix,iy)
      real(kind=coor_k)                :: mydist
      integer(kind=pixe_k), intent(in) :: ix
      integer(kind=pixe_k), intent(in) :: iy
      !
      xval = (ix-xaxis%ref)*xaxis%inc+xaxis%val
      yval = (iy-yaxis%ref)*yaxis%inc+yaxis%val
      mydist = sqrt(xval**2+yval**2)
    end function mydist
    !
    function myangle(ix,iy)
      real(kind=coor_k)                :: myangle
      integer(kind=pixe_k), intent(in) :: ix
      integer(kind=pixe_k), intent(in) :: iy
      !
      rval = mydist(ix,iy)
      myangle = atan2(yval/rval,xval/rval)
    end function myangle
    !
    subroutine cart2polar(xval,yval,jrmin,jrmax,jamin,jamax)
      real(kind=coor_k),    intent(in)    :: xval
      real(kind=coor_k),    intent(in)    :: yval
      integer(kind=pixe_k), intent(inout) :: jrmin
      integer(kind=pixe_k), intent(inout) :: jrmax
      integer(kind=pixe_k), intent(inout) :: jamin
      integer(kind=pixe_k), intent(inout) :: jamax
      !
      integer(kind=pixe_k) :: jr,ja
      !
      rval = sqrt(xval**2+yval**2)
      if (rval.ne.0d0) then
         ! Formula to get a position angle from North to East
         aval = atan2(-xval/rval,-yval/rval)
      else
         aval = 0d0
      endif
      jr = nint(rval/raxis%inc)+1 ! jr = 1 when rval = 0
      jrmin = min(jrmin,jr)
      jrmax = max(jrmax,jr)
      ja = nint(aval/aaxis%inc)
      jamin = min(jamin,ja)
      jamax = max(jamax,ja)
    end subroutine cart2polar
  end subroutine cubemain_polar_prog_indices
  !
  subroutine cubemain_polar_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(polar_prog_t), intent(inout) :: prog
    logical,             intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='POLAR>PROG>DATA'
    !
    call cubemain_message(mainseve%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 cubemain_polar_prog_data
  !   
  subroutine cubemain_polar_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(polar_prog_t),      intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    type(image_t) :: cartesian,polar
    character(len=*), parameter :: rname='POLAR>PROG>LOOP'
    !
    call cartesian%associate('cartesian',prog%cartesian,iter,error)
    if (error) return
    call polar%allocate('polar',prog%polar,iter,error)
    if (error) return
    !
    do while (iter%iterate_entry(error))
      call prog%act(iter%ie,cartesian,polar,error)
      if (error) return
    enddo ! ie
  end subroutine cubemain_polar_prog_loop
  !   
  subroutine cubemain_polar_prog_act(prog,ie,cartesian,polar,error)
    use cubeadm_image_types
    use cubetools_nan
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(polar_prog_t),  intent(inout) :: prog
    integer(kind=entr_k), intent(in)    :: ie
    type(image_t),        intent(inout) :: cartesian
    type(image_t),        intent(inout) :: polar
    logical,              intent(inout) :: error
    !
    integer(kind=pixe_k) :: ix,iy,ir,ia
    character(len=*), parameter :: rname='POLAR>PROG>ACT'
    !
    call cartesian%get(ie,error)
    if (error) return
    polar%val = gr4nan
    do iy=1,cartesian%ny
       do ix=1,cartesian%nx
          do ir=prog%rindices(1,ix,iy),prog%rindices(2,ix,iy)
             do ia=prog%aindices(1,ix,iy),prog%aindices(2,ix,iy)
                polar%val(ia,ir) = cartesian%val(ix,iy)
             enddo ! ia
          enddo ! ir
       enddo ! ix
    enddo ! iy
    call polar%put(ie,error)
    if (error) return
  end subroutine cubemain_polar_prog_act
end module cubemain_polar
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
