module wei_cls
  !! WEI MPI send/recv test

  use wei_util
  use wei_pro
  use wei_par
  use wei_tag
  use wei_comp

  use wei_S
  use wei_R
  use wei_D
  use wei_W

  use wei_fft
  use wei_kmap
  use wei_xmap

  use wei_image
  use wei_kxmig
  use wei_dump
  !---------------
  implicit none

  logical, private :: wIO

  type(weslow), private :: SS
  type(wedata), private :: DD 
  type(weimag), private :: RR

  type(wedata), public  :: bW
  type(wewfld), private :: WW
contains
  !----------------------------------------------------------------
  subroutine weicls_init(SLin,WCin,FKin,FXin,IGin,in6,in7,in8,in9)
    integer,external,optional ::                  in6,in7,in8,in9
    integer            :: st,er
    character(len=128) :: name
#ifdef DEBUG
    character(len=128), parameter :: unit='weicls_init'
#endif
    interface !!-------------------------
       integer function  SLin() result(st)
       end function SLin
       integer function  WCin() result(st)
       end function WCin
       integer function  FKin() result(st)
       end function FKin
       integer function  FXin() result(st)
       end function FXin
       integer function  IGin() result(st)
       end function IGin
    end interface !!---------------------

#ifdef DEBUG
    if(wpro%dbg>0) call in(unit)
#endif

    wpro%mod_ = wtag%R
    wpro%dat_ = wtag%D

    bW%tag="bW"; call weiD_aux_init(bW)

    !! initialize objects
    SS%tag=wtag%S; call weiS_init(SS)
    DD%tag=wtag%D; call weiD_init(DD)
    RR%tag=wtag%R; call weiR_init(RR)

    wIO=.false.
    if(wpro%operator(1:5)=='.Rw.D') wIO=.true.
    if(wIO) then
       WW%tag=wtag%W; call weiW_init(WW,bW%bin)
    end if

    !! convert frequency to radians
    call weipro_radians()

    call weifft_init()    !! init FFT
    call weikmap_init()   !! init K-map
    call weixmap_init()   !! init X-map
    call weiimage_init()  !! init imaging

    !! allocate slowness arrays for FK/FX ops
    call weiS_fkfx_allocate()

    !! init source/receiver pointers
    call weicomp_init()

    !! check if offset is consistent with ph
    if(wpro%pCIG) call weipro_check_hp()

    !! init operators
    st=SLin()     !! SL op init
    st=WCin()     !! WC op init
    st=FKin()     !! FK op init
    st=FXin()     !! FX op init
    st=IGin()     !! FX op init

!!$    !! spread slowness on the nodes
!!$    call weiS_mpicopy(SS)

#ifdef DEBUG
    if(wpro%dbg>0) call out(unit)
#endif
  end subroutine weicls_init
  !----------------------------------------------------------------
  !----------------------------------------------------------------
  subroutine weicls_outnull()
#ifdef DEBUG
    character(len=128), parameter :: unit='weicls_outnull'
    if(wpro%dbg>0) call in(unit)
#endif

    if(wpro%adj) then !! R<-D
       call weiR_assign(RR,(0.,0.))
    else              !! R->D
       call weiD_assign(DD,(0.,0.))
    end if

#ifdef DEBUG
    if(wpro%dbg>0) call out(unit)
#endif
  end subroutine weicls_outnull
  !----------------------------------------------------------------
  !----------------------------------------------------------------
  integer function weicls(adj,add,mod_,dat_,SLop,WCop,FKop,FXop,IGop,op6,op7,op8,op9)
    integer,external,optional      ::       SLop,WCop,FKop,FXop,IGop,op6,op7,op8,op9
    logical,            intent(in) :: adj,add
    character(len=128), intent(in) :: mod_,dat_
    integer :: izb,iwb
    integer :: st
#ifdef DEBUG
    character(len=128), parameter :: unit='weicls'
    if(wpro%dbg>0) call in(unit)
#endif

    !! reset tag variables
    call weipro_reset(adj,add,mod_,dat_)
    if(wpar%impi==0 .and. wpro%verb) call weipro_follow() !! where am I?

    !! accomodate tag name changes
    !! this is only needed on the master
    !! since the files on the nodes are temporary
    !! and going to be filled next
    if(wpar%impi==0) then
       RR%tag = trim(wpro%mod_)
       DD%tag = trim(wpro%dat_)
    end if

!!$    !! zero the output if add is off
!!$    if(.not. wpro%add) call weicls_outnull()

    !! setup the adjoint sign
    if(wpro%adj) then
       wpro%opsign = weiT2B
    else
       wpro%opsign = weiB2T
    end if

    if(wpar%nmpi>1) then
       !! HERE DISTRIBUTE DATA FROM MASTER
       !! distribute RR & DD
       if(wpro%adj) then
          call weiR_mpizero(RR)              !! Ri = 0
          call weiD_mpisprd(DD)              !! D -> [Do D1 ... Dn]
       else
          call weiR_mpicopy(RR)              !! Ri = R
          call weiD_mpizero(DD)              !! Di = 0
       end if
       if(wIO) then
          if(wpro%wTRA) call weiW_mpizero(WW,bW%bin)  !! Wi = 0
       end if
    end if

    if(wpar%nmpi>1) then
       !! HERE COLLECT DATA FROM NODES
       !! collect RR & DD & bW
       if(wpro%adj) then
          call weiR_mpisumm(RR)              !! R = R + Ri
       else
          call weiD_mpigthr(DD)              !! D <- [Do D1 ... Dn]
       end if
       if(wIO) then
          if(wpro%wTRA) call weiW_mpigthr(WW,bW%bin)    !! W <- [Wo W1 ... Wn]
       end if
    end if

#ifdef DEBUG
    if(wpro%dbg>0) call out(unit)
#endif
    weicls=weiOK
  end function weicls
  !----------------------------------------------------------
end module wei_cls

