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
results,it,mnobd,xcpot,mpi,irank2,isize2,comm)
USE m_types
USE m_symm_hf ,ONLY: symm_hf
USE m_symm_hf
USE m_util ,ONLY: intgrf,intgrf_init
USE m_exchange_valence_hf
USE m_exchange_core
......@@ -100,9 +100,10 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
! local arrays
INTEGER :: degenerat(hybrid%ne_eig(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 :: psym(:)
INTEGER,ALLOCATABLE :: pointer_EIBZ(:)
INTEGER,ALLOCATABLE :: n_q(:)
......@@ -114,7 +115,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:)
CALL timestart("total time hsfock")
CALL timestart("symm_hf")
! preparations
......@@ -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'
parent = 0 ; symop = 0
CALL symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jsp,mpi,irank2,&
nsymop,psym,nkpt_EIBZ,n_q,parent,symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c)
CALL timestart("symm_hf")
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")
! remove weights(wtkpt) in w_iks
DO ikpt=1,kpts%nkptf
DO iband=1,dimension%neigd
......@@ -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
! HF exchange
CALL timestart("valence exchange calculation")
ex%l_real=sym%invs
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,&
mpi,irank2,isize2,comm,ex)
DEALLOCATE (rep_c)
CALL timestop("valence exchange calculation")
......
......@@ -9,21 +9,76 @@
! !
! M.Betzinger (09/07) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE m_symm_hf
MODULE m_symm_hf
#define irreps .false.
CONTAINS
CONTAINS
SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
lapw,jsp,mpi,irank2,nsymop,psym,nkpt_EIBZ,n_q,parent,&
symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c)
SUBROUTINE symm_hf_init(sym,kpts,nk,irank2,nsymop,rrot,psym)
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_types
USE m_util ,ONLY: modulo1,intgrf,intgrf_init
USE m_olap ,ONLY: wfolap_inv,wfolap_noinv,wfolap1,wfolap_init
USE m_trafo ,ONLY: waveftrafo_symm
USE m_types
USE m_io_hybrid
IMPLICIT NONE
......@@ -43,19 +98,22 @@
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: irank2
INTEGER,INTENT(OUT) :: nkpt_EIBZ
INTEGER,INTENT(OUT) :: nsymop
INTEGER,INTENT(IN) :: nsymop
INTEGER,INTENT(OUT) :: maxndb,nddb
! - arrays -
INTEGER,INTENT(IN) :: rrot(3,3,sym%nsym)
INTEGER,INTENT(IN) :: psym(sym%nsym)
INTEGER,INTENT(OUT) :: parent(kpts%nkptf)
INTEGER,INTENT(OUT) :: symop(kpts%nkptf)
INTEGER,INTENT(INOUT) :: degenerat(hybrid%ne_eig(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) :: psym(:),n_q(:)
INTEGER,ALLOCATABLE,INTENT(OUT) :: n_q(:)
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 -
INTEGER :: ikpt,ikpt1,iop,isym,iisym,m
......@@ -75,7 +133,6 @@
COMPLEX , PARAMETER :: img = (0d0,1d0)
! - local arrays -
INTEGER :: rrot(3,3,sym%nsym)
INTEGER :: neqvkpt(kpts%nkptf)
INTEGER :: list(kpts%nkptf)
INTEGER,ALLOCATABLE :: help(:)
......@@ -98,54 +155,6 @@
WRITE(6,'(A)') new_line('n') // new_line('n') // '### subroutine: symm ###'
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.
! those k-points, which can generate the whole BZ by
! applying the symmetry operations of the little group of k
......@@ -520,10 +529,6 @@
IF( hybdat%lmaxcd .gt. atoms%lmaxd ) STOP &
& '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
iatom0 = 0
DO itype = 1,atoms%ntype
......@@ -551,9 +556,9 @@
iatom0 = iatom0 + atoms%neq(itype)
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_types
......@@ -665,6 +670,6 @@
END DO
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