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