PROGRAM Two_Groups
   IMPLICIT NONE
   INCLUDE "mpif.h"
   
    INTEGER :: GlobalComm, GlobalGroup, Group0, Group1
    INTEGER ::  i, ierr, numproc, numproc0, numproc1, id
    INTEGER, DIMENSION(:), ALLOCATABLE :: ranks, ranks0, ranks1

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

    ALLOCATE(ranks(numproc), ranks0(numproc), ranks1(numproc), STAT=ierr)
    ranks=0; ranks0=0; ranks1=0
    
    ! Group of default communicator
    CALL MPI_Comm_group(GlobalComm,GlobalGroup, ierr)
    
    ! Divide processes in 2 groups 
    numproc0 = numproc/2
    DO i = 1, numproc0
       ranks0(i) = i-1
    ENDDO
    CALL MPI_Group_incl(GlobalGroup, numproc0, ranks0, Group0, ierr)
    CALL MPI_Group_excl(GlobalGroup, numproc0, ranks0, Group1, ierr)
    CALL MPI_Group_size(Group1, numproc1, ierr)

    DO i = 1, numproc
       ranks(i) = i-1
    ENDDO
    CALL MPI_Group_translate_ranks(GlobalGroup, numproc, ranks, Group0, &
          ranks0, ierr)
    CALL MPI_Group_translate_ranks(GlobalGroup, numproc, ranks, Group1, &
          ranks1, ierr)
    IF ( id == 0 ) THEN
       WRITE(*,"(A)") "Translating table: GlobalGroup, Group0, Group1"
       DO i = 1, numproc
          WRITE(*,"(3I10)") ranks(i), ranks0(i),ranks1(i)
       ENDDO
    ENDIF

    CALL MPI_Barrier(GlobalComm,ierr)
    CALL MPI_Group_free(GlobalGroup,ierr)
    CALL MPI_Group_free(Group0,ierr)
    CALL MPI_Group_free(Group1,ierr)

    CALL MPI_Finalize(ierr)

    STOP
END PROGRAM Two_Groups