!======================================================================
subroutine owwemva_icond(adj,taper,recv,source,vel,deltaS,deltaI,sref)

logical						:: adj
real, optional					:: sref(:,:,:)
complex						:: recv(:,:),source(:,:)
integer						:: iwa,iz,inode,nodes,i,ixw,ish
real						:: taper(:),vel(:,:)
real						:: deltaS(:,:),deltaI(:,:,:)
real, allocatable					:: GGG(:,:,:,:)
complex, allocatable				:: ws(:,:),wr(:,:)
complex, allocatable				:: ddws(:,:),ddwr(:,:)
complex, allocatable				:: dws(:,:,:),dwr(:,:,:)
complex, allocatable				:: bws(:,:,:),bwr(:,:,:)
complex,allocatable					:: tflds(:,:),tfldr(:,:)
complex, allocatable				:: dws_z(:,:),dwr_z(:,:)
integer, external 					:: omp_get_thread_num,omp_get_num_threads

if (node.eq.9999) then
  !$OMP PARALLEL
  nodes = omp_get_num_threads()
  !$OMP END PARALLEL
else
  nodes=node
end if
write(0,*) "****************"
write(0,*) "* NUM.THREADS = ",nodes
write(0,*) "****************"

allocate(wr(kxm%n,nodes));                  wr=0
allocate(ws(kxm%n,nodes));                  ws=0
allocate(ddwr(kxm%n,nodes));                ddwr=0
allocate(ddws(kxm%n,nodes));                ddws=0
allocate(bwr(img%z%n,kxm%n,rec%w%n));         bwr=0
allocate(bws(img%z%n,kxm%n,rec%w%n));         bws=0

!--------------------------------------------------
! Setting FFTW plans
allocate(tflds(kxm%n,nodes));tflds=0
call owfftws(tflds,nodes)

allocate(tfldr(kxm%n,nodes));tfldr=0
call owfftwr(tfldr,nodes)

if (adj) then

   allocate(GGG(img%z%n,1,kxm%n,nodes)); GGG=0
   allocate(dwr_z(kxm%n,nodes));         dwr_z=0
   allocate(dws_z(kxm%n,nodes));         dws_z=0
   allocate(dwr(img%z%n,kxm%n,nodes));   dwr=0
   allocate(dws(img%z%n,kxm%n,nodes));   dws=0

   !$OMP parallel do private(inode,&
                               iwa,&
                                iz) ordered schedule(dynamic,1) num_threads(nodes)

   do iwa = 1,rec%w%n

       inode=omp_get_thread_num()+1
       ws(tapertr+padtraces+1:sou%h%n+padtraces+tapertr,inode)=source(:,iwa)
       wr(tapertr+padtraces+1:rec%h%n+padtraces+tapertr,inode)=recv(:,iwa)
       dws(:,:,inode)=0.
       dwr(:,:,inode)=0.
       bws(:,:,inode)=0.
       bwr(:,:,inode)=0.
       dws_z(:,inode)=0.
       dwr_z(:,inode)=0.
       ddwr(:,inode)=0
       ddws(:,inode)=0

       do iz=nwbott+1,img%z%n

          if (present(sref)) then
             call owpspi(  iwa, inode, 1,  ws(:,inode), vel(iz-1,:), tflds(:,inode), "sou", sref(:,1,iz-1))
             call owpspi(  iwa, inode,-1,  wr(:,inode), vel(iz-1,:), tfldr(:,inode), "rec", sref(:,1,iz-1))
          else
             call owpspi(  iwa, inode, 1,  ws(:,inode), vel(iz-1,:), tflds(:,inode), "sou")
             call owpspi(  iwa, inode,-1,  wr(:,inode), vel(iz-1,:), tfldr(:,inode), "rec")
          end if
          ws(:,inode)=ws(:,inode)*taper
          wr(:,inode)=wr(:,inode)*taper
          bws(iz,:,iwa)=ws(:,inode)
          bwr(iz,:,iwa)=wr(:,inode)

       end do

       do iz=1,img%z%n
          call owimage(.true., .false., iwa, bws(iz,:,inode),  dwr(iz,:,inode), deltaI(iz,:,:))
          call owimage(.true., .true.,  iwa, dws(iz,:,inode),  bwr(iz,:,inode),  deltaI(iz,:,:))
       end do

       do iz=img%z%n,nwbott+1,-1
          dws_z(:,inode)=dws_z(:,inode)+dws(iz,:,inode)
          dws_z(:,inode)=dws_z(:,inode)*taper
          if (present(sref)) then
             call owpspi(  iwa, inode, -1, dws_z(:,inode), vel(iz-1,:), tflds(:,inode), "sou", sref(:,1,iz-1))
          else
             call owpspi(  iwa, inode, -1, dws_z(:,inode), vel(iz-1,:), tflds(:,inode), "sou")
          end if
          ddws(:,inode)=0
          call owphsscr(iwa, 1,ddws(:,inode),bws(iz-1,:,inode),vel(iz-1,:))
          GGG(iz-1,1,:,inode)=GGG(iz-1,1,:,inode)+real(conjg(ddws(:,inode))*dws_z(:,inode))

          dwr_z(:,inode)=dwr_z(:,inode)+dwr(iz,:,inode)
          dwr_z(:,inode)=dwr_z(:,inode)*taper
          if (present(sref)) then
             call owpspi(  iwa, inode, +1, dwr_z(:,inode), vel(iz-1,:), tfldr(:,inode), "rec", sref(:,1,iz-1))
          else
             call owpspi(  iwa, inode, +1, dwr_z(:,inode), vel(iz-1,:), tfldr(:,inode), "rec")
          end if
          ddwr(:,inode)=0
          call owphsscr(iwa,-1,ddwr(:,inode),bwr(iz-1,:,inode),vel(iz-1,:))
          GGG(iz-1,1,:,inode)=GGG(iz-1,1,:,inode)+real(conjg(ddwr(:,inode))*dwr_z(:,inode))
	
       end do

       if (mod(iwa,50)==1) write(0,6) " FREQUENCY # ",iwa," OUT OF ",rec%w%n," / SYNTH.FCT. # ",rec%xd%n, &
					" FROM NODE: ",inode
   end do

   !$OMP END PARALLEL DO

   call owfftdestroy()
   deallocate(tfldr,tflds)

   do i=1,nodes
      !$OMP parallel do private(ixw,iz)
      do iz=1,img%z%n
         do ixw=1,kxm%n
            deltaS(iz,ixw)=deltaS(iz,ixw)+GGG(iz,1,ixw,i)
         end do
      end do
      !$OMP END PARALLEL DO
   end do

   deallocate(ddwr,ddws,dwr_z,dws_z)
   deallocate(dwr,dws,GGG,bwr,bws)

end if
6 format(A13,i3,A8,i3,A14,i3,A12,i3)
end subroutine
