scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Removal of writing .epf to file. Everything in memory. If memory issue, this scales down with 

k parallelization. 


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12888 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
sponce 2016-08-31 08:46:23 +00:00
parent cbd08e75df
commit 5aefd02d03
9 changed files with 306 additions and 426 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
EPW/src/close_epw.f90
View File

@ -14,7 +14,6 @@
SUBROUTINE close_epw
!------------------------------------------------------------------
!
USE io_epw, ONLY : iunepmatf
USE phcom, ONLY : iuwfc, iudwf, iudrhous, iudvkb3, fildrho, iudrho
USE uspp, ONLY : okvan
USE mp_global, ONLY : me_pool,root_pool
@ -25,10 +24,8 @@
CLOSE (unit = iudwf, status = 'keep')
IF(okvan) CLOSE(unit = iudrhous, status = 'delete')
IF(okvan) CLOSE (unit = iudvkb3, status = 'delete')
IF (me_pool /= root_pool ) go to 100
IF (fildrho.ne.' ') CLOSE (unit = iudrho, status = 'keep')
100 continue
! the temporary storage for Wannier interpolation
CLOSE (unit = iunepmatf, status = 'delete')
IF (me_pool == root_pool ) THEN
IF (fildrho.ne.' ') CLOSE (unit = iudrho, status = 'keep')
ENDIF
!
END SUBROUTINE close_epw

1
EPW/src/elphon_shuffle_wrap.f90
View File

@ -264,7 +264,6 @@
! compute coarse grid dipole matrix elements. Very fast
CALL compute_pmn_para
ENDIF
!CALL compute_pmn_para
!
! gather electronic eigenvalues for subsequent shuffle
!

207
EPW/src/ephwann_shuffle.f90
View File

@ -31,25 +31,25 @@
USE start_k, ONLY : nk1, nk2, nk3
USE ions_base, ONLY : nat, amass, ityp
USE phcom, ONLY : nq1, nq2, nq3, nmodes, w2
USE epwcom, ONLY : nbndsub, lrepmatf, fsthick, epwread, &
epwwrite, ngaussw, degaussw, lpolar, &
nbndskip, parallel_k, parallel_q, etf_mem, &
elecselfen, phonselfen, nest_fn, a2f, &
vme, eig_read, ephwrite, &
efermi_read, fermi_energy, specfun, band_plot,&
longrange
USE epwcom, ONLY : nbndsub, lrepmatf, fsthick, epwread, longrange, &
epwwrite, ngaussw, degaussw, lpolar, &
nbndskip, parallel_k, parallel_q, etf_mem, &
elecselfen, phonselfen, nest_fn, a2f, &
vme, eig_read, ephwrite, &
efermi_read, fermi_energy, specfun, band_plot
USE noncollin_module, ONLY : noncolin
USE constants_epw, ONLY : ryd2ev, ryd2mev, one, two, czero
USE io_files, ONLY : prefix, diropn
USE io_global, ONLY : stdout, ionode
USE io_epw, ONLY : lambda_phself, linewidth_phself, iunepmatf, &
iunepmatwe, iunepmatwp, crystal
USE elph2, ONLY : nrr_k, nrr_q, cu, cuq, lwin, lwinq, irvec, ndegen_k, ndegen_q, &
wslen, chw, chw_ks, cvmew, cdmew, rdw, epmatwp, epmatq, &
wf, etf, etf_k, etf_ks, xqf, xkf, wkf, &
dynq, nqtotf, nkqf, epf17, nkf, nqf, et_ks, &
ibndmin, ibndmax, lambda_all, dmec, dmef, vmef, &
sigmai_all, sigmai_mode, gamma_all, epsi, zstar, efnew
USE io_epw, ONLY : lambda_phself, linewidth_phself, iunepmatwe, &
iunepmatwp, crystal
USE elph2, ONLY : nrr_k, nrr_q, cu, cuq, lwin, lwinq, irvec, ndegen_k,&
ndegen_q, wslen, chw, chw_ks, cvmew, cdmew, rdw, &
epmatwp, epmatq, wf, etf, etf_k, etf_ks, xqf, xkf, &
wkf, dynq, nqtotf, nkqf, epf17, nkf, nqf, et_ks, &
ibndmin, ibndmax, lambda_all, dmec, dmef, vmef, &
sigmai_all, sigmai_mode, gamma_all, epsi, zstar, &
efnew
#ifdef __NAG
USE f90_unix_io, ONLY : flush
#endif
@ -109,6 +109,8 @@
!! record index when reading file
INTEGER :: lrepmatw
!! record length while reading file
INTEGER :: i
!! Index when writing to file
!
REAL(kind=DP) :: xxq(3)
!! Current q-point
@ -141,6 +143,7 @@
!! Rotation matrix for phonons
COMPLEX(kind=DP), ALLOCATABLE :: bmatf ( :, :)
!! overlap U_k+q U_k^\dagger in smooth Bloch basis, fine mesh
COMPLEX(kind=DP), ALLOCATABLE :: aux ( : )
!
IF (nbndsub.ne.nbnd) &
WRITE(stdout, '(/,14x,a,i4)' ) 'band disentanglement is used: nbndsub = ', nbndsub
@ -494,23 +497,13 @@
IF (parallel_k) THEN
!
! get the size of the matrix elements stored in each pool
!
! for informational purposes. Not necessary
!
CALL mem_size(ibndmin, ibndmax, nmodes, nkf)
!
IF (etf_mem) THEN
! Fine mesh set of g-matrices. It is large for memory storage
ALLOCATE ( epf17 (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes, nkf) )
!
ELSE
!
! open epf and etf files with the correct record length
!
lrepmatf = 2 * (ibndmax-ibndmin+1) * (ibndmax-ibndmin+1) * nmodes
CALL diropn (iunepmatf, 'epf', lrepmatf, exst)
!
ENDIF
! Fine mesh set of g-matrices. It is large for memory storage
! SP: Should not be a memory problem. If so, can always the number of cores to reduce nkf.
ALLOCATE ( epf17 (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes, nkf) )
!
DO iq = 1, nqf
!
@ -623,7 +616,8 @@
! interpolate ONLY when (k,k+q) both have at least one band
! within a Fermi shell of size fsthick
!
IF ( (( minval ( abs(etf (:, ikk) - ef) ) < fsthick ) .and. ( minval ( abs(etf (:, ikq) - ef) ) < fsthick )) ) THEN
IF ( (( minval ( abs(etf (:, ikk) - ef) ) < fsthick ) .and. &
( minval ( abs(etf (:, ikq) - ef) ) < fsthick )) ) THEN
!
! fermicount = fermicount + 1
!
@ -668,30 +662,18 @@
!
ENDIF
!
! write epmatf to file / store in memory
! Store epmatf in memory
!
IF (etf_mem) THEN
DO jbnd = ibndmin, ibndmax
DO ibnd = ibndmin, ibndmax
!
epf17(ibnd-ibndmin+1,jbnd-ibndmin+1,:,ik) = epmatf(ibnd,jbnd,:)
!
ENDDO
DO jbnd = ibndmin, ibndmax
DO ibnd = ibndmin, ibndmax
!
epf17(ibnd-ibndmin+1,jbnd-ibndmin+1,:,ik) = epmatf(ibnd,jbnd,:)
!
ENDDO
ELSE
!
ios = 0
nrec = ik
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'ephwann_shuffle', 'unit is not opened', iunepmatf )
!
WRITE (UNIT = iunepmatf, REC = nrec, IOSTAT = ios) epmatf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'ephwann_shuffle', &
& 'error while writing from file "' // TRIM(nameF) // '"', iunepmatf )
!
ENDIF
ENDDO
!
!DBSP
! Debug on the long/short range. Usefull to keep commented for now.
!if (ik==2) then
! !print*,'iq ',iq
! !do imode = 1, nmodes
@ -753,18 +735,8 @@
!
CALL mem_size(ibndmin, ibndmax, nmodes, nkf)
!
IF (etf_mem) THEN
! Fine mesh set of g-matrices. It is large for memory storage
ALLOCATE ( epf17 (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes, nqf) )
!
ELSE
!
! open epf file with the correct record length
!
lrepmatf = 2 * (ibndmax-ibndmin+1) * (ibndmax-ibndmin+1) * nmodes
CALL diropn (iunepmatf, 'epf', lrepmatf, exst)
!
ENDIF
! Fine mesh set of g-matrices. It is large for memory storage
ALLOCATE ( epf17 (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes, nqf) )
!
DO ik = 1, nkf
!
@ -912,26 +884,13 @@
! write epmatf to file / store in memory
!
!
IF (etf_mem) THEN
DO jbnd = ibndmin, ibndmax
DO ibnd = ibndmin, ibndmax
!
epf17(ibnd-ibndmin+1,jbnd-ibndmin+1,:,iq) = epmatf(ibnd,jbnd,:)
!
ENDDO
DO jbnd = ibndmin, ibndmax
DO ibnd = ibndmin, ibndmax
!
epf17(ibnd-ibndmin+1,jbnd-ibndmin+1,:,iq) = epmatf(ibnd,jbnd,:)
!
ENDDO
ELSE
!
ios = 0
nrec = iq
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'ephwann_shuffle', 'unit is not opened', iunepmatf )
!
WRITE (UNIT = iunepmatf, REC = nrec, IOSTAT = ios) epmatf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'ephwann_shuffle', &
& 'error while writing from file "' // TRIM(nameF) // '"', iunepmatf )
!
ENDIF
ENDDO
!
!if (ik==2) then
! do imode = 1, nmodes
@ -996,18 +955,19 @@
!
IF (a2f) CALL eliashberg_a2f
!
IF ( ALLOCATED(lambda_all) ) DEALLOCATE( lambda_all )
IF ( ALLOCATED(gamma_all) ) DEALLOCATE( gamma_all )
IF ( ALLOCATED(sigmai_all) ) DEALLOCATE( sigmai_all )
IF ( ALLOCATED(lambda_all) ) DEALLOCATE( lambda_all )
IF ( ALLOCATED(gamma_all) ) DEALLOCATE( gamma_all )
IF ( ALLOCATED(sigmai_all) ) DEALLOCATE( sigmai_all )
IF ( ALLOCATED(sigmai_mode) ) DEALLOCATE( sigmai_mode )
IF ( ALLOCATED(aux)) DEALLOCATE ( aux )
!
CALL stop_clock ( 'ephwann' )
!
END SUBROUTINE ephwann_shuffle
!
!-------------------------------------------
SUBROUTINE epw_write
!-------------------------------------------
!-------------------------------------------
SUBROUTINE epw_write
!-------------------------------------------
!
USE kinds, ONLY : DP
USE epwcom, ONLY : nbndsub, vme, eig_read, etf_mem
@ -1103,12 +1063,12 @@ SUBROUTINE epw_write
!
ENDIF
CALL mp_barrier(inter_pool_comm)
!---------------------------------
END SUBROUTINE epw_write
!---------------------------------
!---------------------------------
SUBROUTINE epw_read()
!---------------------------------
!---------------------------------
END SUBROUTINE epw_write
!---------------------------------
!---------------------------------
SUBROUTINE epw_read()
!---------------------------------
USE kinds, ONLY : DP
USE epwcom, ONLY : nbndsub, vme, eig_read, etf_mem
USE pwcom, ONLY : ef
@ -1229,13 +1189,9 @@ SUBROUTINE epw_read()
!
lrepmatw = 2 * nbndsub * nbndsub * nrr_k * nmodes * nrr_q
filint = trim(prefix)//'.epmatwp'
!CALL diropn (iunepmatwp, filint, lrepmatw, exst)
CALL diropn (iunepmatwp, 'epmatwp', lrepmatw, exst)
CALL davcio ( aux, lrepmatw, iunepmatwp, 1, -1 )
!READ( UNIT = iunepmatwp, REC = 1, IOSTAT = ios ) aux
!
i = 0
DO irq = 1, nrr_q
DO imode = 1, nmodes
@ -1265,12 +1221,12 @@ SUBROUTINE epw_read()
!
WRITE(stdout,'(/5x,"Finished reading Wann rep data from file"/)')
!
!---------------------------------
END SUBROUTINE epw_read
!---------------------------------
!---------------------------------
SUBROUTINE mem_size(ibndmin, ibndmax, nmodes, nkf)
!---------------------------------
!---------------------------------
END SUBROUTINE epw_read
!---------------------------------
!---------------------------------
SUBROUTINE mem_size(ibndmin, ibndmax, nmodes, nkf)
!---------------------------------
!!
!! SUBROUTINE estimates the amount of memory taken up by
!! the $$<k+q| dV_q,nu |k>$$ on the fine meshes and prints
@ -1281,9 +1237,19 @@ SUBROUTINE mem_size(ibndmin, ibndmax, nmodes, nkf)
!
implicit none
!
integer :: imelt, ibndmin, ibndmax, nmodes, nkf
real(kind=DP) :: rmelt
character (len=256) :: chunit
INTEGER, INTENT (in) :: ibndmin
!! Min band
INTEGER, INTENT (in) :: ibndmax
!! Min band
INTEGER, INTENT (in) :: nmodes
!! Number of modes
INTEGER, INTENT (in) :: nkf
!! Number of k-points in pool
!
! Work variables
INTEGER :: imelt
REAL(kind=DP) :: rmelt
CHARACTER (len=256) :: chunit
!
imelt = (ibndmax-ibndmin+1)**2 * nmodes * nkf
rmelt = imelt * 8 / 1048576.d0 ! 8 bytes per number, value in Mb
@ -1300,13 +1266,12 @@ SUBROUTINE mem_size(ibndmin, ibndmax, nmodes, nkf)
WRITE(stdout,'(/,5x,a, i13, a,f7.2,a,a)') "Number of ep-matrix elements per pool :", &
imelt, " ~= ", rmelt, trim(chunit), " (@ 8 bytes/ DP)"
!
!---------------------------------
END SUBROUTINE mem_size
!---------------------------------
!--------------------------------------------------------------------
FUNCTION efermig_seq (et, nbnd, nks, nelec, wk, Degauss, Ngauss, is, isk)
!---------------------------------
END SUBROUTINE mem_size
!---------------------------------
!
!--------------------------------------------------------------------
FUNCTION efermig_seq (et, nbnd, nks, nelec, wk, Degauss, Ngauss, is, isk)
!--------------------------------------------------------------------
!!
!! Finds the Fermi energy - Gaussian Broadening
@ -1384,10 +1349,11 @@ FUNCTION efermig_seq (et, nbnd, nks, nelec, wk, Degauss, Ngauss, is, isk)
!
efermig_seq = Ef
RETURN
end FUNCTION efermig_seq
!-----------------------------------------------------------------------
function sumkg_seq (et, nbnd, nks, wk, degauss, ngauss, e, is, isk)
!
end FUNCTION efermig_seq
!
!-----------------------------------------------------------------------
function sumkg_seq (et, nbnd, nks, wk, degauss, ngauss, e, is, isk)
!-----------------------------------------------------------------------
!!
!! This function computes the number of states under a given energy e
@ -1441,8 +1407,9 @@ function sumkg_seq (et, nbnd, nks, wk, degauss, ngauss, e, is, isk)
sumkg_seq = sumkg_seq + wk (ik) * sum1
ENDDO
RETURN
end function sumkg_seq
!
!
end function sumkg_seq
!
!-----------------------------------------------------------------
subroutine rwepmatw ( epmatw, nbnd, np, nmodes, nrec, iun, iop)
!-----------------------------------------------------------------
@ -1523,5 +1490,3 @@ end function sumkg_seq
!
end subroutine rwepmatw

3
EPW/src/io_epw.f90
View File

@ -26,7 +26,7 @@
iufilgap, iospectral_sup, iua2ftrfil, iufilgapFS, iufillambdaFS, &
iuwanep, iuwane, iunukk, iudvscf
PUBLIC :: epwdata, iundmedata, iunvmedata, iunksdata, iudyn, iukgmap, iuepb,&
iunepmatf, iurecover, iufilfreq, iufilegnv, iufileph, iufilkqmap, &
iurecover, iufilfreq, iufilegnv, iufileph, iufilkqmap, &
iufilikmap, iueig, iunepmatwp, iunepmatwe, iunkf, iunqf, &
iufileig, iukmap, crystal
PUBLIC :: iuwinfil, iun_plot, iuukk, iuprojfil !, iummn
@ -74,7 +74,6 @@
INTEGER :: iunksdata = 104 ! Hamiltonian in wannier basis
INTEGER :: iuepb = 105 ! Electron-phonon matrix in Bloch
! representation [.epb]
INTEGER :: iunepmatf = 106 ! Rotation matrix on fine mesh
INTEGER :: iurecover = 107 ! Dvanqq2 recovery file
INTEGER :: iufilfreq = 108 ! Phonon frequency from a previous epw run
! [.freq]

326
EPW/src/nesting_fn.f90
View File

@ -19,21 +19,21 @@
!! from ep-wannier interpolation.
!!
!-----------------------------------------------------------------------
USE kinds, only : DP
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
use epwcom, only : nbndsub, fsthick, &
USE epwcom, ONLY : nbndsub, fsthick, &
eptemp, ngaussw, degaussw, &
nsmear, delta_smear, efermi_read, fermi_energy
use pwcom, only : nelec, ef, isk
use elph2, only : ibndmax, ibndmin, etf, &
USE pwcom, ONLY : nelec, ef, isk
USE elph2, ONLY : ibndmax, ibndmin, etf, &
wkf, xqf, wqf, nkqf, &
nkf, nkqtotf, xqf
USE constants_epw, ONLY : ryd2ev, two, pi
#ifdef __NAG
USE f90_unix_io, ONLY : flush
#endif
use mp, only : mp_barrier,mp_sum
use mp_global, only : inter_pool_comm
USE mp, ONLY : mp_barrier,mp_sum
USE mp_global, ONLY : inter_pool_comm
!
implicit none
!
@ -95,92 +95,92 @@
!
! Here we loop on smearing values
DO ismear = 1, nsmear
!
degaussw0 = (ismear-1)*delta_smear+degaussw
!
! Fermi level and corresponding DOS
!
! Note that the weights of k+q points must be set to zero here
! no spin-polarized calculation here
IF ( efermi_read ) THEN
ef0 = fermi_energy
ELSE
ef0 = efermig(etf, nbndsub, nkqf, nelec, wkf, degaussw0, ngaussw, 0, isk)
ENDIF
!
dosef = dos_ef (ngaussw, degaussw0, ef0, etf, wkf, nkqf, nbndsub)
! N(Ef) in the equation for lambda is the DOS per spin
dosef = dosef / two
!
IF (iq.eq.1) then
WRITE (stdout, 100) degaussw0 * ryd2ev, ngaussw
WRITE (stdout, 101) dosef / ryd2ev, ef0 * ryd2ev
ENDIF
!
!
CALL start_clock('nesting')
!
fermicount = 0
!
DO ik = 1, nkf
!
ikk = 2 * ik - 1
ikq = ikk + 1
!
! here we must have ef, not ef0, to be consistent with ephwann_shuffle
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .and. &
!
degaussw0 = (ismear-1)*delta_smear+degaussw
!
! Fermi level and corresponding DOS
!
! Note that the weights of k+q points must be set to zero here
! no spin-polarized calculation here
IF ( efermi_read ) THEN
ef0 = fermi_energy
ELSE
ef0 = efermig(etf, nbndsub, nkqf, nelec, wkf, degaussw0, ngaussw, 0, isk)
ENDIF
!
dosef = dos_ef (ngaussw, degaussw0, ef0, etf, wkf, nkqf, nbndsub)
! N(Ef) in the equation for lambda is the DOS per spin
dosef = dosef / two
!
IF (iq.eq.1) then
WRITE (stdout, 100) degaussw0 * ryd2ev, ngaussw
WRITE (stdout, 101) dosef / ryd2ev, ef0 * ryd2ev
ENDIF
!
!
CALL start_clock('nesting')
!
fermicount = 0
!
DO ik = 1, nkf
!
ikk = 2 * ik - 1
ikq = ikk + 1
!
! here we must have ef, not ef0, to be consistent with ephwann_shuffle
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .and. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) then
!
fermicount = fermicount + 1
!
DO ibnd = 1, ibndmax-ibndmin+1
!
ekk = etf (ibndmin-1+ibnd, ikk) - ef0
w0g1 = w0gauss ( ekk / degaussw0, 0) / degaussw0
!
DO jbnd = 1, ibndmax-ibndmin+1
!
ekq = etf (ibndmin-1+jbnd, ikq) - ef0
w0g2 = w0gauss ( ekq / degaussw0, 0) / degaussw0
!
! = k-point weight * [f(E_k) - f(E_k+q)]/ [E_k+q - E_k -w_q +id]
! This is the imaginary part of the phonon self-energy, sans the matrix elements
!
! weight = wkf (ikk) * (wgkk - wgkq) * &
! aimag ( cone / ( ekq - ekk - ci * degaussw ) )
!
! the below expression is positive-definite, but also an approximation
! which neglects some fine features
!
weight = wkf (ikk) * w0g1 * w0g2
!
gamma = gamma + weight
!
ENDDO ! jbnd
!
ekk = etf (ibndmin-1+ibnd, ikk) - ef0
w0g1 = w0gauss ( ekk / degaussw0, 0) / degaussw0
!
DO jbnd = 1, ibndmax-ibndmin+1
!
ekq = etf (ibndmin-1+jbnd, ikq) - ef0
w0g2 = w0gauss ( ekq / degaussw0, 0) / degaussw0
!
! = k-point weight * [f(E_k) - f(E_k+q)]/ [E_k+q - E_k -w_q +id]
! This is the imaginary part of the phonon self-energy, sans the matrix elements
!
! weight = wkf (ikk) * (wgkk - wgkq) * &
! aimag ( cone / ( ekq - ekk - ci * degaussw ) )
!
! the below expression is positive-definite, but also an approximation
! which neglects some fine features
!
weight = wkf (ikk) * w0g1 * w0g2
!
gamma = gamma + weight
!
ENDDO ! jbnd
ENDDO ! ibnd
!
ENDIF ! endif fsthick
!
ENDDO ! loop on k
!
! collect contributions from all pools (sum over k-points)
! this finishes the integral over the BZ (k)
!
CALL mp_sum(gamma,inter_pool_comm)
CALL mp_sum(fermicount, inter_pool_comm)
!
WRITE(stdout,'(/5x,"iq = ",i5," coord.: ", 3f9.5, " wt: ", f9.5)') iq, xqf(:,iq) , wqf(iq)
WRITE(stdout,'(5x,a)') repeat('-',67)
!
WRITE(stdout, 102) gamma
WRITE(stdout,'(5x,a/)') repeat('-',67)
CALL flush(6)
!
WRITE( stdout, '(/5x,a,i8,a,i8/)' ) &
'Number of (k,k+q) pairs on the Fermi surface: ',fermicount, ' out of ', nkqtotf/2
!
!
CALL stop_clock('nesting')
ENDIF ! endif fsthick
!
ENDDO ! loop on k
!
! collect contributions from all pools (sum over k-points)
! this finishes the integral over the BZ (k)
!
CALL mp_sum(gamma,inter_pool_comm)
CALL mp_sum(fermicount, inter_pool_comm)
!
WRITE(stdout,'(/5x,"iq = ",i5," coord.: ", 3f9.5, " wt: ", f9.5)') iq, xqf(:,iq) , wqf(iq)
WRITE(stdout,'(5x,a)') repeat('-',67)
!
WRITE(stdout, 102) gamma
WRITE(stdout,'(5x,a/)') repeat('-',67)
CALL flush(6)
!
WRITE( stdout, '(/5x,a,i8,a,i8/)' ) &
'Number of (k,k+q) pairs on the Fermi surface: ',fermicount, ' out of ', nkqtotf/2
!
!
CALL stop_clock('nesting')
ENDDO !smears
!
!
@ -200,48 +200,84 @@
!! account in the energy selection rule.
!!
!-----------------------------------------------------------------------
USE kinds, only : DP
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
use epwcom, only : nbndsub, fsthick, &
USE epwcom, ONLY : nbndsub, fsthick, &
eptemp, ngaussw, degaussw, &
nsmear, delta_smear, efermi_read, fermi_energy
use pwcom, only : nelec, ef, isk
use elph2, only : ibndmax, ibndmin, etf, etf_k, &
USE pwcom, ONLY : nelec, ef, isk
USE elph2, ONLY : ibndmax, ibndmin, etf, etf_k, &
wkf, xqf, wqf, nkqf, nqf, nqtotf, &
nkqtotf, xqf, gamma_nest
USE constants_epw, ONLY : ryd2ev, two, pi, zero
#ifdef __NAG
USE f90_unix_io, ONLY : flush
#endif
use mp, only : mp_barrier,mp_sum, mp_bcast
use mp_global, only : inter_pool_comm
USE mp, ONLY : mp_barrier,mp_sum, mp_bcast
USE mp_global, ONLY : inter_pool_comm
USE mp_world, ONLY : mpime
USE io_global, ONLY : ionode_id
!
implicit none
!
integer :: ik, ikk, ikq, ibnd, jbnd, iq, fermicount, ismear, &
lower_bnd, upper_bnd
real(kind=DP) :: ekk, ekq, ef0, &
weight, w0g1, w0g2, w0gauss, dosef, degaussw0
real(kind=DP), external :: efermig_seq, dos_ef_seq
REAL(kind=DP), ALLOCATABLE :: xqf_all(:,:), wqf_all(:,:)
INTEGER, INTENT (in) :: ik
!! Current k-point
!
real(kind=DP), external :: efermig
! Work variables
INTEGER :: iq
!! Counter on the k-point index
INTEGER :: ikk
!! k-point index
INTEGER :: ikq
!! q-point index
INTEGER :: ibnd
!! Counter on bands
INTEGER :: jbnd
!! Counter on bands
INTEGER :: imode
!! Counter on mode
INTEGER :: fermicount
!! Number of states on the Fermi surface
INTEGER :: ismear
!! Smearing for the Gaussian function
INTEGER :: lower_bnd
!! Upper bounds index after k or q paral
INTEGER :: upper_bnd
!! Upper bounds index after k or q paral
!
REAL(kind=DP) :: ekk
!! Eigen energy on the fine grid relative to the Fermi level
REAL(kind=DP) :: ekq
!! Eigen energy of k+q on the fine grid relative to the Fermi level
REAL(kind=DP) :: ef0
!! Fermi energy level
REAL(kind=DP) :: weight
!! Imaginary part of the phonhon self-energy factor
REAL(kind=DP) :: dosef
!! Density of state N(Ef)
REAL(kind=DP) :: w0g1
!! Dirac delta for the imaginary part of $\Sigma$
REAL(kind=DP) :: w0g2
!! Dirac delta for the imaginary part of $\Sigma$
!
REAL(kind=DP) :: w0gauss, degaussw0
REAL(kind=DP), external :: efermig_seq, dos_ef_seq
REAL(kind=DP), ALLOCATABLE :: xqf_all(:,:), wqf_all(:,:)
REAL(kind=DP), external :: efermig
!
!
IF (ik.eq.1) then
WRITE(stdout,'(/5x,a)') repeat('=',67)
WRITE(stdout,'(5x,"Nesting Function in the double delta approx")')
WRITE(stdout,'(5x,a/)') repeat('=',67)
!
IF ( fsthick.lt.1.d3 ) &
WRITE(stdout, '(/5x,a,f10.6,a)' ) &
'Fermi Surface thickness = ', fsthick * ryd2ev, ' eV'
WRITE(stdout, '(/5x,a,f10.6,a)' ) &
'Golden Rule strictly enforced with T = ',eptemp * ryd2ev, ' eV'
IF ( .not. ALLOCATED (gamma_nest) ) ALLOCATE( gamma_nest (nqtotf,nsmear) )
gamma_nest(:,:) = zero
WRITE(stdout,'(/5x,a)') repeat('=',67)
WRITE(stdout,'(5x,"Nesting Function in the double delta approx")')
WRITE(stdout,'(5x,a/)') repeat('=',67)
!
IF ( fsthick.lt.1.d3 ) &
WRITE(stdout, '(/5x,a,f10.6,a)' ) &
'Fermi Surface thickness = ', fsthick * ryd2ev, ' eV'
WRITE(stdout, '(/5x,a,f10.6,a)' ) &
'Golden Rule strictly enforced with T = ',eptemp * ryd2ev, ' eV'
IF ( .not. ALLOCATED (gamma_nest) ) ALLOCATE( gamma_nest (nqtotf,nsmear) )
gamma_nest(:,:) = zero
ENDIF
! here we loop on smearing values
@ -282,44 +318,44 @@
fermicount = 0
!
DO iq = 1, nqf
!
ikq = 2 * iq
ikk = ikq - 1
!
! here we must have ef, not ef0, to be consistent with ephwann_shuffle
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .and. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) then
!
ikq = 2 * iq
ikk = ikq - 1
!
! here we must have ef, not ef0, to be consistent with ephwann_shuffle
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .and. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) then
!
fermicount = fermicount + 1
!
DO ibnd = 1, ibndmax-ibndmin+1
!
fermicount = fermicount + 1
ekk = etf (ibndmin-1+ibnd, ikk) - ef0
w0g1 = w0gauss ( ekk / degaussw0, 0) / degaussw0
!
DO ibnd = 1, ibndmax-ibndmin+1
!
ekk = etf (ibndmin-1+ibnd, ikk) - ef0
w0g1 = w0gauss ( ekk / degaussw0, 0) / degaussw0
!
DO jbnd = 1, ibndmax-ibndmin+1
!
ekq = etf (ibndmin-1+jbnd, ikq) - ef0
w0g2 = w0gauss ( ekq / degaussw0, 0) / degaussw0
!
! = k-point weight * [f(E_k) - f(E_k+q)]/ [E_k+q - E_k -w_q +id]
! This is the imaginary part of the phonon self-energy, sans the matrix elements
!
! weight = wkf (ikk) * (wgkk - wgkq) * &
! aimag ( cone / ( ekq - ekk - ci * degaussw ) )
!
! the below expression is positive-definite, but also an approximation
! which neglects some fine features
!
weight = wkf (ikk) * w0g1 * w0g2
!
gamma_nest(iq+lower_bnd-1,ismear) = gamma_nest(iq+lower_bnd-1,ismear) + weight
!
ENDDO ! jbnd
ENDDO ! ibnd
!
ENDIF ! endif fsthick
!
DO jbnd = 1, ibndmax-ibndmin+1
!
ekq = etf (ibndmin-1+jbnd, ikq) - ef0
w0g2 = w0gauss ( ekq / degaussw0, 0) / degaussw0
!
! = k-point weight * [f(E_k) - f(E_k+q)]/ [E_k+q - E_k -w_q +id]
! This is the imaginary part of the phonon self-energy, sans the matrix elements
!
! weight = wkf (ikk) * (wgkk - wgkq) * &
! aimag ( cone / ( ekq - ekk - ci * degaussw ) )
!
! the below expression is positive-definite, but also an approximation
! which neglects some fine features
!
weight = wkf (ikk) * w0g1 * w0g2
!
gamma_nest(iq+lower_bnd-1,ismear) = gamma_nest(iq+lower_bnd-1,ismear) + weight
!
ENDDO ! jbnd
ENDDO ! ibnd
!
ENDIF ! endif fsthick
!
ENDDO ! loop on q
!
CALL stop_clock('nesting')

60
EPW/src/selfen_elec.f90
View File

@ -31,11 +31,11 @@
!-----------------------------------------------------------------------
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE io_epw, ONLY : iunepmatf, linewidth_elself
USE io_epw, ONLY : linewidth_elself
USE phcom, ONLY : nmodes
USE epwcom, ONLY : nbndsub, lrepmatf, shortrange, &
fsthick, eptemp, ngaussw, degaussw, &
etf_mem, eps_acustic, efermi_read, fermi_energy
eps_acustic, efermi_read, fermi_energy
USE pwcom, ONLY : ef !, nelec, isk
USE elph2, ONLY : etf, ibndmin, ibndmax, nkqf, xqf, &
nkf, epf17, wkf, nqtotf, wf, wqf, xkf, nkqtotf, &
@ -83,6 +83,8 @@
!! Lower bounds index after k or q paral
INTEGER :: upper_bnd
!! Upper bounds index after k or q paral
INTEGER :: i
!! Index for reading files
!
REAL(kind=DP) :: tmp
!! Temporary variable to store real part of Sigma for the degenerate average
@ -146,9 +148,6 @@
REAL(kind=DP), ALLOCATABLE :: etf_all(:,:)
!! Collect eigenenergies from all pools in parallel case
!
COMPLEX(kind=DP) epf (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes)
!! Electron-phonon matrix element on the fine grid.
!
! SP: Define the inverse so that we can efficiently multiply instead of
! dividing
!
@ -228,21 +227,6 @@
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .and. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) THEN
!
! we read the e-p matrix
!
IF (etf_mem) THEN
epf(:,:,:) = epf17 ( :, :, :, ik)
ELSE
ios = 0
nrec = ik
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'selfen_elec', 'unit is not opened', iunepmatf )
!
READ( UNIT = iunepmatf, REC = nrec, IOSTAT = ios ) epf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'selfen_elec', &
& 'error while reading from file "' // TRIM(nameF) // '"', iunepmatf )
ENDIF
!
fermicount = fermicount + 1
DO imode = 1, nmodes
!
@ -277,11 +261,11 @@
!
IF ( shortrange .AND. ( abs(xqf (1, iq))> eps2 .OR. abs(xqf (2, iq))> eps2 &
.OR. abs(xqf (3, iq))> eps2 )) THEN
! SP: The abs has to be removed. Indeed the epf can be a pure imaginary
! SP: The abs has to be removed. Indeed the epf17 can be a pure imaginary
! number, in which case its square will be a negative number.
g2 = (epf (jbnd, ibnd, imode)**two)*inv_wq*g2_tmp
g2 = (epf17 (jbnd, ibnd, imode, ik)**two)*inv_wq*g2_tmp
ELSE
g2 = (abs(epf (jbnd, ibnd, imode))**two)*inv_wq*g2_tmp
g2 = (abs(epf17 (jbnd, ibnd, imode, ik))**two)*inv_wq*g2_tmp
ENDIF
!
! There is a sign error for wq in Eq. 9 of Comp. Phys. Comm. 181, 2140 (2010). - RM
@ -510,11 +494,11 @@
!-----------------------------------------------------------------------
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE io_epw, ONLY : iunepmatf, linewidth_elself
USE io_epw, ONLY : linewidth_elself
USE phcom, ONLY : nmodes
USE epwcom, ONLY : nbndsub, lrepmatf, shortrange, &
fsthick, eptemp, ngaussw, degaussw, &
etf_mem, eps_acustic, efermi_read, fermi_energy
fsthick, eptemp, ngaussw, degaussw, &
eps_acustic, efermi_read, fermi_energy
USE pwcom, ONLY : ef !, nelec, isk
USE elph2, ONLY : etf, ibndmin, ibndmax, nkqf, etf_k, xqf, &
epf17, wkf, nqtotf, wf, wqf, xkf, nkqtotf, &
@ -580,11 +564,6 @@
REAL(kind=DP), PARAMETER :: eps2 = 0.01/ryd2mev
!! Tolerence
!
! variables for collecting data from all pools in parallel case
!
COMPLEX(kind=DP) :: epf (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes)
!! Electron-phonon matrix element on the fine grid.
!
! SP: Define the inverse so that we can efficiently multiply instead of
! dividing
!
@ -678,19 +657,6 @@
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .and. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) THEN
!
IF (etf_mem) THEN
epf(:,:,:) = epf17 ( :, :, :, iq)
ELSE
ios = 0
nrec = ik
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'selfen_elec', 'unit is not opened', iunepmatf )
!
READ( UNIT = iunepmatf, REC = nrec, IOSTAT = ios ) epf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'selfen_elec', &
& 'error while reading from file "' // TRIM(nameF) // '"', iunepmatf )
ENDIF
!
fermicount = fermicount + 1
DO imode = 1, nmodes
!
@ -725,11 +691,11 @@
!
IF ( shortrange .AND. ( abs(xqf (1, iq))> eps2 .OR. abs(xqf (2, iq))> eps2 &
.OR. abs(xqf (3, iq))> eps2 )) THEN
! SP: The abs has to be removed. Indeed the epf can be a pure imaginary
! SP: The abs has to be removed. Indeed the epf17 can be a pure imaginary
! number, in which case its square will be a negative number.
g2 = (epf (jbnd, ibnd, imode)**two)*inv_wq*g2_tmp
g2 = (epf17 (jbnd, ibnd, imode, iq)**two)*inv_wq*g2_tmp
ELSE
g2 = (abs(epf (jbnd, ibnd, imode))**two)*inv_wq*g2_tmp
g2 = (abs(epf17 (jbnd, ibnd, imode, iq))**two)*inv_wq*g2_tmp
ENDIF
!
! There is a sign error for wq in Eq. 9 of Comp. Phys. Comm. 181, 2140 (2010). - RM

51
EPW/src/selfen_phon.f90
View File

@ -28,11 +28,10 @@
!-----------------------------------------------------------------------
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE io_epw, ONLY : iunepmatf
use phcom, ONLY : nmodes
use epwcom, ONLY : nbndsub, lrepmatf, fsthick, &
eptemp, ngaussw, degaussw, shortrange, &
etf_mem, nsmear, delta_smear, eps_acustic, &
nsmear, delta_smear, eps_acustic, &
efermi_read, fermi_energy, delta_approx
use pwcom, ONLY : nelec, ef, isk
use elph2, ONLY : epf17, ibndmax, ibndmin, etf, &
@ -142,9 +141,6 @@
REAL(kind=DP), PARAMETER :: eps2 = 0.01/ryd2mev
!! Tolerence
!
COMPLEX(kind=DP) epf (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes)
!! Electron-phonon matrix element on the fine grid.
!
IF ( iq .eq. 1 ) THEN
WRITE(stdout,'(/5x,a)') repeat('=',67)
WRITE(stdout,'(5x,"Phonon (Imaginary) Self-Energy in the Migdal Approximation")')
@ -246,19 +242,6 @@
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .AND. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) THEN
!
IF (etf_mem) THEN
epf(:,:,:) = epf17 ( :, :, :, ik)
ELSE
ios = 0
nrec = ik
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'selfen_elec', 'unit is not opened', iunepmatf )
!
READ( UNIT = iunepmatf, REC = nrec, IOSTAT = ios ) epf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'selfen_elec', &
& 'error while reading from file "' // TRIM(nameF) // '"', iunepmatf )
ENDIF
!
fermicount = fermicount + 1
DO imode = 1, nmodes
!
@ -296,11 +279,11 @@
!
IF ( shortrange .AND. ( abs(xqf (1, iq))> eps2 .OR. abs(xqf (2, iq))> eps2 &
.OR. abs(xqf (3, iq))> eps2 )) THEN
! SP: The abs has to be removed. Indeed the epf can be a pure imaginary
! SP: The abs has to be removed. Indeed the epf17 can be a pure imaginary
! number, in which case its square will be a negative number.
g2 = (epf (jbnd, ibnd, imode)**two)*inv_wq*g2_tmp
g2 = (epf17 (jbnd, ibnd, imode, ik)**two)*inv_wq*g2_tmp
ELSE
g2 = (abs(epf (jbnd, ibnd, imode))**two)*inv_wq*g2_tmp
g2 = (abs(epf17 (jbnd, ibnd, imode, ik))**two)*inv_wq*g2_tmp
ENDIF
!
IF (delta_approx) THEN
@ -416,11 +399,11 @@ END SUBROUTINE selfen_phon_q
!-----------------------------------------------------------------------
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE io_epw, ONLY : iunepmatf, lambda_phself, linewidth_phself
USE io_epw, ONLY : lambda_phself, linewidth_phself
use phcom, ONLY : nmodes
use epwcom, ONLY : nbndsub, lrepmatf, fsthick, &
eptemp, ngaussw, degaussw, shortrange, &
etf_mem, nsmear, delta_smear, eps_acustic, &
nsmear, delta_smear, eps_acustic, &
efermi_read, fermi_energy, delta_approx
use pwcom, ONLY : nelec, ef, isk
use elph2, ONLY : epf17, ibndmax, ibndmin, etf, etf_k, &
@ -546,9 +529,6 @@ END SUBROUTINE selfen_phon_q
REAL(kind=DP), PARAMETER :: eps2 = 0.01/ryd2mev
!! Tolerence
!
COMPLEX(kind=DP) epf (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes)
!! Electron-phonon matrix element on the fine grid.
!
IF ( ik .eq. 1 ) THEN
WRITE(stdout,'(/5x,a)') repeat('=',67)
WRITE(stdout,'(5x,"Phonon (Imaginary) Self-Energy in the Migdal Approximation")')
@ -653,19 +633,6 @@ END SUBROUTINE selfen_phon_q
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .AND. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) THEN
!
IF (etf_mem) THEN
epf(:,:,:) = epf17 ( :, :, :, ik)
ELSE
ios = 0
nrec = ik
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'selfen_elec', 'unit is not opened', iunepmatf )
!
READ( UNIT = iunepmatf, REC = nrec, IOSTAT = ios ) epf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'selfen_elec', &
& 'error while reading from file "' // TRIM(nameF) // '"', iunepmatf )
ENDIF
!
fermicount = fermicount + 1
DO imode = 1, nmodes
!
@ -703,11 +670,11 @@ END SUBROUTINE selfen_phon_q
!
IF ( shortrange .AND. ( abs(xqf (1, iq))> eps2 .OR. abs(xqf (2, iq))> eps2 &
.OR. abs(xqf (3, iq))> eps2 )) THEN
! SP: The abs has to be removed. Indeed the epf can be a pure imaginary
! SP: The abs has to be removed. Indeed the epf17 can be a pure imaginary
! number, in which case its square will be a negative number.
g2 = (epf (jbnd, ibnd, imode)**two)*inv_wq*g2_tmp
g2 = (epf17 (jbnd, ibnd, imode, iq)**two)*inv_wq*g2_tmp
ELSE
g2 = (abs(epf (jbnd, ibnd, imode))**two)*inv_wq*g2_tmp
g2 = (abs(epf17 (jbnd, ibnd, imode, iq))**two)*inv_wq*g2_tmp
ENDIF
!
IF (delta_approx) THEN

54
EPW/src/spectral_func.f90
View File

@ -24,9 +24,9 @@
!-----------------------------------------------------------------------
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE io_epw, ONLY : iunepmatf, iospectral_sup ,iospectral
USE io_epw, ONLY : iospectral_sup ,iospectral
USE phcom, ONLY : nmodes
USE epwcom, ONLY : nbndsub, lrepmatf, etf_mem, eps_acustic, &
USE epwcom, ONLY : nbndsub, lrepmatf, eps_acustic, &
fsthick, eptemp, ngaussw, degaussw, wmin_specfun,&
wmax_specfun, nw_specfun, shortrange, &
efermi_read, fermi_energy
@ -115,9 +115,6 @@
real(kind=DP) :: fermi(nw_specfun)
real(kind=DP), external :: efermig, dos_ef, wgauss
!
COMPLEX(kind=DP) epf (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes)
!! Electron-phonon matrix element on the fine grid.
!
! variables for collecting data from all pools in parallel case
!
real(kind=DP), allocatable :: xkf_all(:,:) , etf_all(:,:)
@ -205,21 +202,6 @@
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .AND. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) THEN
!
! we read the e-p matrix
!
IF (etf_mem) THEN
epf(:,:,:) = epf17 ( :, :, :, ik)
ELSE
ios = 0
nrec = ik
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'selfen_elec', 'unit is not opened', iunepmatf )
!
READ( UNIT = iunepmatf, REC = nrec, IOSTAT = ios ) epf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'selfen_elec', &
& 'error while reading from file "' // TRIM(nameF) // '"', iunepmatf )
ENDIF
!
fermicount = fermicount + 1
DO imode = 1, nmodes
!
@ -254,11 +236,11 @@
!
IF ( shortrange .AND. ( abs(xqf (1, iq))> eps2 .OR. abs(xqf (2, iq))> eps2 &
.OR. abs(xqf (3, iq))> eps2 )) THEN
! SP: The abs has to be removed. Indeed the epf can be a pure imaginary
! SP: The abs has to be removed. Indeed the epf17 can be a pure imaginary
! number, in which case its square will be a negative number.
g2 = (epf (jbnd, ibnd, imode)**two)*inv_wq*g2_tmp
g2 = (epf17 (jbnd, ibnd, imode, ik)**two)*inv_wq*g2_tmp
ELSE
g2 = (abs(epf (jbnd, ibnd, imode))**two)*inv_wq*g2_tmp
g2 = (abs(epf17 (jbnd, ibnd, imode, ik))**two)*inv_wq*g2_tmp
ENDIF
!
DO iw = 1, nw_specfun
@ -470,9 +452,9 @@
!!-----------------------------------------------------------------------
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE io_epw, ONLY : iunepmatf, iospectral_sup, iospectral
USE io_epw, ONLY : iospectral_sup, iospectral
USE phcom, ONLY : nmodes
USE epwcom, ONLY : nbndsub, lrepmatf, etf_mem, eps_acustic, &
USE epwcom, ONLY : nbndsub, lrepmatf, eps_acustic, &
fsthick, eptemp, ngaussw, degaussw, wmin_specfun,&
wmax_specfun, nw_specfun, shortrange, &
efermi_read, fermi_energy
@ -530,7 +512,6 @@
REAL(kind=DP), PARAMETER :: eps2 = 0.01/ryd2mev
!! Tolerenc
real(kind=DP), external :: efermig, dos_ef, wgauss
complex(kind=DP) epf (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes)
real(kind=DP) :: g2, ekk, ekq, wq, ef0, wgq, wgkq, ww, dw, weight
real(kind=DP) :: dosef, specfun_sum, esigmar0
real(kind=DP) :: fermi(nw_specfun)
@ -619,21 +600,6 @@
IF ( ( minval ( abs(etf (:, ikk) - ef) ) .lt. fsthick ) .AND. &
( minval ( abs(etf (:, ikq) - ef) ) .lt. fsthick ) ) THEN
!
! we read the e-p matrix
!
IF (etf_mem) THEN
epf(:,:,:) = epf17 ( :, :, :, iq)
ELSE
ios = 0
nrec = ik
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'selfen_elec', 'unit is not opened', iunepmatf )
!
READ( UNIT = iunepmatf, REC = nrec, IOSTAT = ios ) epf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'selfen_elec', &
& 'error while reading from file "' // TRIM(nameF) // '"', iunepmatf )
ENDIF
!
fermicount = fermicount + 1
DO imode = 1, nmodes
!
@ -668,11 +634,11 @@
!
IF ( shortrange .AND. ( abs(xqf (1, iq))> eps2 .OR. abs(xqf (2, iq))> eps2 &
.OR. abs(xqf (3, iq))> eps2 )) THEN
! SP: The abs has to be removed. Indeed the epf can be a pure imaginary
! SP: The abs has to be removed. Indeed the epf17 can be a pure imaginary
! number, in which case its square will be a negative number.
g2 = (epf (jbnd, ibnd, imode)**two)*inv_wq*g2_tmp
g2 = (epf17 (jbnd, ibnd, imode, iq)**two)*inv_wq*g2_tmp
ELSE
g2 = (abs(epf (jbnd, ibnd, imode))**two)*inv_wq*g2_tmp
g2 = (abs(epf17 (jbnd, ibnd, imode, iq))**two)*inv_wq*g2_tmp
ENDIF
!
DO iw = 1, nw_specfun

21
EPW/src/write_ephmat.f90
View File

@ -19,11 +19,11 @@
!-----------------------------------------------------------------------
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE io_epw, ONLY : iunepmatf, iufilfreq, iufilegnv, iufileph
USE io_epw, ONLY : iufilfreq, iufilegnv, iufileph
USE io_files, ONLY : prefix, tmp_dir
USE phcom, ONLY : nmodes
USE epwcom, ONLY : nbndsub, lrepmatf, fsthick, ngaussw, degaussw, &
etf_mem, nkf1, nkf2, nkf3, &
nkf1, nkf2, nkf3, &
efermi_read, fermi_energy
USE pwcom, ONLY : nelec, ef, isk
USE elph2, ONLY : etf, ibndmin, ibndmax, nkqf, epf17, wkf, nkf, nqtotf, wf, xqf, nkqtotf
@ -75,7 +75,6 @@
!! Memory allocated
!
REAL(DP) :: wq, g2
COMPLEX(kind=DP) :: epf (ibndmax-ibndmin+1, ibndmax-ibndmin+1, nmodes)
REAL(DP), EXTERNAL :: efermig, dos_ef
CHARACTER (len=256) :: filfreq, filegnv, filephmat
CHARACTER (len=3) :: filelab
@ -207,20 +206,6 @@
IF ( ixkf(lower_bnd+ik-1) > 0 ) THEN
IF ( ixkqf(ixkf(lower_bnd+ik-1),iq) > 0 ) THEN
!
! we read the e-p matrix
!
IF (etf_mem) THEN
epf(:,:,:) = epf17 ( :, :, :, ik)
ELSE
ios = 0
nrec = ik
INQUIRE( UNIT = iunepmatf, OPENED = opnd, NAME = nameF )
IF ( .NOT. opnd ) CALL errore( 'selfen_elec', 'unit is not opened', iunepmatf )
!
READ( UNIT = iunepmatf, REC = nrec, IOSTAT = ios ) epf(:,:,:)
IF ( ios /= 0 ) CALL errore( 'selfen_elec', &
& 'error while reading from file "' // TRIM(nameF) // '"', iunepmatf )
ENDIF
!
DO imode = 1, nmodes ! phonon modes
wq = wf(imode, iq)
@ -234,7 +219,7 @@
! with hbar = 1 and M already contained in the eigenmodes
! g2 is Ry^2, wkf must already account for the spin factor
!
g2 = abs( epf(jbnd, ibnd, imode) )**two / ( two * wq )
g2 = abs( epf17(jbnd, ibnd, imode, ik) )**two / ( two * wq )
WRITE(iufileph) g2
ENDIF
ENDDO ! jbnd