!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_stitch_spectral
  use cubetools_header_types
  use cubemain_messaging
  use cube_types
  use cubemain_lists
  !
contains
  !
  subroutine cubemain_stitch_spectral_resample_cube(entry,destiny,resampled,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),        intent(inout) :: entry     ! Cube to be resampled
    type(cube_t),pointer, intent(in)    :: destiny   ! Cube containing the description of the output F axis
    type(entry_t),        intent(out)   :: resampled ! Resampled cube
    logical,              intent(inout) :: error     
    !
    type(cube_header_t) :: inhead
    character(len=*),parameter :: rname='STITCH>SPECTRAL>RESAMPLE>CUBE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_cublist_get_entry_header(code_access_speset,entry,error)
    if (error) goto 10
    call cubemain_stitch_spectral_header(entry,destiny,inhead,resampled,error)
    if (error) goto 10
    call cubemain_stitch_spectral_resample(inhead,entry,resampled,error)
    if (error) goto 10
    !
10  continue
    call cubeadm_finish_all('STITCH','',error)
    if (error) return
  end subroutine cubemain_stitch_spectral_resample_cube
  !
  subroutine cubemain_stitch_spectral_header(entry,destiny,inhead,resampled,error)
    use cubetools_header_methods
    use cubedag_allflags
    use cubeadm_get
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),        intent(inout) :: entry
    type(cube_t),pointer, intent(in)    :: destiny
    type(cube_header_t),  intent(out)   :: inhead
    type(entry_t),        intent(inout) :: resampled
    logical,              intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPECTRAL>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_cublist_clone_entry_header(flag_tmp,entry,resampled,error)
    if (error) return
    !
    call cubeadm_access_header(destiny,code_access_imaset_or_speset,code_read,error)
    if (error) return
    call cubetools_header_update_frequency_from_axis(destiny%head%spe%f,resampled%cube%head,error)
    if (error) return
    !
    call inhead%init(error)
    if (error) return
    call cubetools_header_copy(entry%cube%head,inhead,error)
    if (error) return
    call cubetools_header_modify_rest_frequency(resampled%cube%head%spe%ref%f,inhead,error)
    if (error) return
  end subroutine cubemain_stitch_spectral_header
  !
  subroutine cubemain_stitch_spectral_resample(inhead,entry,resampled,error)
    use cubemain_resample
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_header_t), intent(in)    :: inhead
    type(entry_t),       intent(inout) :: entry
    type(entry_t),       intent(inout) :: resampled
    logical,             intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPECTRAL>RESAMPLE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_resample_data(inhead,entry%cube,resampled%cube,error)
    if(error) return
    ! VVV Noise resampling is not as straight forward as depicted here
    ! if (entry%donoise) then
    !    call cubemain_stitch_spectral_resample_noise(resam,entry,output,error)
    !    if(error) return
    ! endif
  end subroutine cubemain_stitch_spectral_resample
  !
  subroutine cubemain_stitch_spectral_resample_noise(entry,output,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),          intent(inout) :: entry
    type(entry_t),          intent(inout) :: output
    logical,                intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPECTRAL>RESAMPLE>NOISE'
    type(cubeadm_iterator_t) :: iter
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP PARALLEL DEFAULT(none) SHARED(output,entry,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error)  exit
       !$OMP TASK SHARED(output,entry) FIRSTPRIVATE(iter,error)
       if (.not.error) call cubemain_stitch_spectral_resample_noise_loop(entry,output,& 
            iter%first,iter%last,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
  end subroutine cubemain_stitch_spectral_resample_noise
  !
  subroutine cubemain_stitch_spectral_resample_noise_loop(entry,output,first,last,error)
    use cubeadm_entryloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),          intent(inout) :: entry
    type(entry_t),          intent(inout) :: output
    integer(kind=entr_k),   intent(in)    :: first
    integer(kind=entr_k),   intent(in)    :: last
    logical,                intent(inout) :: error
    !
    type(spectrum_t) :: innoise,ounoise
    integer(kind=entr_k) :: ie
    real(kind=coor_k) :: incratio
    character(len=*),parameter :: rname='STITCH>SPECTRAL>RESAMPLE>NOISE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call innoise%reassociate_and_init(entry%noise,error)
    if (error) return
    call ounoise%reallocate('out',entry%noise%head%arr%n%c,error)
    if (error) return
    incratio = sqrt(entry%cube%head%spe%f%inc/output%cube%head%spe%f%inc)
    !
    do ie=first,last
       call cubeadm_entryloop_iterate(ie,error)
       if (error) return
       call innoise%get(entry%noise,ie,error)
       if (error) return
       !
       ounoise%t(:) = innoise%t(:)*incratio
       !
       call innoise%put(output%noise,ie,error)
       if (error) return
    enddo
  end subroutine cubemain_stitch_spectral_resample_noise_loop
  !
  subroutine cubemain_stitch_spectral_add_cube(entry,oucube,weight,error)
    use cubeadm_opened
    use cubeadm_get
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),        intent(inout) :: entry
    type(cube_t),pointer, intent(inout) :: oucube  
    type(cube_t),pointer, intent(inout) :: weight
    logical,              intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPECTRAL>ADD>CUBE'
    type(cubeadm_iterator_t) :: iter
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_cublist_get_entry_header(code_access_speset,entry,error)
    if (error) return
    call cubeadm_access_header(oucube,code_access_speset,code_update,error)
    if (error) return
    call cubeadm_access_header(weight,code_access_speset,code_update,error)
    if (error) return
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP PARALLEL DEFAULT(none) SHARED(entry,oucube,weight,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error)  exit
       !$OMP TASK SHARED(entry,oucube,weight) FIRSTPRIVATE(iter,error)
       if (.not.error) call cubemain_stitch_spectral_add_loop(entry,oucube,weight,iter%first,iter%last,error)
       !
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
    !
    call cubeadm_finish_all('STITCH','',error)
    if (error) return
  end subroutine cubemain_stitch_spectral_add_cube
  !
  subroutine cubemain_stitch_spectral_add_loop(entry,oucube,weight,first,last,error)
    use cubeadm_entryloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),        intent(inout) :: entry
    type(cube_t),         intent(inout) :: oucube
    type(cube_t),         intent(inout) :: weight
    integer(kind=entr_k), intent(in)    :: first
    integer(kind=entr_k), intent(in)    :: last
    logical,              intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPECTRAL>ADD>LOOP'
    type(spectrum_t) :: input,output,weiout,weiin
    integer(kind=entr_k) :: ie
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call input%reassociate_and_init(entry%cube,error)
    if (error) return
    call output%reassociate_and_init(oucube,error)
    if (error) return
    call weiout%reassociate_and_init(weight,error)
    if (error) return
    if (entry%donoise) then
       call weiin%reassociate_and_init(entry%noise,error)
       if (error) return
    else
       call weiin%reallocate('in weight',int(1,chan_k),error)
       if (error) return
       weiin%t(:) = entry%weig
    endif
    !
    do ie=first,last
       call cubeadm_entryloop_iterate(ie,error)
       if (error)  return
       call cubemain_stitch_spectral_add(entry,oucube,weight,ie,input,weiin,output,weiout,error)
       if (error)  return
    enddo
  end subroutine cubemain_stitch_spectral_add_loop
  !
  subroutine cubemain_stitch_spectral_add(entry,oucube,weight,ie,input,weiin,output,weiout,error)
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),        intent(inout) :: entry
    type(cube_t),         intent(inout) :: oucube
    type(cube_t),         intent(inout) :: weight
    integer(kind=entr_k), intent(in)    :: ie
    type(spectrum_t),     intent(inout) :: input
    type(spectrum_t),     intent(inout) :: weiin
    type(spectrum_t),     intent(inout) :: output
    type(spectrum_t),     intent(inout) :: weiout
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='STITCH>SPECTRAL>ADD'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call input%get(entry%cube,ie,error)
    if (error) return
    call output%get(oucube,ie,error)
    if (error) return
    call weiout%get(weight,ie,error)
    if (error) return
    if (entry%donoise) then
       call weiin%get(entry%noise,ie,error)
       if (error) return
       weiin%t(:) = 1.0/(weiin%t(:)**2)
    endif
    !
    call cubemain_stitch_spectral_add_spectra(oucube%head%arr%n%c,input,weiin,output,weiout)
    !
    call output%put(oucube,ie,error)
    if (error) return
    call weiout%put(weight,ie,error)
    if (error) return
  end subroutine cubemain_stitch_spectral_add
  !
  subroutine cubemain_stitch_spectral_init_output(oucube,weight,error)
    use cubeadm_opened
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_t),pointer, intent(inout) :: oucube
    type(cube_t),pointer, intent(inout) :: weight
    logical,              intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='STITCH>SPECTRAL>INIT>OUTPUT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP PARALLEL DEFAULT(none) SHARED(oucube,weight,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error)  exit
       !$OMP TASK SHARED(oucube,weight) FIRSTPRIVATE(iter,error)
       if (.not.error) call cubemain_stitch_spectral_init_loop(oucube,weight,iter%first,iter%last,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
    !
    ! Finalize so that all can be re-opened afterwards
    call cubeadm_finish_all('STITCH','',error)
    if (error) return
  end subroutine cubemain_stitch_spectral_init_output
  !
  subroutine cubemain_stitch_spectral_init_loop(oucube,weight,first,last,error)
    use cubetools_nan
    use cubeadm_entryloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_t),         intent(inout) :: oucube
    type(cube_t),         intent(inout) :: weight
    integer(kind=entr_k), intent(in)    :: first
    integer(kind=entr_k), intent(in)    :: last
    logical,              intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPECTRAL>INIT>LOOP'
    type(spectrum_t) :: output,weiout
    integer(kind=entr_k) :: ie
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call output%reallocate('output',oucube%head%arr%n%c,error)
    if (error) return
    call weiout%reallocate('weight',weight%head%arr%n%c,error)
    if (error) return
    output%t(:) = gr4nan
    weiout%t(:) = 0.0
    !
    do ie=first,last
       call cubeadm_entryloop_iterate(ie,error)
       if (error) exit
       call output%put(oucube,ie,error)
       if (error) exit
       call weiout%put(weight,ie,error)
       if (error) exit
    enddo   
  end subroutine cubemain_stitch_spectral_init_loop
  !
  subroutine cubemain_stitch_spectral_resample_add_cube(entry,oucube,weight,error)
    use cubetools_header_methods
    use cubeadm_opened
    use cubeadm_get
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),         intent(inout) :: entry
    type(cube_t), pointer, intent(inout) :: oucube
    type(cube_t), pointer, intent(inout) :: weight
    logical,               intent(inout) :: error
    !
    type(cubeadm_iterator_t) :: iter
    type(cube_header_t) :: inhead
    character(len=*),parameter :: rname='STITCH>SPECTRAL>RESAMPLE>ADD>CUBE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_cublist_get_entry_header(code_access_speset,entry,error)
    if (error) goto 10
    call cubeadm_access_header(oucube,code_access_speset,code_update,error)
    if (error) goto 10
    call cubeadm_access_header(weight,code_access_speset,code_update,error)
    if (error) goto 10
    !
    call inhead%init(error)
    if (error) goto 10
    call cubetools_header_copy(entry%cube%head,inhead,error)
    if (error) goto 10
    call cubetools_header_modify_rest_frequency(oucube%head%spe%ref%f,inhead,error)
    if (error) goto 10
    !
    call cubeadm_datainit_all(iter,error)
    if (error) goto 10
    !$OMP PARALLEL DEFAULT(none) SHARED(inhead,entry,oucube,weight,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error)  exit
       !$OMP TASK SHARED(inhead,entry,oucube,weight) FIRSTPRIVATE(iter,error)
       if (.not.error) call cubemain_stitch_spectral_resample_add_loop(inhead,entry,oucube,weight,&
            iter%first,iter%last,error)
       !$OMP END TASK
    enddo ! ie
    !$OMP END SINGLE
    !$OMP END PARALLEL
    !
10  call cubeadm_finish_all('STITCH','',error)
    if (error) return
  end subroutine cubemain_stitch_spectral_resample_add_cube
  !
  subroutine cubemain_stitch_spectral_resample_add_loop(inhead,entry,oucube,weight,first,last,error)
    use cubeadm_entryloop
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_header_t),  intent(in)    :: inhead
    type(entry_t),        intent(inout) :: entry
    type(cube_t),         intent(inout) :: oucube
    type(cube_t),         intent(inout) :: weight
    integer(kind=entr_k), intent(in)    :: first
    integer(kind=entr_k), intent(in)    :: last
    logical,              intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPECTRAL>RESAMPLE>ADD>LOOP'
    type(spectrum_t) :: input,output,resampled,weiout,weiin
    integer(kind=entr_k) :: ie
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call input%reassociate_and_init(entry%cube,error)
    if (error) return
    ! VVV this is necessary to allow for the proper resampling
    input%w(:) = 1.0
    call output%reassociate_and_init(oucube,error)
    if (error) return
    call weiout%reassociate_and_init(weight,error)
    if (error) return
    call resampled%reallocate('resampled',oucube%head%arr%n%c,error)
    if (error) return
    if (entry%donoise) then
       call weiin%reassociate_and_init(entry%noise,error)
       if (error) return
    else
       call weiin%reallocate('in weight',int(1,chan_k),error)
       if (error) return
       weiin%t(:) = entry%weig
    endif
    !
    do ie=first,last
       call cubeadm_entryloop_iterate(ie,error)
       if (error)  return
       call cubemain_stitch_spectral_resample_add(inhead,entry,oucube,weight,ie,&
            input,weiin,resampled,output,weiout,error)
       if (error)  return
    enddo
  end subroutine cubemain_stitch_spectral_resample_add_loop
  !
  subroutine cubemain_stitch_spectral_resample_add(inhead,entry,oucube,weight,ie,&
       input,weiin,resampled,output,weiout,error)
    use cubemain_spectrum_real
    use cubemain_spectrum_resampling
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_header_t),  intent(in)    :: inhead
    type(entry_t),        intent(inout) :: entry
    type(cube_t),         intent(inout) :: oucube
    type(cube_t),         intent(inout) :: weight
    integer(kind=entr_k), intent(in)    :: ie
    type(spectrum_t),     intent(inout) :: input
    type(spectrum_t),     intent(inout) :: weiin
    type(spectrum_t),     intent(inout) :: resampled
    type(spectrum_t),     intent(inout) :: output
    type(spectrum_t),     intent(inout) :: weiout
    logical,              intent(inout) :: error
    !
    real(kind=coor_k) :: incratio
    character(len=*), parameter :: rname='STITCH>SPECTRAL>RESAMPLE>ADD'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call input%get(entry%cube,ie,error)
    if (error) return
    call output%get(oucube,ie,error)
    if (error) return
    call weiout%get(weight,ie,error)
    if (error) return
    if (entry%donoise) then
       incratio = sqrt(entry%cube%head%spe%f%inc/oucube%head%spe%f%inc)
       call weiin%get(entry%noise,ie,error)
       if (error) return
       weiin%t(:) = 1.0/((weiin%t(:)*incratio)**2)
    endif
    call cubemain_spectrum_resample(inhead%spe%f,oucube%head%spe%f,input,resampled,error)
    if (error)  return
    !
    call cubemain_stitch_spectral_add_spectra(oucube%head%arr%n%c,resampled,weiin,output,weiout)
    !
    call output%put(oucube,ie,error)
    if (error) return
    call weiout%put(weight,ie,error)
    if (error) return
  end subroutine cubemain_stitch_spectral_resample_add
  !
  subroutine cubemain_stitch_spectral_add_spectra(nc,input,weiin,output,weiout)
    use cubetools_nan
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    integer(kind=chan_k), intent(in)    :: nc
    type(spectrum_t),     intent(in)    :: input
    type(spectrum_t),     intent(in)    :: weiin
    type(spectrum_t),     intent(inout) :: output
    type(spectrum_t),     intent(inout) :: weiout
    !
    integer(kind=chan_k),parameter :: one =1
    integer(kind=chan_k) :: ic
    character(len=*),parameter :: rname='STITCH>SPECTRAL>ADD>SPECTRA'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    do ic = 1,nc
       if (ieee_is_nan(input%t(ic))) cycle
       if (ieee_is_nan(output%t(ic))) then
          output%t(ic) = input%t(ic)*weiin%t(one)
          weiout%t(ic) = weiin%t(one)
       else
          weiout%t(ic) = weiout%t(ic)+weiin%t(one)
          output%t(ic) = (output%t(ic)+input%t(ic)*weiin%t(one))/weiout%t(ic)
       endif
    enddo
  end subroutine cubemain_stitch_spectral_add_spectra
  !
  subroutine cubemain_stitch_spectral_merge(inlist,oucube,weight,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(cublist_t),     intent(inout) :: inlist
    type(cube_t),pointer,intent(inout) :: oucube
    type(cube_t),pointer,intent(inout) :: weight
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='STITCH>SPECTRAL>MERGE'
    integer(kind=4) :: icub
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_stitch_spectral_init_output(oucube,weight,error)
    if (error) return
    !
    do icub=1,inlist%n
       call cubemain_stitch_spectral_add_cube(inlist%entries(icub),oucube,weight,error)
       if (error) return
    enddo
  end subroutine cubemain_stitch_spectral_merge
end module cubemain_stitch_spectral
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
