Newer
Older
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ||===\\ |
! || \\ |
! || || //==\\ || || //==|| ||/==\\ |
! || || || || || || || || || || |
! || // || || || || || || || |
! ||===// \\==// \\==\\ \\==\\ || |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ROUTINE Nov. 2006 |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
subroutine interpolate_velocity_on_surface (params,surface,ov)
use definitions
!use mpi
include 'mpif.h'
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
!------------------------------------------------------------------------------|
!(((((((((((((((( 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
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
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)
Douglas Guptill
committed
call octree_interpolate_three (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
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------