PROGRAM Two_Groups
   IMPLICIT NONE
   INCLUDE "mpif.h"
   
    INTEGER :: GlobalComm, LocComm, InterComm, IntraComm
    INTEGER, DIMENSION(MPI_STATUS_SIZE) :: stat
    INTEGER ::  rc, high, colour, numproc, id, lid, root, idinter, np
    INTEGER ::  val, lsum, gsum
    LOGICAL :: flag

    CALL MPI_Init(rc)
    CALL MPI_Comm_dup(MPI_COMM_WORLD,GlobalComm,rc)
    CALL MPI_Comm_size(GlobalComm, numproc, rc)
    CALL MPI_Comm_rank(GlobalComm, id, rc)

    ! Divide processes in 2 groups 
    colour = MOD(id,2)

    CALL MPI_Comm_split(GlobalComm, colour, id, LocComm, rc)
    CALL MPI_Comm_rank(LocComm, lid, rc)

    print*,"Process ",id," in global comm is process ",lid," in local comm"

    ! Generate inter communicator between 2 leaders 
    IF ( colour == 0 ) THEN
       CALL MPI_Intercomm_create(LocComm, 0, GlobalComm, 1, 01, InterComm, rc)
    else
       CALL MPI_Intercomm_create(LocComm, 0, GlobalComm, 0, 01, InterComm, rc)
    END IF

	high = colour
    ! merge two groups 
    CALL MPI_Intercomm_merge(InterComm, high, IntraComm, rc)
	IF ( lid == 0 ) then
       WRITE(*,"(a)",ADVANCE="NO") "Check if InterComm is an inter-communicator: "
       CALL MPI_COMM_TEST_INTER (InterComm, flag, rc)
       WRITE(*,*) "flag=",flag
       WRITE(*,"(a)",ADVANCE="NO") "Check if IntraComm is an inter-communicator"
       CALL MPI_COMM_TEST_INTER (IntraComm, flag, rc)
       WRITE(*,*) "flag=",flag
    ENDIF

    ! Global sum 
    val = 1; lsum = 0;
    CALL MPI_Comm_rank(IntraComm, lid, rc)
    CALL MPI_Reduce(val,lsum,1,MPI_INTEGER,MPI_SUM,0,IntraComm,rc)
    IF ( lid == 0 ) print*,"Global sum = ",lsum
   
    
    CALL MPI_Barrier(GlobalComm,rc)
    CALL MPI_Comm_free(InterComm,rc)
    CALL MPI_Comm_free(LocComm,rc)
    CALL MPI_Comm_free(GlobalComm,rc)

    CALL MPI_Finalize(rc)

    STOP
END PROGRAM Two_Groups