mirror of https://gitlab.com/QEF/q-e.git
165 lines
4.8 KiB
Fortran
165 lines
4.8 KiB
Fortran
!
|
|
! Copyright (C) 2014-2015 Quantum ESPRESSO group
|
|
! This file is distributed under the terms of the
|
|
! GNU General Public License. See the file `License'
|
|
! in the root directory of the present distribution,
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
!
|
|
!----------------------------------------------------------------------------
|
|
MODULE YAMBO
|
|
!----------------------------------------------------------------------------
|
|
!
|
|
USE kinds, ONLY : DP
|
|
!----------------------------------------------------------------------------
|
|
!
|
|
LOGICAL :: elph_yambo = .FALSE.
|
|
LOGICAL :: dvscf_yambo = .FALSE.
|
|
!
|
|
CHARACTER(300) :: yambo_elph_file_name = " "
|
|
!
|
|
END MODULE YAMBO
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
SUBROUTINE debye_waller(y_grad_at_gamma,y_pol_vec,ibnd,jbnd,ik,mu)
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! debye_waller term
|
|
!
|
|
USE kinds, ONLY:DP
|
|
USE wvfct, ONLY:nbnd
|
|
USE ions_base, ONLY:nat
|
|
USE control_lr, ONLY:lgamma
|
|
USE el_phon, ONLY:el_ph_mat
|
|
USE phcom, ONLY:dyn
|
|
USE modes, ONLY:u
|
|
!
|
|
IMPLICIT NONE
|
|
INTEGER :: ibnd,jbnd,ik,mu
|
|
COMPLEX(DP) :: y_grad_at_gamma(nat,3),y_pol_vec(nat,3)
|
|
!
|
|
! Work Space
|
|
!
|
|
INTEGER :: i,ia,icart,idisp
|
|
!
|
|
if (lgamma) then
|
|
!
|
|
y_grad_at_gamma(:,:)=(0._DP,0._DP)
|
|
!
|
|
! At gamma The <\grad> is stored in y_grad_at_gamma
|
|
! after transforming from displacment basis in cartesian
|
|
!
|
|
do i=1,3*nat
|
|
ia = (i - 1) / 3 + 1
|
|
icart = i - 3 * (ia - 1)
|
|
do idisp=1,3*nat
|
|
y_grad_at_gamma(ia,icart)=y_grad_at_gamma(ia,icart)+&
|
|
& el_ph_mat(ibnd,jbnd,ik,idisp)*conjg(u(i,idisp))
|
|
enddo
|
|
enddo
|
|
endif
|
|
!
|
|
! Polarization vector (/sqrt(atom_mass))
|
|
!
|
|
do i=1,3*nat
|
|
ia = (i - 1) / 3 + 1
|
|
icart = i - 3 * (ia - 1)
|
|
y_pol_vec(ia,icart) = dyn(i,mu)
|
|
enddo
|
|
!
|
|
end subroutine debye_waller
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
SUBROUTINE elph_yambo_eval_and_IO( )
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
USE kinds, ONLY : DP
|
|
USE ions_base, ONLY : nat
|
|
USE wvfct, ONLY : nbnd, et
|
|
USE el_phon, ONLY : el_ph_mat
|
|
USE klist, ONLY : xk
|
|
USE qpoint, ONLY : xq, nksq, ikks
|
|
USE modes, ONLY : u,nmodes
|
|
USE dynmat, ONLY : w2,dyn
|
|
USE io_global, ONLY : ionode, ionode_id
|
|
USE io_files, ONLY : create_directory
|
|
USE mp_images, ONLY : intra_image_comm
|
|
USE mp, ONLY : mp_bcast
|
|
USE control_lr, ONLY : lgamma
|
|
USE control_ph, ONLY : current_iq
|
|
USE cell_base, ONLY : alat
|
|
USE YAMBO, ONLY : yambo_elph_file_name
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
REAL(dp) :: yambo_kpts(3,nksq)
|
|
CHARACTER(300) :: y_file_name
|
|
COMPLEX(DP) :: gkkp_disk(nbnd,nbnd,nmodes),y_grad_at_gamma(nbnd,nbnd,nat,3),&
|
|
& y_pol_vec(3*nat,nat,3)
|
|
!
|
|
INTEGER :: ik, ikk, ikq, ibnd, jbnd, mu, i,j
|
|
LOGICAL :: exst
|
|
!
|
|
CHARACTER(LEN=256) :: elph_dir
|
|
!
|
|
elph_dir='elph_dir/'
|
|
IF (ionode) INQUIRE(file=TRIM(elph_dir), EXIST=exst)
|
|
CALL mp_bcast(exst, ionode_id, intra_image_comm)
|
|
IF (.NOT.exst) CALL create_directory( elph_dir )
|
|
!
|
|
WRITE (6, '(5x,"electron-phonon interaction (to be used in YAMBO) ..."/)')
|
|
!
|
|
IF ( ionode ) open(unit=99,file=trim(yambo_elph_file_name),form='unformatted')
|
|
IF ( ionode ) write (99) nmodes,nksq,nbnd
|
|
DO ik=1,nksq
|
|
ikk = ikks(ik)
|
|
yambo_kpts(:,ik)=xk(:,ikk)
|
|
END DO
|
|
IF ( ionode ) write (99) alat,xq,yambo_kpts
|
|
IF ( ionode ) write (99) w2(:)
|
|
!
|
|
DO ik=1,nksq
|
|
ikk = ik
|
|
ikq = ik
|
|
IF (.not.lgamma) THEN
|
|
ikk = 2 * ik - 1
|
|
ikq = ikk + 1
|
|
ENDIF
|
|
!
|
|
gkkp_disk=(0.d0, 0.d0)
|
|
!
|
|
DO ibnd=1,nbnd
|
|
DO jbnd=1,nbnd
|
|
DO mu=1,3*nat
|
|
!
|
|
call debye_waller(y_grad_at_gamma(ibnd,jbnd,:,:),y_pol_vec(mu,:,:),&
|
|
& ibnd,jbnd,ik,mu)
|
|
!
|
|
! Here we have transition xk(:,ikq) (k+q) -> xk(:,ikk) (k), with ME
|
|
! el_ph_mat(i,j,k,I)= <\psi(k+q) n_i|dV_{SCF}/du^q_{i a}|\psi(k) n_j>
|
|
!
|
|
! Note that as wu are small I use
|
|
!
|
|
! gkk(k,i,j,mu) = \sum_{IJ} el_ph_mat(i,j,k,I) u^*(I,J) dyn(J,mu)
|
|
!
|
|
DO j=1,3*nat
|
|
DO i=1,3*nat
|
|
gkkp_disk(ibnd,jbnd,mu)=gkkp_disk(ibnd,jbnd,mu)+&
|
|
& el_ph_mat(ibnd,jbnd,ik,i)*conjg(u(j,i))*dyn(j,mu)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO !mu
|
|
ENDDO !jbnd
|
|
ENDDO !ibnd
|
|
!
|
|
IF ( ionode ) write(99) gkkp_disk(:,:,:)
|
|
IF ( ionode ) write(99) y_pol_vec(:,:,:)
|
|
IF ( ionode .and. lgamma ) write(99) y_grad_at_gamma(:,:,:,:)
|
|
IF ( ionode ) write (99) et(:nbnd,ikk)
|
|
IF ( ionode ) write (99) et(:nbnd,ikq)
|
|
!
|
|
ENDDO !ik
|
|
IF ( ionode ) close(99)
|
|
!
|
|
RETURN
|
|
END SUBROUTINE elph_yambo_eval_and_IO
|