1!
2! Copyright (C) 2013 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!----------------------------------------------------------------------------
9MODULE mp_bands
10  !----------------------------------------------------------------------------
11  !
12  USE mp, ONLY : mp_barrier, mp_bcast, mp_size, mp_rank, mp_comm_split
13  USE parallel_include
14  !
15  IMPLICIT NONE
16  SAVE
17  !
18  ! ... Band groups (processors within a pool of bands)
19  ! ... Subdivision of pool group, used for parallelization over bands
20  !
21  INTEGER :: nbgrp       = 1  ! number of band groups
22  INTEGER :: nproc_bgrp  = 1  ! number of processors within a band group
23  INTEGER :: me_bgrp     = 0  ! index of the processor within a band group
24  INTEGER :: root_bgrp   = 0  ! index of the root processor within a band group
25  INTEGER :: my_bgrp_id  = 0  ! index of my band group
26  INTEGER :: root_bgrp_id     = 0  ! index of root band group
27  INTEGER :: inter_bgrp_comm  = 0  ! inter band group communicator
28  INTEGER :: intra_bgrp_comm  = 0  ! intra band group communicator
29  ! Next variable is .T. if band parallelization is performed inside H\psi
30  ! and S\psi, .F. otherwise (band parallelization can be performed outside
31  ! H\psi and S\psi, though)
32  LOGICAL :: use_bgrp_in_hpsi = .FALSE.
33  !
34  ! ... "task" groups (for band parallelization of FFT)
35  !
36  INTEGER :: ntask_groups = 1  ! number of proc. in an orbital "task group"
37  !
38  ! ... "nyfft" groups (to push FFT parallelization beyond the nz-planes limit)
39  INTEGER :: nyfft = 1         ! number of y-fft groups. By default =1, i.e. y-ffts are done by a single proc
40  !
41CONTAINS
42  !
43  !----------------------------------------------------------------------------
44  SUBROUTINE mp_start_bands( nband_, ntg_, nyfft_, parent_comm )
45    !---------------------------------------------------------------------------
46    !
47    ! ... Divide processors (of the "parent_comm" group) into nband_ pools
48    ! ... Requires: nband_, read from command line
49    ! ...           parent_comm, typically processors of a k-point pool
50    ! ...           (intra_pool_comm)
51    !
52    IMPLICIT NONE
53    !
54    INTEGER, INTENT(IN) :: nband_, parent_comm
55    INTEGER, INTENT(IN), OPTIONAL :: ntg_, nyfft_
56    !
57    INTEGER :: parent_nproc = 1, parent_mype = 0
58    !
59#if defined (__MPI)
60    !
61    parent_nproc = mp_size( parent_comm )
62    parent_mype  = mp_rank( parent_comm )
63    !
64    ! ... nband_ must have been previously read from command line argument
65    ! ... by a call to routine get_command_line
66    !
67    nbgrp = nband_
68    !
69    IF ( nbgrp < 1 .OR. nbgrp > parent_nproc ) CALL errore( 'mp_start_bands',&
70                          'invalid number of band groups, out of range', 1 )
71    IF ( MOD( parent_nproc, nbgrp ) /= 0 ) CALL errore( 'mp_start_bands', &
72        'n. of band groups  must be divisor of parent_nproc', 1 )
73    !
74    ! set logical flag so that band parallelization in H\psi is allowed
75    ! (can be disabled before calling H\psi if not desired)
76    !
77    use_bgrp_in_hpsi = ( nbgrp > 1 )
78    !
79    ! ... Set number of processors per band group
80    !
81    nproc_bgrp = parent_nproc / nbgrp
82    !
83    ! ... set index of band group for this processor   ( 0 : nbgrp - 1 )
84    !
85    my_bgrp_id = parent_mype / nproc_bgrp
86    !
87    ! ... set index of processor within the image ( 0 : nproc_image - 1 )
88    !
89    me_bgrp    = MOD( parent_mype, nproc_bgrp )
90    !
91    CALL mp_barrier( parent_comm )
92    !
93    ! ... the intra_bgrp_comm communicator is created
94    !
95    CALL mp_comm_split( parent_comm, my_bgrp_id, parent_mype, intra_bgrp_comm )
96    !
97    CALL mp_barrier( parent_comm )
98    !
99    ! ... the inter_bgrp_comm communicator is created
100    !
101    CALL mp_comm_split( parent_comm, me_bgrp, parent_mype, inter_bgrp_comm )
102    !
103    IF ( PRESENT(ntg_) ) THEN
104       ntask_groups = ntg_
105    END IF
106    IF ( PRESENT(nyfft_) ) THEN
107       nyfft = nyfft_
108    END IF
109    call errore('mp_bands',' nyfft value incompatible with nproc_bgrp ', MOD(nproc_bgrp, nyfft) )
110    !
111#endif
112    RETURN
113    !
114  END SUBROUTINE mp_start_bands
115  !
116END MODULE mp_bands
117!
118!
119MODULE mp_bands_TDDFPT
120!
121! NB: These two variables used to be in mp_bands and are loaded from mp_global in TDDFPT
122!     I think they would better stay in a TDDFPT specific module but leave them here not to
123!     be too invasive on a code I don't know well. SdG
124!
125  INTEGER :: ibnd_start = 0              ! starting band index used in bgrp parallelization
126  INTEGER :: ibnd_end = 0                ! ending band index used in bgrp parallelization
127!
128END MODULE mp_bands_TDDFPT
129!
130