Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ||===\\ |
! || \\ |
! || || //==\\ || || //==|| ||/==\\ |
! || || || || || || || || || || |
! || // || || || || || || || |
! ||===// \\==// \\==\\ \\==\\ || |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! 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
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------