flash_sim.F90

!
                             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