module wei_dS
  use wei_util
  use wei_type
  use wei_pro
  use wei_par
  use wei_lint
  use wei_attr
  !---------------
  implicit none

  complex, dimension(:), pointer, public :: dsloline
  !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  type(wedslomap), public :: dsl
  !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!

contains
  !----------------------------------------------------------------  
  subroutine weidS_init(X)
    type(weslow), intent(inout) :: X
    integer :: er
    character(len=128), parameter :: unit='weidS_init' 
#ifdef DEBUG
    if(wpro%dbg>0) call in(unit)
#endif

    if(wpar%impi==0) then
       if(isfile(X%tag)) then
          call weiS_his_init(X)
       else
          call weiS_par_init(X)
       end if
    end if

    if(wpar%impi/=0) call weiS_scr_init(X)

    call weimem_add(8,wpro%nzs,unit)
    allocate(dsloline(wpro%nzs),stat=er)
    if(er/=0) call seperr('cant allocate dsloline')
#ifdef DEBUG
    if(wpro%dbg>0) call out(unit)
#endif
  end subroutine weidS_init
  !----------------------------------------------------------------
  subroutine weidS_fkfx_allocate()
    integer :: er
    character(len=128), parameter :: unit='weidS_allocate' 
#ifdef DEBUG
    if(wpro%dbg>0) call in(unit)
#endif

    !! prestack slowness
    call weimem_add(8,wpro%amx%n*wpro%amy%n*wpro%ahx%n*wpro%ahy%n*wpro%nzs,unit)
    allocate(dsl%ds_s(wpro%amx%n,wpro%amy%n,wpro%ahx%n,wpro%ahy%n,wpro%nzs),stat=er)
    if(er/=0) call seperr('cant allocate dsl%ds_s')
    call weimem_add(8,wpro%amx%n*wpro%amy%n*wpro%ahx%n*wpro%ahy%n*wpro%nzs,unit)
    allocate(dsl%ds_r(wpro%amx%n,wpro%amy%n,wpro%ahx%n,wpro%ahy%n,wpro%nzs),stat=er)
    if(er/=0) call seperr('cant allocate dsl%ds_r')

#ifdef DEBUG
    if(wpro%dbg>0) call out(unit)
#endif
  end subroutine weidS_fkfx_allocate
  !----------------------------------------------------------------
  !! pull dSlow from pba into bin
  subroutine weidS_pba2bin(X)
    type(weslow), intent(inout) :: X
    integer :: imx,imy,ihx,ihy
    real    :: xc,yc
    character(len=128), parameter :: unit='weidS_pba2bin' 
#ifdef DEBUG
    if(wpro%dbg>0) call in(unit)
#endif

    call weilint_init()

    !! loop over PBA
    do ihy=1,wpro%ahy%n
       do ihx=1,wpro%ahx%n
          do imy=1,wpro%amy%n
             do imx=1,wpro%amx%n

                !-----------------------------------------
                xc=xmap%sx(imx,ihx) !! source
                yc=xmap%sy(imy,ihy) !! coordinates

!                dsloline = dsl%ds_s(imx,imy,ihx,ihy,:)
!                call weilintc(.true.,X,dsloline,xc,yc)

                dsloline = dsl%ds_s(imx,imy,ihx,ihy,:)
                call weilint(.true.,xc,yc,dsloline,X%bin)
                !-----------------------------------------

                !-----------------------------------------
                xc=xmap%rx(imx,ihx) !! receiver
                yc=xmap%ry(imy,ihy) !! coordinates

!                dsloline = dsl%ds_r(imx,imy,ihx,ihy,:)
!                call weilintc(.true.,X,dsloline,xc,yc)

                dsloline = dsl%ds_r(imx,imy,ihx,ihy,:)
                call weilint(.true.,xc,yc,dsloline,X%bin)
                !-----------------------------------------
             end do
          end do
       end do
    end do
!!$
!!$    do ihy=1,wpro%ahy%n
!!$       do ihx=1,wpro%ahx%n
!!$          do imy=1,5
!!$             do imx=1,1
!!$                xc=xmap%sx(imx,ihx) !! source
!!$                yc=xmap%sy(imy,ihy) !! coordinates
!!$                write(0,*) imy,yc
!!$                dsloline = dsl%ds_s(imx,imy,ihx,ihy,:)
!!$                call weilint(.true.,xc,yc,dsloline,X%bin)
!!$             end do
!!$          end do
!!$       end do
!!$    end do

#ifdef DEBUG
    if(wpro%dbg>0) call out(unit)
#endif
  end subroutine weidS_pba2bin
  !----------------------------------------------------------------
  !! push dSlow from bin to pba
  subroutine weidS_bin2pba(X)
    type(weslow), intent(inout) :: X
    integer :: imx,imy,ihx,ihy
    real    :: xc,yc
#ifdef DEBUG
    character(len=128), parameter :: unit='weidS_bin2pba' 
    if(wpro%dbg>0) call in(unit)
#endif

    call weilint_init()
    dsl%ds_s=0.
    dsl%ds_r=0.

    !! loop over PBA
    do ihy=1,wpro%ahy%n
       do ihx=1,wpro%ahx%n
          do imy=1,wpro%amy%n
             do imx=1,wpro%amx%n

                !-----------------------------------------
                xc=xmap%sx(imx,ihx) !! source
                yc=xmap%sy(imy,ihy) !! coordinates

!!$                call weilintc(.false.,X,dsloline,xc,yc)
!!$                dsl%ds_s(imx,imy,ihx,ihy,:) = dsloline
!!$
                call weilint(.false.,xc,yc,dsloline,X%bin)
                dsl%ds_s(imx,imy,ihx,ihy,:) = dsloline
                !-----------------------------------------

                !-----------------------------------------
                xc=xmap%rx(imx,ihx) !! receiver
                yc=xmap%ry(imy,ihy) !! coordinates

!!$                call weilintc(.false.,X,dsloline,xc,yc)
!!$                dsl%ds_r(imx,imy,ihx,ihy,:) = dsloline
!!$
                call weilint(.false.,xc,yc,dsloline,X%bin)
                dsl%ds_r(imx,imy,ihx,ihy,:) = dsloline
                !-----------------------------------------

             end do
          end do
       end do
    end do

#ifdef DEBUG
    if(wpro%dbg>0) call out(unit)
#endif
  end subroutine weidS_bin2pba
  !----------------------------------------------------------------
end module wei_dS















