module tomo_wt_deriv_mod
use sep
use adj_mod
use sep3d_struct_mod
implicit none
real, private, save,  pointer :: wts(:)
integer, private,save :: ndomain,nrange
integer, private,pointer,save :: ibeg(:),iend(:)

contains

logical function load_wt_deriv_op(data)
real           :: data(:)
type(sep3d) :: wt_s
integer, external :: auxin,sreed
real, allocatable :: lenr(:)
integer, allocatable :: lens(:)
integer :: i

load_wt_deriv_op=.false.
ndomain=size(data)
nrange=size(data)
if(-1==auxin("wt_lens")) then
  call seperr("when using wt_deriv must supply wt_lens")
else
 call init_sep3d("wt_lens",wt_s,"INPUT")
 allocate(lenr(product(wt_s%n(1:sep3d_ndims(wt_s)))))
 allocate(lens(product(wt_s%n(1:sep3d_ndims(wt_s)))))
 allocate(ibeg(product(wt_s%n(1:sep3d_ndims(wt_s)))))
 allocate(iend(product(wt_s%n(1:sep3d_ndims(wt_s)))))
 if(4*size(lens)/=sreed("wt_lens",lenr,size(lenr)*4)) then
   write(0,*)"trouble loading wt_lens"
   return
 end if
 lens=nint(lenr) 
 ibeg(1)=1 
 do i=2,size(lens) 
  ibeg(i)=ibeg(i-1)+lens(i-1);
  iend(i-1)=ibeg(i)-1
 end do
 iend(size(lens))=ndomain
 deallocate(lens)
end if
load_wt_deriv_op=.true.
end function

integer function wt_deriv_range()
 wt_deriv_range=nrange
end function

integer function wt_deriv_domain()
 wt_deriv_domain=ndomain
end function

integer function wt_deriv_op(adj,add,model,data)
logical,intent(in) :: adj,add
real    :: model(:),data(:)
integer :: n,i2,i


call adjnull(adj,add,model,data)
do i2=1,size(ibeg) 
 if(iend(i2) > ibeg(i2)) then
  if(.not. adj) then
    data(ibeg(i2))=data(ibeg(i2))+(model(ibeg(i2)+1)-model(ibeg(i2)))
    do i=ibeg(i2)+1,iend(i2)
       data(i)=data(i)+(model(i)-model(i-1))
    end do
  else
    model(ibeg(i2)+1)=model(ibeg(i2)+1) +data(ibeg(i2))
    model(ibeg(i2))=model(ibeg(i2)) -data(ibeg(i2))
    do i=ibeg(i2)+1,iend(i2)
       model(i)=model(i)+data(i)
       model(i-1)=model(i-1)-data(i)
    end do
  end if
 end if
end do
wt_deriv_op=0

end function


end module
