PROGRAM mpi_comm_split
USE MPI
IMPLICIT NONE
INTEGER i,ierr,rank,rank1,root,size,size1,    color,key,REDCOMM
!---------------------------------------------------------------------------------------
CALL MPI_INIT(ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,size,ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
!---------------------------------------------------------------------------------------
write(6,1)size,rank
1 format('size,rank=',2i4)
size1=size-2 !only size-2 threads are necessary for the computation (an MPI_REDUCE call)
!---------------------------------------------------------------------------------------
!Split into new communicator with size1 processes
IF(rank.LE.size1-1)THEN; color=1; ELSE; color=2; ENDIF; key=rank
CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,1,key,REDCOMM,ierr) 
CALL MPI_COMM_SIZE(REDCOMM,size1,ierr); CALL MPI_COMM_RANK(REDCOMM,rank1,ierr)
write(6,2)size1,rank1
2 format('size1,rank1=',2i4)
!---------------------------------------------------------------------------------------------------
read(5,333)i
333 format(i4)    
!---------------------------------------------------------------------------------------
CALL MPI_FINALIZE(ierr)
STOP
END