! PROGRAM flash_sim ! INCLUDE 'mpif.h' ! Declaration of local variables. ! ------------------------------- INTEGER, PARAMETER :: ndim=3,l_refine=2,rsize=50.0 INTEGER, PARAMETER :: nZonesx=2 INTEGER, PARAMETER :: nZonesy=2 INTEGER, PARAMETER :: nZonesz=2 INTEGER(KIND=8) :: n REAL, DIMENSION (3):: rmin REAL, DIMENSION (3,8**l_refine):: pos_blk INTEGER(KIND=4), DIMENSION(2048) ::BlocksToPE,SumBlocksToPE INTEGER :: i,tag,istatus(MPI_STATUS_SIZE), blockCellsSIZE INTEGER :: me,ierror,npes,PE0=0,npes_rmt,PE_rmt INTEGER :: blocksRemainder,nBlocksToSend character*(MPI_MAX_PROCESSOR_NAME) hostname_me real:: bl_size character*(MPI_MAX_PORT_NAME) portName real(kind=8), dimension(ndim, 2) :: bnd_box real(kind=8), dimension(nZonesx,nZonesy,nZonesz) :: blockCells real(kind=8) act_red, next_red integer :: flashComm,n_blocks,tot_l_body,tot_g_body integer(KIND=4), dimension(3) :: nZones !======================================================================= CALL MPI_Init(ierror) CALL MPI_COMM_RANK(MPI_COMM_WORLD, me, ierror) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, npes, ierror) CALL MPI_GET_PROCESSOR_NAME(hostname_me, lname, ierror) WRITE(6, *) "FLASH_SIM - START. PE=",me," HOSTNAME:",hostname_me(1:lname) CALL flush(6) CALL MPI_BARRIER(MPI_COMM_WORLD,ierror) CALL MPI_Lookup_name("particleInterface", MPI_INFO_NULL, portName,ierror) WRITE(6, *) "FLASH_SIM PE=",me," portName",portName CALL flush(6) CALL MPI_COMM_CONNECT(portName, MPI_INFO_NULL, PE0,MPI_COMM_WORLD , flashComm,ierror) !----------------------------------------------------------------------- ! Create local complete BLOCK structure !----------------------------------------------------------------------- tot_l_body=0 tot_g_body=0 rmin(1)=0.0 rmin(2)=0.0 rmin(3)=0.0 bl_size=rsize n_blocks=8**l_refine bl_size=bl_size/(2**l_refine) BlocksToPE=0 CALL MPI_BARRIER(MPI_COMM_WORLD,ierror) i1=0 i2=0 i3=0 DO i=1,n_blocks pos_blk(1,i)=0.0+i1*bl_size+bl_size/2 pos_blk(2,i)=0.0+i2*bl_size+bl_size/2 pos_blk(3,i)=0.0+i3*bl_size+bl_size/2 i1=i1+1 IF(i1*bl_size.eq.rsize)THEN i1=0 i2=i2+1 IF(i2*bl_size.eq.rsize)THEN i2=0 i3=i3+1 ENDIF ENDIF ! IF(me.eq.0) write(6,*)i,i1,i2,i3,bl_size,bl_size/2,pos_blk(1:3,i) ENDDO !i !----------------------------------------------------------------------- ! END of Create local complete BLOCK structure !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! Receive actual and next red-shift only to the root PE !----------------------------------------------------------------------- nZones(1)=nZonesx nZones(2)=nZonesy nZones(3)=nZonesz blockCellsSIZE=nZones(1) * nZones(2) * nZones(3) if(me.eq.0) THEN CALL MPI_BCAST(nZones(1), ndim, MPI_INTEGER4, MPI_ROOT, flashComm, & ierror) endif DO i_cycle=1,10 if(me.eq.0) THEN CALL MPI_RECV(act_red, 1, MPI_REAL8, 0, MPI_ANY_TAG, flashComm, istatus,ierror) CALL MPI_RECV(next_red, 1, MPI_REAL8, 0, MPI_ANY_TAG, flashComm, istatus,ierror) write(6,*)"Actual red-shift=",act_red," Next red-shift=",next_red CALL MPI_BCAST(n_blocks, 1, MPI_INTEGER, MPI_ROOT, flashComm, & ierror) endif CALL MPI_COMM_REMOTE_SIZE(flashComm,npes_rmt,ierror) blocksRemainder = MOD(n_blocks, npes) nBlocksToSend = n_blocks / npes if(me.LT.blocksRemainder) THEN nBlocksToSend = nBlocksToSend + 1 ENDIF ibl=0 PE_rmt=me IF(PE_rmt.ge.npes_rmt) PE_rmt=MOD(PE_rmt,npes_rmt) BlocksToPE=nBlocksToSend/npes_rmt blocksRemainder = MOD(nBlocksToSend, npes_rmt) ! write(6,*)"TP1 ME=",me,n_blocks,nBlocksToSend, BlocksToPE(1:npes_rmt),blocksRemainder IF(blocksRemainder.eq.0) GOTO 100 i_pe=PE_rmt DO WHILE(.TRUE.) BlocksToPE(i_pe+1)=BlocksToPE(i_pe+1)+1 blocksRemainder=blocksRemainder-1 IF(blocksRemainder.eq.0) GOTO 100 i_pe=i_pe+1 IF(i_pe.ge.npes_rmt) i_pe=0 ENDDO 100 CONTINUE ! write(6,*)"TP2 ME=",me," Invio Elementi ",BlocksToPE(1:npes_rmt) CALL MPI_ALLREDUCE(BlocksToPE,SumBlocksToPE , 2048, MPI_INTEGER4, & MPI_SUM, MPI_COMM_WORLD, ierror) IF(me.eq.0) THEN ! send the number of blocks to each PE DO i=0,npes_rmt-1 CALL MPI_SSEND(SumBlocksToPE(i+1), 1, MPI_INTEGER4, & i, 0, flashComm, ierror) ! invio a un PE remoto write(6,*)"Sending number of element ",SumBlocksToPE(i+1)," to PE=",i ENDDO ENDIF CALL MPI_BARRIER(MPI_COMM_WORLD,ierror) DO i=1+me,n_blocks,npes bnd_box(1:3,1)=pos_blk(1:3,i)-bl_size/2 bnd_box(1:3,2)=pos_blk(1:3,i)+bl_size/2 ! write(6,*)"ME=",me," sending block i=",i," to PE_rmt=",PE_rmt CALL MPI_SEND(bnd_box(1, 1), ndim * 2, MPI_REAL8, & PE_rmt, 0, flashComm, ierror) ! invio a un PE remoto CALL MPI_RECV(blockCells(1, 1, 1), blockCellsSIZE, MPI_REAL8, & PE_rmt, MPI_ANY_TAG, flashComm, istatus,ierror) !ricevo da chi mi mando ! write(6,*)"ME=",me," receiving block i=",i," from PE_rmt=",PE_rmt tot_l_body=tot_l_body+sum(blockCells) PE_rmt=PE_rmt+1 IF(PE_rmt.eq.npes_rmt) PE_rmt=0 ENDDO 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(6, *) "Tot_found_bodies =", tot_g_body ENDDO ! i_cycle CALL flush(6) call MPI_Finalize(ierror) STOP END