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
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ||===\\ |
! || \\ |
! || || //==\\ || || //==|| ||/==\\ |
! || || || || || || || || || || |
! || // || || || || || || || |
! ||===// \\==// \\==\\ \\==\\ || |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ASSIGN CLOUD MAT NUMBER OCT. 2012 |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
subroutine assign_cloud_mat_number (params,osolve,cl)
use definitions
!------------------------------------------------------------------------------|
!(((((((((((((((( Purpose of the routine ))))))))))))))))))))))))))))))))))))))
!------------------------------------------------------------------------------|
! This routine finds the LSF values for all cloud particles and assigns the |
! cloud particles a material number
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine arguments ))))))))))))))))))))
!------------------------------------------------------------------------------|
implicit none
type (parameters) params
type (octreesolve) osolve
type (cloud) cl
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
!------------------------------------------------------------------------------|
double precision :: cur_lsf,eps
integer, dimension(:), allocatable :: cloud_matnum
integer :: i,j,iproc,nproc,ierr
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
call mpi_comm_size (mpi_comm_world,nproc,ierr)
call mpi_comm_rank (mpi_comm_world,iproc,ierr)
eps = 1.d-10
!allocate (lsf(ov%nnode),stat=err) ; if (err.ne.0) call stop_run ('Error alloc lsf in update_cloud_fields$')
!lsf=0.d0
!if (osolve%nlsf.ne.0) lsf=osolve%lsf(1:osolve%nnode,1)
allocate (cloud_matnum(cl%np),stat=err) ; if (err.ne.0) call stop_run ('Error alloc cloud_matnum in assign_cloud_mat_number$')
cloud_matnum=0
do i=1,osolve%nlsf
do j=1+iproc,cl%np,nproc
call octree_interpolate (osolve%octree,osolve%noctree,osolve%icon, &
osolve%nleaves,osolve%lsf(:,i),osolve%nnode,cl%x(j), &
cl%y(j),cl%z(j),cur_lsf)
if (cur_lsf < eps) cloud_matnum(j) = i
enddo
enddo
cl%matnum=0
call mpi_allreduce (cloud_matnum, cl%matnum, cl%np, mpi_integer, mpi_sum, mpi_comm_world, ierr)
deallocate (cloud_matnum)
end subroutine assign_cloud_material_number
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------