First approach to implement MPI refinement.
It seems to be pretty complex. So far I collect blocks selected for refinement which have neighbors laying on other processors. Using this I set the neighbors from other processors for refinement if required. The remaining things are the neighbors update after refinement and MPI version of derefinement.
This commit is contained in:
Grzegorz Kowal
parent
c686e301fc
commit
c216adb422
@ -54,7 +54,6 @@ module boundaries
|
|||||||
integer :: i, j, k, p, l, dl
|
integer :: i, j, k, p, l, dl
|
||||||
|
|
||||||
#ifdef MPI
|
#ifdef MPI
|
||||||
|
|
||||||
integer(kind=4) :: itag
|
integer(kind=4) :: itag
|
||||||
logical :: lf
|
logical :: lf
|
||||||
|
|
||||||
@ -111,9 +110,11 @@ module boundaries
|
|||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
|
#ifdef MPI
|
||||||
! neighbor associated; exchange boundaries
|
! neighbor associated; exchange boundaries
|
||||||
!
|
!
|
||||||
if (pblock%neigh(i,j,k)%cpu .eq. ncpu) then
|
if (pblock%neigh(i,j,k)%cpu .eq. ncpu) then
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
! neighbor is on the same CPU, update
|
! neighbor is on the same CPU, update
|
||||||
!
|
!
|
||||||
@ -158,8 +159,9 @@ module boundaries
|
|||||||
iblk(p,cn(p),4) = i ! 4: directions of boundary
|
iblk(p,cn(p),4) = i ! 4: directions of boundary
|
||||||
iblk(p,cn(p),5) = j ! 5: side at the boundary
|
iblk(p,cn(p),5) = j ! 5: side at the boundary
|
||||||
iblk(p,cn(p),6) = k ! 6: part of the boundary
|
iblk(p,cn(p),6) = k ! 6: part of the boundary
|
||||||
#endif /* MPI */
|
|
||||||
endif
|
endif
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
endif
|
endif
|
||||||
end do
|
end do
|
||||||
|
|||||||
@ -122,17 +122,17 @@ module evolution
|
|||||||
call mallreduceminr(dtn)
|
call mallreduceminr(dtn)
|
||||||
#endif /* MPI */
|
#endif /* MPI */
|
||||||
|
|
||||||
! ! check refinement and refine
|
! check refinement and refine
|
||||||
! !
|
|
||||||
! call start_timer(5)
|
|
||||||
! call update_mesh(0)
|
|
||||||
! call stop_timer(5)
|
|
||||||
!
|
!
|
||||||
! ! update boundaries
|
call start_timer(5)
|
||||||
! !
|
call update_mesh(0)
|
||||||
! call start_timer(4)
|
call stop_timer(5)
|
||||||
! call boundary
|
|
||||||
! call stop_timer(4)
|
! update boundaries
|
||||||
|
!
|
||||||
|
call start_timer(4)
|
||||||
|
call boundary
|
||||||
|
call stop_timer(4)
|
||||||
|
|
||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
|
|||||||
381
src/mesh.F90
381
src/mesh.F90
@ -369,8 +369,12 @@ module mesh
|
|||||||
subroutine update_mesh(ref)
|
subroutine update_mesh(ref)
|
||||||
|
|
||||||
use config , only : maxlev
|
use config , only : maxlev
|
||||||
use blocks , only : block, plist, ndims, nchild, refine_block, get_pointer
|
use blocks , only : block, plist, ndims, nchild, nblocks, refine_block &
|
||||||
|
, get_pointer
|
||||||
use error , only : print_info
|
use error , only : print_info
|
||||||
|
#ifdef MPI
|
||||||
|
use mpitools, only : ncpus, ncpu, mallreducemaxl, msendi, mrecvi
|
||||||
|
#endif /* MPI */
|
||||||
use problem , only : check_ref
|
use problem , only : check_ref
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
@ -380,12 +384,38 @@ module mesh
|
|||||||
! local variables
|
! local variables
|
||||||
!
|
!
|
||||||
type(block), pointer :: pblock, pneigh, pchild, pparent
|
type(block), pointer :: pblock, pneigh, pchild, pparent
|
||||||
integer(kind=4) :: l, i, j, k, n, p
|
integer(kind=4) :: l, i, j, k, m, n, p, q
|
||||||
|
|
||||||
|
#ifdef MPI
|
||||||
|
integer(kind=4) :: itag
|
||||||
|
|
||||||
|
! local arrays for MPI
|
||||||
|
!
|
||||||
|
integer(kind=4), dimension(:,:,:) , allocatable :: iblk, ichl
|
||||||
|
integer(kind=4), dimension(:,:) , allocatable :: cn, cc, ibuf
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
!----------------------------------------------------------------------
|
!----------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
|
#ifdef MPI
|
||||||
|
! allocate temporary arrays; since we have two blocks per boundary and 4 sides
|
||||||
|
! of each block we need to increase the second dimension
|
||||||
|
!
|
||||||
|
allocate(cn (0:ncpus-1,0:ncpus-1))
|
||||||
|
allocate(cc (0:ncpus-1,0:ncpus-1))
|
||||||
|
allocate(iblk(0:ncpus-1,2**(NDIMS-1)*NDIMS*nblocks,3))
|
||||||
|
allocate(ichl(0:ncpus-1,2**(NDIMS-1)*NDIMS*nblocks,7))
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
do l = 1, maxlev
|
do l = 1, maxlev
|
||||||
|
|
||||||
|
#ifdef MPI
|
||||||
|
! reset the local arrays storing blocks to exchange
|
||||||
|
!
|
||||||
|
cn(:,:) = 0
|
||||||
|
iblk(:,:,:) = 0
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
! check refinement criterion
|
! check refinement criterion
|
||||||
!
|
!
|
||||||
pblock => plist
|
pblock => plist
|
||||||
@ -410,7 +440,7 @@ module mesh
|
|||||||
|
|
||||||
! refinement conditions for blocks:
|
! refinement conditions for blocks:
|
||||||
!
|
!
|
||||||
! - all neighbors must be at the same or lower level
|
! - all neighbors must be at the same or one level higher
|
||||||
!
|
!
|
||||||
do n = l, 2, -1
|
do n = l, 2, -1
|
||||||
pblock => plist
|
pblock => plist
|
||||||
@ -421,11 +451,36 @@ module mesh
|
|||||||
do i = 1, ndims
|
do i = 1, ndims
|
||||||
do j = 1, 2
|
do j = 1, 2
|
||||||
do k = 1, 2
|
do k = 1, 2
|
||||||
|
#ifdef MPI
|
||||||
|
if (pblock%neigh(i,j,k)%cpu .eq. ncpu) then
|
||||||
|
#endif /* MPI */
|
||||||
pneigh => get_pointer(pblock%neigh(i,j,k)%id)
|
pneigh => get_pointer(pblock%neigh(i,j,k)%id)
|
||||||
if (associated(pneigh)) then
|
if (associated(pneigh)) then
|
||||||
if (pneigh%level .lt. pblock%level) &
|
if (pneigh%level .lt. pblock%level) &
|
||||||
pneigh%refine = 1
|
pneigh%refine = 1
|
||||||
endif
|
endif
|
||||||
|
#ifdef MPI
|
||||||
|
else
|
||||||
|
|
||||||
|
! TODO: fill temporary array with neighbors of the current block laying on other processes
|
||||||
|
! this array should store current block ID and level, and neighbor ID
|
||||||
|
!
|
||||||
|
! get the processor number of neighbor
|
||||||
|
!
|
||||||
|
p = pblock%neigh(i,j,k)%cpu
|
||||||
|
|
||||||
|
! increase the number of blocks to retrieve from that CPU
|
||||||
|
!
|
||||||
|
cn(ncpu,p) = cn(ncpu,p) + 1
|
||||||
|
|
||||||
|
! fill out the info array
|
||||||
|
!
|
||||||
|
iblk(p,cn(ncpu,p),1) = pblock%id
|
||||||
|
iblk(p,cn(ncpu,p),2) = pblock%level
|
||||||
|
iblk(p,cn(ncpu,p),3) = pblock%neigh(i,j,k)%id
|
||||||
|
|
||||||
|
endif
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
@ -435,9 +490,57 @@ module mesh
|
|||||||
|
|
||||||
pblock => pblock%next
|
pblock => pblock%next
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
#ifdef MPI
|
||||||
|
! TODO: after sweeping the current level, send the temporary array to neighbors
|
||||||
|
! and select them for refinement if their level is lower
|
||||||
|
!
|
||||||
|
! update number of blocks across all processes
|
||||||
|
!
|
||||||
|
call mallreducemaxl(size(cn),cn)
|
||||||
|
|
||||||
|
if (maxval(cn) .gt. 0) then
|
||||||
|
|
||||||
|
allocate(ibuf(maxval(cn),3))
|
||||||
|
|
||||||
|
do p = 0, ncpus-1
|
||||||
|
do q = 0, ncpus-1
|
||||||
|
|
||||||
|
itag = 10*(p * ncpus + q) + 2111
|
||||||
|
|
||||||
|
if (cn(p,q) .gt. 0) then
|
||||||
|
if (ncpu .eq. p) then ! sender
|
||||||
|
call msendi(size(iblk(q,1:cn(p,q),:)), q, itag, iblk(q,1:cn(p,q),:))
|
||||||
|
endif
|
||||||
|
if (ncpu .eq. q) then ! receiver
|
||||||
|
call mrecvi(size(ibuf(1:cn(p,q),:)), p, itag, ibuf(1:cn(p,q),:))
|
||||||
|
|
||||||
|
do i = 1, cn(p,q)
|
||||||
|
pblock => get_pointer(ibuf(i,3))
|
||||||
|
|
||||||
|
if (pblock%level .lt. ibuf(i,2)) &
|
||||||
|
pblock%refine = 1
|
||||||
|
end do
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
deallocate(ibuf)
|
||||||
|
endif
|
||||||
|
#endif /* MPI */
|
||||||
|
end do
|
||||||
|
|
||||||
|
! after selecting blocks for refinement, do refine them gradually starting from
|
||||||
|
! the lowest level in order to avoid situation when two neighbors have level
|
||||||
|
! difference larger than 2
|
||||||
|
!
|
||||||
do n = 1, l
|
do n = 1, l
|
||||||
|
#ifdef MPI
|
||||||
|
cc (:,:) = 0
|
||||||
|
ichl(:,:,:) = 0
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
pblock => plist
|
pblock => plist
|
||||||
do while (associated(pblock))
|
do while (associated(pblock))
|
||||||
|
|
||||||
@ -448,114 +551,206 @@ module mesh
|
|||||||
|
|
||||||
call refine_block(pblock)
|
call refine_block(pblock)
|
||||||
call prolong_block(pparent)
|
call prolong_block(pparent)
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
pblock => pblock%next
|
#ifdef MPI
|
||||||
|
! TODO: collect information about refined block in order to update neighbors
|
||||||
|
! laying on other processors
|
||||||
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
end do
|
|
||||||
|
|
||||||
! else
|
|
||||||
|
|
||||||
do l = maxlev, 1, -1
|
|
||||||
|
|
||||||
! derefinement conditions for blocks:
|
|
||||||
!
|
|
||||||
! - all neighbors must be at the same or lower level
|
|
||||||
! - all neighbors at the same level must be not selected for refinement
|
|
||||||
! - all sibling must be at the same level and marked for derefinement
|
|
||||||
!
|
|
||||||
! if all above conditions are fulfilled, select the refinement of
|
|
||||||
! the parent of the current block to -1
|
|
||||||
!
|
|
||||||
! if at least one is not fulfilled, set all sibling to not do the refinement
|
|
||||||
!
|
|
||||||
do n = l, maxlev
|
|
||||||
pblock => plist
|
|
||||||
do while (associated(pblock))
|
|
||||||
|
|
||||||
if (pblock%level .eq. n) then
|
|
||||||
if (pblock%leaf .and. pblock%refine .eq. -1) then
|
|
||||||
do i = 1, ndims
|
do i = 1, ndims
|
||||||
do j = 1, 2
|
do j = 1, 2
|
||||||
do k = 1, 2
|
do k = 1, 2
|
||||||
pneigh => get_pointer(pblock%neigh(i,j,k)%id)
|
if (pparent%neigh(i,j,k)%cpu .ne. ncpu) then
|
||||||
if (associated(pneigh)) then
|
p = pparent%neigh(i,j,k)%cpu
|
||||||
if (pneigh%level .gt. pblock%level) &
|
cc(ncpu,p) = cc(ncpu,p) + 1
|
||||||
pblock%refine = 0
|
ichl(p,cc(ncpu,p),1) = pparent%neigh(i,j,k)%id
|
||||||
if (pneigh%level .eq. pblock%level .and. pneigh%refine .eq. 1) &
|
ichl(p,cc(ncpu,p),2) = pparent%id
|
||||||
pblock%refine = 0
|
ichl(p,cc(ncpu,p),3) = pparent%level
|
||||||
endif
|
ichl(p,cc(ncpu,p),4) = pparent%child(1)%id
|
||||||
|
ichl(p,cc(ncpu,p),5) = pparent%child(2)%id
|
||||||
end do
|
ichl(p,cc(ncpu,p),6) = pparent%child(3)%id
|
||||||
end do
|
ichl(p,cc(ncpu,p),7) = pparent%child(4)%id
|
||||||
end do
|
|
||||||
|
|
||||||
pparent => get_pointer(pblock%parent%id)
|
|
||||||
if (associated(pparent)) then
|
|
||||||
do p = 1, nchild
|
|
||||||
pchild => get_pointer(pparent%child(p)%id)
|
|
||||||
|
|
||||||
if (associated(pchild)) then
|
|
||||||
if (pchild%refine .ne. -1 .or. pchild%level .ne. pblock%level) &
|
|
||||||
pblock%refine = 0
|
|
||||||
endif
|
endif
|
||||||
end do
|
end do
|
||||||
|
|
||||||
if (pblock%refine .ne. -1) then
|
|
||||||
do p = 1, nchild
|
|
||||||
pchild => get_pointer(pparent%child(p)%id)
|
|
||||||
|
|
||||||
if (associated(pchild)) then
|
|
||||||
if (pchild%refine .eq. -1 .and. pchild%level .eq. pblock%level) &
|
|
||||||
pchild%refine = 0
|
|
||||||
endif
|
|
||||||
end do
|
end do
|
||||||
endif
|
end do
|
||||||
endif
|
#endif /* MPI */
|
||||||
|
|
||||||
endif
|
! TODO: remove parent after refinement
|
||||||
endif
|
|
||||||
|
|
||||||
pparent => get_pointer(pblock%parent%id)
|
|
||||||
if (associated(pparent) .and. pblock%refine .eq. -1) &
|
|
||||||
pparent%refine = -1
|
|
||||||
|
|
||||||
! point to the next block
|
|
||||||
!
|
!
|
||||||
pblock => pblock%next
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
! perform derefinements for all selected blocks
|
|
||||||
!
|
|
||||||
do n = maxlev, l, -1
|
|
||||||
pblock => plist
|
|
||||||
do while (associated(pblock))
|
|
||||||
|
|
||||||
if (pblock%level .eq. n) then
|
|
||||||
if (pblock%leaf .and. pblock%refine .eq. -1) then
|
|
||||||
|
|
||||||
pparent => get_pointer(pblock%parent%id)
|
|
||||||
|
|
||||||
if (associated(pparent) .and. pparent%refine .eq. -1) then
|
|
||||||
! print *, 'derefine block ', pparent%id
|
|
||||||
call restrict_block(pparent)
|
|
||||||
pblock => pparent
|
|
||||||
endif
|
|
||||||
endif
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
||||||
pblock => pblock%next
|
pblock => pblock%next
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
#ifdef MPI
|
||||||
|
! TODO: exchange information about refined blocks in order to update neighbors
|
||||||
|
!
|
||||||
|
call mallreducemaxl(size(cc),cc)
|
||||||
|
|
||||||
|
if (maxval(cc) .gt. 0) then
|
||||||
|
|
||||||
|
allocate(ibuf(maxval(cc),7))
|
||||||
|
|
||||||
|
do p = 0, ncpus-1
|
||||||
|
do q = 0, ncpus-1
|
||||||
|
|
||||||
|
itag = 10*(p * ncpus + q) + 3111
|
||||||
|
|
||||||
|
if (cc(p,q) .gt. 0) then
|
||||||
|
if (ncpu .eq. p) then ! sender
|
||||||
|
call msendi(size(ichl(q,1:cc(p,q),:)), q, itag, ichl(q,1:cc(p,q),:))
|
||||||
|
endif
|
||||||
|
if (ncpu .eq. q) then ! receiver
|
||||||
|
call mrecvi(size(ibuf(1:cc(p,q),:)), p, itag, ibuf(1:cc(p,q),:))
|
||||||
|
|
||||||
|
do m = 1, cn(p,q)
|
||||||
|
pblock => get_pointer(ibuf(m,1))
|
||||||
|
|
||||||
|
if (pblock%leaf) then
|
||||||
|
! TODO: if leaf, update its neighbors according to the information sent
|
||||||
|
!
|
||||||
|
do i = 1, ndims
|
||||||
|
do j = 1, 2
|
||||||
|
do k = 1, 2
|
||||||
|
if (pblock%neigh(i,j,k)%cpu .eq. p) then
|
||||||
|
if (pblock%neigh(i,j,k)%id .eq. ibuf(m,2)) then
|
||||||
|
|
||||||
|
! TODO: depending in the level difference and side update neighbors
|
||||||
|
!
|
||||||
|
! if (pblock%level .eq. ibuf(m,3) then
|
||||||
! endif
|
! endif
|
||||||
|
! pblock%neigh(i,j,k)%id =
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
|
else
|
||||||
|
! TODO: if not leaf, it means that the block has been refined in the meantime, so
|
||||||
|
! update its children
|
||||||
|
!
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
|
||||||
|
deallocate(ibuf)
|
||||||
|
endif
|
||||||
|
#endif /* MPI */
|
||||||
|
end do
|
||||||
|
|
||||||
|
end do
|
||||||
|
|
||||||
|
! ! iterate starting from the maximum level and select blocks for derefinement
|
||||||
|
! ! if they fullfil below conditions
|
||||||
|
! !
|
||||||
|
! do l = maxlev, 1, -1
|
||||||
|
!
|
||||||
|
! ! derefinement conditions for blocks:
|
||||||
|
! !
|
||||||
|
! ! - all neighbors must be at the same or lower level
|
||||||
|
! ! - all neighbors at the same level must be not selected for refinement
|
||||||
|
! ! - all sibling must be at the same level and marked for derefinement
|
||||||
|
! !
|
||||||
|
! ! if all above conditions are fulfilled, select the refinement of
|
||||||
|
! ! the parent of the current block to -1
|
||||||
|
! !
|
||||||
|
! ! if at least one is not fulfilled, set all sibling to not do the refinement
|
||||||
|
! !
|
||||||
|
! do n = l, maxlev
|
||||||
|
! pblock => plist
|
||||||
|
! do while (associated(pblock))
|
||||||
|
!
|
||||||
|
! if (pblock%level .eq. n) then
|
||||||
|
! if (pblock%leaf .and. pblock%refine .eq. -1) then
|
||||||
|
! do i = 1, ndims
|
||||||
|
! do j = 1, 2
|
||||||
|
! do k = 1, 2
|
||||||
|
! pneigh => get_pointer(pblock%neigh(i,j,k)%id)
|
||||||
|
! if (associated(pneigh)) then
|
||||||
|
! if (pneigh%level .gt. pblock%level) &
|
||||||
|
! pblock%refine = 0
|
||||||
|
! if (pneigh%level .eq. pblock%level .and. pneigh%refine .eq. 1) &
|
||||||
|
! pblock%refine = 0
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! end do
|
||||||
|
! end do
|
||||||
|
! end do
|
||||||
|
!
|
||||||
|
! pparent => get_pointer(pblock%parent%id)
|
||||||
|
! if (associated(pparent)) then
|
||||||
|
! do p = 1, nchild
|
||||||
|
! pchild => get_pointer(pparent%child(p)%id)
|
||||||
|
!
|
||||||
|
! if (associated(pchild)) then
|
||||||
|
! if (pchild%refine .ne. -1 .or. pchild%level .ne. pblock%level) &
|
||||||
|
! pblock%refine = 0
|
||||||
|
! endif
|
||||||
|
! end do
|
||||||
|
!
|
||||||
|
! if (pblock%refine .ne. -1) then
|
||||||
|
! do p = 1, nchild
|
||||||
|
! pchild => get_pointer(pparent%child(p)%id)
|
||||||
|
!
|
||||||
|
! if (associated(pchild)) then
|
||||||
|
! if (pchild%refine .eq. -1 .and. pchild%level .eq. pblock%level) &
|
||||||
|
! pchild%refine = 0
|
||||||
|
! endif
|
||||||
|
! end do
|
||||||
|
! endif
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! endif
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! pparent => get_pointer(pblock%parent%id)
|
||||||
|
! if (associated(pparent) .and. pblock%refine .eq. -1) &
|
||||||
|
! pparent%refine = -1
|
||||||
|
!
|
||||||
|
! ! point to the next block
|
||||||
|
! !
|
||||||
|
! pblock => pblock%next
|
||||||
|
! end do
|
||||||
|
! end do
|
||||||
|
!
|
||||||
|
! ! perform derefinement for all selected blocks
|
||||||
|
! !
|
||||||
|
! do n = maxlev, l, -1
|
||||||
|
! pblock => plist
|
||||||
|
! do while (associated(pblock))
|
||||||
|
!
|
||||||
|
! if (pblock%level .eq. n) then
|
||||||
|
! if (pblock%leaf .and. pblock%refine .eq. -1) then
|
||||||
|
!
|
||||||
|
! pparent => get_pointer(pblock%parent%id)
|
||||||
|
!
|
||||||
|
! if (associated(pparent) .and. pparent%refine .eq. -1) then
|
||||||
|
! call restrict_block(pparent)
|
||||||
|
! pblock => pparent
|
||||||
|
! endif
|
||||||
|
! endif
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! pblock => pblock%next
|
||||||
|
! end do
|
||||||
|
! end do
|
||||||
|
!
|
||||||
|
! end do
|
||||||
|
|
||||||
|
#ifdef MPI
|
||||||
|
! deallocate temporary arrays
|
||||||
|
!
|
||||||
|
deallocate(cc)
|
||||||
|
deallocate(ichl)
|
||||||
|
deallocate(cn)
|
||||||
|
deallocate(iblk)
|
||||||
|
#endif /* MPI */
|
||||||
|
|
||||||
!-------------------------------------------------------------------------------
|
!-------------------------------------------------------------------------------
|
||||||
!
|
!
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user