!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! This file contains the outimage_tool module before implementing the
! PARAMETERS command.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefit_outimage_tool
  use cube_types
  use cubedag_allflags
  use cubeadm_cubeprod_types
  use cubefit_messaging
  use cubefit_parameters
  !
  public :: nsig,nvari
  public :: jcol_flag,jcol_signal,jcol_noise,jcol_snr
  public :: jcol_rmsbase,jcol_rmsspec,jcol_rmsline
  public :: jcol_method,jcol_nfunc
  public :: outimage_t
  private
  !
  integer(kind=4), parameter :: nsig  = 2
  integer(kind=4), parameter :: nvari = 4
  integer(kind=4), parameter :: jcol_flag    = 1
  integer(kind=4), parameter :: jcol_signal  = 2
  integer(kind=4), parameter :: jcol_noise   = 3
  integer(kind=4), parameter :: jcol_snr     = 4
  integer(kind=4), parameter :: jcol_rmsline = +1
  integer(kind=4), parameter :: jcol_rmsbase = +2
  integer(kind=4), parameter :: jcol_rmsspec = -1 ! Fit RMS
  integer(kind=4), parameter :: jcol_method  = -2 ! Fit Method
  integer(kind=4), parameter :: jcol_nfunc   = -3 ! Fit number of components
  !
  type outimage_t
     type(cube_t), pointer :: cube
     type(cube_prod_t)     :: prod
     character(len=unit_l) :: unit
   contains
     procedure, public :: init  => cubefit_parameters_outimage_init
     procedure, public :: clone => cubefit_parameters_outimage_clone
  end type outimage_t
  !
contains
  !
  subroutine cubefit_parameters_outimage_init(out,imeth,ifunc,jcol,iout,prod,error)
    use gkernel_interfaces
    use cubefit_spectral_fit
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(outimage_t), intent(inout) :: out
    integer(kind=4),   intent(in)    :: imeth
    integer(kind=4),   intent(in)    :: ifunc
    integer(kind=4),   intent(in)    :: jcol
    integer(kind=4),   intent(in)    :: iout
    type(cube_prod_t), intent(in)    :: prod  ! Output cube description (reference)
    logical,           intent(inout) :: error
    !
    type(flag_t) :: signoiflag(nvari),sigmaflags(nsig),flags(3)
    character(len=*), parameter :: rname='PARAMETERS>OUTIMAGE>INIT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    signoiflag(:) = [flag_flag,flag_signal,flag_noise,flag_snr]
    sigmaflags(:) = [flag_base,flag_line]
    !
    call prod%copy(out%prod,error)
    if (error)  return
    !
    select case(jcol)
    case(jcol_rmsspec)
      ! Pre-defined flags are fit,parameters,*,noise,*
       call cubefit_parameters_flags(imeth,1,flags(1),flags(2),flags(3),error)
       if (error) return
       call out%prod%flag_to_flag(flag_any,flags(1),error)  ! Replace 1st *
       if (error)  return
       call out%prod%flag_to_flag(flag_any,sigmaflags(iout),error)  ! Replace 2nd *
       if (error)  return
       out%unit = strg_id ! Sigma has the same unit as the original cube 
    case(jcol_nfunc)
       ! Pre-defined flags are fit,parameters,nlines (no change needed)
       out%unit = '---' ! No unit for number of lines
    case(jcol_method)
       ! Pre-defined flags are fit,parameters,method (no change needed)
       out%unit = '---' ! No unit for method
    case default
       ! Pre-defined flags are fit,parameters,*,*,*,*
       call cubefit_parameters_flags(imeth,jcol,flags(1),flags(2),flags(3),error)
       if (error) return
       if (ifunc.ne.0) then
          call cubefit_func2flag(ifunc,flags(3),error)
          if (error) return
       endif
       call out%prod%flag_to_flag(flag_any,flags(1),error)  ! Replace 1st *
       if (error)  return
       call out%prod%flag_to_flag(flag_any,flags(2),error)  ! Replace 2nd *
       if (error)  return
       call out%prod%flag_to_flag(flag_any,flags(3),error)  ! Replace 3rd *
       if (error)  return
       call out%prod%flag_to_flag(flag_any,signoiflag(iout),error)  ! Replace 4th *
       if (error)  return
       if (iout.eq.2.or.iout.eq.3) then
          ! Signal and noise have the same unit as the data
          call cubefit_parameters_units(imeth,jcol,out%unit,error)
          if (error) return
       else
          ! Flag and snr have no unit
          out%unit = '---'
       endif
    end select
  end subroutine cubefit_parameters_outimage_init
  !
  subroutine cubefit_parameters_outimage_clone(ou,incube,error)
    use cubetools_header_methods
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(outimage_t),     intent(inout) :: ou
    type(cube_t), pointer, intent(in)    :: incube
    logical,               intent(inout) :: error
    !
    character(len=unit_l) :: unit
    character(len=*), parameter :: rname='PARAMETERS>OUTIMAGE>CLONE'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call cubeadm_clone_header(ou%prod,incube,ou%cube,error)
    if (error) return
    call cubetools_header_nullify_axset_c(ou%cube%head,error)
    if (error) return
    if (ou%unit.ne.strg_id) then
       if (ou%unit(1:1).eq.strg_add) then
          call cubetools_header_get_array_unit(ou%cube%head,unit,error)
          if (error) return
          unit = trim(unit)//'.'//ou%unit(2:)
          call cubetools_header_put_array_unit(unit,ou%cube%head,error)
          if (error) return
       else
          call cubetools_header_put_array_unit(ou%unit,ou%cube%head,error)
          if (error) return
       endif
    endif
  end subroutine cubefit_parameters_outimage_clone
end module cubefit_outimage_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefit_command_parameters
  use cube_types
  use cubetools_structure
  use cubeadm_cubeid_types
  use cubeadm_cubeprod_types
  use cubefit_messaging
  use cubefit_parameters
  use cubefit_selection
  use cubefit_outimage_tool
  !
  public :: parameters
  private
  !
  integer(kind=chan_k), parameter :: one   = 1
  !
  type :: parameters_comm_t
     type(option_t),     pointer :: comm
     type(cubeid_arg_t), pointer :: incube
     type(selection_opt_t)       :: select
     type(cube_prod_t),  pointer :: method
     type(cube_prod_t),  pointer :: nfuncs
     type(cube_prod_t),  pointer :: sigmas  ! One for all, adapted at run time
     type(cube_prod_t),  pointer :: output  ! One for all, adapted at run time
   contains
     procedure, public  :: register => cubefit_parameters_register
     procedure, private :: parse    => cubefit_parameters_parse
     procedure, private :: main     => cubefit_parameters_main
  end type parameters_comm_t
  type(parameters_comm_t) :: parameters
  !
  type parameters_user_t
     type(cubeid_user_t)    :: cubeids
     type(selection_user_t) :: sele
   contains
     procedure, private :: toprog => cubefit_parameters_user_toprog
  end type parameters_user_t
  !
  type parameters_prog_t
     type(cube_t),      pointer     :: incube
     type(selection_prog_t)         :: sele
     integer(kind=4)                :: nmeth
     integer(kind=4)                :: methhash(nmeth)
     integer(kind=npar_k)           :: npara(nmeth)
     integer(kind=4),   allocatable :: parahash(:,:)
     type(outimage_t),  allocatable :: output(:,:,:)
     logical,           allocatable :: ispos(:,:)
     real(kind=coor_k), allocatable :: reso(:)
     type(outimage_t),  allocatable :: sigmas(:,:)
     type(outimage_t)               :: method
     type(outimage_t)               :: nfuncs
   contains
      procedure, private :: header  => cubefit_parameters_prog_header
      procedure, private :: data    => cubefit_parameters_prog_data
      procedure, private :: loop    => cubefit_parameters_prog_loop
      procedure, private :: act     => cubefit_parameters_prog_act
  end type parameters_prog_t
  !
contains
  !
  subroutine cubefit_parameters_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(parameters_user_t) :: user
    character(len=*), parameter :: rname='PARAMETERS>COMMAND'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call parameters%parse(line,user,error)
    if (error) return
    call parameters%main(user,error)
    if (error) return
  end subroutine cubefit_parameters_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubefit_parameters_register(parameters,error)
    use cubedag_allflags
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_comm_t), intent(inout) :: parameters
    logical,                  intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(cube_prod_t) :: oucube
    character(len=*), parameter :: comm_abstract='Extract parameters from fit results'
    character(len=*), parameter :: comm_help=&
         'Apart from extracting the fit results a SNR image is&
         & produced for each of the parameters fitted. This SNR image&
         & is computed as the fit result divided by the fit error,&
         & except for the position parameters (Frequency and&
         & Velocity). In this case the SNR is computed as the&
         & Spectral resolution divided by the fit error.'
    character(len=*), parameter :: rname='PARAMETERS>REGISTER'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'PARAMETERS','[fit]',&
         comm_abstract,&
         comm_help,&
         cubefit_parameters_command,&
         parameters%comm,error)
    if (error) return
    call cubearg%register(&
         'FIT',&
         'FIT\MINIMIZE output',&
         strg_id,&
         code_arg_optional,&
         [flag_fit,flag_minimize],&
         code_read,&
         code_access_imaset,&  ! %toprog() needs to first access the data in imaset,
                               ! %data() will change it for speset iteration afterwards.
         parameters%incube,&
         error)
    if (error) return
    !
    call parameters%select%register(error)
    if (error) return
    !
    ! Products
    call oucube%register(&
         'METHOD',&
         'The fitting method code',&
         strg_id,&
         [flag_fit,flag_parameters,flag_method],&
         parameters%method,&
         error)
    if (error) return
    call oucube%register(&
         'NLINES',&
         'The number of fitted lines',&
         strg_id,&
         [flag_fit,flag_parameters,flag_nlines],&
         parameters%nfuncs,&
         error)
    if (error) return
    call oucube%register(&
         'NOISE',&
         'The base or line noise image',&
         strg_id,&
         [flag_fit,flag_parameters,flag_any,flag_noise,flag_any],&
         parameters%sigmas,&
         error)
    if (error) return
    call oucube%register(&
         'PARAMETER',&
         'The fitted parameters (as many as needed)',&
         strg_id,&
         [flag_fit,flag_parameters,flag_any,flag_any,flag_any,flag_any],&
         parameters%output,&
         error)
    if (error) return
  end subroutine cubefit_parameters_register
  !
  subroutine cubefit_parameters_parse(parameters,line,user,error)
    !----------------------------------------------------------------------
    ! PARAMETERS cubname
    !----------------------------------------------------------------------
    class(parameters_comm_t), intent(in)    :: parameters
    character(len=*),         intent(in)    :: line
    type(parameters_user_t),  intent(out)   :: user
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname='PARAMETERS>PARSE'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,parameters%comm,user%cubeids,error)
    if (error) return
    call parameters%select%parse(line,user%sele,error)
    if (error) return
  end subroutine cubefit_parameters_parse
  !
  subroutine cubefit_parameters_main(comm,user,error) 
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_comm_t), intent(in)    :: comm
    type(parameters_user_t),  intent(in)    :: user
    logical,                  intent(inout) :: error
    !
    type(parameters_prog_t) :: prog
    character(len=*), parameter :: rname='PARAMETERS>MAIN'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call user%toprog(comm,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 cubefit_parameters_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubefit_parameters_user_toprog(user,comm,prog,error)
    use gkernel_interfaces
    use cubetools_nan
    use cubetools_shape_types
    use cubetools_header_methods
    use cubedag_allflags
    use cubeadm_taskloop
    use cubeadm_opened
    use cubeadm_get
    use cubeadm_image_types
    use cubefit_spectral_fit
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_user_t), intent(in)    :: user
    type(parameters_comm_t),  intent(in)    :: comm
    type(parameters_prog_t),  intent(out)   :: prog
    logical,                  intent(inout) :: error
    !
    type(shape_t) :: n
    type(flag_t) :: methflag,funcflag,paraflag
    type(image_t) :: method,imnfuncs,status
    type(cubeadm_iterator_t) :: iter
    logical :: loop,found,meth_prob,nfunc_prob,round_prob
    integer(kind=4) :: nfuncs(nmeth),nfunc,imeth,maxpar,ier,iout,icol,jcol,ifunc,stat
    integer(kind=chan_k) :: nout,nmax
    integer(kind=pixe_k) :: ix,iy
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='PARAMETERS>USER>TOPROG'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call cubeadm_get_header(comm%incube,user%cubeids,prog%incube,error)
    if (error) return
    call comm%select%user2prog(user%sele,prog%sele,error)
    if (error) return
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    call method%associate('method',prog%incube,iter,error)
    if (error) return
    call imnfuncs%associate('imnfuncs',prog%incube,iter,error)
    if (error) return
    call status%associate('status',prog%incube,iter,error)
    if (error) return
    !
    loop = cubeadm_dataiterate_all(iter,error)  ! ZZZ we should ensure we get
      ! planes icol_method, icol_nfunc, icol_status. Probably by iterating
      ! until they are all iterated.
    if (error)  return
    ! call cubeadm_io_iterate(icol_status,icol_nfunc,prog%incube,error)
    ! if (error) return
    call method%get(icol_method,error)
    if (error) return
    call imnfuncs%get(icol_nfunc,error)
    if (error) return
    call status%get(icol_status,error)
    if (error) return
    !
    meth_prob  = .false.
    nfunc_prob = .false.
    round_prob = .false.
    nfuncs(:) = 0
    do iy=1,method%ny
       do ix=1,method%nx
          if (ieee_is_nan(status%val(ix,iy))) cycle
          stat  = nint(status%val(ix,iy))
          if (stat.eq.code_status_diverged) cycle
          imeth = nint(method%val(ix,iy))
          nfunc = nint(imnfuncs%val(ix,iy))
          round_prob = round_prob .or.(abs(nfunc-imnfuncs%val(ix,iy)).gt.1e-6)
          round_prob = round_prob .or.(abs(imeth-method%val(ix,iy)).gt.1e-6)
          meth_prob  = meth_prob  .or. (imeth.le.0.or.imeth.gt.nmeth)
          nfunc_prob = nfunc_prob .or. (nfunc.le.0.or.nfunc.gt.mfunc)
          if (nfunc.gt.nfuncs(imeth)) then
             nfuncs(imeth) = nfunc
          endif
       enddo ! ix
    enddo ! iy
    !
    if (meth_prob) then
       call cubefit_message(seve%e,rname,'Method description contains unrecognized methods')
       error = .true.
    endif
    if (nfunc_prob) then
       call cubefit_message(seve%e,rname,'Number of lines description goes beyond bounds')
       write(mess,'(a,i0,a)') 'Number of lines goes greater than ',mfunc,' and/or less than 0'
       call cubefit_message(seve%e,rname,mess)
       error = .true.
    endif
    if (round_prob) then
       call cubefit_message(seve%e,rname,'Cube does not contain a proper description of a fit')
       error = .true.
    endif
    if (error) return
    !
    if (prog%sele%ifunc.gt.maxval(imnfuncs%val)) then
       write (mess,'(2(a,i0))') 'Line ',prog%sele%ifunc,' Goes beyond the maximum of lines found: ',&
            nint(maxval(imnfuncs%val))
       call cubefit_message(seve%w,rname,mess)
    endif
    !
    nmax = 0
    if (prog%sele%imeth.eq.code_method_all) then
       ! All Methods are to be used
       prog%nmeth     = 0
       prog%methhash(:) = 0
       prog%npara(:)     = 0 
       do imeth=1,nmeth
          if (nfuncs(imeth).gt.0) then
             prog%nmeth = prog%nmeth+1
             prog%methhash(imeth) = prog%nmeth
             call cubefit_parameters_npars_nout(imeth,nfuncs(imeth),prog%npara(imeth),nout,error)
             if (error) return
             if (nout.gt.nmax) nmax = nout
          endif
       enddo
    else
       ! A single method is to be used
       prog%nmeth = 1
       prog%methhash(:) = 0
       prog%npara(:)      = 0
       found = .false.
       do iy=1,method%ny
          do ix=1,method%nx
             if (method%val(ix,iy).eq.prog%sele%imeth) found = .true.
          enddo ! ix
       enddo ! iy
       if (.not.found) call cubefit_message(seve%w,rname,'Method '//trim(prog%sele%meth)&
            //' Not found in fit')
       prog%methhash(prog%sele%imeth) = 1
       call cubefit_parameters_npars_nout(prog%sele%imeth,nfuncs(imeth),prog%npara(prog%sele%imeth),nout,error)
       if (error) return
       if (nout.gt.nmax) nmax = nout
    endif
    maxpar = maxval(prog%npara)
    !
    call cubetools_header_get_array_shape(prog%incube%head,n,error)
    if (error) return
    if (nmax.gt.n%c) then
       call cubefit_message(fitseve%trace,rname,'Number of channels in cube is inferior to what is expected')
       error = .true.
       return
    endif
    !
    allocate(prog%output(prog%nmeth,maxpar,nvari),prog%sigmas(prog%nmeth,nvari),&
         prog%parahash(nmeth,maxpar),prog%ispos(prog%nmeth,maxpar),prog%reso(prog%nmeth),stat=ier)
    if (failed_allocate(rname,'Parameters cubes',ier,error)) return
    !
    prog%parahash(:,:) = 0
    do imeth=1,nmeth
       if (prog%methhash(imeth).eq.0) cycle
       do iout=1,nsig
          call prog%sigmas(prog%methhash(imeth),iout)%init&
               (imeth,prog%sele%ifunc,jcol_rmsspec,iout,comm%sigmas,error)
          if (error) return
       enddo
       jcol = 0
       do icol=1,prog%npara(imeth)
          call cubefit_parameters_flags(imeth,icol,methflag,funcflag,paraflag,error)
          if (error) return
          if (prog%sele%ifunc.ne.0) then
             call cubefit_flag2func(funcflag,ifunc,error)
             if (error) return
             if (ifunc.eq.prog%sele%ifunc) then
                jcol = jcol+1
                prog%parahash(imeth,icol) = jcol
             endif
          else
             prog%parahash(imeth,icol) = icol
          endif
          prog%ispos(prog%methhash(imeth),prog%parahash(imeth,icol)) = &
            (paraflag.eq.flag_velocity) .or. (paraflag.eq.flag_frequency)
       enddo
       if (imeth.eq.code_method_shell) then
          prog%reso(prog%methhash(imeth)) = prog%incube%head%spe%inc%f
       else
          prog%reso(prog%methhash(imeth)) = prog%incube%head%spe%inc%v
       endif
       if (imeth.eq.code_method_absorption.and.prog%sele%ifunc.gt.1) then
          prog%parahash(imeth,1) = 1
          do icol=2,size(prog%parahash(imeth,:))
             if (prog%parahash(imeth,icol).gt.0) prog%parahash(imeth,icol) = prog%parahash(imeth,icol)+1
          enddo
       endif
       do icol=1,prog%npara(imeth)
          jcol = prog%parahash(imeth,icol)
          if (jcol.gt.0) then
             do iout=1,nvari
                call prog%output(prog%methhash(imeth),jcol,iout)%init&
                     (imeth,prog%sele%ifunc,icol,iout,comm%output,error)
                if (error) return
             enddo
          endif
       enddo
    enddo
    call prog%nfuncs%init(0,0,jcol_nfunc,0,comm%nfuncs,error)
    if (error) return
    call prog%method%init(0,0,jcol_method,0,comm%method,error)
    if (error) return
    !
    call cubeadm_access_header(prog%incube,code_access_speset,code_read,error)
    if (error) return
  end subroutine cubefit_parameters_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubefit_parameters_prog_header(prog,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_prog_t), intent(inout) :: prog
    logical,                  intent(inout) :: error
    !
    integer(kind=4) :: imeth,iout,icol
    character(len=*), parameter :: rname='PARAMETERS>PROG>HEADER'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    do imeth=1,nmeth
       if (prog%methhash(imeth).eq.0) cycle
       do iout=1,nsig
          call prog%sigmas(prog%methhash(imeth),iout)%clone(prog%incube,error)
          if (error) return
       enddo ! iout
       do icol=1,prog%npara(imeth)
          if (prog%parahash(imeth,icol).gt.0) then
             do iout=1,nvari
                call prog%output(prog%methhash(imeth),prog%parahash(imeth,icol),iout)%clone(prog%incube,error)
                if (error) return
             enddo ! iout
          endif
       enddo ! icol
    enddo
    call prog%nfuncs%clone(prog%incube,error)
    if (error) return
    call prog%method%clone(prog%incube,error)
    if (error) return
  end subroutine cubefit_parameters_prog_header
  !
  subroutine cubefit_parameters_prog_data(prog,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    class(parameters_prog_t), intent(inout) :: prog
    logical,                  intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='PARAMETERS>PROG>DATA'
    !
    call cubefit_message(fitseve%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 cubefit_parameters_prog_data
  !
  subroutine cubefit_parameters_prog_loop(prog,iter,error)
    use cubetools_nan
    use cubeadm_taskloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_prog_t), intent(inout) :: prog
    type(cubeadm_iterator_t), intent(inout) :: iter
    logical,                  intent(inout) :: error
    !
    integer(kind=chan_k),parameter :: one = 1
    type(spectrum_t) :: inspec,oupoint,nanpoint,sigbas,siglin
    character(len=*), parameter :: rname='PARAMETERS>PROG>LOOP'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call inspec%reassociate_and_init(prog%incube,iter,error)
    if (error) return
    call oupoint%reallocate('oupoint',one,iter,error)
    if (error) return
    call nanpoint%reallocate('nanpoint',one,iter,error)
    if (error) return
    call sigbas%reallocate('sigbas',one,iter,error)
    if (error) return
    call siglin%reallocate('siglin',one,iter,error)
    if (error) return
    !
    nanpoint%t(one) = gr4nan
    !
    do while (iter%iterate_entry(error))
      call prog%act(iter%ie,inspec,oupoint,nanpoint,sigbas,siglin,error)
      if (error) return
    enddo ! ie
  end subroutine cubefit_parameters_prog_loop
  !
  subroutine cubefit_parameters_prog_act(prog,ie,inspec,oupoint,nanpoint,sigbas,siglin,error)
    use cubetools_nan
    use cubetools_shape_types
    use cubetools_header_methods
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_prog_t), intent(inout) :: prog
    integer(kind=entr_k),     intent(in)    :: ie
    type(spectrum_t),         intent(inout) :: inspec
    type(spectrum_t),         intent(inout) :: oupoint
    type(spectrum_t),         intent(in)    :: nanpoint
    type(spectrum_t),         intent(inout) :: sigbas
    type(spectrum_t),         intent(inout) :: siglin
    logical,                  intent(inout) :: error
    !
    type(shape_t) :: n
    integer(kind=4) :: imeth,icol,iout,jmeth,jcol
    integer(kind=chan_k) :: ic
    real(kind=sign_K) :: outdata(nvari)
    character(len=*), parameter :: rname='PARAMETERS>PROG>ACT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call inspec%get(prog%incube,ie,error)
    if (error) return
    !
    icol = 0
    iout = 0
    ! Store method image
    oupoint%t(one) = inspec%t(icol_method)
    call oupoint%put(prog%method%cube,ie,error)
    if (error) return
    ! Store Nlines image
    oupoint%t(one) = inspec%t(icol_nfunc)
    call oupoint%put(prog%nfuncs%cube,ie,error)
    if (error) return    
    sigbas%t(one) = inspec%t(icol_rmsbase)
    siglin%t(one) = inspec%t(icol_rmsline)
    do imeth=1,nmeth
       if (prog%methhash(imeth).eq.0) cycle
       jmeth = prog%methhash(imeth)
       if (nint(inspec%t(icol_method)).eq.imeth) then
          call siglin%put(prog%sigmas(jmeth,jcol_rmsline)%cube,ie,error)
          if (error) return
          call sigbas%put(prog%sigmas(jmeth,jcol_rmsbase)%cube,ie,error)
          if (error) return          
       else
          call nanpoint%put(prog%sigmas(jmeth,jcol_rmsline)%cube,ie,error)
          if (error) return
          call nanpoint%put(prog%sigmas(jmeth,jcol_rmsbase)%cube,ie,error)
          if (error) return   
       endif
    enddo ! imeth
    call cubetools_header_get_array_shape(prog%incube%head,n,error)
    if (error) return
    do ic=ndaps+1,n%c
       select case(mod(ic-ndaps,3))
       case(1)
          ! Flags and we have reached a new parameter
          icol = icol+1
          outdata(jcol_flag) = inspec%t(ic)
       case(2)
          ! Results
          outdata(jcol_signal) = inspec%t(ic)
       case(0)
          ! Errors and then export
          outdata(jcol_noise) = inspec%t(ic)
          do imeth=1,nmeth
             jmeth = prog%methhash(imeth)
             jcol  = prog%parahash(imeth,icol)
             if (jcol.eq.0.or.jmeth.eq.0) cycle
             if (outdata(jcol_noise).eq.0) then
                outdata(jcol_snr) = gr4nan
             else
                if (prog%ispos(jmeth,jcol)) then
                   outdata(jcol_snr) = prog%reso(jmeth)/outdata(jcol_noise)
                else
                   outdata(jcol_snr) = outdata(jcol_signal)/outdata(jcol_noise)
                endif
             endif
             if (nint(inspec%t(icol_method)).eq.imeth) then
                do iout=1,nvari
                   oupoint%t(one) = outdata(iout)
                   call oupoint%put(prog%output(jmeth,jcol,iout)%cube,ie,error)
                   if (error) return
                enddo ! iout
             else
                do iout=1,nvari
                   call nanpoint%put(prog%output(jmeth,jcol,iout)%cube,ie,error)
                   if (error) return
                enddo ! iout
             endif
          enddo ! imeth
       end select
    enddo ! ic
  end subroutine cubefit_parameters_prog_act
end module cubefit_command_parameters
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
