c*******************************************************************
c
c                        Example 5  ( fan_in_blocking.f )
c
c  Objective           : To find sum of 'n' integers on 'p' processors 
c                        using 'Associative Fan-in' rule.
c                        MPI Blocking Communication library calls are used. 
c                        This example demonstrates the use of
c                        MPI_Init
c                        MPI_Comm_rank
c                        MPI_Comm_size
c                        MPI_Recv
c                        MPI_Send
c                        MPI_Finalize
c
c  Input               : Automatic input data generation  
c                        The rank of each process is input on each process. 
c
c  Output              : Process with Rank 0 should print the sum of 
c                        'n' values. 
c
c  Necessary Condition : Number of Processes should be 
c                        less than or equal to 8.
c*********************************************************************



       program main
       include 'mpif.h'

       integer 	   MyRank, Numprocs
       integer     Root
       integer     ilevel, value
       integer	   Source, Source_tag
       integer     Destination, Destination_tag
       integer	   Level, NextLevel
       real        NoofLevels
       integer     sum, ValidInput
       integer     status(MPI_STATUS_SIZE)

C      ....MPI initialisation....
       call MPI_INIT(ierror)
       call MPI_COMM_SIZE(MPI_COMM_WORLD,Numprocs, ierror)
       call MPI_COMM_RANK(MPI_COMM_WORLD,MyRank, ierror)

C      Check for the no. of processors to be a power of 2 

	 Root = 0
	 sum = 0
	 ValidInput = 0
	 do iproc = 1, Numprocs
		if((2 ** iproc) .eq. Numprocs) then
			NoofLevels = iproc
			ValidInput = 1
			goto 11
		endif
	 enddo

 11	 continue

	 if(ValidInput .ne. 1) then
   	    if(MyRank .eq. Root) 
     *      print*,"Number of processors should be power of 2"
	    goto 100
	 endif

    	 sum = MyRank 
    	 Source_tag = 0
    	 Destination_tag = 0

    	 do ilevel = 0, NoofLevels-1
	     Level = 2 ** ilevel
	
	    if(mod(MyRank, Level) .eq. 0) then
	       NextLevel = 2 ** (ilevel+1)

	     if(mod(MyRank, NextLevel) .eq. 0) then
	        Source = MyRank + Level
	        call MPI_RECV(value, 1, MPI_INTEGER, Source, Source_tag, 
     *                 MPI_COMM_WORLD, status, ierror)
	     		  sum = sum + value
	     else
	     	      Destination = MyRank - Level
	        call MPI_SEND(sum, 1, MPI_INTEGER, Destination, Destination_tag, 
     * 	               MPI_COMM_WORLD, ierror)
	     endif
	     endif
    	 enddo

	 if(MyRank .eq. Root) print*,'MyRank  ', MyRank,'  Final SUM  ', sum

 100    call MPI_FINALIZE(ierror)

	     stop
	     end