!------------------------------------------------------------------------------| !------------------------------------------------------------------------------| ! | ! ||===\\ | ! || \\ | ! || || //==\\ || || //==|| ||/==\\ | ! || || || || || || || || || || | ! || // || || || || || || || | ! ||===// \\==// \\==\\ \\==\\ || | ! | !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| ! | ! ROUTINE Nov. 2006 | ! | !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| subroutine interpolate_velocity_on_surface (params,surface,ov) use definitions implicit none !------------------------------------------------------------------------------| !(((((((((((((((( Purpose of the routine )))))))))))))))))))))))))))))))))))))) !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| !(((((((((((((((( declaration of the subroutine arguments )))))))))))))))))))) !------------------------------------------------------------------------------| type(parameters) params type(sheet) surface(params%ns) type (octreev) ov !------------------------------------------------------------------------------| !(((((((((((((((( declaration of the subroutine internal variables ))))))))))))) !------------------------------------------------------------------------------| integer iproc,nproc,ierr integer is,err,i double precision, dimension(:), allocatable :: ubuf,vbuf,wbuf double precision xi,yi,zi,u,v,w !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- INCLUDE 'mpif.h' call mpi_comm_size (mpi_comm_world,nproc,ierr) call mpi_comm_rank (mpi_comm_world,iproc,ierr) do is=1,params%ns allocate (ubuf(surface(is)%nsurface),stat=err) ; if (err.ne.0) call stop_run ('Error alloc xbuf in move_surface$') allocate (vbuf(surface(is)%nsurface),stat=err) ; if (err.ne.0) call stop_run ('Error alloc ybuf in move_surface$') allocate (wbuf(surface(is)%nsurface),stat=err) ; if (err.ne.0) call stop_run ('Error alloc zbuf in move_surface$') ubuf=0.d0 vbuf=0.d0 wbuf=0.d0 do i=iproc+1,surface(is)%nsurface,nproc xi=surface(is)%x(i) yi=surface(is)%y(i) zi=surface(is)%z(i) call octree_interpolate_many (3,ov%octree,ov%noctree,ov%icon,ov%nleaves, & ov%nnode,xi,yi,zi,ov%unode,u,ov%vnode,v,ov%wnode,w) ! call octree_interpolate3 (ov%octree,ov%noctree,ov%icon,ov%nleaves,ov%unode,ov%x,ov%y,ov%z,ov%nnode,xi,yi,zi,u) ! call octree_interpolate3 (ov%octree,ov%noctree,ov%icon,ov%nleaves,ov%vnode,ov%x,ov%y,ov%z,ov%nnode,xi,yi,zi,v) ! call octree_interpolate3 (ov%octree,ov%noctree,ov%icon,ov%nleaves,ov%wnode,ov%x,ov%y,ov%z,ov%nnode,xi,yi,zi,w) ubuf(i)=u vbuf(i)=v wbuf(i)=w end do surface(is)%u=0.d0 surface(is)%v=0.d0 surface(is)%w=0.d0 call mpi_allreduce (ubuf,surface(is)%u,surface(is)%nsurface,mpi_double_precision,mpi_sum,mpi_comm_world,ierr) call mpi_allreduce (vbuf,surface(is)%v,surface(is)%nsurface,mpi_double_precision,mpi_sum,mpi_comm_world,ierr) call mpi_allreduce (wbuf,surface(is)%w,surface(is)%nsurface,mpi_double_precision,mpi_sum,mpi_comm_world,ierr) deallocate(ubuf) deallocate(vbuf) deallocate(wbuf) end do return end subroutine interpolate_velocity_on_surface !------------------------------------------------------------------------------- !-------------------------------------------------------------------------------