!*********************************************************************** ! ! 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