!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefield_incline
  use cube_types
  use cubetools_parameters
  use cubetools_structure
  use cubetools_array_types
  use cubeadm_cubeid_types
  use cubemain_interpolate_image_tool
  use cubefield_messaging
  use cubefield_incline_tool
  !
  public :: incline
  public :: cubefield_incline_command
  private
  !
  type :: incline_comm_t
     type(option_t), pointer :: comm
     type(option_t), pointer :: angle
   contains
     procedure, public  :: register => cubefield_incline_register
     procedure, private :: parse    => cubefield_incline_parse
     procedure, private :: main     => cubefield_incline_main
  end type incline_comm_t
  type(incline_comm_t) :: incline
  !
  integer(kind=4), parameter :: ivoldens = 1
  integer(kind=4), parameter :: ivx = 2
  integer(kind=4), parameter :: ivy = 3
  integer(kind=4), parameter :: ivz = 4
  type incline_user_t
     type(cubeid_user_t)   :: cubeids
     character(len=argu_l) :: inclination
   contains
     procedure, private :: toprog => cubefield_incline_user_toprog
  end type incline_user_t
  !
  type incline_prog_t
     integer(kind=indx_k)           :: nxin,nyin,nzin
     integer(kind=indx_k)           :: nxou,nyou,nzou
     type(interpolate_image_prog_t) :: interpolate
     type(incline_tool_t)           :: incline
     real(kind=coor_k)              :: inclination
     type(cube_t), pointer          :: involdens
     type(cube_t), pointer          :: ouvoldens
     type(cube_t), pointer          :: invx
     type(cube_t), pointer          :: ouvx
     type(cube_t), pointer          :: invy
     type(cube_t), pointer          :: ouvy
     type(cube_t), pointer          :: invz
     type(cube_t), pointer          :: ouvz
     !
     type(real_3d_t) :: tmpvoldens
     type(real_3d_t) :: tmpvx
     type(real_3d_t) :: tmpvy
     type(real_3d_t) :: tmpvz
   contains
     procedure, private :: header => cubefield_incline_prog_header
     procedure, private :: init   => cubefield_incline_prog_init
     procedure, private :: data   => cubefield_incline_prog_data
     procedure, private :: loop   => cubefield_incline_prog_loop
     procedure, private :: act    => cubefield_incline_prog_act
  end type incline_prog_t
  !
contains
  !
  subroutine cubefield_incline_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(incline_user_t) :: user
    character(len=*), parameter :: rname='INCLINE>COMMAND'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call incline%parse(line,user,error)
    if (error) return
    call incline%main(user,error)
    if (error) continue
  end subroutine cubefield_incline_command
  !
  !------------------------------------------------------------------------
  !
  subroutine cubefield_incline_register(incline,error)
    use cubedag_parameters
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(incline_comm_t), intent(inout) :: incline
    logical,               intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: comm_abstract = 'Compute column density and centroid velocity'
    character(len=*), parameter :: comm_help = &
         'It uses the 3D volume density and velocity fields'&
         &'and it assumes the optically thin limit'
    character(len=*), parameter :: rname='INCLINE>REGISTER'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'INCLINE','voldens vx vy vz',&
         comm_abstract,&
         comm_help,&
         cubefield_incline_command,&
         incline%comm,error)
    if (error) return
    call cubearg%register(&
         'VOLDENS',&
         'Volume density',&
         strg_id,&
         code_arg_mandatory,&
         [flag_any],&
         error)
    call cubearg%register(&
         'VX',&
         'x-axis velocity component',&
         strg_id,&
         code_arg_mandatory,&
         [flag_any],&
         error)
    call cubearg%register(&
         'VY',&
         'y-axis velocity component',&
         strg_id,&
         code_arg_mandatory,&
         [flag_any],&
         error)
    call cubearg%register(&
         'VZ',&
         'z-axis velocity component',&
         strg_id,&
         code_arg_mandatory,&
         [flag_any],&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'ANGLE','angle',&
         'Inclination angle',&
         strg_id,&
         incline%angle,error)
    if (error) return
    call stdarg%register(&
         'angle',&
         'angle',&
         'default is 0',&
         code_arg_mandatory,&
         error)
    if (error) return
  end subroutine cubefield_incline_register
  !
  subroutine cubefield_incline_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! INCLINE voldensid vxid vyid vzid /ANGLE angle
    !----------------------------------------------------------------------
    class(incline_comm_t), intent(in)    :: comm
    character(len=*),      intent(in)    :: line
    type(incline_user_t),  intent(out)   :: user
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='INCLINE>PARSE'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,incline%comm,user%cubeids,error)
    if (error) return
    call cubetools_getarg(line,incline%angle,1,user%inclination,mandatory,error)
    if (error) return
  end subroutine cubefield_incline_parse
  !
  subroutine cubefield_incline_main(comm,user,error)    
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(incline_comm_t), intent(in)    :: comm
    type(incline_user_t),  intent(inout) :: user
    logical,               intent(inout) :: error
    !
    type(incline_prog_t) :: prog
    character(len=*), parameter :: rname='INCLINE>MAIN'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) return
    call prog%header(error)
    if (error) return
    call cubeadm_timing_prepro2process()
    call prog%data(error)
    if (error) return
    call cubeadm_timing_process2postpro()
  end subroutine cubefield_incline_main
  !
  !------------------------------------------------------------------------
  !
  subroutine cubefield_incline_user_toprog(user,prog,error)
    use cubetools_user2prog
    use cubetools_unit
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(incline_user_t), intent(in)    :: user
    type(incline_prog_t),  intent(out)   :: prog
    logical,               intent(inout) :: error
    !
    real(coor_k) :: default
    type(unit_user_t) :: unit
    character(len=*), parameter :: rname='INCLINE>USER>TOPROG'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_get_header(incline%comm,ivoldens,user%cubeids,&
         code_access_imaset,code_read,prog%involdens,error)
    if (error) return
    call cubeadm_cubeid_get_header(incline%comm,ivx,user%cubeids,&
         code_access_imaset,code_read,prog%invx,error)
    if (error) return
    call cubeadm_cubeid_get_header(incline%comm,ivy,user%cubeids,&
         code_access_imaset,code_read,prog%invy,error)
    if (error) return
    call cubeadm_cubeid_get_header(incline%comm,ivz,user%cubeids,&
         code_access_imaset,code_read,prog%invz,error)
    if (error) return
    !
    call cubetools_unit_get(strg_star,code_unit_pang,unit,error)
    if (error) return
    default = 0
    call cubetools_user2prog_resolve_star(user%inclination,unit,default,&
         prog%inclination,error)
    if (error) return
  end subroutine cubefield_incline_user_toprog
  !
  !------------------------------------------------------------------------
  !
  subroutine cubefield_incline_prog_header(prog,error)
    use cubedag_allflags
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(incline_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='INCLINE>PROG>HEADER'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    ! *** JP: there should be a check that the input cubes are consistent
    call cubeadm_clone_header(prog%involdens,flag_inclined,&
         prog%ouvoldens,error,keepflags=.true.)
    if (error) return
    call cubeadm_clone_header(prog%invx,flag_inclined,&
         prog%ouvx,error,keepflags=.true.)
    if (error) return
    call cubeadm_clone_header(prog%invy,flag_inclined,&
         prog%ouvy,error,keepflags=.true.)
    if (error) return
    call cubeadm_clone_header(prog%invz,flag_inclined,&
         prog%ouvz,error,keepflags=.true.)
    if (error) return
    call prog%init(prog%involdens%head,prog%ouvoldens%head,error)
    if (error) return
  end subroutine cubefield_incline_prog_header
  !
  subroutine cubefield_incline_prog_init(prog,inhead,ouhead,error)
    use cubetools_array_types
    use cubetools_axis_types
    use cubetools_header_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    ! Initialize all the computations that will be independent of the x
    ! rotation axis
    ! Start from output image to get the input image pixels that will need
    ! to be interpolated
    !----------------------------------------------------------------------
    class(incline_prog_t), intent(inout) :: prog
    type(cube_header_t),   intent(in)    :: inhead
    type(cube_header_t),   intent(in)    :: ouhead
    logical,               intent(inout) :: error
    !
    integer(kind=pixe_k) :: iyou,izou
    real(kind=coor_k) :: xin,xou
    real(kind=coor_k) :: you,zou ! Output     pixel coordinates
    type(dble_2d_t)   :: yin,zin ! Associated pixel coordinates in input image
    type(axis_t) :: yinaxis,zinaxis ! Input  axes
    type(axis_t) :: youaxis,zouaxis ! Output axes
    character(len=*), parameter :: rname='INCLINE>PROG>INIT'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    prog%nxin = prog%involdens%head%arr%n%l
    prog%nyin = prog%involdens%head%arr%n%m
    prog%nzin = prog%involdens%head%arr%n%c
    !
    prog%nxou = prog%ouvoldens%head%arr%n%l
    prog%nyou = prog%ouvoldens%head%arr%n%m
    prog%nzou = prog%ouvoldens%head%arr%n%c
    !
    call cubetools_header_get_axis_head_m(inhead,yinaxis,error)
    if (error) return
    call cubetools_header_get_axis_head_m(ouhead,youaxis,error)
    if (error) return
    !
    call cubetools_header_get_axis_head_c(inhead,zinaxis,error)
    if (error) return
    call cubetools_header_get_axis_head_c(ouhead,zouaxis,error)
    if (error) return
    !
    call yin%reallocate('yin',prog%nyou,prog%nzou,error)
    if (error) return
    call zin%reallocate('zin',prog%nyou,prog%nzou,error)
    if (error) return
    call prog%incline%init(prog%inclination)
    xou = 0.0 ! Irrelevant in this particular computation => Any value would be OK
    do izou=1,prog%nzou
       zou = zouaxis%coord(izou)
       do iyou=1,prog%nyou
          you = youaxis%coord(iyou)
          call prog%incline%sky2sou(xou,you,zou,xin,yin%val(iyou,izou),zin%val(iyou,izou))
       enddo ! iy
    enddo ! iz
    call prog%interpolate%init(yinaxis,zinaxis,yin,zin,error)
    if (error) return
  end subroutine cubefield_incline_prog_init
  !
!!$  subroutine cubefield_incline_prog_data(prog,error)
!!$    use cubeadm_opened
!!$    !----------------------------------------------------------------------
!!$    ! 
!!$    !----------------------------------------------------------------------
!!$    class(incline_prog_t), intent(inout) :: prog
!!$    logical,               intent(inout) :: error
!!$    !
!!$    type(cubeadm_iterator_t) :: iter
!!$    character(len=*), parameter :: rname='INCLINE>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) FIRSTPRIVATE(iter,error)
!!$       if (.not.error)  &
!!$         call prog%loop(iter%first,iter%last,error)
!!$       !$OMP END TASK
!!$    enddo ! ie
!!$    !$OMP END SINGLE
!!$    !$OMP END PARALLEL
!!$  end subroutine cubefield_incline_prog_data
  !
  subroutine cubefield_incline_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(incline_prog_t), intent(inout) :: prog
    logical,               intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='INCLINE>PROG>DATA'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    do while (cubeadm_dataiterate_all(iter,error))
       if (iter%first.eq.1) then
          call cubefield_incline_prog_preloop(prog,error)
          if (error) return
       endif
       call prog%loop(iter%first,iter%last,error)
       if (error) return
    enddo ! ie
  end subroutine cubefield_incline_prog_data
  !
  subroutine cubefield_incline_prog_preloop(prog,error)
    use cubetools_axis_types
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(incline_prog_t), target, intent(inout) :: prog
    logical,                       intent(inout) :: error
    !
    integer(kind=pixe_k) :: ixin,nxou
    integer(kind=pixe_k) :: iyin,nyou
    integer(kind=pixe_k) :: izin,nzou
    real(kind=coor_k) :: vxsou,vysou,vzsou
    real(kind=coor_k) :: vxsky,vysky,vzsky
    type(real_3d_t) :: voldens,skyvx,skyvy,skyvz
    character(len=*), parameter :: rname='INCLINE>PROG>PRELOOP'
    !
    call cubefield_message(fieldseve%trace,rname,'Welcome')
    !
    ! Rotate the velocity vectors without rotating the positions
    call skyvx%reallocate('skyvx',prog%nxin,prog%nyin,prog%nzin,error)
    if (error) return
    call skyvy%reallocate('skyvy',prog%nxin,prog%nyin,prog%nzin,error)
    if (error) return
    call skyvz%reallocate('skyvz',prog%nxin,prog%nyin,prog%nzin,error)
    if (error) return
    do izin=1,prog%nzin
       do iyin=1,prog%nyin
          do ixin=1,prog%nxin
             vxsou = prog%invx%tuple%current%data%r4(ixin,iyin,izin)
             vysou = prog%invy%tuple%current%data%r4(ixin,iyin,izin)
             vzsou = prog%invz%tuple%current%data%r4(ixin,iyin,izin)
             call prog%incline%sou2sky(vxsou,vysou,vzsou,vxsky,vysky,vzsky)
             skyvx%val(ixin,iyin,izin) = vxsky
             skyvy%val(ixin,iyin,izin) = vysky
             skyvz%val(ixin,iyin,izin) = vzsky
          enddo ! ix
       enddo ! iy
    enddo ! iz
    !
    call voldens%prepare_association('voldens',prog%nxin,prog%nyin,prog%nzin,error)
    if (error) return
    voldens%val => prog%involdens%tuple%current%data%r4
    !
    ! Rotate the density and velocity cubes around the x axis
    nxou = prog%nxou
    nyou = prog%nyou
    nzou = prog%nzou
    call interpolate_onecube(prog%interpolate,voldens,prog%tmpvoldens,nxou,nyou,nzou)
    call interpolate_onecube(prog%interpolate,skyvx,prog%tmpvx,nxou,nyou,nzou)
    call interpolate_onecube(prog%interpolate,skyvy,prog%tmpvy,nxou,nyou,nzou)
    call interpolate_onecube(prog%interpolate,skyvz,prog%tmpvz,nxou,nyou,nzou)
    !
  contains
    !
    subroutine interpolate_onecube(interpolate,in,ou,nxou,nyou,nzou)
      !----------------------------------------------------------------------
      !
      !----------------------------------------------------------------------
      type(interpolate_image_prog_t), target, intent(inout) :: interpolate
      type(real_3d_t),                        intent(in)    :: in
      type(real_3d_t),                        intent(inout) :: ou
      integer(kind=pixe_k),                   intent(in)    :: nxou,nyou,nzou
      !
      real(kind=dble_k), pointer :: fyin,fzin
      integer(kind=pixe_k), pointer :: ixin,iyin,izin
      integer(kind=pixe_k), target  :: ixou,iyou,izou
      !
      call ou%reallocate('ou',nxou,nyou,nzou,error)
      if (error) return
      !
      ixin => ixou
      do izou=1,ou%nz
         do iyou=1,ou%ny
            ! y in cube correspond to x in image!
            ! z in cube correspond to y in image!
            iyin => interpolate%ixin%val(iyou,izou)
            izin => interpolate%iyin%val(iyou,izou)
            fyin => interpolate%fxin%val(iyou,izou)
            fzin => interpolate%fyin%val(iyou,izou)
            if (&
                 ((1.le.iyin).and.(iyin.lt.in%ny)).and.&
                 ((1.le.izin).and.(izin.lt.in%nz))) then
               ! Inside input image
               do ixou=1,ou%nx
                  ou%val(ixou,iyou,izou) = interpolate%pixel(&
                       fyin,fzin,&
                       in%val(ixin,iyin  ,izin  ),& ! blc
                       in%val(ixin,iyin+1,izin  ),& ! brc
                       in%val(ixin,iyin+1,izin+1),& ! trc
                       in%val(ixin,iyin  ,izin+1))  ! tlc
               enddo ! ixou
            else
               ! Outside input image
               do ixou=1,ou%nx
                  ou%val(ixou,iyou,izou) = 0
               enddo ! ixou
            endif
         enddo ! iyou
      enddo ! izou
    end subroutine interpolate_onecube
  end subroutine cubefield_incline_prog_preloop
  !
  subroutine cubefield_incline_prog_loop(prog,first,last,error)
    use cubeadm_entryloop
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(incline_prog_t), intent(inout) :: prog
    integer(kind=entr_k),  intent(in)    :: first
    integer(kind=entr_k),  intent(in)    :: last
    logical,               intent(inout) :: error
    !
    integer(kind=entr_k) :: ie
    type(image_t) :: involdens,invx,invy,invz
    type(image_t) :: ouvoldens,ouvx,ouvy,ouvz
    character(len=*), parameter :: rname='INCLINE>PROG>LOOP'
    !
    call involdens%associate('involdens',prog%involdens,error)
    if (error) return
    call invx%associate('invx',prog%invx,error)
    if (error) return
    call invy%associate('invy',prog%invy,error)
    if (error) return
    call invz%associate('invz',prog%invz,error)
    if (error) return
    call ouvoldens%allocate('ouvoldens',prog%ouvoldens,error)
    if (error) return
    call ouvx%allocate('ouvx',prog%ouvx,error)
    if (error) return
    call ouvy%allocate('ouvy',prog%ouvy,error)
    if (error) return
    call ouvz%allocate('ouvz',prog%ouvz,error)
    if (error) return
    !
    do ie=first,last
      call cubeadm_entryloop_iterate(ie,error)
      if (error) return
      call prog%act(ie,&
           involdens,invx,invy,invz,&
           ouvoldens,ouvx,ouvy,ouvz,&
           error)
      if (error) return
    enddo
  end subroutine cubefield_incline_prog_loop
  !   
  subroutine cubefield_incline_prog_act(prog,ie,&
       involdens,invx,invy,invz,&
       ouvoldens,ouvx,ouvy,ouvz,&
       error)
    use cubeadm_image_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(incline_prog_t), intent(inout) :: prog
    integer(kind=entr_k),  intent(in)    :: ie
    type(image_t),         intent(inout) :: involdens
    type(image_t),         intent(inout) :: invx
    type(image_t),         intent(inout) :: invy
    type(image_t),         intent(inout) :: invz
    type(image_t),         intent(inout) :: ouvoldens
    type(image_t),         intent(inout) :: ouvx
    type(image_t),         intent(inout) :: ouvy
    type(image_t),         intent(inout) :: ouvz
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='INCLINE>PROG>ACT'
    !
    call involdens%get(ie,error)
    if (error) return
    call invx%get(ie,error)
    if (error) return
    call invy%get(ie,error)
    if (error) return
    call invz%get(ie,error)
    if (error) return
    ouvoldens%val = prog%tmpvoldens%val(:,:,ie)
    ouvx%val = prog%tmpvx%val(:,:,ie)
    ouvy%val = prog%tmpvy%val(:,:,ie)
    ouvz%val = prog%tmpvz%val(:,:,ie)
    call ouvoldens%put(ie,error)
    if (error) return
    call ouvx%put(ie,error)
    if (error) return
    call ouvy%put(ie,error)
    if (error) return
    call ouvz%put(ie,error)
    if (error) return
  end subroutine cubefield_incline_prog_act
end module cubefield_incline
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
