Commit 9123f441 authored by giannozz's avatar giannozz

Merge branch 'develop' into 'develop'

Select q-point extension to random grids.

See merge request !211
parents 50ed8228 145fc74d
This diff is collapsed.
...@@ -99,6 +99,8 @@ ...@@ -99,6 +99,8 @@
!! Check wheter this is the first cycle after a restart. !! Check wheter this is the first cycle after a restart.
LOGICAL :: first_time LOGICAL :: first_time
!! Check wheter this is the first timeafter a restart. !! Check wheter this is the first timeafter a restart.
LOGICAL :: homogeneous
!! Check if the k and q grids are homogenous and commensurate.
! !
CHARACTER (len=256) :: filint CHARACTER (len=256) :: filint
!! Name of the file to write/read !! Name of the file to write/read
...@@ -840,46 +842,45 @@ ...@@ -840,46 +842,45 @@
! Determines which q-points falls within the fsthick windows ! Determines which q-points falls within the fsthick windows
! Store the result in the selecq.fmt file ! Store the result in the selecq.fmt file
! If the file exists, automatically restart from the file ! If the file exists, automatically restart from the file
! This is only done in the case of homogeneous grids.
! ----------------------------------------------------------------------- ! -----------------------------------------------------------------------
!
! Check if the grids are homogeneous and commensurate
homogeneous = .FALSE.
IF ( (nkf1 /= 0) .AND. (nkf2 /= 0) .AND. (nkf3 /= 0) .AND. &
(nqf1 /= 0) .AND. (nqf2 /= 0) .AND. (nqf3 /= 0) .AND. &
(MOD(nkf1,nqf1) == 0) .AND. (MOD(nkf2,nqf2) == 0) .AND. (MOD(nkf3,nqf3) == 0) ) THEN
homogeneous = .TRUE.
ELSE
homogeneous = .FALSE.
ENDIF
!
totq = 0 totq = 0
! Check if the file has been pre-computed
IF (mpime == ionode_id) THEN
INQUIRE(FILE='selecq.fmt',EXIST=exst)
ENDIF
CALL mp_bcast(exst, ionode_id, world_comm)
! !
IF ( (nkf1 /= 0) .AND. (nkf2 /= 0) .AND. (nkf3 /= 0) .AND. (nqf1 /= 0) .AND. (nqf2 /= 0) .AND. (nqf3 /= 0) ) THEN IF (exst) THEN
! IF (selecqread) THEN
! Check if the file has been pre-computed WRITE(stdout,'(5x,a)')' '
IF (mpime == ionode_id) THEN WRITE(stdout,'(5x,a)')'Reading selecq.fmt file. '
INQUIRE(FILE='selecq.fmt',EXIST=exst) CALL qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq, homogeneous)
ELSE
WRITE(stdout,'(5x,a)')' '
WRITE(stdout,'(5x,a)')'A selecq.fmt file was found but re-created because selecqread == .false. '
CALL qwindow(.FALSE., nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq, homogeneous)
ENDIF ENDIF
CALL mp_bcast(exst, ionode_id, world_comm) ELSE ! exst
! IF (selecqread) THEN
IF (exst) THEN CALL errore( 'ephwann_shuffle', 'Variable selecqread == .true. but file selecq.fmt not found.',1 )
IF (selecqread) THEN ELSE
WRITE(stdout,'(5x,a)')' ' CALL qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq, homogeneous)
WRITE(stdout,'(5x,a)')'Reading selecq.fmt file. '
CALL qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq)
ELSE
WRITE(stdout,'(5x,a)')' '
WRITE(stdout,'(5x,a)')'A selecq.fmt file was found but re-created because selecqread == .false. '
CALL qwindow(.FALSE., nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq)
ENDIF
ELSE ! exst
IF (selecqread) THEN
CALL errore( 'ephwann_shuffle', 'Variable selecqread == .true. but file selecq.fmt not found.',1 )
ELSE
CALL qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq)
ENDIF
ENDIF ENDIF
! ENDIF
WRITE(stdout,'(5x,a,i8,a)')'We only need to compute ',totq, ' q-points' !
WRITE(stdout,'(5x,a)')' ' WRITE(stdout,'(5x,a,i8,a)')'We only need to compute ',totq, ' q-points'
ELSE WRITE(stdout,'(5x,a)')' '
! If Random points or points read from files, then take all.
totq = nqf
ALLOCATE(selecq(totq))
DO iq = 1, totq
selecq(iq) = iq
ENDDO
ENDIF ! homogeneous grids
! !
! ----------------------------------------------------------------------- ! -----------------------------------------------------------------------
! Possible restart during step 1) ! Possible restart during step 1)
......
...@@ -100,6 +100,8 @@ ...@@ -100,6 +100,8 @@
!! Check wheter this is the first cycle after a restart. !! Check wheter this is the first cycle after a restart.
LOGICAL :: first_time LOGICAL :: first_time
!! Check wheter this is the first timeafter a restart. !! Check wheter this is the first timeafter a restart.
LOGICAL :: homogeneous
!! Check if the k and q grids are homogenous and commensurate.
! !
CHARACTER (len=256) :: filint CHARACTER (len=256) :: filint
!! Name of the file to write/read !! Name of the file to write/read
...@@ -809,45 +811,46 @@ ...@@ -809,45 +811,46 @@
! Determines which q-points falls within the fsthick windows ! Determines which q-points falls within the fsthick windows
! Store the result in the selecq.fmt file ! Store the result in the selecq.fmt file
! If the file exists, automatically restart from the file ! If the file exists, automatically restart from the file
! This is only done in the case of homogeneous grids.
! ----------------------------------------------------------------------- ! -----------------------------------------------------------------------
!
! Check if the grids are homogeneous and commensurate
homogeneous = .FALSE.
IF ( (nkf1 /= 0) .AND. (nkf2 /= 0) .AND. (nkf3 /= 0) .AND. &
(nqf1 /= 0) .AND. (nqf2 /= 0) .AND. (nqf3 /= 0) .AND. &
(MOD(nkf1,nqf1) == 0) .AND. (MOD(nkf2,nqf2) == 0) .AND. (MOD(nkf3,nqf3) == 0) ) THEN
homogeneous = .TRUE.
ELSE
homogeneous = .FALSE.
ENDIF
!
totq = 0 totq = 0
! !
IF ( (nkf1 /= 0) .AND. (nkf2 /= 0) .AND. (nkf3 /= 0) .AND. (nqf1 /= 0) .AND. (nqf2 /= 0) .AND. (nqf3 /= 0) ) THEN ! Check if the file has been pre-computed
! IF (mpime == ionode_id) THEN
! Check if the file has been pre-computed INQUIRE(FILE='selecq.fmt',EXIST=exst)
IF (mpime == ionode_id) THEN ENDIF
INQUIRE(FILE='selecq.fmt',EXIST=exst) CALL mp_bcast(exst, ionode_id, world_comm)
!
IF (exst) THEN
IF (selecqread) THEN
WRITE(stdout,'(5x,a)')' '
WRITE(stdout,'(5x,a)')'Reading selecq.fmt file. '
CALL qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq, homogeneous)
ELSE
WRITE(stdout,'(5x,a)')' '
WRITE(stdout,'(5x,a)')'A selecq.fmt file was found but re-created because selecqread == .false. '
CALL qwindow(.FALSE., nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq, homogeneous)
ENDIF ENDIF
CALL mp_bcast(exst, ionode_id, world_comm) ELSE ! exst
! IF (selecqread) THEN
IF (exst) THEN CALL errore( 'ephwann_shuffle', 'Variable selecqread == .true. but file selecq.fmt not found.',1 )
IF (selecqread) THEN ELSE
WRITE(stdout,'(5x,a)')' ' CALL qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq, homogeneous)
WRITE(stdout,'(5x,a)')'Reading selecq.fmt file. '
CALL qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq)
ELSE
WRITE(stdout,'(5x,a)')' '
WRITE(stdout,'(5x,a)')'A selecq.fmt file was found but re-created because selecqread == .false. '
CALL qwindow(.FALSE., nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq)
ENDIF
ELSE ! exst
IF (selecqread) THEN
CALL errore( 'ephwann_shuffle', 'Variable selecqread == .true. but file selecq.fmt not found.',1 )
ELSE
CALL qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq)
ENDIF
ENDIF ENDIF
! ENDIF
WRITE(stdout,'(5x,a,i8,a)')'We only need to compute ',totq, ' q-points' !
WRITE(stdout,'(5x,a)')' ' WRITE(stdout,'(5x,a,i8,a)')'We only need to compute ',totq, ' q-points'
ELSE WRITE(stdout,'(5x,a)')' '
totq = nqf
ALLOCATE(selecq(totq))
DO iq = 1, totq
selecq(iq) = iq
ENDDO
ENDIF ! homogeneous grids
! !
! ----------------------------------------------------------------------- ! -----------------------------------------------------------------------
! Possible restart during step 1) ! Possible restart during step 1)
......
...@@ -17,7 +17,8 @@ ...@@ -17,7 +17,8 @@
CONTAINS CONTAINS
! !
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
SUBROUTINE qwindow(exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, cufkk, cufkq) SUBROUTINE qwindow( exst, nrr_k, dims, totq, selecq, irvec_r, ndegen_k, &
cufkk, cufkq, homogeneous )
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!! !!
!! This subroutine pre-computes the q-points that falls within the fstichk !! This subroutine pre-computes the q-points that falls within the fstichk
...@@ -44,6 +45,8 @@ ...@@ -44,6 +45,8 @@
! !
LOGICAL, INTENT(in) :: exst LOGICAL, INTENT(in) :: exst
!! If the file exist !! If the file exist
LOGICAL, INTENT(in) :: homogeneous
!! Check if the grids are homogeneous and commensurate
INTEGER, INTENT(IN) :: nrr_k INTEGER, INTENT(IN) :: nrr_k
!! Number of WS points for electrons !! Number of WS points for electrons
INTEGER, INTENT(IN) :: dims INTEGER, INTENT(IN) :: dims
...@@ -105,6 +108,8 @@ ...@@ -105,6 +108,8 @@
!! $r\cdot k$ !! $r\cdot k$
REAL(kind=DP) :: etf_loc(nbndsub, nkf) REAL(kind=DP) :: etf_loc(nbndsub, nkf)
!! Eigen-energies all full k-grid. !! Eigen-energies all full k-grid.
REAL(kind=DP) :: etf_locq(nbndsub, nkf)
!! Eigen-energies all full k-grid.
REAL(kind=DP) :: etf_all(nbndsub, nkqtotf/2) REAL(kind=DP) :: etf_all(nbndsub, nkqtotf/2)
!! Eigen-energies all full k-grid. !! Eigen-energies all full k-grid.
REAL(kind=DP) :: xkf_tmp (3, nkqtotf) REAL(kind=DP) :: xkf_tmp (3, nkqtotf)
...@@ -138,104 +143,153 @@ ...@@ -138,104 +143,153 @@
CALL mp_bcast(selecq, ionode_id, world_comm ) CALL mp_bcast(selecq, ionode_id, world_comm )
IF (nqtot /= nqtotf) THEN IF (nqtot /= nqtotf) THEN
CALL errore( 'qwindow', 'Cannot read from selecq.fmt, the q-point grid or & CALL errore( 'qwindow', 'Cannot read from selecq.fmt, the q-point grid or &
fsthick window are different from read one. Remove the selecq.fmt file and restart. ',1 ) & fsthick window are different from read one. Remove the selecq.fmt file and restart.',1 )
ENDIF ENDIF
! !
ELSE ELSE
ALLOCATE(selecq(nqf)) ALLOCATE(selecq(nqf))
selecq(:) = 0 selecq(:) = 0
etf_loc(:,:) = zero etf_loc(:,:) = zero
etf_locq(:,:) = zero
etf_all(:,:) = zero etf_all(:,:) = zero
! !
! First store eigen energies on full grid. IF (homogeneous) THEN
DO ik = 1, nkf ! First store eigen energies on full grid.
ikk = 2 * ik - 1 DO ik = 1, nkf
xkk = xkf(:, ikk) ikk = 2 * ik - 1
CALL dgemv('t', 3, nrr_k, twopi, irvec_r, 3, xkk, 1, 0.0_DP, rdotk, 1 ) xkk = xkf(:, ikk)
IF (use_ws) THEN CALL dgemv('t', 3, nrr_k, twopi, irvec_r, 3, xkk, 1, 0.0_DP, rdotk, 1 )
DO iw=1, dims IF (use_ws) THEN
DO iw2=1, dims DO iw=1, dims
DO ir = 1, nrr_k DO iw2=1, dims
IF (ndegen_k(ir,iw2,iw) > 0) THEN DO ir = 1, nrr_k
cfac(ir,iw2,iw) = exp( ci*rdotk(ir) ) / ndegen_k(ir,iw2,iw) IF (ndegen_k(ir,iw2,iw) > 0) THEN
ENDIF cfac(ir,iw2,iw) = exp( ci*rdotk(ir) ) / ndegen_k(ir,iw2,iw)
ENDIF
ENDDO
ENDDO ENDDO
ENDDO ENDDO
ENDDO ELSE
ELSE cfac(:,1,1) = exp( ci*rdotk(:) ) / ndegen_k(:,1,1)
cfac(:,1,1) = exp( ci*rdotk(:) ) / ndegen_k(:,1,1) ENDIF
ENDIF CALL hamwan2bloch ( nbndsub, nrr_k, cufkk, etf_loc(:, ik), chw, cfac, dims)
CALL hamwan2bloch ( nbndsub, nrr_k, cufkk, etf_loc(:, ik), chw, cfac, dims) ENDDO
ENDDO CALL poolgather ( nbndsub, nkqtotf/2, nkf, etf_loc, etf_all )
CALL poolgather ( nbndsub, nkqtotf/2, nkf, etf_loc, etf_all )
!
! In case of k-point symmetry
IF (mp_mesh_k) THEN
BZtoIBZ(:) = 0
s_BZtoIBZ(:,:,:) = 0
! !
IF ( mpime == ionode_id ) THEN ! In case of k-point symmetry
IF (mp_mesh_k) THEN
BZtoIBZ(:) = 0
s_BZtoIBZ(:,:,:) = 0
! !
CALL set_sym_bl( ) IF ( mpime == ionode_id ) THEN
! !
! What we get from this call is BZtoIBZ CALL set_sym_bl( )
CALL kpoint_grid_epw ( nrot, time_reversal, .false., s, t_rev, bg, nkf1*nkf2*nkf3, & !
nkf1,nkf2,nkf3, nkqtotf_tmp, xkf_tmp, wkf_tmp,BZtoIBZ,s_BZtoIBZ) ! What we get from this call is BZtoIBZ
CALL kpoint_grid_epw ( nrot, time_reversal, .false., s, t_rev, bg, nkf1*nkf2*nkf3, &
nkf1,nkf2,nkf3, nkqtotf_tmp, xkf_tmp, wkf_tmp,BZtoIBZ,s_BZtoIBZ)
!
IF (iterative_bte) THEN
BZtoIBZ_tmp(:) = 0
DO ikbz=1, nkf1*nkf2*nkf3
BZtoIBZ_tmp(ikbz) = map_rebal( BZtoIBZ( ikbz ) )
ENDDO
BZtoIBZ(:) = BZtoIBZ_tmp(:)
ENDIF
!
ENDIF ! mpime
CALL mp_bcast( BZtoIBZ, ionode_id, inter_pool_comm )
! !
IF (iterative_bte) THEN ENDIF ! mp_mesh_k
BZtoIBZ_tmp(:) = 0 !
DO ikbz=1, nkf1*nkf2*nkf3 DO iq=1, nqf
BZtoIBZ_tmp(ikbz) = map_rebal( BZtoIBZ( ikbz ) ) xxq = xqf (:, iq)
ENDDO
BZtoIBZ(:) = BZtoIBZ_tmp(:)
ENDIF
! !
ENDIF ! mpime found(:) = 0
CALL mp_bcast( BZtoIBZ, ionode_id, inter_pool_comm ) DO ik = 1, nkf
! ikk = 2 * ik - 1
ENDIF ! mp_mesh_k xkk = xkf(:, ikk)
! xkq = xkk + xxq
DO iq=1, nqf !
xxq = xqf (:, iq) CALL kpmq_map( xkk, (/0d0,0d0,0d0/), 1, ind1 )
! CALL kpmq_map( xkk, xxq, 1, ind2 )
found(:) = 0 !
DO ik = 1, nkf ! Use k-point symmetry
ikk = 2 * ik - 1 IF (mp_mesh_k) THEN
xkk = xkf(:, ikk) IF ( (( minval ( abs(etf_all(:, BZtoIBZ(ind1)) - ef) ) < fsthick ) .and. &
xkq = xkk + xxq ( minval ( abs(etf_all(:, BZtoIBZ(ind2)) - ef) ) < fsthick )) ) THEN
! found(my_pool_id+1) = 1
CALL kpmq_map( xkk, (/0d0,0d0,0d0/), 1, ind1 ) EXIT ! exit the loop
CALL kpmq_map( xkk, xxq, 1, ind2 ) ENDIF
ELSE
IF ( (( minval ( abs(etf_all(:, ind1) - ef) ) < fsthick ) .and. &
( minval ( abs(etf_all(:, ind2) - ef) ) < fsthick )) ) THEN
found(my_pool_id+1) = 1
EXIT ! exit the loop
ENDIF
ENDIF
!
ENDDO ! k-loop
! If found on any k-point from the pools
CALL mp_sum(found, world_comm)
! !
! Use k-point symmetry IF (SUM(found) > 0) THEN
IF (mp_mesh_k) THEN totq = totq + 1
IF ( (( minval ( abs(etf_all(:, BZtoIBZ(ind1)) - ef) ) < fsthick ) .and. & selecq(totq) = iq
( minval ( abs(etf_all(:, BZtoIBZ(ind2)) - ef) ) < fsthick )) ) THEN !
found(my_pool_id+1) = 1 IF (MOD(totq,500) == 0) THEN
EXIT ! exit the loop WRITE(stdout,'(5x,a,i8,i8)')'Number selected, total',totq,iq
ENDIF ENDIF
ELSE ENDIF
IF ( (( minval ( abs(etf_all(:, ind1) - ef) ) < fsthick ) .and. & ENDDO ! iq
( minval ( abs(etf_all(:, ind2) - ef) ) < fsthick )) ) THEN ELSE ! homogeneous
DO iq=1, nqf
xxq = xqf (:, iq)
found(:) = 0
DO ik = 1, nkf
ikk = 2 * ik - 1
xkk = xkf(:, ikk)
xkq = xkk + xxq
!
CALL dgemv('t', 3, nrr_k, twopi, irvec_r, 3, xkk, 1, 0.0_DP, rdotk, 1 )
CALL dgemv('t', 3, nrr_k, twopi, irvec_r, 3, xkq, 1, 0.0_DP, rdotk2, 1 )
IF (use_ws) THEN
DO iw=1, dims
DO iw2=1, dims
DO ir = 1, nrr_k
IF (ndegen_k(ir,iw2,iw) > 0) THEN
cfac(ir,iw2,iw) = exp( ci*rdotk(ir) ) / ndegen_k(ir,iw2,iw)
cfacq(ir,iw2,iw) = exp( ci*rdotk2(ir) ) / ndegen_k(ir,iw2,iw)
ENDIF
ENDDO
ENDDO
ENDDO
ELSE
cfac(:,1,1) = exp( ci*rdotk(:) ) / ndegen_k(:,1,1)
cfacq(:,1,1) = exp( ci*rdotk2(:) ) / ndegen_k(:,1,1)
ENDIF
CALL hamwan2bloch ( nbndsub, nrr_k, cufkk, etf_loc(:, ik), chw, cfac, dims)
CALL hamwan2bloch ( nbndsub, nrr_k, cufkq, etf_locq(:, ik), chw, cfacq, dims)
IF ( (( minval ( abs(etf_loc(:, ik) - ef) ) < fsthick ) .and. &
( minval ( abs(etf_locq(:, ik) - ef) ) < fsthick )) ) THEN
found(my_pool_id+1) = 1 found(my_pool_id+1) = 1
EXIT ! exit the loop EXIT ! exit the loop
ENDIF ENDIF
ENDIF ENDDO ! ik
! ! If found on any k-point from the pools
ENDDO ! k-loop CALL mp_sum(found, world_comm)
! If found on any k-point from the pools
CALL mp_sum(found, world_comm)
!
IF (SUM(found) > 0) THEN
totq = totq + 1
selecq(totq) = iq
! !
IF (MOD(totq,500) == 0) THEN IF (SUM(found) > 0) THEN
WRITE(stdout,'(5x,a,i8,i8)')'Number selected, total',totq,iq totq = totq + 1
selecq(totq) = iq
!
IF (MOD(totq,500) == 0) THEN
WRITE(stdout,'(5x,a,i8,i8)')'Number selected, total',totq,iq
ENDIF
ENDIF ENDIF
ENDIF ENDDO ! iq
! ENDIF ! homogeneous
ENDDO !
IF (mpime == ionode_id) THEN IF (mpime == ionode_id) THEN
OPEN(unit=iunselecq, file='selecq.fmt', action='write') OPEN(unit=iunselecq, file='selecq.fmt', action='write')
WRITE (iunselecq,*) totq ! Selected number of q-points WRITE (iunselecq,*) totq ! Selected number of q-points
......
...@@ -60,7 +60,7 @@ ...@@ -60,7 +60,7 @@
phonselfen = .false. phonselfen = .false.
a2f = .false. a2f = .false.
fsthick = 1.2 ! eV fsthick = 2.0 ! eV
eptemp = 1 ! K eptemp = 1 ! K
degaussw = 0.05 ! eV degaussw = 0.05 ! eV
......
...@@ -60,7 +60,7 @@ ...@@ -60,7 +60,7 @@
phonselfen = .false. phonselfen = .false.
a2f = .false. a2f = .false.
fsthick = 1.2 ! eV fsthick = 2.0 ! eV
eptemp = 1 ! K eptemp = 1 ! K
degaussw = 0.05 ! eV degaussw = 0.05 ! eV
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment