!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_stitch_spatial
  use cube_types
  use cubetools_nan
  use cubemain_messaging
  use cubemain_lists
  !
contains
  !
  subroutine cubemain_stitch_spatial_reproject_cube(entry,destiny,reprojected,error)
    use cubeadm_opened
    use cubemain_reproject
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),         intent(inout) :: entry       ! Cube to be reprojected
    type(cube_t), pointer, intent(in)    :: destiny     ! Cube containing the target spatial description
    type(entry_t),         intent(out)   :: reprojected ! Reprojected cube
    logical,               intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPATIAL>REPROJECT>CUBE'
    type(reproject_prog_t) :: myreproject
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_cublist_get_entry_header(code_access_imaset,entry,error)
    if (error) goto 10
    call cubemain_stitch_spatial_header(entry,destiny,reprojected,error)
    if (error) goto 10
    call cubemain_stitch_spatial_prepare(entry,destiny,myreproject,error)
    if (error) goto 10
    call cubemain_stitch_spatial_reproject(myreproject,entry,reprojected,error)
    if (error) goto 10
    !
10  continue
    call cubeadm_finish_all('STITCH','',error)
    if (error) return
  end subroutine cubemain_stitch_spatial_reproject_cube
  !
  subroutine cubemain_stitch_spatial_header(entry,destiny,reprojected,error)
    use cubedag_allflags
    use cubetools_header_methods
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),          intent(inout) :: entry
    type(cube_t), pointer,  intent(in)    :: destiny
    type(entry_t),          intent(inout) :: reprojected
    logical,                intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPATIAL>HEADER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_cublist_clone_entry_header(flag_tmp,entry,reprojected,error)
    if (error) return
    call cubetools_header_spatial_like(destiny%head,reprojected%cube%head,error)
    if (error) return   
  end subroutine cubemain_stitch_spatial_header
  !
  subroutine cubemain_stitch_spatial_prepare(entry,destiny,myreproject,error)
    use cubetools_header_methods
    use cubemain_reproject
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),          intent(in)    :: entry
    type(cube_t), pointer,  intent(in)    :: destiny
    type(reproject_prog_t), intent(out)   :: myreproject
    logical,                intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPATIAL>PREPARE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_reproject_user_toprog_find_convcode(&
         entry%cube%head%spa%fra,&
         destiny%head%spa%fra,&
         myreproject%code,error)
    if(error) return
    call cubetools_header_get_axis_head_l(destiny%head,myreproject%newx,error)
    if (error) return
    call cubetools_header_get_axis_head_m(destiny%head,myreproject%newy,error)
    if (error) return
    call cubetools_header_get_axis_head_l(entry%cube%head,myreproject%oldx,error)
    if (error) return
    call cubetools_header_get_axis_head_m(entry%cube%head,myreproject%oldy,error)
    if (error) return
    myreproject%cube => entry%cube
    myreproject%reprojected => destiny
  end subroutine cubemain_stitch_spatial_prepare
  !
  subroutine cubemain_stitch_spatial_reproject(myreproject,entry,reprojected,error)
    use cubemain_reproject
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(reproject_prog_t), intent(inout) :: myreproject
    type(entry_t),          intent(inout) :: entry
    type(entry_t),          intent(inout) :: reprojected
    logical,                intent(inout) :: error
    !
    character(len=*),parameter :: rname='STITCH>SPATIAL>REPROJECT'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call myreproject%data(entry%cube,reprojected%cube,error)
    if(error) return
    ! VVV This is not what should be done
    ! if (entry%donoise) then
    !    call repro%data(entry%noise,output%noise,error)
    !    if(error) return
    ! endif
  end subroutine cubemain_stitch_spatial_reproject
  !
  subroutine cubemain_stitch_spatial_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
    !
    type(cubeadm_iterator_t) :: iter
    character(len=*),parameter :: rname='STITCH>SPATIAL>ADD>CUBE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_cublist_get_entry_header(code_access_imaset,entry,error)
    if (error) return
    call cubeadm_access_header(oucube,code_access_imaset,code_update,error)
    if (error) return
    call cubeadm_access_header(weight,code_access_imaset,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_spatial_add_loop(entry,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_spatial_add_cube
  !
  subroutine cubemain_stitch_spatial_add_loop(entry,oucube,weight,first,last,error)
    use cubeadm_entryloop
    use cubemain_image_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),         intent(inout) :: entry
    type(cube_t), pointer, intent(inout) :: oucube
    type(cube_t), pointer, intent(inout) :: weight
    integer(kind=entr_k),  intent(in)    :: first
    integer(kind=entr_k),  intent(in)    :: last
    logical,               intent(inout) :: error
    !
    type(image_t) :: input,weiin,output,weiout
    integer(kind=entr_k) :: ie
    character(len=*), parameter :: rname='STITCH>SPATIAL>ADD>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call input%init(entry%cube,error)
    if (error) return
    call output%init(oucube,error)
    if (error) return
    call weiout%init(weight,error)
    if (error) return
    if (entry%donoise) then
       call weiin%init(entry%noise,error)
       if (error) return
       call weiin%get(entry%noise,int(1,chan_k),error)
       if (error) return
       weiin%z(:,:) = 1/(weiin%z(:,:)**2)
    else
       call weiin%reallocate('weiin',entry%cube%head%arr%n%l,entry%cube%head%arr%n%m,error)
       if (error) return
       weiin%z(:,:) = entry%weig
    endif
    do ie=first,last
       call cubeadm_entryloop_iterate(ie,error)
       if (error)  return
       call cubemain_stitch_spatial_add(entry,oucube,weight,ie,input,weiin,output,weiout,error)
       if (error)  return
    enddo
  end subroutine cubemain_stitch_spatial_add_loop
  !
  subroutine cubemain_stitch_spatial_add(entry,oucube,weight,ie,input,weiin,output,weiout,error)
    use cubemain_image_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(entry_t),         intent(inout) :: entry
    type(cube_t), pointer, intent(inout) :: oucube
    type(cube_t), pointer, intent(inout) :: weight
    integer(kind=entr_k),  intent(in)    :: ie
    type(image_t),         intent(inout) :: input
    type(image_t),         intent(inout) :: weiin
    type(image_t),         intent(inout) :: output
    type(image_t),         intent(inout) :: weiout
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='STITCH>SPATIAL>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
    !
    call cubemain_stitch_spatial_add_images(oucube%head%arr%n%l,oucube%head%arr%n%m,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_spatial_add
  !
  subroutine cubemain_stitch_spatial_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>SPATIAL>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_spatial_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_spatial_init_output
  !
  subroutine cubemain_stitch_spatial_init_loop(oucube,weight,first,last,error)
    use cubeadm_entryloop
    use cubemain_image_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(cube_t), pointer, intent(inout) :: oucube
    type(cube_t), pointer, intent(inout) :: weight
    integer(kind=entr_k),  intent(in)    :: first
    integer(kind=entr_k),  intent(in)    :: last
    logical,               intent(inout) :: error
    !
    type(image_t) :: output,weiout
    integer(kind=entr_k) :: ie
    character(len=*), parameter :: rname='STITCH>SPATIAL>INIT>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call output%reallocate('output',oucube%head%arr%n%l,oucube%head%arr%n%m,error)
    if (error) return
    call weiout%reallocate('weiout',oucube%head%arr%n%l,oucube%head%arr%n%m,error)
    if (error) return
    output%z(:,:) = gr4nan
    weiout%z(:,:) = 0.0
    !
    do ie=first,last
       call cubeadm_entryloop_iterate(ie,error)
       if (error) return
       call output%put(oucube,ie,error)
       if (error) return
       call weiout%put(weight,ie,error)
       if (error) return
    enddo
  end subroutine cubemain_stitch_spatial_init_loop
  !
  subroutine cubemain_stitch_spatial_reproject_add_cube(entry,oucube,weight,error)
    use cubeadm_opened
    use cubeadm_get
    use cubemain_reproject
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    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(reproject_prog_t) :: myreproject
    type(cubeadm_iterator_t) :: iter
    character(len=*), parameter :: rname='STITCH>SPATIAL>REPROJECT>ADD>CUBE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_cublist_get_entry_header(code_access_imaset,entry,error)
    if (error) goto 10
    call cubeadm_access_header(oucube,code_access_imaset,code_update,error)
    if (error) goto 10
    call cubeadm_access_header(weight,code_access_imaset,code_update,error)
    if (error) goto 10
    !
    call cubemain_stitch_spatial_prepare(entry,oucube,myreproject,error)
    if (error) goto 10
    call myreproject%precompute(error)
    if(error) return
    !
    call cubeadm_datainit_all(iter,error)
    if (error) return
    !$OMP PARALLEL DEFAULT(none) SHARED(myreproject,entry,oucube,weight,error) FIRSTPRIVATE(iter)
    !$OMP SINGLE
    do while (cubeadm_dataiterate_all(iter,error))
       if (error)  exit
       !$OMP TASK SHARED(myreproject,entry,oucube,weight) FIRSTPRIVATE(iter,error)
       if (.not.error) call cubemain_stitch_spatial_reproject_add_loop(myreproject,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_spatial_reproject_add_cube
  !
  subroutine cubemain_stitch_spatial_reproject_add_loop(myreproject,entry,oucube,weight,first,last,error)
    use cubeadm_entryloop
    use cubemain_image_real
    use cubemain_reproject
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(reproject_prog_t),intent(in)    :: myreproject
    type(entry_t),         intent(inout) :: entry
    type(cube_t), pointer, intent(inout) :: oucube
    type(cube_t), pointer, intent(inout) :: weight
    integer(kind=entr_k),  intent(in)    :: first
    integer(kind=entr_k),  intent(in)    :: last
    logical,               intent(inout) :: error
    !
    integer(kind=entr_k) :: ie
    type(image_t) :: input,weiin,weirep,output,weiout,reprojected
    character(len=*), parameter :: rname='STITCH>SPATIAL>REPROJECT>ADD>LOOP'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call input%init(entry%cube,error)
    if (error) return
    call output%init(oucube,error)
    if (error) return
    call weiout%init(weight,error)
    if (error) return
    call reprojected%reallocate('reprojected',oucube%head%arr%n%l,oucube%head%arr%n%m,error)
    if (error) return
    call weirep%reallocate('weirep',oucube%head%arr%n%l,oucube%head%arr%n%m,error)
    if (error) return
    if (entry%donoise) then
       call weiin%init(entry%noise,error)
       if (error) return       
       call weiin%get(entry%noise,ie,error)
       if (error) return
       call myreproject%image(weiin,weirep,error)
       if (error) return
       weirep%z(:,:) = 1/(weirep%z(:,:)**2)
    else
       weirep%z(:,:) = entry%weig
    endif
    !
    do ie = first,last
       call cubeadm_entryloop_iterate(ie,error)
       if (error)  return
       call cubemain_stitch_spatial_reproject_add(myreproject,entry,oucube,weight,ie,&
            input,reprojected,weirep,output,weiout,error)
       if (error)  return
    enddo ! ie
  end subroutine cubemain_stitch_spatial_reproject_add_loop
  !
  subroutine cubemain_stitch_spatial_reproject_add(myreproject,entry,oucube,weight,ie,&
       input,reprojected,weirep,output,weiout,error)
    use cubemain_image_real
    use cubemain_reproject
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    type(reproject_prog_t), intent(in)    :: myreproject
    type(entry_t),          intent(inout) :: entry
    type(cube_t), pointer,  intent(inout) :: oucube
    type(cube_t), pointer,  intent(inout) :: weight
    integer(kind=entr_k),   intent(in)    :: ie
    type(image_t),          intent(inout) :: input
    type(image_t),          intent(inout) :: reprojected
    type(image_t),          intent(inout) :: weirep
    type(image_t),          intent(inout) :: output
    type(image_t),          intent(inout) :: weiout
    logical,                intent(inout) :: error
    !
    character(len=*), parameter :: rname='STITCH>SPATIAL>REPROJECT>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
    call myreproject%image(input,reprojected,error)
    if (error)  return
    !
    call cubemain_stitch_spatial_add_images(oucube%head%arr%n%l,oucube%head%arr%n%m,&
         reprojected,weirep,output,weiout)
    !
    call output%put(oucube,ie,error)
    if (error) return
    call weiout%put(weight,ie,error)
    if (error) return
  end subroutine cubemain_stitch_spatial_reproject_add
  !
  subroutine cubemain_stitch_spatial_add_images(nl,nm,input,weiin,output,weiout)
    use cubemain_image_real
    !----------------------------------------------------------------------
    ! 
    !----------------------------------------------------------------------
    integer(kind=pixe_k), intent(in)    :: nl
    integer(kind=pixe_k), intent(in)    :: nm
    type(image_t),        intent(inout) :: input
    type(image_t),        intent(inout) :: weiin
    type(image_t),        intent(inout) :: output
    type(image_t),        intent(inout) :: weiout
    !
    integer(kind=pixe_k) :: il,im
    character(len=*), parameter :: rname='STITCH>SPATIAL>ADD>IMAGES'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    do im = 1,nm
       do il = 1,nl
          if (ieee_is_nan(input%z(il,im))) cycle
          if (ieee_is_nan(output%z(il,im))) then
             output%z(il,im) = input%z(il,im)*weiin%z(il,im)
             weiout%z(il,im) = weiin%z(il,im)
          else
             weiout%z(il,im) = weiout%z(il,im)+weiin%z(il,im)
             output%z(il,im) = (output%z(il,im)+input%z(il,im)*weiin%z(il,im))/weiout%z(il,im)
          endif
       enddo
    enddo
  end subroutine cubemain_stitch_spatial_add_images
  !
  subroutine cubemain_stitch_spatial_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>SPATIAL>MERGE'
    integer(kind=4) :: icub
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubemain_stitch_spatial_init_output(oucube,weight,error)
    if (error) return
    !
    do icub=1,inlist%n
       call cubemain_stitch_spatial_add_cube(inlist%entries(icub),oucube,weight,error)
       if (error) return
    enddo
  end subroutine cubemain_stitch_spatial_merge
end module cubemain_stitch_spatial
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
