Commit de8ba450 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce symm_hf_init subroutine

(This is probably going to be extended)
parent 427f57c1
...@@ -48,7 +48,7 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -48,7 +48,7 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
results,it,mnobd,xcpot,mpi,irank2,isize2,comm) results,it,mnobd,xcpot,mpi,irank2,isize2,comm)
USE m_types USE m_types
USE m_symm_hf ,ONLY: symm_hf USE m_symm_hf
USE m_util ,ONLY: intgrf,intgrf_init USE m_util ,ONLY: intgrf,intgrf_init
USE m_exchange_valence_hf USE m_exchange_valence_hf
USE m_exchange_core USE m_exchange_core
...@@ -100,9 +100,10 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -100,9 +100,10 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
! local arrays ! local arrays
INTEGER :: degenerat(hybrid%ne_eig(nk)) INTEGER :: degenerat(hybrid%ne_eig(nk))
INTEGER :: nsest(hybrid%nbands(nk)),indx_sest(hybrid%nbands(nk),hybrid%nbands(nk)) INTEGER :: nsest(hybrid%nbands(nk)),indx_sest(hybrid%nbands(nk),hybrid%nbands(nk))
INTEGER :: rrot(3,3,sym%nsym)
INTEGER :: psym(sym%nsym) ! Note: psym is only filled up to index nsymop
INTEGER,ALLOCATABLE :: parent(:),symop(:) INTEGER,ALLOCATABLE :: parent(:),symop(:)
INTEGER,ALLOCATABLE :: psym(:)
INTEGER,ALLOCATABLE :: pointer_EIBZ(:) INTEGER,ALLOCATABLE :: pointer_EIBZ(:)
INTEGER,ALLOCATABLE :: n_q(:) INTEGER,ALLOCATABLE :: n_q(:)
...@@ -114,7 +115,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -114,7 +115,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:) COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:)
CALL timestart("total time hsfock") CALL timestart("total time hsfock")
CALL timestart("symm_hf")
! preparations ! preparations
...@@ -153,10 +153,16 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -153,10 +153,16 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation parent/symop' IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation parent/symop'
parent = 0 ; symop = 0 parent = 0 ; symop = 0
CALL symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jsp,mpi,irank2,& CALL timestart("symm_hf")
nsymop,psym,nkpt_EIBZ,n_q,parent,symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c) CALL symm_hf_init(sym,kpts,nk,irank2,nsymop,rrot,psym)
ALLOCATE(rep_c(-hybdat%lmaxcd:hybdat%lmaxcd,-hybdat%lmaxcd:hybdat%lmaxcd,0:hybdat%lmaxcd,nsymop,atoms%nat), stat=ok)
IF(ok.NE.0) STOP 'hsfock: failure allocation rep_c'
CALL symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jsp,mpi,irank2,&
rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c)
CALL timestop("symm_hf") CALL timestop("symm_hf")
! remove weights(wtkpt) in w_iks ! remove weights(wtkpt) in w_iks
DO ikpt=1,kpts%nkptf DO ikpt=1,kpts%nkptf
DO iband=1,dimension%neigd DO iband=1,dimension%neigd
...@@ -168,12 +174,10 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -168,12 +174,10 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
! calculate contribution from valence electrons to the ! calculate contribution from valence electrons to the
! HF exchange ! HF exchange
CALL timestart("valence exchange calculation") CALL timestart("valence exchange calculation")
ex%l_real=sym%invs ex%l_real=sym%invs
CALL exchange_valence_hf(nk,kpts,nkpt_EIBZ, sym,atoms,hybrid,cell,dimension,input,jsp,hybdat,mnobd,lapw,& CALL exchange_valence_hf(nk,kpts,nkpt_EIBZ, sym,atoms,hybrid,cell,dimension,input,jsp,hybdat,mnobd,lapw,&
eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,it,xcpot,noco,nsest,indx_sest,& eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,it,xcpot,noco,nsest,indx_sest,&
mpi,irank2,isize2,comm,ex) mpi,irank2,isize2,comm,ex)
DEALLOCATE (rep_c) DEALLOCATE (rep_c)
CALL timestop("valence exchange calculation") CALL timestop("valence exchange calculation")
......
...@@ -9,21 +9,76 @@ ...@@ -9,21 +9,76 @@
! ! ! !
! M.Betzinger (09/07) ! ! M.Betzinger (09/07) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE m_symm_hf MODULE m_symm_hf
#define irreps .false. #define irreps .false.
CONTAINS CONTAINS
SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,& SUBROUTINE symm_hf_init(sym,kpts,nk,irank2,nsymop,rrot,psym)
lapw,jsp,mpi,irank2,nsymop,psym,nkpt_EIBZ,n_q,parent,&
symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c) USE m_types
USE m_util ,ONLY: modulo1
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_kpts), INTENT(IN) :: kpts
INTEGER, INTENT(IN) :: nk
INTEGER, INTENT(IN) :: irank2
INTEGER, INTENT(OUT) :: nsymop
INTEGER, INTENT(INOUT) :: rrot(3,3,sym%nsym)
INTEGER, INTENT(INOUT) :: psym(sym%nsym) ! Note: psym is only filled up to index nsymop
INTEGER :: i
REAL :: rotkpt(3)
! calculate rotations in reciprocal space
DO i = 1, sym%nsym
IF(i.LE.sym%nop) THEN
rrot(:,:,i) = transpose(sym%mrot(:,:,sym%invtab(i)))
ELSE
rrot(:,:,i) = -rrot(:,:,i-sym%nop)
END IF
END DO
! determine little group of k., i.e. those symmetry operations
! which keep bk(:,nk) invariant
! nsymop :: number of such symmetry-operations
! psym :: points to the symmetry-operation
psym = 0
nsymop = 0
DO i = 1, sym%nsym
rotkpt = matmul(rrot(:,:,i), kpts%bkf(:,nk))
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt,kpts%nkpt3)
!check if rotkpt is identical to bk(:,nk)
IF(maxval(abs(rotkpt - kpts%bkf(:,nk))) .LE. 1E-07) THEN
nsymop = nsymop + 1
psym(nsymop) = i
END IF
END DO
IF (irank2 == 0) THEN
WRITE(6,'(A,i3)') ' nk',nk
WRITE(6,'(A,3f10.5)') ' kpts%bkf(:,nk):',kpts%bkf(:,nk)
WRITE(6,'(A,i3)') ' Number of elements in the little group:',nsymop
END IF
END SUBROUTINE symm_hf_init
SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
lapw,jsp,mpi,irank2,rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,&
symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c)
USE m_constants USE m_constants
USE m_types
USE m_util ,ONLY: modulo1,intgrf,intgrf_init USE m_util ,ONLY: modulo1,intgrf,intgrf_init
USE m_olap ,ONLY: wfolap_inv,wfolap_noinv,wfolap1,wfolap_init USE m_olap ,ONLY: wfolap_inv,wfolap_noinv,wfolap1,wfolap_init
USE m_trafo ,ONLY: waveftrafo_symm USE m_trafo ,ONLY: waveftrafo_symm
USE m_types
USE m_io_hybrid USE m_io_hybrid
IMPLICIT NONE IMPLICIT NONE
...@@ -43,19 +98,22 @@ ...@@ -43,19 +98,22 @@
INTEGER,INTENT(IN) :: jsp INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: irank2 INTEGER,INTENT(IN) :: irank2
INTEGER,INTENT(OUT) :: nkpt_EIBZ INTEGER,INTENT(OUT) :: nkpt_EIBZ
INTEGER,INTENT(OUT) :: nsymop INTEGER,INTENT(IN) :: nsymop
INTEGER,INTENT(OUT) :: maxndb,nddb INTEGER,INTENT(OUT) :: maxndb,nddb
! - arrays - ! - arrays -
INTEGER,INTENT(IN) :: rrot(3,3,sym%nsym)
INTEGER,INTENT(IN) :: psym(sym%nsym)
INTEGER,INTENT(OUT) :: parent(kpts%nkptf) INTEGER,INTENT(OUT) :: parent(kpts%nkptf)
INTEGER,INTENT(OUT) :: symop(kpts%nkptf) INTEGER,INTENT(OUT) :: symop(kpts%nkptf)
INTEGER,INTENT(INOUT) :: degenerat(hybrid%ne_eig(nk)) INTEGER,INTENT(INOUT) :: degenerat(hybrid%ne_eig(nk))
INTEGER,INTENT(OUT) :: nsest(hybrid%nbands(nk)), indx_sest(hybrid%nbands(nk),hybrid%nbands(nk)) INTEGER,INTENT(OUT) :: nsest(hybrid%nbands(nk)), indx_sest(hybrid%nbands(nk),hybrid%nbands(nk))
INTEGER,ALLOCATABLE,INTENT(OUT) :: pointer_EIBZ(:) INTEGER,ALLOCATABLE,INTENT(OUT) :: pointer_EIBZ(:)
INTEGER,ALLOCATABLE,INTENT(OUT) :: psym(:),n_q(:) INTEGER,ALLOCATABLE,INTENT(OUT) :: n_q(:)
REAL,INTENT(IN) :: eig_irr(dimension%neigd,kpts%nkpt) REAL,INTENT(IN) :: eig_irr(dimension%neigd,kpts%nkpt)
COMPLEX,ALLOCATABLE,INTENT(OUT) :: rep_c(:,:,:,:,:) COMPLEX,INTENT(INOUT) :: rep_c(-hybdat%lmaxcd:hybdat%lmaxcd,-hybdat%lmaxcd:hybdat%lmaxcd,&
0:hybdat%lmaxcd,nsymop,atoms%nat)
! - local scalars - ! - local scalars -
INTEGER :: ikpt,ikpt1,iop,isym,iisym,m INTEGER :: ikpt,ikpt1,iop,isym,iisym,m
...@@ -75,7 +133,6 @@ ...@@ -75,7 +133,6 @@
COMPLEX , PARAMETER :: img = (0d0,1d0) COMPLEX , PARAMETER :: img = (0d0,1d0)
! - local arrays - ! - local arrays -
INTEGER :: rrot(3,3,sym%nsym)
INTEGER :: neqvkpt(kpts%nkptf) INTEGER :: neqvkpt(kpts%nkptf)
INTEGER :: list(kpts%nkptf) INTEGER :: list(kpts%nkptf)
INTEGER,ALLOCATABLE :: help(:) INTEGER,ALLOCATABLE :: help(:)
...@@ -98,54 +155,6 @@ ...@@ -98,54 +155,6 @@
WRITE(6,'(A)') new_line('n') // new_line('n') // '### subroutine: symm ###' WRITE(6,'(A)') new_line('n') // new_line('n') // '### subroutine: symm ###'
END IF END IF
! calculate rotations in reciprocal space
DO i = 1,sym%nsym
IF( i .le. sym%nop ) THEN
rrot(:,:,i) = transpose(sym%mrot(:,:,sym%invtab(i)))
ELSE
rrot(:,:,i) = -rrot(:,:,i-sym%nop)
END IF
END DO
! determine little group of k., i.e. those symmetry operations
! which keep bk(:,nk) invariant
! nsymop :: number of such symmetry-operations
! psym :: points to the symmetry-operation
ic = 0
ALLOCATE(psym(sym%nsym))
DO iop=1,sym%nsym
rotkpt = matmul( rrot(:,:,iop), kpts%bkf(:,nk) )
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt,kpts%nkpt3)
!check if rotkpt is identical to bk(:,nk)
IF( maxval( abs( rotkpt - kpts%bkf(:,nk) ) ) .le. 1E-07) THEN
ic = ic + 1
psym(ic) = iop
END IF
END DO
nsymop = ic
IF ( irank2 == 0 ) THEN
WRITE(6,'(A,i3)') ' nk',nk
WRITE(6,'(A,3f10.5)') ' kpts%bkf(:,nk):',kpts%bkf(:,nk)
WRITE(6,'(A,i3)') ' Number of elements in the little group:',nsymop
END IF
! reallocate psym
ALLOCATE(help(ic))
help = psym(1:ic)
DEALLOCATE(psym)
ALLOCATE(psym(ic))
psym =help
DEALLOCATE(help)
! determine extented irreducible BZ of k ( EIBZ(k) ), i.e. ! determine extented irreducible BZ of k ( EIBZ(k) ), i.e.
! those k-points, which can generate the whole BZ by ! those k-points, which can generate the whole BZ by
! applying the symmetry operations of the little group of k ! applying the symmetry operations of the little group of k
...@@ -520,10 +529,6 @@ ...@@ -520,10 +529,6 @@
IF( hybdat%lmaxcd .gt. atoms%lmaxd ) STOP & IF( hybdat%lmaxcd .gt. atoms%lmaxd ) STOP &
& 'symm_hf: The very impropable case that hybdat%lmaxcd > atoms%lmaxd occurs' & 'symm_hf: The very impropable case that hybdat%lmaxcd > atoms%lmaxd occurs'
ALLOCATE(rep_c(-hybdat%lmaxcd:hybdat%lmaxcd,-hybdat%lmaxcd:hybdat%lmaxcd,0:hybdat%lmaxcd,nsymop,atoms%nat)&
& , stat=ok )
IF( ok .ne. 0) STOP 'symm_hf: failure allocation rep_c'
iatom = 0 iatom = 0
iatom0 = 0 iatom0 = 0
DO itype = 1,atoms%ntype DO itype = 1,atoms%ntype
...@@ -551,9 +556,9 @@ ...@@ -551,9 +556,9 @@
iatom0 = iatom0 + atoms%neq(itype) iatom0 = iatom0 + atoms%neq(itype)
END DO END DO
END SUBROUTINE symm_hf END SUBROUTINE symm_hf
INTEGER FUNCTION symm_hf_nkpt_EIBZ(kpts,nk,sym) INTEGER FUNCTION symm_hf_nkpt_EIBZ(kpts,nk,sym)
USE m_util, ONLY: modulo1 USE m_util, ONLY: modulo1
USE m_types USE m_types
...@@ -665,6 +670,6 @@ ...@@ -665,6 +670,6 @@
END DO END DO
symm_hf_nkpt_EIBZ = ic symm_hf_nkpt_EIBZ = ic
END FUNCTION symm_hf_nkpt_EIBZ END FUNCTION symm_hf_nkpt_EIBZ
END MODULE m_symm_hf END MODULE m_symm_hf
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