Commit 14153624 authored by Matthias Redies's avatar Matthias Redies

revert a5988ae2

parent a2971e70
......@@ -39,7 +39,6 @@ MODULE m_types_kpts
procedure :: is_kpt => kpts_is_kpt
procedure :: init => init_kpts
procedure :: nkpt3 => nkpt3_kpts
procedure :: nkpt_EIBZ => nkpt_EIBZ_kpts
ENDTYPE t_kpts
PUBLIC :: t_kpts
......@@ -365,18 +364,4 @@ CONTAINS
if(abs(k(1)) < 1e-10 .and. abs(k(2)) < 1e-10) nkpt3(3) = nkpt3(3) + 1
enddo
end function nkpt3_kpts
function nkpt_EIBZ_kpts(kpts) result(nkpt_EIBZ)
! determine number of members in the EIBZ(k)
implicit none
class(t_kpts), intent(in) :: kpts
integer :: nkpt_EIBZ
integer :: ikpt
nkpt_EIBZ = 0
DO ikpt = 1, kpts%nkptf
IF(kpts%bkp(ikpt) == ikpt) nkpt_EIBZ = nkpt_EIBZ + 1
END DO
end function nkpt_EIBZ_kpts
END MODULE m_types_kpts
......@@ -60,7 +60,7 @@ MODULE m_exchange_valence_hf
CONTAINS
SUBROUTINE exchange_valence_hf(ik, kpts, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, &
SUBROUTINE exchange_valence_hf(ik, kpts, nkpt_EIBZ, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, &
eig_irr, results, pointer_EIBZ, n_q, wl_iks, xcpot, noco, nsest, indx_sest, &
mpi, mat_ex)
......@@ -92,7 +92,7 @@ CONTAINS
! scalars
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: ik
INTEGER, INTENT(IN) :: ik, nkpt_EIBZ
INTEGER, INTENT(IN) :: mnobd
! arrays
......@@ -201,7 +201,7 @@ CONTAINS
exch_vv = 0
DO jq = 1, kpts%nkpt_EIBZ()
DO jq = 1, nkpt_EIBZ
iq = pointer_EIBZ(jq)
......
......@@ -87,6 +87,7 @@ CONTAINS
INTEGER :: ikpt, ikpt0
INTEGER :: nbasfcn
INTEGER :: nsymop
INTEGER :: nkpt_EIBZ
INTEGER :: ncstd
INTEGER :: ok
REAL :: a_ex
......@@ -149,7 +150,7 @@ CONTAINS
CALL symm_hf_init(sym, kpts, nk, nsymop, rrot, psym)
CALL symm_hf(kpts, nk, sym, hybdat, eig_irr, input,atoms, mpdata, hybinp, cell, lapw, jsp, &
rrot, nsymop, psym, n_q, parent, pointer_EIBZ, nsest, indx_sest)
rrot, nsymop, psym, nkpt_EIBZ, n_q, parent, pointer_EIBZ, nsest, indx_sest)
CALL timestop("symm_hf")
! remove weights(wtkpt) in w_iks
......@@ -163,7 +164,7 @@ CONTAINS
! calculate contribution from valence electrons to the
! HF exchange
ex%l_real = sym%invs
CALL exchange_valence_hf(nk, kpts, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, &
CALL exchange_valence_hf(nk, kpts, nkpt_EIBZ, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, &
eig_irr, results, pointer_EIBZ, n_q, wl_iks, xcpot, noco, nsest, indx_sest, &
mpi, ex)
......@@ -192,7 +193,7 @@ CONTAINS
CALL invtrafo%alloc(olap%l_real, hybdat%nbands(nk), nbasfcn)
CALL trafo%TRANSPOSE(invtrafo)
DO i = 1, hybdat%nbands(nk)
DO j = 1, i - 1
IF (ex%l_real) THEN
......
......@@ -72,7 +72,7 @@ CONTAINS
END SUBROUTINE symm_hf_init
SUBROUTINE symm_hf(kpts, nk, sym, hybdat, eig_irr, input, atoms, mpdata, hybinp, cell, &
lapw, jsp, rrot, nsymop, psym, n_q, parent, &
lapw, jsp, rrot, nsymop, psym, nkpt_EIBZ, n_q, parent, &
pointer_EIBZ, nsest, indx_sest)
USE m_olap
......@@ -94,6 +94,7 @@ CONTAINS
! - scalars -
INTEGER, INTENT(IN) :: nk
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(INOUT) :: nkpt_EIBZ
INTEGER, INTENT(IN) :: nsymop
! - arrays -
......@@ -143,7 +144,7 @@ CONTAINS
COMPLEX, ALLOCATABLE :: rep_d(:, :, :)
LOGICAL, ALLOCATABLE :: symequivalent(:, :)
parent = 0; nsest = 0; indx_sest = 0;
parent = 0; nsest = 0; indx_sest = 0; nkpt_EIBZ = 0;
WRITE(6, '(A)') new_line('n')//new_line('n')//'### subroutine: symm ###'
! determine extented irreducible BZ of k ( EIBZ(k) ), i.e.
......@@ -179,25 +180,32 @@ CONTAINS
parent(1) = 1
neqvkpt(1) = 1
allocate(pointer_EIBZ(kpts%nkpt_EIBZ()), source=0)
! determine number of members in the EIBZ(k)
ic = 0
DO ikpt = 1, kpts%nkptf
IF(parent(ikpt) == ikpt) ic = ic + 1
END DO
nkpt_EIBZ = ic
allocate(pointer_EIBZ(nkpt_EIBZ), source=0)
ic = 0
DO ikpt = 1, kpts%nkptf
IF(kpts%bkp(ikpt) == ikpt) THEN
IF(parent(ikpt) == ikpt) THEN
ic = ic + 1
pointer_EIBZ(ic) = ikpt
END IF
END DO
WRITE(6, '(A,i5)') ' Number of k-points in the EIBZ', kpts%nkpt_EIBZ()
WRITE(6, '(A,i5)') ' Number of k-points in the EIBZ', nkpt_EIBZ
! determine the factor n_q, that means the number of symmetrie operations of the little group of bk(:,nk)
! which keep q (in EIBZ) invariant
allocate(n_q(kpts%nkpt_EIBZ()), source=0)
allocate(n_q(nkpt_EIBZ), source=0)
ic = 0
n_q = 0
DO ikpt = 1, kpts%nkptf
IF(kpts%bkp(ikpt) == ikpt) THEN
IF(parent(ikpt) == ikpt) THEN
ic = ic + 1
DO iop = 1, nsymop
isym = psym(iop)
......@@ -213,7 +221,7 @@ CONTAINS
END DO
END IF
END DO
IF(ic /= kpts%nkpt_EIBZ()) call judft_error('symm: failure EIBZ')
IF(ic /= nkpt_EIBZ) call judft_error('symm: failure EIBZ')
! calculate degeneracy:
! degenerat(i) = 1 state i is not degenerat,
......
......@@ -531,10 +531,10 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
parent = 0
CALL symm_hf_init(sym,kpts,ikpt,nsymop,rrot,psym)
CALL symm_hf(kpts,ikpt,sym,hybdat,eig_irr,input,atoms,mpdata,hybinp,cell,lapw,jspin,&
rrot,nsymop,psym,n_q,parent,pointer_EIBZ,nsest,indx_sest)
rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,pointer_EIBZ,nsest,indx_sest)
exMat%l_real=sym%invs
CALL exchange_valence_hf(ikpt,kpts,sym,atoms,mpdata,hybinp,cell,input,jspin,hybdat,mnobd,lapw,&
CALL exchange_valence_hf(ikpt,kpts,nkpt_EIBZ, sym,atoms,mpdata,hybinp,cell,input,jspin,hybdat,mnobd,lapw,&
eig_irr,results,pointer_EIBZ,n_q,wl_iks,xcpot,noco,nsest,indx_sest,&
mpi,exMat)
CALL exchange_vccv1(ikpt,input,atoms,mpdata,hybinp,hybdat,jspin,lapw,nsymop,nsest,indx_sest,mpi,1.0,results,exMat)
......@@ -571,7 +571,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
CALL invtrafo%alloc(olap%l_real,hybdat%nbands(ikpt),nbasfcn)
CALL trafo%TRANSPOSE(invtrafo)
DO i = 1, hybdat%nbands(ikpt)
DO j = 1, i-1
IF (exMat%l_real) THEN
......
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