mirror of https://gitlab.com/QEF/q-e.git
Update the not_epw_comp test-farm to be in line with QE.
This commit is contained in:
parent
3d6cfbc605
commit
a5488f6eec
|
@ -33,7 +33,7 @@ SUBROUTINE do_phonon(auxdyn)
|
|||
USE disp, ONLY : nqs
|
||||
USE control_ph, ONLY : epsil, trans, qplot, only_init, &
|
||||
only_wfc, rec_code, where_rec
|
||||
USE el_phon, ONLY : elph, elph_mat, elph_simple
|
||||
USE el_phon, ONLY : elph, elph_mat, elph_simple, elph_epa
|
||||
!
|
||||
! YAMBO >
|
||||
USE YAMBO, ONLY : elph_yambo
|
||||
|
@ -116,6 +116,8 @@ SUBROUTINE do_phonon(auxdyn)
|
|||
CALL elphsum_wannier(iq)
|
||||
ELSEIF( elph_simple ) THEN
|
||||
CALL elphsum_simple()
|
||||
ELSEIF( elph_epa ) THEN
|
||||
CALL elphfil_epa(iq)
|
||||
ELSEIF( elph_yambo ) THEN
|
||||
CALL elph_yambo_eval_and_IO()
|
||||
ELSEIF(elph_tetra == 1) THEN
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
!
|
||||
! Copyright (C) 2001-2015 Quantum ESPRESSO group
|
||||
! Copyright (C) 2001-2018 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,
|
||||
|
@ -18,6 +18,7 @@ SUBROUTINE elphon()
|
|||
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau, amass
|
||||
USE gvecs, ONLY: doublegrid
|
||||
USE fft_base, ONLY : dfftp, dffts
|
||||
USE fft_interfaces, ONLY : fft_interpolate
|
||||
USE noncollin_module, ONLY : nspin_mag, noncolin, m_loc
|
||||
USE lsda_mod, ONLY : nspin
|
||||
USE uspp, ONLY: okvan
|
||||
|
@ -87,7 +88,7 @@ SUBROUTINE elphon()
|
|||
ALLOCATE (dvscfins (dffts%nnr, nspin_mag , npert(irr)) )
|
||||
DO is = 1, nspin_mag
|
||||
DO ipert = 1, npe
|
||||
CALL cinterpolate (dvscfin(1,is,ipert),dvscfins(1,is,ipert),-1)
|
||||
CALL fft_interpolate (dfftp, dvscfin(:,is,ipert), dffts, dvscfins(:,is,ipert))
|
||||
ENDDO
|
||||
ENDDO
|
||||
ELSE
|
||||
|
@ -203,6 +204,12 @@ SUBROUTINE readmat (iudyn, ibrav, celldm, nat, ntyp, ityp, omega, &
|
|||
IF ( ntyp.NE.ntyp_ .OR. nat.NE.nat_ .OR.ibrav_.NE.ibrav .OR. &
|
||||
ABS ( celldm_ (1) - celldm (1) ) > 1.0d-5) &
|
||||
CALL errore ('readmat', 'inconsistent data', 1)
|
||||
IF ( ibrav_ == 0 ) THEN
|
||||
READ (iudyn, '(a)') line
|
||||
READ (iudyn, '(a)') line
|
||||
READ (iudyn, '(a)') line
|
||||
READ (iudyn, '(a)') line
|
||||
END IF
|
||||
DO nt = 1, ntyp
|
||||
READ (iudyn, * ) i, atm, amass_
|
||||
IF ( nt.NE.i .OR. ABS (amass_ - amu_ry*amass (nt) ) > 1.0d-5) &
|
||||
|
@ -269,40 +276,47 @@ SUBROUTINE elphel (irr, npe, imode0, dvscfins)
|
|||
! Calculation of the electron-phonon matrix elements el_ph_mat
|
||||
! <\psi(k+q)|dV_{SCF}/du^q_{i a}|\psi(k)>
|
||||
! Original routine written by Francesco Mauri
|
||||
! Modified by A. Floris and I. Timrov to include Hubbard U (01.10.2018)
|
||||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE fft_base, ONLY : dffts
|
||||
USE ions_base, ONLY : nat, ityp
|
||||
USE control_flags, ONLY : iverbosity
|
||||
USE wavefunctions, ONLY : evc
|
||||
USE buffers, ONLY : get_buffer
|
||||
USE klist, ONLY : xk, ngk, igk_k
|
||||
USE lsda_mod, ONLY: lsda, current_spin, isk
|
||||
USE lsda_mod, ONLY : lsda, current_spin, isk, nspin
|
||||
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
|
||||
USE wvfct, ONLY : nbnd, npwx
|
||||
USE buffers, ONLY : get_buffer
|
||||
USE uspp, ONLY : vkb
|
||||
USE el_phon, ONLY : el_ph_mat, el_ph_mat_rec, el_ph_mat_rec_col, &
|
||||
comp_elph, done_elph, elph_nbnd_min, elph_nbnd_max
|
||||
USE modes, ONLY : u
|
||||
USE units_ph, ONLY : iubar, lrbar, lrwfc, iuwfc
|
||||
USE modes, ONLY : u, nmodes
|
||||
USE units_ph, ONLY : iubar, lrbar, iundnsscf
|
||||
USE units_lr, ONLY : iuwfc, lrwfc
|
||||
USE control_ph, ONLY : trans, current_iq
|
||||
USE ph_restart, ONLY : ph_writefile
|
||||
USE spin_orb, ONLY : domag
|
||||
USE mp_bands, ONLY : intra_bgrp_comm, ntask_groups
|
||||
USE mp_pools, ONLY : npool
|
||||
USE mp, ONLY: mp_sum
|
||||
USE mp, ONLY : mp_sum, mp_bcast
|
||||
USE mp_world, ONLY : world_comm
|
||||
USE elph_tetra_mod, ONLY : elph_tetra
|
||||
|
||||
USE eqv, ONLY : dvpsi, evq
|
||||
USE qpoint, ONLY : nksq, ikks, ikqs, nksqtot
|
||||
USE control_lr, ONLY : lgamma
|
||||
USE fft_helper_subroutines
|
||||
USE ldaU, ONLY : lda_plus_u, Hubbard_lmax
|
||||
USE ldaU_ph, ONLY : dnsscf_all_modes, dnsscf
|
||||
USE io_global, ONLY : ionode, ionode_id
|
||||
|
||||
IMPLICIT NONE
|
||||
!
|
||||
INTEGER, INTENT(IN) :: irr, npe, imode0
|
||||
COMPLEX(DP), INTENT(IN) :: dvscfins (dffts%nnr, nspin_mag, npe)
|
||||
! LOCAL variables
|
||||
INTEGER :: npw, npwq
|
||||
INTEGER :: nrec, ik, ikk, ikq, ipert, mode, ibnd, jbnd, ir, ig, &
|
||||
INTEGER :: npw, npwq, nrec, ik, ikk, ikq, ipert, mode, ibnd, jbnd, ir, ig, &
|
||||
ipol, ios, ierr
|
||||
COMPLEX(DP) , ALLOCATABLE :: aux1 (:,:), elphmat (:,:,:), tg_dv(:,:), &
|
||||
tg_psic(:,:), aux2(:,:)
|
||||
|
@ -326,12 +340,35 @@ SUBROUTINE elphel (irr, npe, imode0, dvscfins)
|
|||
el_ph_mat_rec=(0.0_DP,0.0_DP)
|
||||
ALLOCATE (aux2(npwx*npol, nbnd))
|
||||
incr=1
|
||||
IF ( dffts%have_task_groups ) THEN
|
||||
IF ( dffts%has_task_groups ) THEN
|
||||
!
|
||||
v_siz = dffts%nnr_tg
|
||||
ALLOCATE( tg_dv ( v_siz, nspin_mag ) )
|
||||
ALLOCATE( tg_psic( v_siz, npol ) )
|
||||
incr = dffts%nproc2
|
||||
incr = fftx_ntgrp(dffts)
|
||||
!
|
||||
ENDIF
|
||||
!
|
||||
! DFPT+U case
|
||||
!
|
||||
IF (lda_plus_u) THEN
|
||||
!
|
||||
! Allocate and re-read dnsscf_all_modes from file
|
||||
!
|
||||
ALLOCATE (dnsscf_all_modes(2*Hubbard_lmax+1, 2*Hubbard_lmax+1, nspin, nat, nmodes))
|
||||
dnsscf_all_modes = (0.d0, 0.d0)
|
||||
IF (ionode) READ(iundnsscf,*) dnsscf_all_modes
|
||||
CALL mp_bcast(dnsscf_all_modes, ionode_id, world_comm)
|
||||
REWIND(iundnsscf)
|
||||
!
|
||||
! Check whether the re-read is correct
|
||||
!
|
||||
IF (iverbosity==1) CALL elphel_read_dnsscf_check()
|
||||
!
|
||||
! Allocate dnsscf
|
||||
!
|
||||
ALLOCATE (dnsscf(2*Hubbard_lmax+1, 2*Hubbard_lmax+1, nspin, nat, npe))
|
||||
dnsscf = (0.d0, 0.d0)
|
||||
!
|
||||
ENDIF
|
||||
!
|
||||
|
@ -374,11 +411,16 @@ SUBROUTINE elphel (irr, npe, imode0, dvscfins)
|
|||
mode = imode0 + ipert
|
||||
! FIXME: .false. or .true. ???
|
||||
CALL dvqpsi_us (ik, u (1, mode), .FALSE. )
|
||||
!
|
||||
! DFPT+U: calculate the bare derivative of the Hubbard potential in el-ph
|
||||
!
|
||||
IF (lda_plus_u) CALL dvqhub_barepsi_us (ik, u(1,mode))
|
||||
!
|
||||
ENDIF
|
||||
!
|
||||
! calculate dvscf_q*psi_k
|
||||
!
|
||||
IF ( dffts%have_task_groups ) THEN
|
||||
IF ( dffts%has_task_groups ) THEN
|
||||
IF (noncolin) THEN
|
||||
CALL tg_cgather( dffts, dvscfins(:,1,ipert), tg_dv(:,1))
|
||||
IF (domag) THEN
|
||||
|
@ -392,7 +434,7 @@ SUBROUTINE elphel (irr, npe, imode0, dvscfins)
|
|||
ENDIF
|
||||
aux2=(0.0_DP,0.0_DP)
|
||||
DO ibnd = ibnd_fst, ibnd_lst, incr
|
||||
IF ( dffts%have_task_groups ) THEN
|
||||
IF ( dffts%has_task_groups ) THEN
|
||||
CALL cft_wave_tg (ik, evc, tg_psic, 1, v_siz, ibnd, nbnd )
|
||||
CALL apply_dpot(v_siz, tg_psic, tg_dv, 1)
|
||||
CALL cft_wave_tg (ik, aux2, tg_psic, -1, v_siz, ibnd, nbnd)
|
||||
|
@ -403,9 +445,16 @@ SUBROUTINE elphel (irr, npe, imode0, dvscfins)
|
|||
ENDIF
|
||||
ENDDO
|
||||
dvpsi=dvpsi+aux2
|
||||
|
||||
!
|
||||
CALL adddvscf (ipert, ik)
|
||||
!
|
||||
! DFPT+U: add to dvpsi the scf part of the perturbed Hubbard potential
|
||||
!
|
||||
IF (lda_plus_u) THEN
|
||||
dnsscf(:,:,:,:,ipert) = dnsscf_all_modes(:,:,:,:,mode)
|
||||
CALL adddvhubscf (ipert, ik)
|
||||
ENDIF
|
||||
!
|
||||
! calculate elphmat(j,i)=<psi_{k+q,j}|dvscf_q*psi_{k,i}> for this pertur
|
||||
!
|
||||
DO ibnd = ibnd_fst, ibnd_lst
|
||||
|
@ -449,15 +498,98 @@ SUBROUTINE elphel (irr, npe, imode0, dvscfins)
|
|||
DEALLOCATE (elphmat)
|
||||
DEALLOCATE (aux1)
|
||||
DEALLOCATE (aux2)
|
||||
IF ( dffts%have_task_groups ) THEN
|
||||
IF ( dffts%has_task_groups ) THEN
|
||||
DEALLOCATE( tg_dv )
|
||||
DEALLOCATE( tg_psic )
|
||||
ENDIF
|
||||
!
|
||||
IF (lda_plus_u) THEN
|
||||
DEALLOCATE (dnsscf_all_modes)
|
||||
DEALLOCATE (dnsscf)
|
||||
ENDIF
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE elphel
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
!------------------------------------------------------------------------
|
||||
SUBROUTINE elphel_read_dnsscf_check()
|
||||
!
|
||||
! DFPT+U: This subroutine checks whether dnsscf_all_modes was
|
||||
! read correctly from file.
|
||||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE ions_base, ONLY : nat, ityp
|
||||
USE modes, ONLY : u, nmodes
|
||||
USE lsda_mod, ONLY : nspin
|
||||
USE ldaU, ONLY : Hubbard_l, is_hubbard, Hubbard_lmax
|
||||
USE ldaU_ph, ONLY : dnsscf_all_modes
|
||||
USE io_global, ONLY : stdout
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
COMPLEX(DP), ALLOCATABLE :: dnsscf_all_modes_cart(:,:,:,:,:)
|
||||
INTEGER :: na_icart, nah, is, m1, m2, na, icart, nt, na_icar, imode
|
||||
!
|
||||
ALLOCATE(dnsscf_all_modes_cart (2*Hubbard_lmax+1, 2*Hubbard_lmax+1, nspin, nat, nmodes))
|
||||
dnsscf_all_modes_cart = (0.d0, 0.d0)
|
||||
!
|
||||
! Transform dnsscf_all_modes from pattern to cartesian coordinates
|
||||
!
|
||||
DO na_icart = 1, 3*nat
|
||||
DO imode = 1, nmodes
|
||||
DO nah = 1, nat
|
||||
nt = ityp(nah)
|
||||
IF (is_hubbard(nt)) THEN
|
||||
DO is = 1, nspin
|
||||
DO m1 = 1, 2*Hubbard_l(nt) + 1
|
||||
DO m2 = 1, 2*Hubbard_l(nt) + 1
|
||||
!
|
||||
dnsscf_all_modes_cart (m1, m2, is, nah, na_icart) = &
|
||||
dnsscf_all_modes_cart (m1, m2, is, nah, na_icart) + &
|
||||
dnsscf_all_modes (m1, m2, is, nah, imode) * &
|
||||
CONJG(u(na_icart,imode))
|
||||
!
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
!
|
||||
! Write dnsscf in cartesian coordinates
|
||||
!
|
||||
WRITE(stdout,*)
|
||||
WRITE(stdout,*) 'DNS_SCF SYMMETRIZED IN CARTESIAN COORDINATES'
|
||||
!
|
||||
DO na = 1, nat
|
||||
DO icart = 1, 3
|
||||
WRITE( stdout,'(a,1x,i2,2x,a,1x,i2)') 'displaced atom L =', na, 'ipol=', icart
|
||||
na_icart = 3*(na-1) + icart
|
||||
DO nah = 1, nat
|
||||
nt = ityp(nah)
|
||||
IF (is_hubbard(nt)) THEN
|
||||
DO is = 1, nspin
|
||||
WRITE(stdout,'(a,1x,i2,2x,a,1x,i2)') ' Hubbard atom', nah, 'spin', is
|
||||
DO m1 = 1, 2*Hubbard_l(nt) + 1
|
||||
WRITE(stdout,'(14(f15.10,1x))') dnsscf_all_modes_cart (m1,:,is,nah,na_icart)
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
WRITE(stdout,*)
|
||||
!
|
||||
DEALLOCATE(dnsscf_all_modes_cart)
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE elphel_read_dnsscf_check
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
SUBROUTINE elphsum ( )
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
|
@ -481,14 +613,13 @@ SUBROUTINE elphsum ( )
|
|||
USE modes, ONLY : u, nirr
|
||||
USE dynmat, ONLY : dyn, w2
|
||||
USE io_global, ONLY : stdout, ionode, ionode_id
|
||||
USE xml_io_base, ONLY : create_directory
|
||||
USE mp_pools, ONLY : my_pool_id, npool, kunit
|
||||
USE mp_images, ONLY : intra_image_comm
|
||||
USE mp, ONLY : mp_bcast
|
||||
USE control_ph, ONLY : tmp_dir_phq, xmldyn, current_iq
|
||||
USE save_ph, ONLY : tmp_dir_save
|
||||
USE io_files, ONLY : prefix, tmp_dir, seqopn
|
||||
|
||||
USE io_files, ONLY : prefix, tmp_dir, seqopn, create_directory
|
||||
!
|
||||
USE lr_symm_base, ONLY : minus_q, nsymq, rtau
|
||||
USE qpoint, ONLY : xq, nksq
|
||||
USE control_lr, ONLY : lgamma
|
||||
|
@ -523,7 +654,7 @@ SUBROUTINE elphsum ( )
|
|||
COMPLEX(DP) :: dyn22(3*nat,3*nat)
|
||||
!
|
||||
INTEGER :: ik, ikk, ikq, isig, ibnd, jbnd, ipert, jpert, nu, mu, &
|
||||
vu, ngauss1, nsig, iuelph, ios, i,k,j, ii, jj
|
||||
vu, ngauss1, iuelph, ios, i,k,j, ii, jj
|
||||
INTEGER :: nkBZ, nti, ntj, ntk, nkr, itemp1, itemp2, nn, &
|
||||
qx,qy,qz,iq,jq,kq
|
||||
INTEGER, ALLOCATABLE :: eqBZ(:), sBZ(:)
|
||||
|
@ -559,13 +690,12 @@ SUBROUTINE elphsum ( )
|
|||
IF (.NOT.exst) CALL create_directory( elph_dir )
|
||||
WRITE (6, '(5x,"electron-phonon interaction ..."/)')
|
||||
ngauss1 = 0
|
||||
nsig =el_ph_nsigma
|
||||
|
||||
ALLOCATE(xk_collect(3,nkstot))
|
||||
|
||||
ALLOCATE(deg(nsig))
|
||||
ALLOCATE(effit(nsig))
|
||||
ALLOCATE(dosfit(nsig))
|
||||
ALLOCATE(deg(el_ph_nsigma))
|
||||
ALLOCATE(effit(el_ph_nsigma))
|
||||
ALLOCATE(dosfit(el_ph_nsigma))
|
||||
|
||||
IF (npool==1) THEN
|
||||
!
|
||||
|
@ -645,7 +775,7 @@ SUBROUTINE elphsum ( )
|
|||
etfit_dist => etfit
|
||||
#endif
|
||||
!
|
||||
do isig=1,nsig
|
||||
do isig=1,el_ph_nsigma
|
||||
!
|
||||
! recalculate Ef = effit and DOS at Ef N(Ef) = dosfit using dense grid
|
||||
! for value "deg" of gaussian broadening
|
||||
|
@ -726,7 +856,7 @@ SUBROUTINE elphsum ( )
|
|||
nk1,nk2,nk3, nks_real, xk_collect, 2, nkBZ, eqBZ, sBZ)
|
||||
END IF
|
||||
!
|
||||
allocate (gf(3*nat,3*nat,nsig))
|
||||
allocate (gf(3*nat,3*nat,el_ph_nsigma))
|
||||
gf = (0.0d0,0.0d0)
|
||||
!
|
||||
wqa = 1.0d0/nkfit
|
||||
|
@ -776,7 +906,7 @@ SUBROUTINE elphsum ( )
|
|||
!
|
||||
CALL clinear(nk1,nk2,nk3,nti,ntj,ntk,point,noint)
|
||||
!
|
||||
do isig = 1, nsig
|
||||
do isig = 1, el_ph_nsigma
|
||||
degauss1 = deg(isig)
|
||||
do ik=1,nkfit
|
||||
etk = etfit(ibnd,eqkfit(ik)+nksfit*(ispin-1)/2)
|
||||
|
@ -803,10 +933,10 @@ SUBROUTINE elphsum ( )
|
|||
deallocate (etfit)
|
||||
deallocate (eqBZ, sBZ)
|
||||
!
|
||||
allocate (gam(3*nat,nsig), lamb(3*nat,nsig))
|
||||
allocate (gam(3*nat,el_ph_nsigma), lamb(3*nat,el_ph_nsigma))
|
||||
lamb(:,:) = 0.0d0
|
||||
gam (:,:) = 0.0d0
|
||||
do isig= 1,nsig
|
||||
do isig= 1, el_ph_nsigma
|
||||
do nu = 1,3*nat
|
||||
gam(nu,isig) = 0.0d0
|
||||
do mu = 1, 3 * nat
|
||||
|
@ -841,7 +971,7 @@ SUBROUTINE elphsum ( )
|
|||
enddo !nu
|
||||
enddo ! isig
|
||||
!
|
||||
do isig= 1,nsig
|
||||
do isig= 1,el_ph_nsigma
|
||||
WRITE (6, 9000) deg(isig), ngauss1
|
||||
WRITE (6, 9005) dosfit(isig), effit(isig) * rytoev
|
||||
do nu=1,3*nat
|
||||
|
@ -855,10 +985,10 @@ SUBROUTINE elphsum ( )
|
|||
open(unit=12, file=TRIM(name), form='formatted', status='unknown', &
|
||||
iostat=ios)
|
||||
|
||||
write(12, "(5x,3f14.6,2i6)") xq(1),xq(2),xq(3), nsig, 3*nat
|
||||
write(12, "(5x,3f14.6,2i6)") xq(1),xq(2),xq(3), el_ph_nsigma, 3*nat
|
||||
write(12, "(6e14.6)") (w2(i), i=1,3*nat)
|
||||
|
||||
do isig= 1,nsig
|
||||
do isig= 1, el_ph_nsigma
|
||||
WRITE (12, 9000) deg(isig), ngauss1
|
||||
WRITE (12, 9005) dosfit(isig), effit(isig) * rytoev
|
||||
do nu=1,3*nat
|
||||
|
@ -878,7 +1008,7 @@ SUBROUTINE elphsum ( )
|
|||
!
|
||||
call star_q (xq, at, bg, nsym, s, invs, nq, sxq, isq, imq, .TRUE. )
|
||||
!
|
||||
do isig=1,nsig
|
||||
do isig=1,el_ph_nsigma
|
||||
name=TRIM(elph_dir)//'a2Fq2r.'// TRIM(int_to_char(50 + isig)) &
|
||||
//'.'//TRIM(int_to_char(current_iq))
|
||||
if (ionode) then
|
||||
|
@ -1180,7 +1310,7 @@ SUBROUTINE elphsum_simple
|
|||
REAL(DP), PARAMETER :: eps = 20_dp/ry_to_cmm1 ! eps = 20 cm^-1, in Ry
|
||||
!
|
||||
INTEGER :: ik, ikk, ikq, isig, ibnd, jbnd, ipert, jpert, nu, mu, &
|
||||
vu, ngauss1, nsig, iuelph, ios, irr
|
||||
vu, ngauss1, iuelph, ios, irr
|
||||
INTEGER :: nmodes
|
||||
REAL(DP) :: weight, w0g1, w0g2, w0gauss, wgauss, degauss1, dosef, &
|
||||
ef1, phase_space, lambda, gamma
|
||||
|
@ -1218,7 +1348,7 @@ SUBROUTINE elphsum_simple
|
|||
CALL errore ('elphsum_simple', 'opening file '//filelph, ABS (ios) )
|
||||
|
||||
IF (ionode) THEN
|
||||
WRITE (iuelph, '(3f15.8,2i8)') xq, nsig, 3 * nat
|
||||
WRITE (iuelph, '(3f15.8,2i8)') xq, el_ph_nsigma, 3 * nat
|
||||
WRITE (iuelph, '(6e14.6)') (w2 (nu) , nu = 1, nmodes)
|
||||
ENDIF
|
||||
|
||||
|
@ -1354,6 +1484,305 @@ SUBROUTINE elphsum_simple
|
|||
|
||||
END SUBROUTINE elphsum_simple
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
SUBROUTINE elphfil_epa(iq)
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
! EPA (electron-phonon-averaged) approximation
|
||||
! Writes electron-phonon matrix elements to a file
|
||||
! Written by Georgy Samsonidze on 2015-01-28
|
||||
!
|
||||
! Adv. Energy Mater. 2018, 1800246
|
||||
! doi:10.1002/aenm.201800246
|
||||
! https://doi.org/10.1002/aenm.201800246
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
USE cell_base, ONLY : ibrav, alat, omega, tpiba, at, bg
|
||||
USE disp, ONLY : nq1, nq2, nq3, nqs, x_q, wq, lgamma_iq
|
||||
USE dynmat, ONLY : dyn, w2
|
||||
USE el_phon, ONLY : el_ph_mat, done_elph
|
||||
USE fft_base, ONLY : dfftp, dffts, dfftb
|
||||
USE gvect, ONLY : ngm_g, ecutrho
|
||||
USE io_global, ONLY : ionode, ionode_id
|
||||
USE ions_base, ONLY : nat, nsp, atm, ityp, tau
|
||||
USE kinds, ONLY : DP
|
||||
USE klist, ONLY : xk, wk, nelec, nks, nkstot, ngk
|
||||
USE lsda_mod, ONLY : nspin, isk
|
||||
USE modes, ONLY : nirr, nmodes, npert, npertx, u, t, tmq, &
|
||||
name_rap_mode, num_rap_mode
|
||||
USE lr_symm_base, ONLY : irgq, nsymq, irotmq, rtau, gi, gimq, &
|
||||
minus_q, invsymq
|
||||
USE mp, ONLY : mp_bcast, mp_sum
|
||||
USE mp_images, ONLY : intra_image_comm
|
||||
USE mp_pools, ONLY : npool, intra_pool_comm
|
||||
USE qpoint, ONLY : nksq, nksqtot, ikks, ikqs, eigqts
|
||||
USE start_k, ONLY : nk1, nk2, nk3, k1, k2, k3
|
||||
USE symm_base, ONLY : s, invs, ft, nrot, nsym, nsym_ns, &
|
||||
nsym_na, ft, sr, sname, t_rev, irt, time_reversal, &
|
||||
invsym, nofrac, allfrac, nosym, nosym_evc, no_t_rev
|
||||
USE wvfct, ONLY : nbnd, et, wg
|
||||
USE gvecw, ONLY : ecutwfc
|
||||
USE io_files, ONLY : prefix
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER, INTENT(IN) :: iq
|
||||
|
||||
INTEGER :: iuelph, ios, irr, ii, jj, kk, ll
|
||||
character :: cdate*9, ctime*9, sdate*32, stime*32, &
|
||||
stitle*32, myaccess*10, mystatus*7
|
||||
CHARACTER(LEN=80) :: filelph
|
||||
|
||||
REAL(DP), ALLOCATABLE :: xk_collect(:,:), wk_collect(:)
|
||||
REAL(DP), ALLOCATABLE :: et_collect(:,:), wg_collect(:,:)
|
||||
INTEGER, ALLOCATABLE :: ngk_collect(:)
|
||||
INTEGER, ALLOCATABLE :: ikks_collect(:), ikqs_collect(:)
|
||||
COMPLEX(DP), ALLOCATABLE :: el_ph_mat_collect(:,:,:,:)
|
||||
INTEGER :: ftau(3,48)
|
||||
INTEGER, EXTERNAL :: find_free_unit, atomic_number
|
||||
|
||||
filelph = TRIM(prefix) // '.epa.k'
|
||||
|
||||
DO irr = 1, nirr
|
||||
IF (.NOT. done_elph(irr)) RETURN
|
||||
ENDDO
|
||||
|
||||
IF (iq .EQ. 1) THEN
|
||||
myaccess = 'sequential'
|
||||
mystatus = 'replace'
|
||||
ELSE
|
||||
myaccess = 'append'
|
||||
mystatus = 'old'
|
||||
ENDIF
|
||||
IF (ionode) THEN
|
||||
iuelph = find_free_unit()
|
||||
OPEN(unit = iuelph, file = TRIM(filelph), form = 'unformatted', &
|
||||
access = myaccess, status = mystatus, iostat = ios)
|
||||
ELSE
|
||||
iuelph = 0
|
||||
ENDIF
|
||||
CALL mp_bcast(ios, ionode_id, intra_image_comm)
|
||||
CALL errore('elphfil_epa', 'opening file ' // filelph, ABS(ios))
|
||||
|
||||
IF (iq .EQ. 1) THEN
|
||||
CALL date_and_tim(cdate, ctime)
|
||||
WRITE(sdate, '(A2,"-",A3,"-",A4,21X)') cdate(1:2), cdate(3:5), cdate(6:9)
|
||||
WRITE(stime, '(A8,24X)') ctime(1:8)
|
||||
WRITE(stitle, '("EPA-Complex",21X)')
|
||||
CALL cryst_to_cart(nqs, x_q, at, -1)
|
||||
! write header
|
||||
IF (ionode) THEN
|
||||
WRITE(iuelph) stitle, sdate, stime
|
||||
WRITE(iuelph) ibrav, nat, nsp, nrot, nsym, nsym_ns, nsym_na, &
|
||||
ngm_g, nspin, nbnd, nmodes, nqs
|
||||
WRITE(iuelph) nq1, nq2, nq3, nk1, nk2, nk3, k1, k2, k3
|
||||
WRITE(iuelph) time_reversal, invsym, nofrac, allfrac, nosym, &
|
||||
nosym_evc, no_t_rev
|
||||
WRITE(iuelph) alat, omega, tpiba, nelec, ecutrho, ecutwfc
|
||||
WRITE(iuelph) dfftp%nr1, dfftp%nr2, dfftp%nr3
|
||||
WRITE(iuelph) dffts%nr1, dffts%nr2, dffts%nr3
|
||||
WRITE(iuelph) dfftb%nr1, dfftb%nr2, dfftb%nr3
|
||||
WRITE(iuelph) ((at(ii, jj), ii = 1, 3), jj = 1, 3)
|
||||
WRITE(iuelph) ((bg(ii, jj), ii = 1, 3), jj = 1, 3)
|
||||
WRITE(iuelph) (atomic_number(atm(ii)), ii = 1, nsp)
|
||||
WRITE(iuelph) (ityp(ii), ii = 1, nat)
|
||||
WRITE(iuelph) ((tau(ii, jj), ii = 1, 3), jj = 1, nat)
|
||||
WRITE(iuelph) ((x_q(ii, jj), ii = 1, 3), jj = 1, nqs)
|
||||
WRITE(iuelph) (wq(ii), ii = 1, nqs)
|
||||
WRITE(iuelph) (lgamma_iq(ii), ii = 1, nqs)
|
||||
ENDIF
|
||||
CALL cryst_to_cart(nqs, x_q, bg, 1)
|
||||
ENDIF
|
||||
|
||||
! collect data for current q-point
|
||||
ALLOCATE(xk_collect(3, nkstot))
|
||||
ALLOCATE(wk_collect(nkstot))
|
||||
ALLOCATE(et_collect(nbnd, nkstot))
|
||||
ALLOCATE(wg_collect(nbnd, nkstot))
|
||||
ALLOCATE(ngk_collect(nkstot))
|
||||
ALLOCATE(ikks_collect(nksqtot))
|
||||
ALLOCATE(ikqs_collect(nksqtot))
|
||||
ALLOCATE(el_ph_mat_collect(nbnd, nbnd, nksqtot, nmodes))
|
||||
IF (npool > 1) THEN
|
||||
CALL poolcollect(3, nks, xk, nkstot, xk_collect)
|
||||
CALL poolcollect(1, nks, wk, nkstot, wk_collect)
|
||||
CALL poolcollect(nbnd, nks, et, nkstot, et_collect)
|
||||
CALL poolcollect(nbnd, nks, wg, nkstot, wg_collect)
|
||||
CALL ipoolcollect(1, nks, ngk, nkstot, ngk_collect)
|
||||
CALL jpoolcollect(1, nksq, ikks, nksqtot, ikks_collect)
|
||||
CALL jpoolcollect(1, nksq, ikqs, nksqtot, ikqs_collect)
|
||||
CALL el_ph_collect(nmodes, el_ph_mat, el_ph_mat_collect, nksqtot, nksq)
|
||||
ELSE
|
||||
xk_collect(1:3, 1:nks) = xk(1:3, 1:nks)
|
||||
wk_collect(1:nks) = wk(1:nks)
|
||||
et_collect(1:nbnd, 1:nks) = et(1:nbnd, 1:nks)
|
||||
wg_collect(1:nbnd, 1:nks) = wg(1:nbnd, 1:nks)
|
||||
ngk_collect(1:nks) = ngk(1:nks)
|
||||
ikks_collect(1:nksq) = ikks(1:nksq)
|
||||
ikqs_collect(1:nksq) = ikqs(1:nksq)
|
||||
el_ph_mat_collect(1:nbnd, 1:nbnd, 1:nksq, 1:nmodes) = &
|
||||
el_ph_mat(1:nbnd, 1:nbnd, 1:nksq, 1:nmodes)
|
||||
ENDIF
|
||||
CALL cryst_to_cart(nkstot, xk_collect, at, -1)
|
||||
! write data for current q-point
|
||||
IF (ionode) THEN
|
||||
WRITE(iuelph) nsymq, irotmq, nirr, npertx, nkstot, nksqtot
|
||||
WRITE(iuelph) minus_q, invsymq
|
||||
WRITE(iuelph) (irgq(ii), ii = 1, 48)
|
||||
WRITE(iuelph) (npert(ii), ii = 1, nmodes)
|
||||
WRITE(iuelph) (((rtau(ii, jj, kk), ii = 1, 3), jj = 1, 48), &
|
||||
kk = 1, nat)
|
||||
WRITE(iuelph) ((gi(ii, jj), ii = 1, 3), jj = 1, 48)
|
||||
WRITE(iuelph) (gimq(ii), ii = 1, 3)
|
||||
WRITE(iuelph) ((u(ii, jj), ii = 1, nmodes), jj = 1, nmodes)
|
||||
WRITE(iuelph) ((((t(ii, jj, kk, ll), ii = 1, npertx), &
|
||||
jj = 1, npertx), kk = 1, 48), ll = 1, nmodes)
|
||||
WRITE(iuelph) (((tmq(ii, jj, kk), ii = 1, npertx), &
|
||||
jj = 1, npertx), kk = 1, nmodes)
|
||||
WRITE(iuelph) (name_rap_mode(ii), ii = 1, nmodes)
|
||||
WRITE(iuelph) (num_rap_mode(ii), ii = 1, nmodes)
|
||||
WRITE(iuelph) (((s(ii, jj, kk), ii = 1, 3), jj = 1, 3), kk = 1, 48)
|
||||
WRITE(iuelph) (invs(ii), ii = 1, 48)
|
||||
! FIXME: should disappear
|
||||
ftau(1,1:48) = NINT(ft(1,1:48)*dfftp%nr1)
|
||||
ftau(2,1:48) = NINT(ft(2,1:48)*dfftp%nr2)
|
||||
ftau(3,1:48) = NINT(ft(3,1:48)*dfftp%nr3)
|
||||
WRITE(iuelph) ((ftau(ii, jj), ii = 1, 3), jj = 1, 48)
|
||||
! end FIXME
|
||||
WRITE(iuelph) ((ft(ii, jj), ii = 1, 3), jj = 1, 48)
|
||||
WRITE(iuelph) (((sr(ii, jj, kk), ii = 1, 3), jj = 1, 3), kk = 1, 48)
|
||||
WRITE(iuelph) (sname(ii), ii = 1, 48)
|
||||
WRITE(iuelph) (t_rev(ii), ii = 1, 48)
|
||||
WRITE(iuelph) ((irt(ii, jj), ii = 1, 48), jj = 1, nat)
|
||||
WRITE(iuelph) ((xk_collect(ii, jj), ii = 1, 3), jj = 1, nkstot)
|
||||
WRITE(iuelph) (wk_collect(ii), ii = 1, nkstot)
|
||||
WRITE(iuelph) ((et_collect(ii, jj), ii = 1, nbnd), jj = 1, nkstot)
|
||||
WRITE(iuelph) ((wg_collect(ii, jj), ii = 1, nbnd), jj = 1, nkstot)
|
||||
WRITE(iuelph) (isk(ii), ii = 1, nkstot)
|
||||
WRITE(iuelph) (ngk_collect(ii), ii = 1, nkstot)
|
||||
WRITE(iuelph) (ikks_collect(ii), ii = 1, nksqtot)
|
||||
WRITE(iuelph) (ikqs_collect(ii), ii = 1, nksqtot)
|
||||
WRITE(iuelph) (eigqts(ii), ii = 1, nat)
|
||||
WRITE(iuelph) (w2(ii), ii = 1, nmodes)
|
||||
WRITE(iuelph) ((dyn(ii, jj), ii = 1, nmodes), jj = 1, nmodes)
|
||||
WRITE(iuelph) ((((el_ph_mat_collect(ii, jj, kk, ll), ii = 1, nbnd), &
|
||||
jj = 1, nbnd), kk = 1, nksqtot), ll = 1, nmodes)
|
||||
CLOSE (unit = iuelph, status = 'keep')
|
||||
ENDIF
|
||||
CALL cryst_to_cart(nkstot, xk_collect, bg, 1)
|
||||
DEALLOCATE(xk_collect)
|
||||
DEALLOCATE(wk_collect)
|
||||
DEALLOCATE(et_collect)
|
||||
DEALLOCATE(wg_collect)
|
||||
DEALLOCATE(ngk_collect)
|
||||
DEALLOCATE(ikks_collect)
|
||||
DEALLOCATE(ikqs_collect)
|
||||
DEALLOCATE(el_ph_mat_collect)
|
||||
|
||||
RETURN
|
||||
|
||||
END SUBROUTINE elphfil_epa
|
||||
|
||||
!----------------------------------------------------------------------------
|
||||
SUBROUTINE ipoolcollect( length, nks, f_in, nkstot, f_out )
|
||||
!----------------------------------------------------------------------------
|
||||
!
|
||||
! ... as poolcollect, for an integer vector
|
||||
!
|
||||
USE mp_pools, ONLY : my_pool_id, npool, kunit, &
|
||||
inter_pool_comm, intra_pool_comm
|
||||
USE mp, ONLY : mp_sum
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
INTEGER, INTENT(IN) :: length, nks, nkstot
|
||||
! first dimension of arrays
|
||||
! number of k-points per pool
|
||||
! total number of k-points
|
||||
INTEGER, INTENT(IN) :: f_in (length,nks)
|
||||
! pool-distributed function
|
||||
INTEGER, INTENT(OUT) :: f_out(length,nkstot)
|
||||
! pool-collected function
|
||||
!
|
||||
INTEGER :: nbase, rest, nks1
|
||||
!
|
||||
nks1 = kunit * ( nkstot / kunit / npool )
|
||||
!
|
||||
rest = ( nkstot - nks1 * npool ) / kunit
|
||||
!
|
||||
IF ( ( my_pool_id + 1 ) <= rest ) nks1 = nks1 + kunit
|
||||
!
|
||||
IF (nks1.ne.nks) &
|
||||
call errore('ipoolcollect','inconsistent number of k-points',1)
|
||||
!
|
||||
! ... calculates nbase = the position in the list of the first point that
|
||||
! ... belong to this npool - 1
|
||||
!
|
||||
nbase = nks * my_pool_id
|
||||
!
|
||||
IF ( ( my_pool_id + 1 ) > rest ) nbase = nbase + rest * kunit
|
||||
!
|
||||
! copy the original points in the correct position of the list
|
||||
!
|
||||
f_out=0
|
||||
f_out(:,nbase+1:nbase+nks) = f_in(:,1:nks)
|
||||
!
|
||||
CALL mp_sum( f_out, inter_pool_comm )
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE ipoolcollect
|
||||
|
||||
!----------------------------------------------------------------------------
|
||||
SUBROUTINE jpoolcollect( length, nks, f_in, nkstot, f_out )
|
||||
!----------------------------------------------------------------------------
|
||||
!
|
||||
! ... as ipoolcollect, without kunit and with an index shift
|
||||
!
|
||||
USE mp_pools, ONLY : my_pool_id, npool, kunit, &
|
||||
inter_pool_comm, intra_pool_comm
|
||||
USE mp, ONLY : mp_sum
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
INTEGER, INTENT(IN) :: length, nks, nkstot
|
||||
! first dimension of arrays
|
||||
! number of k-points per pool
|
||||
! total number of k-points
|
||||
INTEGER, INTENT(IN) :: f_in (length,nks)
|
||||
! pool-distributed function
|
||||
INTEGER, INTENT(OUT) :: f_out(length,nkstot)
|
||||
! pool-collected function
|
||||
!
|
||||
INTEGER :: nbase, rest, nks1
|
||||
!
|
||||
nks1 = ( nkstot / npool )
|
||||
!
|
||||
rest = ( nkstot - nks1 * npool )
|
||||
!
|
||||
IF ( ( my_pool_id + 1 ) <= rest ) nks1 = nks1 + 1
|
||||
!
|
||||
IF (nks1.ne.nks) &
|
||||
call errore('jpoolcollect','inconsistent number of k-points',1)
|
||||
!
|
||||
! ... calculates nbase = the position in the list of the first point that
|
||||
! ... belong to this npool - 1
|
||||
!
|
||||
nbase = nks * my_pool_id
|
||||
!
|
||||
IF ( ( my_pool_id + 1 ) > rest ) nbase = nbase + rest
|
||||
!
|
||||
! copy the original points in the correct position of the list
|
||||
!
|
||||
f_out=0
|
||||
f_out(:,nbase+1:nbase+nks) = f_in(:,1:nks) + nbase * kunit
|
||||
!
|
||||
CALL mp_sum( f_out, inter_pool_comm )
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE jpoolcollect
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
FUNCTION dos_ef (ngauss, degauss, ef, et, wk, nks, nbnd)
|
||||
!-----------------------------------------------------------------------
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
!
|
||||
! Copyright (C) 2001-2016 Quantum ESPRESSO group
|
||||
! Copyright (C) 2001-2018 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,
|
||||
|
@ -17,17 +17,16 @@ SUBROUTINE phq_readin()
|
|||
!
|
||||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE parameters, ONLY : nsx
|
||||
USE ions_base, ONLY : nat, ntyp => nsp
|
||||
USE mp, ONLY : mp_bcast
|
||||
USE mp_world, ONLY : world_comm
|
||||
USE ions_base, ONLY : amass, atm
|
||||
USE input_parameters, ONLY : max_seconds, nk1, nk2, nk3, k1, k2, k3
|
||||
USE check_stop, ONLY : max_seconds
|
||||
USE start_k, ONLY : reset_grid
|
||||
USE klist, ONLY : xk, nks, nkstot, lgauss, two_fermi_energies, ltetra
|
||||
USE control_flags, ONLY : gamma_only, tqr, restart, lkpoint_dir, io_level, &
|
||||
ts_vdw
|
||||
USE funct, ONLY : dft_is_nonlocc, dft_is_hybrid
|
||||
USE control_flags, ONLY : gamma_only, tqr, restart, io_level, &
|
||||
ts_vdw, ldftd3, lxdm, isolve
|
||||
USE funct, ONLY : dft_is_meta, dft_is_hybrid
|
||||
USE uspp, ONLY : okvan
|
||||
USE fixed_occ, ONLY : tfixed_occ
|
||||
USE lsda_mod, ONLY : lsda, nspin
|
||||
|
@ -43,42 +42,38 @@ SUBROUTINE phq_readin()
|
|||
ext_recover, ext_restart, u_from_file, ldiag, &
|
||||
search_sym, lqdir, electron_phonon, tmp_dir_phq, &
|
||||
rec_code_read, qplot, only_init, only_wfc, &
|
||||
low_directory_check
|
||||
|
||||
low_directory_check, nk1, nk2, nk3, k1, k2, k3
|
||||
USE save_ph, ONLY : tmp_dir_save, save_ph_input_variables
|
||||
USE gamma_gamma, ONLY : asr
|
||||
USE partial, ONLY : atomo, nat_todo, nat_todo_input
|
||||
USE output, ONLY : fildyn, fildvscf, fildrho
|
||||
USE disp, ONLY : nq1, nq2, nq3, x_q, wq, nqs, lgamma_iq
|
||||
USE io_files, ONLY : tmp_dir, prefix
|
||||
USE io_files, ONLY : tmp_dir, prefix, postfix, create_directory, &
|
||||
check_tempdir, xmlpun_schema
|
||||
USE noncollin_module, ONLY : i_cons, noncolin
|
||||
USE ldaU, ONLY : lda_plus_u
|
||||
USE control_flags, ONLY : iverbosity, modenum, twfcollect
|
||||
USE control_flags, ONLY : iverbosity, modenum
|
||||
USE io_global, ONLY : meta_ionode, meta_ionode_id, ionode, ionode_id, stdout
|
||||
USE mp_images, ONLY : nimage, my_image_id, intra_image_comm, &
|
||||
me_image, nproc_image
|
||||
USE mp_global, ONLY : nproc_pool_file, &
|
||||
nproc_bgrp_file, nproc_image_file
|
||||
USE mp_pools, ONLY : nproc_pool, npool
|
||||
USE mp_bands, ONLY : nproc_bgrp, ntask_groups
|
||||
USE mp_pools, ONLY : npool
|
||||
USE paw_variables, ONLY : okpaw
|
||||
USE ramanm, ONLY : eth_rps, eth_ns, lraman, elop, dek
|
||||
USE freq_ph, ONLY : fpol, fiu, nfs
|
||||
USE cryst_ph, ONLY : magnetic_sym
|
||||
USE ph_restart, ONLY : ph_readfile
|
||||
USE xml_io_base, ONLY : create_directory
|
||||
USE el_phon, ONLY : elph,elph_mat,elph_simple,elph_nbnd_min, elph_nbnd_max, &
|
||||
USE el_phon, ONLY : elph,elph_mat,elph_simple,elph_epa,elph_nbnd_min, elph_nbnd_max, &
|
||||
el_ph_sigma, el_ph_nsigma, el_ph_ngauss,auxdvscf
|
||||
USE dfile_star, ONLY : drho_star, dvscf_star
|
||||
|
||||
USE qpoint, ONLY : nksq, xq
|
||||
USE control_lr, ONLY : lgamma, lrpa
|
||||
|
||||
! YAMBO >
|
||||
USE YAMBO, ONLY : elph_yambo,dvscf_yambo
|
||||
! YAMBO <
|
||||
USE elph_tetra_mod,ONLY : elph_tetra, lshift_q, in_alpha2f
|
||||
USE ktetra, ONLY : tetra_type
|
||||
USE ldaU, ONLY : lda_plus_u, U_projection, lda_plus_u_kind
|
||||
USE ldaU_ph, ONLY : read_dns_bare, d2ns_type
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
@ -90,7 +85,7 @@ SUBROUTINE phq_readin()
|
|||
! counter on iterations
|
||||
! counter on atoms
|
||||
! counter on types
|
||||
REAL(DP) :: amass_input(nsx)
|
||||
REAL(DP), ALLOCATABLE :: amass_input(:)
|
||||
! save masses read from input here
|
||||
CHARACTER (LEN=256) :: outdir, filename
|
||||
CHARACTER (LEN=8) :: verbosity
|
||||
|
@ -108,6 +103,7 @@ SUBROUTINE phq_readin()
|
|||
REAL(DP), ALLOCATABLE :: xqaux(:,:)
|
||||
INTEGER, ALLOCATABLE :: wqaux(:)
|
||||
INTEGER :: nqaux, iq
|
||||
CHARACTER(len=80) :: diagonalization='david'
|
||||
!
|
||||
NAMELIST / INPUTPH / tr2_ph, amass, alpha_mix, niter_ph, nmix_ph, &
|
||||
nat_todo, verbosity, iverbosity, outdir, epsil, &
|
||||
|
@ -122,7 +118,7 @@ SUBROUTINE phq_readin()
|
|||
elph_nbnd_min, elph_nbnd_max, el_ph_ngauss, &
|
||||
el_ph_nsigma, el_ph_sigma, electron_phonon, &
|
||||
q_in_band_form, q2d, qplot, low_directory_check, &
|
||||
lshift_q
|
||||
lshift_q, read_dns_bare, d2ns_type, diagonalization
|
||||
|
||||
! tr2_ph : convergence threshold
|
||||
! amass : atomic masses
|
||||
|
@ -162,9 +158,9 @@ SUBROUTINE phq_readin()
|
|||
! ldiag : if .true. force diagonalization of the dyn mat
|
||||
! lqdir : if .true. each q writes in its own directory
|
||||
! search_sym : if .true. analyze symmetry if possible
|
||||
! nk1,nk2,nk3,
|
||||
! ik1, ik2, ik3: when specified in input it uses for the phonon run
|
||||
! a different mesh than that used for the charge density.
|
||||
! nk1,nk2,nk3, k1,k2,k3 :
|
||||
! when specified in input, the phonon run uses a different
|
||||
! k-point mesh from that used for the charge density.
|
||||
!
|
||||
! dvscf_star%open : if .true. write in dvscf_star%dir the dvscf_q
|
||||
! 'for all q' in the star of q with suffix dvscf_star%ext.
|
||||
|
@ -187,6 +183,17 @@ SUBROUTINE phq_readin()
|
|||
! low_directory_check : if .true. only the requested representations
|
||||
! are searched on file
|
||||
!
|
||||
! read_dns_bare : If .true. the code tries to read three files in DFPT+U calculations:
|
||||
! dnsorth, dnsbare, d2nsbare
|
||||
! d2ns_type : DFPT+U - the 2nd bare derivative of occupation matrices ns
|
||||
! (d2ns_bare matrix). Experimental! This is why it is not documented in Doc.
|
||||
! d2ns_type='full': matrix calculated with no approximation.
|
||||
! d2ns_type='fmmp': assume a m <=> m' symmetry.
|
||||
! d2ns_type='diag': if okvan=.true. the matrix is calculated retaining only
|
||||
! for <\beta_J|\phi_I> products where for J==I.
|
||||
! d2ns_type='dmmp': same as 'diag', but also assuming a m <=> m'.
|
||||
! diagonalization : diagonalization method used in the nscf calc
|
||||
!
|
||||
! Note: meta_ionode is a single processor that reads the input
|
||||
! (ionode is also a single processor but per image)
|
||||
! Data read from input is subsequently broadcast to all processors
|
||||
|
@ -243,7 +250,7 @@ SUBROUTINE phq_readin()
|
|||
elph_nbnd_min = 1
|
||||
elph_nbnd_max = 0
|
||||
el_ph_sigma = 0.02
|
||||
el_ph_nsigma = 30
|
||||
el_ph_nsigma = 10
|
||||
el_ph_ngauss = 1
|
||||
lraman = .FALSE.
|
||||
elop = .FALSE.
|
||||
|
@ -300,6 +307,8 @@ SUBROUTINE phq_readin()
|
|||
dvscf_star%dir = TRIM(outdir)//"/Rotated_DVSCF/"
|
||||
!
|
||||
lshift_q = .false.
|
||||
read_dns_bare =.false.
|
||||
d2ns_type = 'full'
|
||||
!
|
||||
! ... reading the namelist inputph
|
||||
!
|
||||
|
@ -329,6 +338,16 @@ SUBROUTINE phq_readin()
|
|||
ELSE IF ( ABS(ios) /= 0 ) THEN
|
||||
CALL errore( 'phq_readin', 'reading inputph namelist', ABS( ios ) )
|
||||
END IF
|
||||
! diagonalization option
|
||||
SELECT CASE(TRIM(diagonalization))
|
||||
CASE ('david','davidson')
|
||||
isolve = 0
|
||||
CASE ('cg')
|
||||
isolve = 1
|
||||
CASE DEFAULT
|
||||
CALL errore('phq_readin','diagonalization '//trim(diagonalization)//' not implemented',1)
|
||||
END SELECT
|
||||
|
||||
!
|
||||
! ... broadcast all input variables
|
||||
!
|
||||
|
@ -376,20 +395,29 @@ SUBROUTINE phq_readin()
|
|||
elph=.true.
|
||||
elph_mat=.false.
|
||||
elph_simple=.true.
|
||||
elph_epa=.false.
|
||||
CASE( 'epa' )
|
||||
elph=.true.
|
||||
elph_mat=.false.
|
||||
elph_simple=.false.
|
||||
elph_epa=.true.
|
||||
CASE( 'Wannier' )
|
||||
elph=.true.
|
||||
elph_mat=.true.
|
||||
elph_simple=.false.
|
||||
elph_epa=.false.
|
||||
auxdvscf=trim(fildvscf)
|
||||
CASE( 'interpolated' )
|
||||
elph=.true.
|
||||
elph_mat=.false.
|
||||
elph_simple=.false.
|
||||
elph_epa=.false.
|
||||
! YAMBO >
|
||||
CASE( 'yambo' )
|
||||
elph=.true.
|
||||
elph_mat=.false.
|
||||
elph_simple=.false.
|
||||
elph_epa=.false.
|
||||
elph_yambo=.true.
|
||||
nogg=.true.
|
||||
auxdvscf=trim(fildvscf)
|
||||
|
@ -397,6 +425,7 @@ SUBROUTINE phq_readin()
|
|||
elph=.false.
|
||||
elph_mat=.false.
|
||||
elph_simple=.false.
|
||||
elph_epa=.false.
|
||||
elph_yambo=.false.
|
||||
dvscf_yambo=.true.
|
||||
nogg=.true.
|
||||
|
@ -424,6 +453,7 @@ SUBROUTINE phq_readin()
|
|||
elph=.false.
|
||||
elph_mat=.false.
|
||||
elph_simple=.false.
|
||||
elph_epa=.false.
|
||||
END SELECT
|
||||
! YAMBO >
|
||||
IF (.not.elph_yambo) then
|
||||
|
@ -549,13 +579,14 @@ SUBROUTINE phq_readin()
|
|||
! Here we finished the reading of the input file.
|
||||
! Now allocate space for pwscf variables, read and check them.
|
||||
!
|
||||
! amass will also be read from file:
|
||||
! amass will be read again from file:
|
||||
! save its content in auxiliary variables
|
||||
!
|
||||
ALLOCATE ( amass_input( SIZE(amass) ) )
|
||||
amass_input(:)= amass(:)
|
||||
!
|
||||
tmp_dir_save=tmp_dir
|
||||
tmp_dir_ph= TRIM (tmp_dir) // '_ph' // TRIM(int_to_char(my_image_id)) //'/'
|
||||
tmp_dir_ph= trimcheck( TRIM (tmp_dir) // '_ph' // int_to_char(my_image_id) )
|
||||
CALL check_tempdir ( tmp_dir_ph, exst, parallelfs )
|
||||
tmp_dir_phq=tmp_dir_ph
|
||||
|
||||
|
@ -583,13 +614,13 @@ SUBROUTINE phq_readin()
|
|||
! we read from there, otherwise use the information in tmp_dir.
|
||||
!
|
||||
IF (lqdir) THEN
|
||||
tmp_dir_phq= TRIM (tmp_dir_ph) //TRIM(prefix)//&
|
||||
& '.q_' // TRIM(int_to_char(current_iq))//'/'
|
||||
tmp_dir_phq= trimcheck ( TRIM(tmp_dir_ph) // TRIM(prefix) // &
|
||||
& '.q_' // int_to_char(current_iq) )
|
||||
CALL check_restart_recover(ext_recover, ext_restart)
|
||||
IF (.NOT.ext_recover.AND..NOT.ext_restart) tmp_dir_phq=tmp_dir_ph
|
||||
ENDIF
|
||||
!
|
||||
filename=TRIM(tmp_dir_phq)//TRIM(prefix)//'.save/data-file.xml'
|
||||
filename=TRIM(tmp_dir_phq)//TRIM(prefix)//postfix//xmlpun_schema
|
||||
IF (ionode) inquire (file =TRIM(filename), exist = exst)
|
||||
!
|
||||
CALL mp_bcast( exst, ionode_id, intra_image_comm )
|
||||
|
@ -637,14 +668,16 @@ SUBROUTINE phq_readin()
|
|||
WRITE(stdout, '(5x,i3, 3f14.9)') iq, x_q(1,iq), x_q(2,iq), x_q(3,iq)
|
||||
END DO
|
||||
ENDIF
|
||||
|
||||
!
|
||||
! DFPT+U: the occupation matrix ns is read via read_file
|
||||
!
|
||||
CALL read_file ( )
|
||||
|
||||
magnetic_sym=noncolin .AND. domag
|
||||
!
|
||||
! init_start_grid returns .true. if a new k-point grid is set from values
|
||||
! read from input (this happens if nk1*nk2*nk3, else it returns .false.,
|
||||
! leaves the current values, as read in read_file, unchanged)
|
||||
! read from input (this happens if nk1*nk2*nk3 > 0; otherwise reset_grid
|
||||
! returns .false., leaves the current values, read in read_file, unchanged)
|
||||
!
|
||||
newgrid = reset_grid (nk1, nk2, nk3, k1, k2, k3)
|
||||
!
|
||||
|
@ -655,14 +688,31 @@ SUBROUTINE phq_readin()
|
|||
IF (gamma_only) CALL errore('phq_readin',&
|
||||
'cannot start from pw.x data file using Gamma-point tricks',1)
|
||||
|
||||
IF (lda_plus_u) CALL errore('phq_readin',&
|
||||
'The phonon code with LDA+U is not yet available',1)
|
||||
IF (lda_plus_u) THEN
|
||||
!
|
||||
WRITE(stdout,'(/5x,a)') "Phonon calculation with DFPT+U; please cite"
|
||||
WRITE(stdout,'(5x,a)') "A. Floris et al., Phys. Rev. B 84, 161102(R) (2011)"
|
||||
WRITE(stdout,'(5x,a)') "in publications or presentations arising from this work."
|
||||
!
|
||||
IF (U_projection.NE."atomic") CALL errore("phq_readin", &
|
||||
" The phonon code for this U_projection_type is not implemented",1)
|
||||
IF (lda_plus_u_kind.NE.0) CALL errore("phq_readin", &
|
||||
" The phonon code for this lda_plus_u_kind is not implemented",1)
|
||||
IF (elph) CALL errore("phq_readin", &
|
||||
" Electron-phonon with Hubbard U is not supported",1)
|
||||
IF (lraman) CALL errore("phq_readin", &
|
||||
" The phonon code with Raman and Hubbard U is not implemented",1)
|
||||
!
|
||||
ENDIF
|
||||
|
||||
IF (ts_vdw) CALL errore('phq_readin',&
|
||||
'The phonon code with TS-VdW is not yet available',1)
|
||||
|
||||
! IF ( dft_is_nonlocc() ) CALL errore('phq_readin',&
|
||||
! 'The phonon code with non-local vdW functionals is not yet available',1)
|
||||
IF (ldftd3) CALL errore('phq_readin',&
|
||||
'The phonon code with Grimme''s DFT-D3 is not yet available',1)
|
||||
|
||||
IF ( dft_is_meta() ) CALL errore('phq_readin',&
|
||||
'The phonon code with meta-GGA functionals is not yet available',1)
|
||||
|
||||
IF ( dft_is_hybrid() ) CALL errore('phq_readin',&
|
||||
'The phonon code with hybrid functionals is not yet available',1)
|
||||
|
@ -682,18 +732,7 @@ SUBROUTINE phq_readin()
|
|||
IF (lmovecell) CALL errore('phq_readin', &
|
||||
'The phonon code is not working after vc-relax',1)
|
||||
|
||||
IF (reduce_io) io_level=0
|
||||
|
||||
IF (nproc_image /= nproc_image_file .and. .not. twfcollect .AND. .NOT. in_alpha2f) &
|
||||
CALL errore('phq_readin',&
|
||||
'pw.x run with a different number of processors. Use wf_collect=.true.',1)
|
||||
|
||||
IF (nproc_pool /= nproc_pool_file .and. .not. twfcollect .AND. .NOT. in_alpha2f) &
|
||||
CALL errore('phq_readin',&
|
||||
'pw.x run with a different number of pools. Use wf_collect=.true.',1)
|
||||
!
|
||||
IF (nproc_bgrp_file /= nproc_bgrp .AND. .NOT. twfcollect .AND. .NOT. in_alpha2f) &
|
||||
CALL errore('phq_readin','pw.x run with different band parallelization',1)
|
||||
IF (reduce_io) io_level=1
|
||||
|
||||
if(elph_mat.and.fildvscf.eq.' ') call errore('phq_readin',&
|
||||
'el-ph with wannier requires fildvscf',1)
|
||||
|
@ -714,6 +753,8 @@ SUBROUTINE phq_readin()
|
|||
IF(drho_star%open.and.nimage>1) CALL errore('phq_readin',&
|
||||
'drho_star with image parallelization is not yet available',1)
|
||||
|
||||
IF (lda_plus_u .AND. read_dns_bare .AND. ldisp) lqdir=.TRUE.
|
||||
|
||||
IF (.NOT.ldisp) lqdir=.FALSE.
|
||||
|
||||
IF (i_cons /= 0) &
|
||||
|
@ -735,12 +776,11 @@ SUBROUTINE phq_readin()
|
|||
! .xml or in the noncollinear case.
|
||||
!
|
||||
xmldyn=has_xml(fildyn)
|
||||
IF (noncolin) xmldyn=.TRUE.
|
||||
!IF (noncolin) xmldyn=.TRUE.
|
||||
!
|
||||
! If a band structure calculation needs to be done do not open a file
|
||||
! for k point
|
||||
!
|
||||
lkpoint_dir=.FALSE.
|
||||
restart = recover
|
||||
!
|
||||
! set masses to values read from input, if available;
|
||||
|
@ -752,6 +792,7 @@ SUBROUTINE phq_readin()
|
|||
IF (amass_input(it) > 0.D0) amass(it) = amass_input(it)
|
||||
IF (amass(it) <= 0.D0) CALL errore ('phq_readin', 'Wrong masses', it)
|
||||
ENDDO
|
||||
DEALLOCATE (amass_input)
|
||||
lgamma_gamma=.FALSE.
|
||||
IF (.NOT.ldisp) THEN
|
||||
IF (nkstot==1.OR.(nkstot==2.AND.nspin==2)) THEN
|
||||
|
@ -773,6 +814,7 @@ SUBROUTINE phq_readin()
|
|||
ENDIF
|
||||
ENDIF
|
||||
IF (lgamma_gamma.AND.ldiag) CALL errore('phq_readin','incompatible flags',1)
|
||||
IF (lgamma_gamma.AND.elph ) CALL errore('phq_readin','lgamma_gamma and electron-phonon are incompatible',1)
|
||||
!
|
||||
IF (tfixed_occ) &
|
||||
CALL errore('phq_readin','phonon with arbitrary occupations not tested',1)
|
||||
|
|
Loading…
Reference in New Issue