!------------------------------------------------------------------------------| !------------------------------------------------------------------------------| ! | ! ||===\\ | ! || \\ | ! || || //==\\ || || //==|| ||/==\\ | ! || || || || || || || || || || | ! || // || || || || || || || | ! ||===// \\==// \\==\\ \\==\\ || | ! | !------------------------------------------------------------------------------| !------------------------------------------------------------------------------| ! | ! 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 !------------------------------------------------------------------------------- !-------------------------------------------------------------------------------