!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefit_parameters_outimage
  use cube_types
  use cubedag_allflags
  use cubefit_messaging
  use cubefit_parameters
  !
  public :: nsig,nvari,iflg,ires,ierr,isnr,isbase,issigma,isline,ismethod,isnlines
  public :: outimage_t
  private
  !
  integer(kind=4), parameter :: nsig   = 2
  integer(kind=4), parameter :: nvari  = 4
  integer(kind=4), parameter :: iflg   = 1
  integer(kind=4), parameter :: ires   = 2
  integer(kind=4), parameter :: ierr   = 3
  integer(kind=4), parameter :: isnr   = 4
  integer(kind=4), parameter :: isline  = 1
  integer(kind=4), parameter :: isbase  = 2
  integer(kind=4), parameter :: issigma   = -1
  integer(kind=4), parameter :: ismethod  = -2
  integer(kind=4), parameter :: isnlines  = -3
  !
  type outimage_t
     type(cube_t), pointer     :: cube
     type(flag_t), allocatable :: flags(:)
     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(outimag,imeth,jline,ipar,iout,error)
    use gkernel_interfaces
    use cubefit_spectral_fit
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(outimage_t), intent(inout) :: outimag
    integer(kind=4),   intent(in)    :: imeth
    integer(kind=4),   intent(in)    :: jline
    integer(kind=4),   intent(in)    :: ipar
    integer(kind=4),   intent(in)    :: iout
    logical,           intent(inout) :: error
    !
    type(flag_t) :: signoiflag(nvari),sigmaflags(nsig)
    integer(kind=4) :: ier
    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]
    !
    select case(ipar)
    case(issigma) ! sigma image
       allocate(outimag%flags(5),stat=ier)
       if (failed_allocate(rname,'Flag list',ier,error)) return
       outimag%flags(1) = flag_fit
       outimag%flags(2) = flag_parameters
       call cubefit_parameters_flags(imeth,1,outimag%flags(3),outimag%flags(4),outimag%flags(5),error)
       if (error) return
       outimag%flags(4) = flag_noise
       outimag%flags(5) = sigmaflags(iout)
       outimag%unit     = strg_id ! Sigma has the same unit as the original cube 
    case(isnlines)
       allocate(outimag%flags(3),stat=ier)
       if (failed_allocate(rname,'Flag list',ier,error)) return
       outimag%flags(:) = [flag_fit,flag_parameters,flag_nlines]
       outimag%unit     = '---' ! No unit for number of lines
    case(ismethod)
       allocate(outimag%flags(3),stat=ier)
       if (failed_allocate(rname,'Flag list',ier,error)) return
       outimag%flags(:) = [flag_fit,flag_parameters,flag_method]
       outimag%unit     = '---' ! No unit for method
    case default ! Parameter images
       allocate(outimag%flags(6),stat=ier)
       if (failed_allocate(rname,'Flag list',ier,error)) return
       outimag%flags(1) = flag_fit
       outimag%flags(2) = flag_parameters
       outimag%flags(6) = signoiflag(iout)
       call cubefit_parameters_flags(imeth,ipar,outimag%flags(3),outimag%flags(4),outimag%flags(5),error)
       if (error) return
       if (jline.ne.0) then
          call cubefit_line2flag(jline,outimag%flags(5),error)
          if (error)  return
       endif
       if (iout.eq.2.or.iout.eq.3) then ! Signal and noise are on the parameter unit
          call cubefit_parameters_units(imeth,ipar,outimag%unit,error)
          if (error) return
       else ! flag and snr have no unit
          outimag%unit     = '---'
       endif
    end select
  end subroutine cubefit_parameters_outimage_init
  !
  subroutine cubefit_parameters_outimage_clone(outimag,incube,error)
    use cubetools_header_methods
    use cubeadm_clone
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(outimage_t),    intent(inout) :: outimag
    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(incube,outimag%flags,outimag%cube,error)
    if (error) return
    call cubetools_header_nullify_axset_c(outimag%cube%head,error)
    if (error) return
    if (outimag%unit.ne.strg_id) then
       if (outimag%unit(1:1).eq.strg_add) then
          call cubetools_header_get_array_unit(outimag%cube%head,unit,error)
          if (error) return
          unit = trim(unit)//'.'//outimag%unit(2:)
          call cubetools_header_put_array_unit(unit,outimag%cube%head,error)
          if (error) return
       else
          call cubetools_header_put_array_unit(outimag%unit,outimag%cube%head,error)
          if (error) return
       endif
    endif
  end subroutine cubefit_parameters_outimage_clone
  !
end module cubefit_parameters_outimage
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefit_command_parameters
  use cube_types
  use cubetools_structure
  use cubeadm_cubeid_types
  use cubefit_messaging
  use cubefit_parameters
  use cubefit_selection
  use cubefit_parameters_outimage
  !
  public :: parameters
  public :: cubefit_parameters_command
  private
  !
  integer(kind=chan_k), parameter :: one   = 1
 
  !
  type :: parameters_comm_t
     type(option_t), pointer :: comm
     type(selection_opt_t)   :: select
   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
  !
  integer(kind=4), parameter :: icube  = 1
  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)                :: nmethod
     integer(kind=4)                :: methhash(spec_nmeth)
     integer(kind=npar_k)           :: npar(spec_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)               :: nlines
   contains
      procedure, private :: header  => cubefit_parameters_prog_header
      procedure, private :: data    => cubefit_parameters_prog_data
      procedure, private :: loop    => cubefit_parameters_prog_loop
      procedure, private :: extract => cubefit_parameters_prog_extract
     
  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
    character(len=*), parameter :: comm_abstract = 'Extract parameters from fit results'
    character(len=*), parameter :: comm_help = &
         'Apart from extracting the fit resutls 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], &
         error)
    if (error) return
    !
    call parameters%select%register(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(parameters,user,error)    
    use cubeadm_timing
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_comm_t), intent(in)    :: parameters
    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(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,prog,error)
    use gkernel_interfaces
    use cubetools_nan
    use cubedag_allflags
    use cubefit_spectral_fit
    use cubeadm_ioloop
    use cubeadm_get
    use cubemain_image_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_user_t), intent(in)    :: user
    type(parameters_prog_t),  intent(out)   :: prog
    logical,                  intent(inout) :: error
    !
    integer(kind=4) :: nlines(spec_nmeth),nline,imeth,maxpar,ier,iout,ipar,jpar,jline,stat
    type(flag_t) :: methodflag,lineflag,parflag
    integer(kind=chan_k) :: nout,nmax
    integer(kind=pixe_k) :: il,im,nl,nm
    type(image_t) :: method,imnlines,status
    logical :: found, meth_prob,nline_prob,round_prob
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='PARAMETERS>USER>TOPROG'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_get_header(parameters%comm,icube,user%cubeids,&
         code_access_imaset,code_read,prog%incube,error)
    if (error) return
    call parameters%select%user2prog(user%sele,prog%sele,error)
    if (error) return
    !
    call method%init(prog%incube,error)
    if (error) return
    call imnlines%init(prog%incube,error)
    if (error) return
    call status%init(prog%incube,error)
    if (error) return
    !
    nl = prog%incube%head%spa%l%n
    nm = prog%incube%head%spa%m%n
    call cubeadm_io_iterate(istatus,inline,prog%incube,error)
    if (error) return
    call method%get(prog%incube,imethod,error)
    if (error) return
    call imnlines%get(prog%incube,inline,error)
    if (error) return
    call status%get(prog%incube,istatus,error)
    if (error) return
    !
    meth_prob  = .false.
    nline_prob = .false.
    round_prob = .false.
    nlines(:) = 0
    do im=1,nm
       do il=1,nl
          if (ieee_is_nan(status%z(il,im))) cycle
          stat  = nint(status%z(il,im))
          if (stat.eq.code_diverged) cycle
          imeth = nint(method%z(il,im))
          nline = nint(imnlines%z(il,im))
          round_prob = round_prob .or.(abs(nline-imnlines%z(il,im)).gt.1e-6)
          round_prob = round_prob .or.(abs(imeth-method%z(il,im)).gt.1e-6)
          meth_prob  = meth_prob  .or. (imeth.le.0.or.imeth.gt.spec_nmeth)
          nline_prob = nline_prob .or. (nline.le.0.or.nline.gt.mline)
          if (nline.gt.nlines(imeth)) then
             nlines(imeth) = nline
          endif
       enddo
    enddo
    !
    if (meth_prob) then
       call cubefit_message(seve%e,rname,'Method description contains unrecognized methods')
       error = .true.
    endif
    if (nline_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 ',mline,' 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%iline.gt.maxval(imnlines%z)) then
       write (mess,'(2(a,i0))') 'Line ',prog%sele%iline,' Goes beyond the maximum of lines found: ',&
            nint(maxval(imnlines%z))
       call cubefit_message(seve%w,rname,mess)
    endif
    !
    nmax = 0
    if (prog%sele%imeth.eq.code_all_meth) then ! All Methods are to be used
       prog%nmethod     = 0
       prog%methhash(:) = 0
       prog%npar(:)     = 0 
       do imeth=1,spec_nmeth
          if(nlines(imeth).gt.0) then
             prog%nmethod = prog%nmethod+1
             prog%methhash(imeth) = prog%nmethod
             call cubefit_parameters_npars_nout(imeth,nlines(imeth),prog%npar(imeth),nout,error)
             if (error) return
             if (nout.gt.nmax) nmax = nout
          endif
       enddo
    else ! A single method is to be used
       prog%nmethod = 1
       prog%methhash(:) = 0
       prog%npar(:)      = 0
       found = .false.
       do im=1,nm
          do il=1,nl
             if (method%z(il,im).eq.prog%sele%imeth) found = .true.
          enddo
       enddo
       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,nlines(imeth),prog%npar(prog%sele%imeth),nout,error)
       if (error) return
       if (nout.gt.nmax) nmax = nout
    endif    
    maxpar = maxval(prog%npar)
    !
    if (nmax.gt.prog%incube%head%arr%n%c) then
       call cubefit_message(fitseve%trace,rname,'Number of channels in cube is inferior to what is expected')
       error = .true.
       return
    end if
    !
    allocate(prog%output(prog%nmethod,maxpar,nvari),prog%sigmas(prog%nmethod,nvari),&
         prog%parahash(spec_nmeth,maxpar),prog%ispos(prog%nmethod,maxpar),prog%reso(prog%nmethod),stat=ier)
    if (failed_allocate(rname,'Parameters cubes',ier,error)) return
    !
    prog%parahash(:,:) = 0
    do imeth=1,spec_nmeth
       if (prog%methhash(imeth).eq.0) cycle
       do iout=1,nsig
          call prog%sigmas(prog%methhash(imeth),iout)%init(imeth,prog%sele%iline,issigma,iout,error)
          if (error) return
       enddo
       jpar = 0
       do ipar=1,prog%npar(imeth)
          call cubefit_parameters_flags(imeth,ipar,methodflag,lineflag,parflag,error)
          if (error) return
          if (prog%sele%iline.ne.0) then
             call cubefit_flag2line(lineflag,jline,error)
             if (error)  return
             if (jline.eq.prog%sele%iline) then
                jpar = jpar+1
                prog%parahash(imeth,ipar) = jpar
             endif
          else
             prog%parahash(imeth,ipar) = ipar
          endif
          prog%ispos(prog%methhash(imeth),prog%parahash(imeth,ipar)) = &
            (parflag.eq.flag_velocity) .or. (parflag.eq.flag_frequency)
       enddo
       if (imeth.eq.ishell) 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.iabsorption.and.prog%sele%iline.gt.1) then
          prog%parahash(imeth,1) = 1
          do ipar=2,size(prog%parahash(imeth,:))
             if (prog%parahash(imeth,ipar).gt.0) prog%parahash(imeth,ipar) = prog%parahash(imeth,ipar)+1
          enddo
       endif
       do ipar=1,prog%npar(imeth)
          jpar = prog%parahash(imeth,ipar)
          if (jpar.gt.0) then
             do iout=1,nvari
                call prog%output(prog%methhash(imeth),jpar,iout)%init(imeth,prog%sele%iline,ipar,iout,error)
                if (error) return
             enddo
          endif
       enddo
    enddo
    call prog%nlines%init(0,0,isnlines,0,error)
    if (error) return
    call prog%method%init(0,0,ismethod,0,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,ipar
    character(len=*), parameter :: rname='PARAMETERS>PROG>HEADER'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    do imeth=1,spec_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
       do ipar=1,prog%npar(imeth)
          if (prog%parahash(imeth,ipar).gt.0) then
             do iout=1,nvari
                call prog%output(prog%methhash(imeth),prog%parahash(imeth,ipar),iout)%clone(prog%incube,error)
                if (error) return
             enddo
          endif
       enddo
    enddo
    call prog%nlines%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) 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 cubefit_parameters_prog_data
  !
  subroutine cubefit_parameters_prog_loop(prog,first,last,error)
    use cubetools_nan
    use cubeadm_entryloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(parameters_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
    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,error)
    if (error) return
    call oupoint%reallocate('oupoint',one,error)
    if (error) return
    call nanpoint%reallocate('nanpoint',one,error)
    if (error) return
    call sigbas%reallocate('sigbas',one,error)
    if (error) return
    call siglin%reallocate('siglin',one,error)
    if (error) return
    !
    nanpoint%t(one) = gr4nan
    !
    do ie=first,last
      call cubeadm_entryloop_iterate(ie,error)
      if (error)  return
      call prog%extract(ie,inspec,oupoint,nanpoint,sigbas,siglin,error)
      if (error)  return
    enddo
  end subroutine cubefit_parameters_prog_loop
  !
  subroutine cubefit_parameters_prog_extract(prog,ie,inspec,oupoint,nanpoint,sigbas,siglin,error)
    use cubetools_nan
    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
    !
    integer(kind=4) :: imeth,ipar,iout,jmeth,jpar
    integer(kind=chan_k) :: ic
    real(kind=sign_K) :: outdata(nvari)
    character(len=*), parameter :: rname='PARAMETERS>PROG>EXTRACT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call inspec%get(prog%incube,ie,error)
    if (error)  return
    !
    ipar = 0
    iout = 0
    ! Store method image
    oupoint%t(one) = inspec%t(imethod)
    call oupoint%put(prog%method%cube,ie,error)
    if (error) return
    ! Store Nlines image
    oupoint%t(one) = inspec%t(inline)
    call oupoint%put(prog%nlines%cube,ie,error)
    if (error) return    
    sigbas%t(one) = inspec%t(isigbase)
    siglin%t(one) = inspec%t(isigline)
    do imeth=1,spec_nmeth
       if (prog%methhash(imeth).eq.0) cycle
       jmeth = prog%methhash(imeth)
       if (nint(inspec%t(imethod)).eq.imeth) then
          call siglin%put(prog%sigmas(jmeth,isline)%cube,ie,error)
          if (error) return
          call sigbas%put(prog%sigmas(jmeth,isbase)%cube,ie,error)
          if (error) return          
       else
          call nanpoint%put(prog%sigmas(jmeth,isline)%cube,ie,error)
          if (error) return
          call nanpoint%put(prog%sigmas(jmeth,isbase)%cube,ie,error)
          if (error) return   
       endif
    enddo
    do ic=spec_ndaps+1,prog%incube%head%arr%n%c
       select case(mod(ic-spec_ndaps,3))
       case(1) ! Flags and we have reached a new parameter
          ipar = ipar+1
          outdata(iflg) = inspec%t(ic)
       case(2) ! Results
          outdata(ires) = inspec%t(ic)
       case(0) ! Errors and then export
          outdata(ierr) = inspec%t(ic)
          do imeth=1,spec_nmeth
             jmeth = prog%methhash(imeth)
             jpar  = prog%parahash(imeth,ipar)
             if (jpar.eq.0.or.jmeth.eq.0) cycle
             if (outdata(ierr).eq.0) then
                outdata(isnr) = gr4nan
             else
                if (prog%ispos(imeth,jpar)) then
                   outdata(isnr) = prog%reso(jmeth)/outdata(ierr)
                else
                   outdata(isnr) = outdata(ires)/outdata(ierr)
                endif
             endif
             if (nint(inspec%t(imethod)).eq.imeth) then
                do iout=1,nvari
                   oupoint%t(one) = outdata(iout)
                   call oupoint%put(prog%output(jmeth,jpar,iout)%cube,ie,error)
                   if (error) return
                enddo
             else
                do iout=1,nvari
                   call nanpoint%put(prog%output(jmeth,jpar,iout)%cube,ie,error)
                   if (error) return
                enddo
             endif
          enddo
       end select
       !
    enddo
  end subroutine cubefit_parameters_prog_extract
end module cubefit_command_parameters
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
