SUBROUTINE flashBlockToFlyCell(bnd_box_min, bnd_box_max, blockCells)


	USE fly_h
	
	INCLUDE 'mpif.h'
	
	real, dimension(ndim) :: bnd_box_min, bnd_box_max
	real(kind=8), dimension(nZones(1), nZones(2), nZones(3)) :: blockCells
 
#ifdef FLASH

	real :: blockSize, boxSize, cellVolume
	real, dimension(ndim) :: blockCenter
	real(KIND=8), dimension(ndim) :: bodyPosition
	
	real, dimension(ndim) :: cellSize
        real(KIND=8), dimension(ndim) :: pl, pcl, pcl_par

	integer, dimension(ndim) :: cellIndex
	integer :: sub_temp1, blockLevel
	integer(KIND=4) ::  par_temp1
        integer :: i, j, k,ind_pe
        integer, dimension(ndim) :: nindex

        INTEGER(KIND=MPI_ADDRESS_KIND) :: startIndex

       
        INTEGER(KIND=4), DIMENSION(nsubcell) :: isub	!,sub_app

	DATA nindex/4,2,1/
	
!================================================================================
	
	boxSize = size_level(1)

	blockSize	= bnd_box_max(1) - bnd_box_min(1)
	blockCenter	= bnd_box_min + (blockSize / 2)

	cellSize        = blockSize / nZones
	
	blockLevel=0
	
	DO i=1,nmax_level
	IF(boxSize.gt.blockSize) THEN
	 blockLevel=blockLevel+1
	 boxSize=boxSize/2.0
	ELSE
	 EXIT
	ENDIF
	ENDDO 
	 

	par_temp1 = root

	DO i = 1, blockLevel    
	
	   i_sh = par_temp1 - nbodsmax

	   IF(POW2) THEN
 	   ind_pe	= IAND((i_sh - 1), npes - 1)
	   ind_loc	= ISHFT((i_sh - 1), -lpes) + 1
	   ELSE
	   ind_pe	= MOD((i_sh - 1), npes)
	   ind_loc	=((i_sh - 1)/ npes) + 1
	   ENDIF

	   IF(ind_pe.EQ.me) THEN
		
	      pcl(1:ndim)	= pos_cell(1:ndim, ind_loc)
	      isub(1:nsubcell)	= subp(1:nsubcell, ind_loc)

	   ELSE
	

              startIndex = (((ind_loc - 1) * ndim) + 1) - 1


              CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,                        &
     				ind_pe, 0, win_pos_cell, ierror)
              CALL MPI_GET(pcl(1), ndim, MPI_REAL8, ind_pe,             &
                       startIndex, ndim, MPI_REAL8, win_pos_cell, ierror)
              CALL MPI_WIN_UNLOCK(ind_pe, win_pos_cell, ierror)	

	      startIndex = (((ind_loc - 1) * nsubcell) + 1) - 1


	      CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,                               &
     				ind_pe, 0, win_subp, ierror)
              CALL MPI_GET(isub(1), nsubcell, MPI_INTEGER4, ind_pe,     &
                          startIndex, nsubcell, MPI_INTEGER4, win_subp, ierror)
              CALL MPI_WIN_UNLOCK(ind_pe, win_subp, ierror)

	   ENDIF
		

	   pl(1:3) = blockCenter(1:3)
	   
!  	write(100+me,*)"p1 ME=",me," par_temp1 =",par_temp1," pcl =",pcl, &
!	" pl =",pl," ind_pe=", ind_pe ," ind_loc=",ind_loc," startIndex=",startIndex
!	call flush(uterm)

	   sub_temp1 = 1
		
	   DO k = 1, ndim
		                            
	      IF(pl(k).GE.pcl(k)) sub_temp1 = sub_temp1 + nindex(k)

	   ENDDO

!	write(100+me,*)"p2 ME=",me," sub_temp1 =",sub_temp1," isub_temp1=",isub(sub_temp1)
!	call flush(uterm)

	   IF(isub(sub_temp1).GT.nbodsmax) THEN
		
	      par_temp1 = isub(sub_temp1)
			
	   ELSEIF(isub(sub_temp1).EQ.0) THEN
		
	      !no bodies in the block
	      blockCells = 0.0


	      RETURN

	   ELSE
		
	      !one body in the block
	      i_sh	= isub(sub_temp1)
	      ind_pe	= (i_sh-1)/ max_pr 
	      ind_loc	= i_sh - (max_pr * ind_pe)


	      IF(ind_pe.EQ.me) THEN
		
	         bodyPosition(1:3) = pos(1:3, ind_loc)

	      ELSE
	
	         startIndex = (((ind_loc - 1) * ndim) + 1) - 1

                 CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, ind_pe, 0,          &
     		        		win_pos, ierror)
                 CALL MPI_GET(bodyPosition(1), ndim, MPI_REAL8, ind_pe, &
     	        		startIndex, ndim, MPI_REAL8, win_pos, ierror)
                 CALL MPI_WIN_UNLOCK(ind_pe, win_pos, ierror)	
	      ENDIF

	IF(bodyPosition(3).GE.bnd_box_min(3).AND.bodyPosition(3).LT.bnd_box_max(3)) THEN
	IF(bodyPosition(2).GE.bnd_box_min(2).AND.bodyPosition(2).LT.bnd_box_max(2)) THEN
	IF(bodyPosition(1).GE.bnd_box_min(1).AND.bodyPosition(1).LT.bnd_box_max(1)) THEN
	      

	   cellIndex = (bodyPosition - bnd_box_min)/cellSize + 1

	   blockCells(cellIndex(1), cellIndex(2), cellIndex(3)) = &
			blockCells(cellIndex(1), cellIndex(2), cellIndex(3)) + 1


	ENDIF
	ENDIF
	ENDIF

	      RETURN
	   ENDIF
	ENDDO

!	write(100+me,*)"ME=",me," par_temp1 =",par_temp1," pcl =",pcl, &
!	" pl =",pl
!	call flush(uterm)

	CALL findParticlesInCell(par_temp1, bnd_box_min, bnd_box_max, &
				 blockCells)
!	write(100+me,*)"ME=",me," esco da flashBlockToFlyCell"
!	call flush(uterm)
!	STOP
#endif
	RETURN

	END