1!
2! Copyright (C) 2002-2009 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!=----------------------------------------------------------------------------=!
9  MODULE electrons_module
10!=----------------------------------------------------------------------------=!
11        USE kinds
12        USE electrons_base,     ONLY: nbnd, nbndx, nbsp, nbspx, nspin, nel, nelt, &
13                                      nupdwn, iupdwn, telectrons_base_initval, f, &
14                                      nudx, nupdwn_bgrp, iupdwn_bgrp, nudx_bgrp, &
15                                      nbsp_bgrp, nbspx_bgrp, i2gupdwn_bgrp
16
17        USE cp_electronic_mass, ONLY: ecutmass => emass_cutoff, emass, emass_precond
18
19
20        IMPLICIT NONE
21        SAVE
22
23        PRIVATE
24
25!  ...  declare module-scope variables
26
27        INTEGER, PARAMETER :: nspinx  = 2
28        LOGICAL :: band_first = .TRUE.
29
30        INTEGER :: nb_l(nspinx)    =  0  ! local number of states ( for each spin components )
31        !
32        INTEGER, ALLOCATABLE :: ib_owner(:)
33        INTEGER, ALLOCATABLE :: ib_local(:)
34
35        REAL(DP), ALLOCATABLE :: ei(:,:)
36
37!  ...  Fourier acceleration
38
39        LOGICAL :: toccrd = .FALSE.  ! read occupation number from standard input
40
41        PUBLIC :: electrons_setup
42        PUBLIC :: bmeshset, occn_info
43        PUBLIC :: deallocate_electrons
44        PUBLIC :: ib_owner, ib_local, nb_l
45        PUBLIC :: ei
46        PUBLIC :: print_eigenvalues
47        PUBLIC :: distribute_c, collect_c
48        PUBLIC :: distribute_b, collect_b
49!
50!  end of module-scope declarations
51!
52!=----------------------------------------------------------------------------=!
53   CONTAINS
54!=----------------------------------------------------------------------------=!
55
56
57
58   SUBROUTINE occn_info( occ )
59     !
60     !   This subroutine prints occupation numbers to stdout
61     !
62     USE io_global, ONLY: stdout, ionode
63     !
64     REAL(DP) :: occ(:)
65     INTEGER  :: i, iss
66     !
67     IF( ionode ) THEN
68       WRITE( stdout, fmt="(3X,'Occupation number from init')" )
69       IF( nspin == 1 ) THEN
70         WRITE( stdout, fmt = " (3X, 'nbnd = ', I5 ) " ) nbnd
71         WRITE( stdout, fmt = " (3X,10F5.2)" ) ( occ( i ), i = 1, nbnd )
72       ELSE
73         DO iss = 1, nspin
74           WRITE( stdout, fmt = " (3X,'spin = ', I3, ' nbnd = ', I5 ) " ) iss, nupdwn( iss )
75           WRITE( stdout, fmt = " (3X,10F5.2)" ) ( occ( i+iupdwn(iss)-1 ), i = 1, nupdwn( iss ) )
76         END DO
77       END IF
78     END IF
79     !
80     RETURN
81   END SUBROUTINE occn_info
82
83!  ----------------------------------------------
84    SUBROUTINE distribute_b( b, b_bgrp )
85      REAL(DP), INTENT(IN) :: b(:,:)
86      REAL(DP), INTENT(OUT) :: b_bgrp(:,:)
87      INTEGER :: iss, n1, n2, m1, m2
88      DO iss = 1, nspin
89         n1 = iupdwn_bgrp(iss)
90         n2 = n1 + nupdwn_bgrp(iss) - 1
91         m1 = iupdwn(iss)+i2gupdwn_bgrp(iss) - 1
92         m2 = m1 + nupdwn_bgrp(iss) - 1
93         b_bgrp(:,n1:n2) = b(:,m1:m2)
94      END DO
95      RETURN
96    END SUBROUTINE distribute_b
97!
98    SUBROUTINE collect_b( b, b_bgrp )
99      USE mp_global, ONLY : inter_bgrp_comm
100      USE mp,        ONLY : mp_sum
101      REAL(DP), INTENT(OUT) :: b(:,:)
102      REAL(DP), INTENT(IN)  :: b_bgrp(:,:)
103      INTEGER :: iss, n1, n2, m1, m2
104      b = 0.0d0
105      DO iss = 1, nspin
106         n1 = iupdwn_bgrp(iss)
107         n2 = n1 + nupdwn_bgrp(iss) - 1
108         m1 = iupdwn(iss)+i2gupdwn_bgrp(iss) - 1
109         m2 = m1 + nupdwn_bgrp(iss) - 1
110         b(:,m1:m2) = b_bgrp(:,n1:n2)
111         !write(1000+mpime,*) 'n1, n2 = ', n1, n2 ! debug
112         !write(1000+mpime,*) 'm1, m2 = ', m1, m2 ! debug
113      END DO
114      CALL mp_sum( b, inter_bgrp_comm )
115      RETURN
116    END SUBROUTINE collect_b
117
118
119    SUBROUTINE distribute_c( c, c_bgrp )
120      COMPLEX(DP), INTENT(IN) :: c(:,:)
121      COMPLEX(DP), INTENT(OUT) :: c_bgrp(:,:)
122      INTEGER :: iss, n1, n2, m1, m2
123      DO iss = 1, nspin
124         n1 = iupdwn_bgrp(iss)
125         n2 = n1 + nupdwn_bgrp(iss) - 1
126         m1 = iupdwn(iss)+i2gupdwn_bgrp(iss) - 1
127         m2 = m1 + nupdwn_bgrp(iss) - 1
128         c_bgrp(:,n1:n2) = c(:,m1:m2)
129      END DO
130      RETURN
131    END SUBROUTINE distribute_c
132!
133    SUBROUTINE collect_c( c, c_bgrp )
134      USE mp_global, ONLY : inter_bgrp_comm
135      USE mp,        ONLY : mp_sum
136      COMPLEX(DP), INTENT(OUT) :: c(:,:)
137      COMPLEX(DP), INTENT(IN)  :: c_bgrp(:,:)
138      INTEGER :: iss, n1, n2, m1, m2
139      c = 0.0d0
140      DO iss = 1, nspin
141         n1 = iupdwn_bgrp(iss)
142         n2 = n1 + nupdwn_bgrp(iss) - 1
143         m1 = iupdwn(iss)+i2gupdwn_bgrp(iss) - 1
144         m2 = m1 + nupdwn_bgrp(iss) - 1
145         c(:,m1:m2) = c_bgrp(:,n1:n2)
146         !write(1000+mpime,*) 'n1, n2 = ', n1, n2 ! debug
147         !write(1000+mpime,*) 'm1, m2 = ', m1, m2 ! debug
148      END DO
149      CALL mp_sum( c, inter_bgrp_comm )
150      RETURN
151    END SUBROUTINE collect_c
152
153!  ----------------------------------------------
154!  ----------------------------------------------
155
156   SUBROUTINE bmeshset
157
158     !   This subroutine initialize the variables for the
159     !   distribution across processors of the overlap matrixes
160     !   of sizes ( nx, nx )
161
162     USE mp_global, ONLY: me_bgrp, nproc_bgrp
163
164     IMPLICIT NONE
165
166     INTEGER :: i, ierr
167
168     IF( band_first ) THEN
169       CALL errore(' bmeshset ',' module not initialized ',0)
170     END IF
171
172     DO i = 1, nspin
173       !
174       IF( i > nspinx ) CALL errore( ' bmeshset ',' spin too large ', i)
175       !
176       nb_l( i ) = nupdwn( i ) / nproc_bgrp
177       IF( me_bgrp < MOD( nupdwn( i ), nproc_bgrp ) ) nb_l( i ) = nb_l( i ) + 1
178       !
179     END DO
180
181     IF( ALLOCATED( ib_owner ) ) DEALLOCATE( ib_owner )
182     ALLOCATE( ib_owner( nbndx ), STAT=ierr)
183     IF( ierr/=0 ) CALL errore( ' bmeshset ',' allocating ib_owner ', ierr)
184     IF( ALLOCATED( ib_local ) ) DEALLOCATE( ib_local )
185     ALLOCATE( ib_local( nbndx ), STAT=ierr)
186     IF( ierr/=0 ) CALL errore( ' bmeshset ',' allocating ib_local ', ierr)
187
188     !  here define the association between processors and electronic states
189     !  round robin distribution is used
190
191     ib_local =  0
192     ib_owner = -1
193     DO i = 1, nbndx
194       ib_local( i ) = ( i - 1 ) / nproc_bgrp        !  local index of the i-th band
195       ib_owner( i ) = MOD( ( i - 1 ), nproc_bgrp )  !  owner of th i-th band
196       IF( me_bgrp <= ib_owner( i ) ) THEN
197         ib_local( i ) = ib_local( i ) + 1
198       END IF
199     END DO
200
201     RETURN
202   END SUBROUTINE bmeshset
203
204!  ----------------------------------------------
205!
206!
207!
208!  ----------------------------------------------
209
210
211   SUBROUTINE electrons_setup( emass_inp, ecutmass_inp )
212
213     IMPLICIT NONE
214     REAL(DP),  INTENT(IN) :: emass_inp, ecutmass_inp
215     INTEGER :: ierr, i
216
217
218     IF( .NOT. telectrons_base_initval ) &
219       CALL errore( ' electrons_setup ', ' electrons_base not initialized ', 1 )
220
221     !
222     IF( ALLOCATED( ei ) ) DEALLOCATE( ei )
223     ALLOCATE( ei( nudx, nspin ), STAT=ierr)
224     IF( ierr/=0 ) CALL errore( ' electrons ',' allocating ei ',ierr)
225     ei = 0.0_DP
226
227     ecutmass = ecutmass_inp
228     emass    = emass_inp
229     IF ( ecutmass < 0.0_DP ) &
230       CALL errore(' electrons ',' ecutmass out of range ' , 0)
231
232     band_first = .FALSE.
233
234     RETURN
235   END SUBROUTINE electrons_setup
236
237!----------------------------------------------------------------------
238
239   SUBROUTINE print_eigenvalues( ei_unit, tfile, tstdout, nfi, tps )
240      !
241      use constants,  only : autoev
242      USE io_global,  ONLY : stdout, ionode
243      !
244      INTEGER,  INTENT(IN) :: ei_unit
245      LOGICAL,  INTENT(IN) :: tfile, tstdout
246      INTEGER,  INTENT(IN) :: nfi
247      REAL(DP), INTENT(IN) :: tps
248      !
249      INTEGER :: i, j, ik
250      !
251      IF ( tfile ) THEN
252          WRITE(ei_unit,30) nfi, tps
253      END IF
254      !
255      ik = 1
256      !
257      DO j = 1, nspin
258         !
259         IF( tstdout ) THEN
260            WRITE( stdout,1002) ik, j
261            WRITE( stdout,1004) ( ei( i, j ) * autoev, i = 1, nupdwn(j) )
262         END IF
263         !
264         IF( tfile ) THEN
265            WRITE(ei_unit,1010) ik, j
266            WRITE(ei_unit,1020) ( ei( i, j ) * autoev, i = 1, nupdwn(j) )
267         END IF
268         !
269      END DO
270      !
271  30  FORMAT(2X,'STEP:',I7,1X,F10.2)
272 1002 FORMAT(/,3X,'Eigenvalues (eV), kp = ',I3, ' , spin = ',I2,/)
273 1004 FORMAT(10F8.2)
274 1010 FORMAT(3X,'Eigenvalues (eV), kp = ',I3, ' , spin = ',I2)
275 1020 FORMAT(10F8.2)
276      !
277      RETURN
278   END SUBROUTINE print_eigenvalues
279
280!  ----------------------------------------------
281
282   SUBROUTINE deallocate_electrons
283      INTEGER :: ierr
284      IF(ALLOCATED(ei))       THEN
285            DEALLOCATE(ei, STAT=ierr)
286            IF( ierr/=0 ) CALL errore( ' deallocate_electrons ',' deallocating ei ',ierr )
287      END IF
288      IF(ALLOCATED(ib_owner)) THEN
289            DEALLOCATE(ib_owner, STAT=ierr)
290            IF( ierr/=0 ) CALL errore( ' deallocate_electrons ',' deallocating ib_owner ',ierr )
291      END IF
292      IF(ALLOCATED(ib_local)) THEN
293            DEALLOCATE(ib_local, STAT=ierr)
294            IF( ierr/=0 ) CALL errore( ' deallocate_electrons ',' deallocating ib_local ',ierr )
295      END IF
296      RETURN
297   END SUBROUTINE deallocate_electrons
298
299
300
301
302!=----------------------------------------------------------------------------=!
303  END MODULE electrons_module
304!=----------------------------------------------------------------------------=!
305