!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_baseline_chebyshev
  use cubetools_structure
  use cubetools_unit_arg
  use cubetools_array_types
  use cubetools_axis_types
  use cubemain_messaging
  use cubemain_baseline_cubes_types
  use cubemain_lineset_or_mask_types
  !
  public :: baseline_chebyshev_comm_t,baseline_chebyshev_user_t
  private
  !
  type baseline_chebyshev_comm_t
     type(option_t),   pointer :: key
     type(unit_arg_t), pointer :: unit
     type(lineset_or_mask_comm_t), pointer :: lineregion => null()
     type(baseline_cubes_comm_t),  pointer :: cubes => null()
   contains
     procedure, public :: register     => cubemain_baseline_chebyshev_comm_register
     procedure, public :: parse_key    => cubemain_baseline_chebyshev_comm_parse_key
     procedure, public :: parse_others => cubemain_baseline_chebyshev_comm_parse_others
     procedure, public :: main         => cubemain_baseline_chebyshev_comm_main
  end type baseline_chebyshev_comm_t
  !
  type baseline_chebyshev_user_t
     logical               :: present = .false.
     type(strg_1d_t)       :: degree
     type(strg_1d_t)       :: transi
     character(len=unit_l) :: unit = strg_star
     type(lineset_or_mask_user_t) :: lineregion
     type(baseline_cubes_user_t)  :: cubes
   contains
     procedure, public :: toprog => cubemain_baseline_chebyshev_user_toprog
     procedure, public :: list   => cubemain_baseline_chebyshev_user_list
  end type baseline_chebyshev_user_t
  !
  type baseline_chebyshev_prog_t
     type(axis_t), pointer :: axis => null()    ! [----] Associated axis
     type(inte_1d_t)       :: degree
     type(long_1d_t)       :: transi
     type(lineset_or_mask_prog_t) :: lineregion !
     type(baseline_cubes_prog_t)  :: cubes      ! Input and output cubes
   contains
     procedure :: list   => cubemain_baseline_chebyshev_prog_list
     procedure :: header => cubemain_baseline_chebyshev_prog_header
     procedure :: data   => cubemain_baseline_chebyshev_prog_data
     procedure :: loop   => cubemain_baseline_chebyshev_prog_loop
     procedure :: act    => cubemain_baseline_chebyshev_prog_act
  end type baseline_chebyshev_prog_t
  !
contains
  !
  subroutine cubemain_baseline_chebyshev_comm_register(comm,error)
    use cubetools_unit
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(baseline_chebyshev_comm_t), intent(inout) :: comm
    logical,                          intent(inout) :: error
    !
    type(unit_arg_t) :: unitarg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         'POLYNOMIAL','deg1 [tr12 deg2 [... [trij degj [unit]]]]',&
         'Fit Chebyshev polynomials to define the baseline',&
         strg_id,&
         comm%key,error)
    if (error) return
    call stdarg%register(&
         'deg1',&
         'Degree for the first polynomial',&
         strg_id,&
         code_arg_mandatory,&
         error)
    if (error) return
    call stdarg%register(&
         'tr12',&
         'Transition between first and second polynomial',&
         strg_id,&
         code_arg_unlimited,&
         error)
    if (error) return
    call stdarg%register(&
         'deg2',&
         'Degree for the second polynomial',&
         strg_id,&
         code_arg_unlimited,&
         error)
    if (error) return
    call stdarg%register(&
         'trij',&
         'Transition between ith and jth polynomial',&
         strg_id,&
         code_arg_unlimited,&
         error)
    if (error) return
    call stdarg%register(&
         'degj',&
         'Degree for the jth polynomial',&
         strg_id,&
         code_arg_unlimited,&
         error)
    if (error) return
    call unitarg%register(&
         'UNIT',&
         'Unit of the transitions between two chebyshev polynomial',&
         '"*" or "=" mean internal unit of the spectral axis',&
         code_arg_optional,&
         code_unit_velo,&
         comm%unit,&
         error)
    if (error) return
  end subroutine cubemain_baseline_chebyshev_comm_register
  !
  subroutine cubemain_baseline_chebyshev_comm_parse_key(comm,line,user,error)
    use cubetools_structure
    !----------------------------------------------------------------------
    ! /CHEBYSHEV deg1 [tr12 deg2 [trij degj] [unit]]
    !----------------------------------------------------------------------
    class(baseline_chebyshev_comm_t), intent(inout) :: comm
    character(len=*),                 intent(in)    :: line
    type(baseline_chebyshev_user_t),  intent(out)   :: user
    logical,                          intent(inout) :: error
    !
    integer(kind=argu_k), parameter :: one=1
    integer(kind=argu_k) :: iarg,narg
    integer(kind=indx_k) :: ideg,itra,npoly
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>COMM>PARSE>KEY'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call comm%key%present(line,user%present,error)
    if (error) return
    if (user%present) then
       ! Get number of arguments and analyze it
       narg = comm%key%getnarg()
       if (narg.lt.0) then
          call cubemain_message(seve%e,rname,'Negative number of arguments')
          error = .true.
          return
       else if ((narg.eq.0).or.(narg.eq.1)) then
          ! Only one argument
          npoly = 1
          call user%degree%reallocate('chebyshev degree',npoly,error)
          if (error) return
       else if (narg.eq.2) then
          call cubemain_message(seve%e,rname,'1 or more than 3 arguments are required')
          error = .true.
          return
       else
          if (modulo(narg,2).eq.0) then
             ! Even number of arguments
             npoly = narg/2
             ! Last argument must be a unit
             call cubetools_getarg(line,comm%key,narg,user%unit,mandatory,error)
             if (error) return
          else
             ! Odd number of arguments
             npoly = narg/2+1
          endif
          ! Allocate npoly degrees and npoly-1 transitions
          call user%degree%reallocate('chebyshev degree',npoly,error)
          if (error) return
          call user%transi%reallocate('chebyshev transition',npoly-1,error)
          if (error) return
       endif
       ! Now get argument values
       if (narg.eq.0) then
          ! Default value
          user%degree%val(one) = strg_star
       else
          ! Parse degrees and transitions
          do ideg=1,user%degree%n
             iarg = 2*ideg-1
             call cubetools_getarg(line,comm%key,iarg,user%degree%val(ideg),mandatory,error)
             if (error) return
          enddo ! ideg
          do itra=1,user%transi%n
             iarg = 2*itra
             call cubetools_getarg(line,comm%key,iarg,user%transi%val(itra),mandatory,error)
             if (error) return          
          enddo ! itra
       endif
    endif
  end subroutine cubemain_baseline_chebyshev_comm_parse_key
  !
  subroutine cubemain_baseline_chebyshev_comm_parse_others(comm,cubes,lineregion,line,user,error)
    !----------------------------------------------------------------------
    ! Parse the others useful keys of the commands in this case
    !----------------------------------------------------------------------
    class(baseline_chebyshev_comm_t),     intent(inout) :: comm
    type(baseline_cubes_comm_t),  target, intent(inout) :: cubes
    type(lineset_or_mask_comm_t), target, intent(inout) :: lineregion
    character(len=*),                     intent(in)    :: line
    type(baseline_chebyshev_user_t),      intent(inout) :: user
    logical,                              intent(inout) :: error
    !
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>COMM>PARSE>OTHERS'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    comm%cubes => cubes
    call comm%cubes%parse(line,user%cubes,error)
    if (error) return
    !
    comm%lineregion => lineregion
    call comm%lineregion%parse(line,user%lineregion,error)
    if (error) return
  end subroutine cubemain_baseline_chebyshev_comm_parse_others
  !
  subroutine cubemain_baseline_chebyshev_comm_main(comm,user,error) 
    use cubeadm_timing
    !----------------------------------------------------------------------
    ! Parsing call is done in command_baseline.f90. Reminder calls are done
    ! here!
    !----------------------------------------------------------------------
    class(baseline_chebyshev_comm_t), intent(in)    :: comm
    type(baseline_chebyshev_user_t),  intent(inout) :: user
    logical,                          intent(inout) :: error
    !
    type(baseline_chebyshev_prog_t) :: prog
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>COMM>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(comm,prog,error)
    if (error) return
    call prog%list(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_baseline_chebyshev_comm_main
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_baseline_chebyshev_user_toprog(user,comm,prog,error)
    use cube_types
    use cubetools_unit
    use cubetools_user2prog
    use cubetools_header_methods
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(baseline_chebyshev_user_t), intent(inout) :: user
    type(baseline_chebyshev_comm_t),  intent(in)    :: comm
    type(baseline_chebyshev_prog_t),  intent(inout) :: prog
    logical,                          intent(inout) :: error
    !
    integer(kind=chan_k) :: ideg,nchan
    integer(kind=chan_k) :: itran,ntran
    real(kind=coor_k) :: transival
    type(unit_user_t) :: default_unit,user_unit
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! Get input and output cubes
    call user%cubes%toprog(comm%cubes,prog%cubes,error)
    if (error) return
    !
    ! 1. Chebyshev degrees
    call prog%degree%reallocate('chebyshev degree',user%degree%n,error)
    if (error) return
    do ideg=1,prog%degree%n
       call cubetools_user2prog_resolve_unk(user%degree%val(ideg),prog%degree%val(ideg),error)
       if (error) return
       if (prog%degree%val(ideg).lt.0) then
          call cubemain_message(seve%e,rname,'Polynomial degree must be positive')
          error = .true.
          return
       endif
    enddo ! ideg
    !
    ! 2. Transition between chebyshev polynomials
    ! 2.a Associate the cube spectral axis
    call cubetools_header_point2axis(prog%cubes%cube%head%set%ic,prog%cubes%cube%head,prog%axis,error)
    if (error) return
    ! 2.b Get units of the problem
    ! 2.b.1 Default unit will depend on the axis kind
    call default_unit%get_from_code(prog%axis%kind,error)
    if (error) return
    ! 2.b.2 Get user unit from user input
    call user_unit%get_from_name(user%unit,error)
    if (error) return
    ! 2.b.3 Sanity check
    select case(user_unit%kind%code)
    case(code_unit_chan,code_unit_pixe,code_unit_unk)
       ! Does nothing
    case default
       ! Check whether user and default units are consistent
       call user_unit%is_consistent_with(default_unit,error)
    end select
    ! 2.c Allocate transition array with an additional first and last element
    ntran = user%transi%n+2
    nchan = prog%axis%n
    call prog%transi%reallocate('chebyshev transition',ntran,error)
    if (error) return
    prog%transi%val(1) = 1
    prog%transi%val(ntran) = nchan
    ! 2.d Process the ith transition
    do itran=1,user%transi%n
       call cubetools_user2prog_resolve_unk(user%transi%val(itran),transival,error)
       if (error) return
       call transition_user2prog(prog%axis,user_unit,transival,prog%transi%val(itran+1),error)
       if (error) return
    enddo ! itran
    ! 2.e Sanity checks
    do itran=1,prog%transi%n
       if ((prog%transi%val(itran).lt.1).or.(prog%transi%val(itran).gt.nchan)) then
          write(mess,'(a,1pg14.7,x,2a)') &
               'Transition at ',user%transi%val(itran-1),trim(user_unit%name),&
               ' goes beyond spectrum boundaries'
          call cubemain_message(seve%e,rname,mess)
          error = .true.
          return
       endif
    enddo ! itran
    ! ***JP: Ascending or descending order should be OK!
    do itran=2,prog%transi%n
       if (prog%transi%val(itran).le.prog%transi%val(itran-1)) then
          call cubemain_message(seve%e,rname,'Transitions must be sorted in ascending order of channels')
          error = .true.
          return
       endif
    enddo ! itran
    !
    ! 3  Define the regions where the lines are
    call user%lineregion%toprog(prog%cubes%cube,comm%lineregion,prog%lineregion,error)
    if (error) return
    !
  contains
    !
    subroutine transition_user2prog(axis,userunit,userval,progval,error)
      type(axis_t),         intent(in)    :: axis
      type(unit_user_t),    intent(in)    :: userunit
      real(kind=coor_k),    intent(in)    :: userval
      integer(kind=chan_k), intent(out)   :: progval
      logical,              intent(inout) :: error
      !
      real(kind=coor_k) :: converted
      !
      select case(userunit%kind%code)
      case(code_unit_chan,code_unit_pixe)
         ! Directly use the values
         progval = nint(userval)
      case(code_unit_unk)
         ! No unit conversion can be done => Directly use the axis conversion formula
         call cubetools_axis_offset2pixel(axis,userval,progval,error)
         if (error) return
      case default
         ! Convert from user to prog unit
         converted = userunit%prog_per_user*userval
         ! Now use the axis conversion formula
         call cubetools_axis_offset2pixel(axis,converted,progval,error)
         if (error) return
      end select
    end subroutine transition_user2prog
  end subroutine cubemain_baseline_chebyshev_user_toprog
  !
  subroutine cubemain_baseline_chebyshev_user_list(user,error)
    !----------------------------------------------------------------------
    ! Mostly for debugging purpose
    !----------------------------------------------------------------------
    class(baseline_chebyshev_user_t), intent(in)    :: user 
    logical,                          intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>USER>LIST'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    ! *** JP: To be written
    call cubemain_message(seve%r,rname,mess)
  end subroutine cubemain_baseline_chebyshev_user_list
  !
  !------------------------------------------------------------------------
  !
  subroutine cubemain_baseline_chebyshev_prog_list(prog,error)
    use cubetools_format
    !-------------------------------------------------------------------
    ! List the baseline_chebyshev_prog information in a user friendly way
    !-------------------------------------------------------------------
    class(baseline_chebyshev_prog_t), intent(in)    :: prog
    logical,                          intent(inout) :: error
    !
    integer(kind=chan_k) :: ideg,itra
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>PROG>LIST'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_message(seve%r,rname,'')
    mess = cubetools_format_stdkey_boldval('Baselining method','Chebyshev Polynomial',40)
    call cubemain_message(seve%r,rname,mess)
    itra = 1
    do ideg=1,prog%degree%n
       mess = '  '//cubetools_format_stdkey_boldval('#',ideg,'i2',4)
       mess = trim(mess)//': '//cubetools_format_stdkey_boldval('degree',prog%degree%val(ideg),'i3',12)
       call transition_list(mess,'from',itra,prog%transi,prog%axis,error)
       if (error) return
       itra = itra+1
       call transition_list(mess,'to',itra,prog%transi,prog%axis,error)
       if (error) return
       call cubemain_message(seve%r,rname,mess)
    enddo ! ideg
    !
    call prog%lineregion%list(error)
    if (error) return
    !
    call prog%cubes%list(error)
    if (error) return
    !
  contains
    !
    subroutine transition_list(mess,key,itra,prog,axis,error)
      character(len=*),     intent(inout) :: mess
      character(len=*),     intent(in)    :: key
      integer(kind=chan_k), intent(inout) :: itra
      type(long_1d_t),      intent(in)    :: prog
      type(axis_t),         intent(in)    :: axis
      logical,              intent(inout) :: error
      !
      real(kind=coor_k) :: user
      !
      if (itra.le.prog%n) then
         call cubetools_axis_pixel2offset(axis,prog%val(itra),user,error)
         if (error) return
         mess = trim(mess)//' '//cubetools_format_stdkey_boldval(key,user,fsimple,nsimple)
      else
         call cubemain_message(seve%e,rname,'Not enough transitions for ith degree')
         error = .true.
         return
      endif
    end subroutine transition_list
  end subroutine cubemain_baseline_chebyshev_prog_list
  !
  subroutine cubemain_baseline_chebyshev_prog_header(prog,comm,error)
    use cube_types
    use cubetools_axis_types
    use cubetools_header_methods
    !-------------------------------------------------------------------
    ! Update cube header according to the polynomial fit
    !-------------------------------------------------------------------
    class(baseline_chebyshev_prog_t), intent(inout) :: prog
    type(baseline_chebyshev_comm_t),  intent(in)    :: comm
    logical,                          intent(inout) :: error
    !
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>PROG>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call prog%cubes%header(comm%cubes,error)
    if (error) return
  end subroutine cubemain_baseline_chebyshev_prog_header
  !
  subroutine cubemain_baseline_chebyshev_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(baseline_chebyshev_prog_t), intent(inout) :: prog
    logical,                          intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>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_baseline_chebyshev_prog_data
  !
  subroutine cubemain_baseline_chebyshev_prog_loop(prog,iter,error)
    use cubeadm_taskloop
    use cubeadm_spectrum_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(baseline_chebyshev_prog_t), intent(inout) :: prog
    type(cubeadm_iterator_t),         intent(inout) :: iter
    logical,                          intent(inout) :: error
    !
    type(spectrum_t) :: input,mask,good,line,base
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>PROG>LOOP'
    !
    ! input with associated x and allocated w
    call input%associate('input',prog%cubes%cube,iter,error)
    if (error) return
    call input%associate_x(error)
    if (error) return
    call input%allocate_w(error)
    if (error) return
    ! good with allocated x and w
    call good%allocate('good',prog%cubes%cube,iter,error)
    if (error) return
    call good%allocate_xw(error)
    if (error) return
    ! The other ones do not need x or w arrays
    ! base and line products
    call line%allocate('line',prog%cubes%line,iter,error)
    if (error) return
    call base%allocate('base',prog%cubes%base,iter,error)
    if (error) return
    !
    ! Process lineregion method
    select case (prog%lineregion%method)
    case (code_line_none)
       input%w%val(:) = 1.0
       do while (iter%iterate_entry(error))
          call prog%act(iter%ie,input,good,base,line,error)
          if (error) return
       enddo ! ie
    case (code_line_set)
       call input%set_base_channels(prog%lineregion%lineset,error)
       if (error) return
       do while (iter%iterate_entry(error))
          call prog%act(iter%ie,input,good,base,line,error)
          if (error) return
       enddo ! ie
    case (code_line_mask)
       call mask%associate('mask',prog%lineregion%mask%cube,iter,error)
       if (error) return
       do while (iter%iterate_entry(error))
          ! Get mask and set input weight accordingly
          call mask%get(iter%ie,error)
          if (error) return
          call input%set_base_channels_from_mask(mask,error)
          if (error) return
          ! Fit
          call prog%act(iter%ie,input,good,base,line,error)
          if (error) return
       enddo ! ie
    case default
       call cubemain_message(seve%e,rname,'Unknown line method code')
       error = .true.
       return
    end select
  end subroutine cubemain_baseline_chebyshev_prog_loop
  !
  subroutine cubemain_baseline_chebyshev_prog_act(prog,ie,input,good,base,line,error)
    use cubetools_nan
    use cubeadm_spectrum_types
    use cubemain_svd_tool
    use cubemain_chebyshev_tool
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(baseline_chebyshev_prog_t), intent(inout) :: prog
    integer(kind=entr_k),             intent(in)    :: ie
    type(spectrum_t),                 intent(inout) :: input
    type(spectrum_t),                 intent(inout) :: good
    type(spectrum_t),                 intent(inout) :: base
    type(spectrum_t),                 intent(inout) :: line
    logical,                          intent(inout) :: error
    !
    integer(kind=4) :: ifit
    integer(kind=chan_k) :: ifirst,ilast
    type(chebyshev_t) :: poly
    type(svd_t)       :: svd
    type(spectrum_t)  :: extracted
    character(len=*), parameter :: rname='BASELINE>CHEBYSHEV>PROG>ACT'
    !
    ! Get input spectrum
    call input%get(ie,error)
    if (error) return
    ! Process it
    if (input%y%isblanked()) then
       ! Spectrum is blanked => blank output
       line%y%val(:) = gr4nan
       base%y%val(:) = gr4nan
    else
       ! Loop on fits
       do ifit=1,prog%transi%n-1
          ! Extral spectral region to fit the baseline
          ifirst = prog%transi%val(ifit)
          ilast  = prog%transi%val(ifit+1)
          call extracted%point_to(input,ifirst,ilast,input%noi,error)
          if (error) return
          ! Remove NaN
          call good%mask(extracted,error)
          if (error) return
          ! Fit
          if (good%n.gt.prog%degree%val(ifit)) then
             call poly%fit(prog%degree%val(ifit),good,svd,error)
             if (error) return
             call poly%subtract(input,ifirst,ilast,base,line,error)
             if (error) return
          else
             line%y%val(:) = input%y%val(:)
             base%y%val(:) = gr4nan
          endif
       enddo ! ifit
    endif
    ! Put output spectra
    call base%put(ie,error)
    if (error) return
    call line%put(ie,error)
    if (error) return
  end subroutine cubemain_baseline_chebyshev_prog_act
end module cubemain_baseline_chebyshev
! 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
