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

Debug when lifc = .true. 

epw_metal/epw2.in is now passing.
This commit is contained in:
Samuel Ponce 2019-09-11 14:27:14 +01:00
parent 45d91af273
commit e8562840aa
5 changed files with 49 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
EPW/src/elphon_shuffle.f90
View File

@ -7,7 +7,7 @@
! present distribution, or http://www.gnu.org/copyleft.gpl.txt .
!
!-----------------------------------------------------------------------
SUBROUTINE elphon_shuffle( iq_irr, nqc_irr, iq, gmapsym, eigv, isym, xq0, timerev )
SUBROUTINE elphon_shuffle(iq_irr, nqc_irr, iq, gmapsym, eigv, isym, xq0, timerev)
!-----------------------------------------------------------------------
!!
!! Electron-phonon calculation from data saved in fildvscf
@ -46,13 +46,13 @@
!! Total number of irreducible q-points in the list
INTEGER, INTENT(in) :: iq
!! Current q-point in the star of iq_irr q-point
INTEGER, INTENT(in) :: gmapsym(ngm,48)
INTEGER, INTENT(in) :: gmapsym(ngm, 48)
!! Correspondence G-->S(G)
INTEGER, INTENT(in) :: isym
!! The symmetry which generates the current q in the star
REAL(KIND = DP), INTENT(in) :: xq0(3)
!! The first q-point in the star (cartesian coords.)
COMPLEX(KIND = DP), INTENT(in) :: eigv(ngm,48)
COMPLEX(KIND = DP), INTENT(in) :: eigv(ngm, 48)
!! e^{iGv} for 1...nsym (v the fractional translation)
LOGICAL, INTENT(in) :: timerev
!! true if we are using time reversal
@ -90,10 +90,10 @@
imode0 = 0
DO irr = 1, nirr
npe = npert(irr)
ALLOCATE(dvscfin(dfftp%nnr, nspin_mag, npe) )
ALLOCATE(dvscfin(dfftp%nnr, nspin_mag, npe))
IF (okvan) THEN
ALLOCATE(int3(nhm, nhm, nat, nspin_mag, npe) )
IF (noncolin) ALLOCATE(int3_nc(nhm, nhm, nat, nspin, npe) )
ALLOCATE(int3(nhm, nhm, nat, nspin_mag, npe))
IF (noncolin) ALLOCATE(int3_nc(nhm, nhm, nat, nspin, npe))
ENDIF
!
! read the <prefix>.dvscf_q[iq] files
@ -101,7 +101,7 @@
dvscfin = czero
IF (my_pool_id == 0) THEN
DO ipert = 1, npe
CALL readdvscf( dvscfin(1,1,ipert), imode0 + ipert, iq_irr, nqc_irr )
CALL readdvscf(dvscfin(1, 1, ipert), imode0 + ipert, iq_irr, nqc_irr)
ENDDO
ENDIF
CALL mp_sum(dvscfin,inter_pool_comm)
@ -110,22 +110,22 @@
ALLOCATE(dvscfins(dffts%nnr, nspin_mag, npe) )
DO is = 1, nspin_mag
DO ipert = 1, npe
CALL fft_interpolate(dfftp, dvscfin(:,is,ipert), dffts, dvscfins(:,is,ipert))
CALL fft_interpolate(dfftp, dvscfin(:, is, ipert), dffts, dvscfins(:, is, ipert))
ENDDO
ENDDO
ELSE
dvscfins => dvscfin
ENDIF
!
CALL newdq2( dvscfin, npe, xq0, timerev )
CALL elphel2_shuffle( npe, imode0, dvscfins, gmapsym, eigv, isym, xq0, timerev )
CALL newdq2(dvscfin, npe, xq0, timerev)
CALL elphel2_shuffle(npe, imode0, dvscfins, gmapsym, eigv, isym, xq0, timerev)
!
imode0 = imode0 + npe
IF (doublegrid) DEALLOCATE(dvscfins)
DEALLOCATE(dvscfin)
IF (okvan) THEN
DEALLOCATE(int3)
IF (noncolin) DEALLOCATE(int3_nc)
DEALLOCATE(int3)
IF (noncolin) DEALLOCATE(int3_nc)
ENDIF
ENDDO
!
@ -145,11 +145,11 @@
! Here is where we calculate epmatq, it appears to be
! epmatq = cone * conjug(u) * el_ph_mat + czero
IF (timerev) THEN
CALL zgemv( 'n', nmodes, nmodes, cone, u, nmodes, &
el_ph_mat(ibnd,jbnd,ik,:), 1, czero, epmatq(ibnd,jbnd,ik,:,iq), 1 )
CALL ZGEMV('n', nmodes, nmodes, cone, u, nmodes, &
el_ph_mat(ibnd, jbnd, ik, :), 1, czero, epmatq(ibnd, jbnd, ik, :, iq), 1)
ELSE
CALL zgemv( 'n', nmodes, nmodes, cone, CONJG(u), nmodes, &
el_ph_mat(ibnd,jbnd,ik,:), 1, czero, epmatq(ibnd,jbnd,ik,:,iq), 1 )
CALL ZGEMV('n', nmodes, nmodes, cone, CONJG(u), nmodes, &
el_ph_mat(ibnd, jbnd, ik, :), 1, czero, epmatq(ibnd, jbnd, ik, :, iq), 1)
ENDIF
!
ENDDO
@ -163,4 +163,6 @@
!
CALL stop_clock('elphon_shuffle')
!
!-----------------------------------------------------------------------
END SUBROUTINE elphon_shuffle
!-----------------------------------------------------------------------

18
EPW/src/elphon_shuffle_wrap.f90
View File

@ -49,7 +49,7 @@
USE lr_symm_base, ONLY : minus_q, rtau, gi, gimq, irotmq, nsymq, invsymq
USE epwcom, ONLY : epbread, epbwrite, epwread, lifc, etf_mem, vme, &
nbndsub, iswitch, kmaps, eig_read, dvscf_dir, lpolar
USE elph2, ONLY : epmatq, dynq, et_ks, xkq, &
USE elph2, ONLY : epmatq, dynq, et_ks, xkq, ifc, &
zstar, epsi, cu, cuq, lwin, lwinq, bmat, igk_k_all, &
ngk_all, exband, wscache, umat, umat_all
USE klist_epw, ONLY : xk_all, et_loc, et_all
@ -209,6 +209,11 @@
xqc_irr(:, :) = zero
xqc(:, :) = zero
wqlist(:) = zero
IF (lifc) THEN
ALLOCATE(ifc(nq1, nq2, nq3, 3, 3, nat, nat))
ifc(:, :, :, :, :, :, :) = zero
ENDIF
!
IF (meta_ionode) THEN
DO iq_irr = 1, nqc_irr
@ -329,7 +334,9 @@
cuq(:, :, :) = czero
!
! read interatomic force constat matrix from q2r
IF (lifc) CALL read_ifc
IF (lifc) THEN
CALL read_ifc
ENDIF
!
! SP: The symmetries are now consistent with QE 5. This means that the order of the q in the star
! should be the same as in the .dyn files produced by QE 5.
@ -691,7 +698,9 @@
IF (nqc /= nq1 * nq2 * nq3) CALL errore('elphon_shuffle_wrap', 'nqc /= nq1*nq2*nq3', nqc)
wqlist = DBLE(1) / DBLE(nqc)
!
IF (lifc) DEALLOCATE(wscache)
IF (lifc) THEN
DEALLOCATE(wscache)
ENDIF
DEALLOCATE(evc)
DEALLOCATE(evq)
DEALLOCATE(xkq)
@ -824,6 +833,9 @@
#endif
ENDIF
DEALLOCATE(xqc)
IF (lifc) THEN
DEALLOCATE(ifc)
ENDIF
!
5 FORMAT (8x,"q(",i5," ) = (",3f12.7," )")
!

24
EPW/src/ephwann_shuffle.f90
View File

@ -55,7 +55,7 @@
inv_tau_allcb, zi_allcb, exband, xkfd, etfd, &
etfd_ks, gamma_v_all, esigmar_all, esigmai_all, &
a_all, a_all_ph, wscache, lambda_v_all, threshold, &
nktotf, transp_temp, xkq, lower_bnd, upper_bnd
nktotf, transp_temp, xkq, lower_bnd, upper_bnd
USE wan2bloch, ONLY : dmewan2bloch, hamwan2bloch, dynwan2bloch, &
ephwan2blochp, ephwan2bloch, vmewan2bloch, &
dynifc2blochf, vmewan2blochp
@ -440,8 +440,8 @@
!
IF (epwread .AND. .NOT. epbread) THEN
!
! read all quantities in Wannier representation from file
! in parallel case all pools read the same file
! Read all quantities in Wannier representation from file
! in parallel case all pools read the same file
CALL epw_read(nrr_k, nrr_q, nrr_g)
!
ELSE !if not epwread (i.e. need to calculate fmt file)
@ -2006,22 +2006,22 @@
IF (eig_read) CLOSE(iunksdata)
!
ENDIF
!---------------------------------
!--------------------------------------------------------------------------------
END SUBROUTINE epw_write
!---------------------------------
!---------------------------------
!--------------------------------------------------------------------------------
!--------------------------------------------------------------------------------
SUBROUTINE epw_read(nrr_k, nrr_q, nrr_g)
!---------------------------------
!--------------------------------------------------------------------------------
USE epwcom, ONLY : nbndsub, vme, eig_read, etf_mem, lifc
USE pwcom, ONLY : ef
USE elph2, ONLY : chw, rdw, epmatwp, &
cdmew, cvmew, chw_ks, zstar, epsi
USE phcom, ONLY : nq1, nq3, nq2
USE elph2, ONLY : chw, rdw, epmatwp, cdmew, cvmew, chw_ks, zstar, epsi
USE ions_base, ONLY : nat
USE phcom, ONLY : nmodes
USE io_global, ONLY : stdout
USE io_files, ONLY : prefix, diropn
USE io_epw, ONLY : epwdata, iundmedata, iunvmedata, iunksdata, iunepmatwp
USE constants_epw, ONLY : czero
USE constants_epw, ONLY : czero, zero
#if defined(__NAG)
USE f90_unix_io,ONLY : flush
#endif
@ -2142,7 +2142,9 @@
CALL mp_bcast(cdmew, ionode_id, world_comm)
ENDIF
!
IF (lifc) CALL read_ifc
IF (lifc) THEN
CALL read_ifc
ENDIF
!
IF (etf_mem == 0) THEN
ALLOCATE(epmatwp(nbndsub, nbndsub, nrr_k, nmodes, nrr_g))

14
EPW/src/readmat.f90
View File

@ -527,6 +527,7 @@
atws(:, 3) = at(:, 3) * DBLE(nq3)
! initialize WS r-vectors
CALL wsinit(rws, nrwsx, nrws, atws)
! dynifc2blochc requires ifc
CALL dynifc2blochc(nmodes, rws, nrws, q(:, 1), dynq_tmp)
dynq(:, :, iq_first) = dynq_tmp
WRITE(stdout, '(5x,a)') "Dyn mat calculated from ifcs"
@ -782,17 +783,7 @@
WRITE(stdout, '(/5x,"Reading interatomic force constants"/)')
FLUSH(stdout)
!
! This is important in restart mode as zstar etc has not been allocated
!IF (.NOT. ALLOCATED (zstar) ) ALLOCATE(zstar(3, 3, nat))
!IF (.NOT. ALLOCATED (epsi) ) ALLOCATE(epsi(3, 3))
!IF (.NOT. ALLOCATED (ifc)) ALLOCATE(ifc(nq1, nq2, nq3, 3, 3, nat, nat))
!ALLOCATE(zstar(3, 3, nat))
!ALLOCATE(epsi(3, 3))
ALLOCATE(ifc(nq1, nq2, nq3, 3, 3, nat, nat))
!zstar = 0.d0
!epsi = 0.d0
! generic name for the ifc.q2r file. If it is xml, the file will be named
! ifc.q2r.xml instead
! Generic name for the ifc.q2r file. If it is xml, the file will be named ifc.q2r.xml instead
tempfile = TRIM(dvscf_dir) // 'ifc.q2r'
! The following function will check if the file exists in xml format
CALL check_is_xml_file(tempfile, is_xml_file)
@ -888,7 +879,6 @@
CLOSE(iunifc)
ENDIF
!
DEALLOCATE(ifc)
WRITE(stdout, '(/5x,"Finished reading ifcs"/)')
!
!-------------------------------------------------------------------------------

2
EPW/src/wan2bloch.f90
View File

@ -793,7 +793,7 @@
total_weight = zero
DO n1 = -2 * nq1, 2 * nq1
DO n2= -2 * nq2, 2 * nq2
DO n3 = -2*nq3,2*nq3
DO n3 = -2 * nq3, 2 * nq3
!
! Sum over R vectors in the supercell - safe range
!