program ftmain
!-----------------------------------------------------------------------
!                                                        since '94/07/31
!                                                       update '09/09/14
!
!     Electronic structure calculation 
!       with the plane-wave        method for solving Khon-Sham equation,
!        and the finite difference method for solving Poisson equation.
!
!     External potential is calculated by pseudopotentials.
!
!         make pwp      for serial calculation
!         make pwpmpi   for MPI
!-----------------------------------------------------------------------
implicit none
include 'mpif.h'

integer :: world            ! global, default communicator
integer :: nodes            ! the number of nodes in communicator world
integer :: myid             ! node ID in communicator world
integer :: world_qm         ! communicator

integer :: ierr


!-----Start parallel environment and keep my node ID
call MPI_INIT(ierr)
world = MPI_COMM_WORLD

call MPI_COMM_RANK( world, myid, ierr )

call MPI_COMM_SIZE( world, nodes, ierr )


if( myid == 0 ) then
    write(*,*) 'Starting--nodes = ', nodes
end if


call get_newcomm( myid, nodes, world, world_qm )


!------internode syncronization
call MPI_BARRIER(world,ierr)

!-----release communicator
call MPI_COMM_FREE( world_qm, ierr )

!-----Finalize the parallel environment
call MPI_FINALIZE(ierr)


stop
end program




subroutine get_newcomm( myid, nodes, world, world_qm )
!-----------------------------------------------------------------------
!     define and create new communicators
!-----------------------------------------------------------------------
implicit none
include 'mpif.h'
integer :: myid, nodes, world, world_qm

!-----declare local variables
integer :: group            ! group of communicator world
!integer, allocatable, dimension(:) :: extract_ids  ! node IDs to be extracted
integer, allocatable, dimension(:) :: include_ids  ! node IDs to be included
integer :: iworld           ! temporal communicator
integer :: igroup           ! temporal group
!integer :: nextract
integer :: i, nmd, ii, repeat, nrepeat, count
integer :: status
integer :: ierr



!-----extract group from communicator
call MPI_COMM_GROUP( world, group, ierr )


!-----allocate memory for include_ids
allocate( include_ids(0:nodes-1), stat=status )

count = 0
!-----create new communicator for QM nodes
!nextract = nodes - 1
repeat = 4096/nodes;
    do nrepeat = 0, repeat
    do nmd = 0, nodes - 1
       count = count + 1
       call MPI_BARRIER(world,ierr)
       if( myid == 0 ) write(*,*) 'check_newcomm do-start', nmd, ', repeat ',nrepeat, ', total', count

       ii = - 1
       do i = nmd, nmd
          ii = ii + 1
          include_ids(ii) = i
       end do

       !-----create new group by extracting some nodes
!       call MPI_GROUP_EXCL( group, nextract, extract_ids(0), igroup, ierr )
       call MPI_GROUP_INCL( group, 1, include_ids(0), igroup, ierr )
       if( ierr /= MPI_SUCCESS ) then
           write(*,*) 'group_incl: ierr =',ierr
           stop
       end if

       !-----create new communicator from new group
       call MPI_COMM_CREATE( world, igroup, iworld, ierr )
       if( ierr /= MPI_SUCCESS ) then
           write(*,*) 'comm_create: ierr =',ierr
           stop
       end if

       !-----release group
       call MPI_GROUP_FREE( igroup, ierr )

       if( myid >= nmd .and. myid <= nmd ) then
           world_qm = iworld
       end if

       call MPI_BARRIER(world,ierr)
       if( myid == 0 ) write(*,*) 'check_newcomm do-end'

    end do
    end do
!-----release group
call MPI_GROUP_FREE( group, ierr )

!-----deallocate memory for include_ids
deallocate( include_ids, stat=status )


return
end subroutine