Skip to content
density_send.F90 4.34 KiB
Newer Older
Fabio Roberto Vitello's avatar
Fabio Roberto Vitello committed
!***********************************************************************
!
!
                          SUBROUTINE density_send
!
!
!***********************************************************************
!
!
!     Main routine to control initialization of the tree structure
!     for computing the gravitational interaction.
!
!
!=======================================================================

	 USE fly_h 

	 	
	implicit none


	 INCLUDE 'mpif.h'
	

#ifdef FLASH

	real, dimension(ndim) :: bnd_box_min, bnd_box_max
	real(kind=8), dimension(ndim, 2) :: bnd_box

	INTEGER :: istatus(MPI_STATUS_SIZE),i_tag

	real(KIND=8), dimension(nZones(1), nZones(2), nZones(3)) :: blockCells
	real, dimension(ndim) :: cellSize

	integer :: blockCellsSIZE
	integer :: totNBlocks

	integer(KIND=4) :: nBlocksToReceive	
	integer :: blocksRemainder	
	integer :: i,tot_l_body,tot_g_body
	real	:: blockSize, cellVolume, blockVolume , totVolume 
	real(KIND=8) :: red_shift_next 


!=======================================================================
         
	 CALL MPI_BARRIER(MPI_COMM_WORLD,ierror)

	
!-----------------------------------------------------------------------
!   Flash interface
!-----------------------------------------------------------------------
	 
	 tot_l_body=0
	 nBlocksToReceive= 0
	 blocksRemainder= 0
	 blockVolume = 0
	 totVolume = 0

	IF(me.EQ.0) THEN
		WRITE(uterm, *)
		WRITE(uterm, *) "*******************************"
		WRITE(uterm, *) "***Flash interface*****start***"
		WRITE(uterm, *) "*******************************"
		WRITE(uterm, *)
		CALL flush(uterm)
	ENDIF
!	
!	Send the current Red-shift	
!
	IF(me.eq.0) THEN
	   i_tag=10
	   write(uterm,*) ".... sending actual red_shift=",znow
	   CALL MPI_SEND(znow, 1, MPI_REAL8, 0, i_tag, flashComm, ierror)    !send to remote PE0
           red_shift_next= 1./((tpos+dtime)**(1./alpha))-1.
	   write(uterm,*) "..... sending the next red_shift=", red_shift_next
	   i_tag=20
	   CALL MPI_SEND(red_shift_next, 1, MPI_REAL8, 0, i_tag, flashComm, ierror)    !send to remote PE0
	ENDIF
	
	blockCellsSIZE	= nZones(1) * nZones(2) * nZones(3)

	CALL MPI_BCAST(totNBlocks, 1, MPI_INTEGER, 0, flashComm, &  ! numero totale di blocchi
                       ierror)
	
	CALL MPI_RECV(nBlocksToReceive, 1, MPI_INTEGER4, &
			 MPI_ANY_SOURCE, MPI_ANY_TAG, flashComm, istatus, ierror) ! ricevo da un qualunque PE remoto

!	blocksRemainder		= MOD(totNBlocks, npes)
!	nBlocksToReceive	= totNBlocks / npes

!	if(me.LT.blocksRemainder) THEN

!	   nBlocksToReceive = nBlocksToReceive + 1

!	ENDIF

	WRITE(6,*) "PE=",me," I will receive ",nBlocksToReceive," Blocks"
	
	DO i = 1, nBlocksToReceive

	   CALL MPI_RECV(bnd_box(1, 1), ndim * 2, MPI_REAL8, &
			 MPI_ANY_SOURCE, MPI_ANY_TAG, flashComm, istatus, ierror) ! ricevo da un qualunque PE remoto

!	write(uterm,*)"ME=",me," receiving block i=",i," from PE_rmt=",istatus(MPI_SOURCE)," bnd_box=",bnd_box
!	call flush(uterm)

	   bnd_box_min = bnd_box(1:3, 1)
	   bnd_box_max = bnd_box(1:3, 2)


	blockSize	= bnd_box_max(1) - bnd_box_min(1)
        cellSize        = blockSize / nZones
        cellVolume      = cellSize(1) * cellSize(2) * cellSize(3)
	blockVolume	= blockSize * blockSize * blockSize


	   blockCells = 0.0

	   CALL flashBlockToFlyCell(bnd_box_min, bnd_box_max, &
				    blockCells)
	   
	   tot_l_body=tot_l_body+sum(blockCells)
				    
!	write(uterm,*)"ME=",me," tot_l_body=",tot_l_body
!	call flush(uterm)

!	   blockCells = (blockCells * mass_read) / cellVolume  !blockcells = n.puntixcella, poi densita' **QUI mettere


	   CALL MPI_SEND(blockCells(1, 1, 1), blockCellsSIZE, MPI_REAL8, &
                        istatus(MPI_SOURCE), 0, flashComm, ierror)    !spedisco a chi mi manda
!	write(uterm,*)"ME=",me," sending block i=",i," to PE_rmt=",istatus(MPI_SOURCE)
!	call flush(uterm)

	totVolume = totVolume + blockVolume
	

	ENDDO

!	write(uterm, *) "totVolume =", totVolume
	CALL MPI_REDUCE(tot_l_body,tot_g_body,1, &
    		MPI_INTEGER,MPI_SUM,PE0,MPI_COMM_WORLD,ierror)


	CALL MPI_BARRIER(MPI_COMM_WORLD,ierror)
	
	IF(me.eq.0) write(uterm, *) "Tot_found_bodies =", tot_g_body
	
	IF(me.EQ.0) THEN
		WRITE(uterm, *)
		WRITE(uterm, *) "*******************************"
		WRITE(uterm, *) "***Flash interface******stop***"
		WRITE(uterm, *) "*******************************"
		WRITE(uterm, *)
		CALL flush(uterm)
	ENDIF
!	CALL MPI_Finalize(ierror) !**QUI eliminare
!	STOP

#endif

		
        RETURN
        END