Commit f1144931 authored by Gregor Michalicek's avatar Gregor Michalicek

Slight code beautifications in hybrid functionals code

parent 84c77200
This diff is collapsed.
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_hsfock MODULE m_hsfock
USE m_judft
USE m_judft
! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c ! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
! This module is the driver routine for the calculation of the Hartree c ! This module is the driver routine for the calculation of the Hartree c
! Fock exchange term by using the mixed basis set. c ! Fock exchange term by using the mixed basis set. c
...@@ -34,267 +41,194 @@ MODULE m_hsfock ...@@ -34,267 +41,194 @@ MODULE m_hsfock
! c ! c
! M.Betzinger (09/07) c ! M.Betzinger (09/07) c
! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c ! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
CONTAINS
SUBROUTINE hsfock(&
& nk,atoms,hybrid,lapw,dimension,&
& kpts,jsp,input,&
& hybdat,&
& eig_irr,sym,&
& cell,noco,&
& results,&
& it,mnobd,&
& xcpot,&
& mpi,irank2,isize2,comm)
USE m_symm_hf ,ONLY: symm_hf
USE m_util ,ONLY: intgrf,intgrf_init
USE m_exchange_valence_hf
USE m_exchange_core
USE m_symmetrizeh
USE m_wrapper
USE m_hsefunctional ,ONLY: exchange_vccvHSE,exchange_ccccHSE
USE m_types
USE m_io_hybrid
IMPLICIT NONE
TYPE(t_hybdat),INTENT(IN) :: hybdat
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_xcpot_inbuild),INTENT(IN) :: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
! - scalars -
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: it
INTEGER,INTENT(IN) :: irank2 ,isize2,comm
INTEGER,INTENT(IN) :: nk
INTEGER,INTENT(IN) :: mnobd
! - arrays - CONTAINS
REAL,INTENT(IN) :: eig_irr(dimension%neigd,kpts%nkpt)
SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,sym,cell,noco,&
results,it,mnobd,xcpot,mpi,irank2,isize2,comm)
USE m_types
! - local scalars - USE m_symm_hf ,ONLY: symm_hf
INTEGER :: i,j,ic,ic1,l,itype,n,nn USE m_util ,ONLY: intgrf,intgrf_init
INTEGER :: iband,iband1,iband2 USE m_exchange_valence_hf
INTEGER :: ikpt,ikpt0 USE m_exchange_core
INTEGER :: irec USE m_symmetrizeh
INTEGER :: irecl_olap,irecl_z,irecl_vx USE m_wrapper
INTEGER :: maxndb USE m_hsefunctional ,ONLY: exchange_vccvHSE,exchange_ccccHSE
INTEGER :: nddb USE m_io_hybrid
INTEGER :: nsymop
INTEGER :: nkpt_EIBZ IMPLICIT NONE
INTEGER :: ncstd
INTEGER :: ok TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_results), INTENT(INOUT) :: results
REAL :: a_ex TYPE(t_xcpot_inbuild), INTENT(IN) :: xcpot
! - local arrays - TYPE(t_mpi), INTENT(IN) :: mpi
INTEGER :: gpt(3,lapw%nv(jsp)) TYPE(t_dimension), INTENT(IN) :: dimension
INTEGER :: degenerat(hybrid%ne_eig(nk)) TYPE(t_hybrid), INTENT(INOUT) :: hybrid
INTEGER :: nsest(hybrid%nbands(nk)),indx_sest(hybrid%nbands(nk),hybrid%nbands(nk)) TYPE(t_input), INTENT(IN) :: input
TYPE(t_noco), INTENT(IN) :: noco
INTEGER,ALLOCATABLE :: parent(:),symop(:) TYPE(t_sym), INTENT(IN) :: sym
INTEGER,ALLOCATABLE :: psym(:) TYPE(t_cell), INTENT(IN) :: cell
INTEGER,ALLOCATABLE :: pointer_EIBZ(:) TYPE(t_kpts), INTENT(IN) :: kpts
INTEGER,ALLOCATABLE :: n_q(:) TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw
REAL :: wl_iks(dimension%neigd,kpts%nkptf)
! scalars
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: it
INTEGER, INTENT(IN) :: irank2 ,isize2,comm
INTEGER, INTENT(IN) :: nk
INTEGER, INTENT(IN) :: mnobd
! arrays
REAL, INTENT(IN) :: eig_irr(dimension%neigd,kpts%nkpt)
! local scalars
INTEGER :: i,j,ic,ic1,l,itype,n,nn
INTEGER :: iband,iband1,iband2
INTEGER :: ikpt,ikpt0
INTEGER :: irec
INTEGER :: irecl_olap,irecl_z,irecl_vx
INTEGER :: maxndb
INTEGER :: nddb
INTEGER :: nsymop
INTEGER :: nkpt_EIBZ
INTEGER :: ncstd
INTEGER :: ok
REAL :: a_ex
! local arrays
INTEGER :: gpt(3,lapw%nv(jsp))
INTEGER :: degenerat(hybrid%ne_eig(nk))
INTEGER :: nsest(hybrid%nbands(nk)),indx_sest(hybrid%nbands(nk),hybrid%nbands(nk))
INTEGER,ALLOCATABLE :: parent(:),symop(:)
INTEGER,ALLOCATABLE :: psym(:)
INTEGER,ALLOCATABLE :: pointer_EIBZ(:)
INTEGER,ALLOCATABLE :: n_q(:)
REAL :: wl_iks(dimension%neigd,kpts%nkptf)
TYPE(t_mat) :: olap,trafo,invtrafo,ex,tmp,v_x,z TYPE(t_mat) :: olap,trafo,invtrafo,ex,tmp,v_x,z
COMPLEX :: exch(dimension%neigd,dimension%neigd) COMPLEX :: exch(dimension%neigd,dimension%neigd)
COMPLEX,ALLOCATABLE :: carr(:) COMPLEX,ALLOCATABLE :: carr(:)
COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:) COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:)
CALL timestart("total time hsfock") CALL timestart("total time hsfock")
CALL timestart("symm_hf") CALL timestart("symm_hf")
! preparations
! ! initialize gridf for radial integration
! preparations !CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
!
! initialize gridf for radial integration
!CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
!
! initialize weighting factor for HF exchange part
!
a_ex=xcpot%get_exchange_weight()
! write k1,k2,k3 in gpt ! initialize weighting factor for HF exchange part
DO i=1,lapw%nv(jsp) a_ex=xcpot%get_exchange_weight()
gpt(:,i) = (/lapw%k1(i,jsp),lapw%k2(i,jsp),lapw%k3(i,jsp)/)
END DO
! write k1,k2,k3 in gpt
DO i=1,lapw%nv(jsp)
gpt(:,i) = (/lapw%k1(i,jsp),lapw%k2(i,jsp),lapw%k3(i,jsp)/)
END DO
! read in lower triangle part of overlap matrix from direct acces file olap ! read in lower triangle part of overlap matrix from direct acces file olap
call olap%alloc(sym%invs,dimension%nbasfcn) call olap%alloc(sym%invs,dimension%nbasfcn)
call read_olap(olap, kpts%nkpt*(jsp-1) + nk) call read_olap(olap, kpts%nkpt*(jsp-1) + nk)
if (.not.olap%l_real) olap%data_c=conjg(olap%data_c) if (.not.olap%l_real) olap%data_c=conjg(olap%data_c)
IF( hybrid%l_calhf ) THEN IF(hybrid%l_calhf) THEN
ncstd = sum( (/ ( (hybdat%nindxc(l,itype)*(2*l+1)*atoms%neq(itype),& ncstd = sum( (/ ( (hybdat%nindxc(l,itype)*(2*l+1)*atoms%neq(itype),l=0,hybdat%lmaxc(itype)), itype = 1,atoms%ntype) /) )
& l=0,hybdat%lmaxc(itype)), itype = 1,atoms%ntype) /) ) IF( nk .eq. 1 .and. mpi%irank == 0 ) WRITE(*,*) 'calculate new HF matrix'
IF( nk .eq. 1 .and. mpi%irank == 0 )& IF( nk .eq. 1 .and. jsp .eq. 1 .and. input%imix .gt. 10) CALL system('rm -f broyd*')
& WRITE(*,*) 'calculate new HF matrix' ! calculate all symmetrie operations, which yield k invariant
IF( nk .eq. 1 .and. jsp .eq. 1 .and. input%imix .gt. 10)&
& CALL system('rm -f broyd*') ALLOCATE( parent(kpts%nkptf),symop(kpts%nkptf) ,stat=ok)
! calculate all symmetrie operations, which yield k invariant IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation parent/symop'
parent = 0 ; symop = 0
ALLOCATE( parent(kpts%nkptf),symop(kpts%nkptf) ,stat=ok)
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation parent/symop' CALL symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jsp,gpt,mpi,irank2,&
parent = 0 ; symop = 0 nsymop,psym,nkpt_EIBZ,n_q,parent,symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c)
CALL symm_hf( kpts,nk,sym,& CALL timestop("symm_hf")
& dimension,hybdat,eig_irr,& ! remove weights(wtkpt) in w_iks
& atoms,hybrid,cell,& DO ikpt=1,kpts%nkptf
& lapw,jsp,& DO iband=1,dimension%neigd
& gpt,&
& mpi,irank2,&
& 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
ikpt0 = kpts%bkp(ikpt) ikpt0 = kpts%bkp(ikpt)
wl_iks(iband,ikpt) = results%w_iks(iband,ikpt0,jsp) /& wl_iks(iband,ikpt) = results%w_iks(iband,ikpt0,jsp) / (kpts%wtkpt(ikpt0)*kpts%nkptf)
& ( kpts%wtkpt(ikpt0) * kpts%nkptf ) END DO
END DO END DO
END DO
! calculate contribution from valence electrons to the
! ! HF exchange
! calculate contribution from valence electrons to the CALL timestart("valence exchange calculation")
! 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 ) ex%l_real=sym%invs
CALL timestop("valence exchange calculation") 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)
CALL timestart("core exchange calculation") DEALLOCATE (rep_c)
! do the rest of the calculation only on master CALL timestop("valence exchange calculation")
IF ( irank2 /= 0 ) RETURN
CALL timestart("core exchange calculation")
! calculate contribution from the core states to the HF exchange ! do the rest of the calculation only on master
IF ( xcpot%is_name("hse") .OR. xcpot%is_name("vhse") ) THEN IF (irank2 /= 0) RETURN
! calculate contribution from the core states to the HF exchange
IF (xcpot%is_name("hse").OR.xcpot%is_name("vhse")) THEN
#ifdef CPP_NEVER #ifdef CPP_NEVER
CALL exchange_vccvHSE(& CALL exchange_vccvHSE(nk,atoms,hybrid,hybdat,dimension,jsp,lapw,nsymop,nsest,indx_sest,mpi,a_ex,results,mat_ex%core)
& nk,atoms,& CALL exchange_ccccHSE(nk,obsolete,atoms,hybdat,ncstd,kpts(:,nk),sym,a_ex,mpi,results%core)
& hybrid,hybdat,&
& dimension,jsp,&
& lapw,&
& nsymop,nsest,indx_sest,mpi,&
& a_ex,results,&
& mat_ex%core )
CALL exchange_ccccHSE(&
& nk,obsolete,atoms,hybdat,&
& ncstd,&
& kpts(:,nk),&
& sym,a_ex,mpi,&
& results%core )
#endif #endif
STOP "HSE not implemented in hsfock" STOP "HSE not implemented in hsfock"
ELSE ELSE
CALL exchange_vccv1(& CALL exchange_vccv1(nk,atoms,hybrid,hybdat,dimension,jsp,lapw,nsymop,nsest,indx_sest,mpi,a_ex,results,ex)
& nk,atoms,& CALL exchange_cccc(nk,atoms,hybdat,ncstd,sym,kpts,a_ex,mpi,results)
& hybrid,hybdat,& END IF
& dimension,jsp,&
& lapw,& DEALLOCATE(n_q)
& nsymop,nsest,indx_sest,mpi,& CALL timestop("core exchange calculation")
& a_ex,results,&
& ex) CALL timestart("time for performing T^-1*mat_ex*T^-1*")
CALL exchange_cccc(& !calculate trafo from wavefunctions to APW basis
& nk,atoms,hybdat,& IF(dimension%neigd.LT.hybrid%nbands(nk)) STOP 'mhsfock: neigd < nbands(nk) ; '&
& ncstd,& 'trafo from wavefunctions to APW requires at least nbands(nk) '
& sym,kpts,a_ex,mpi,&
& results ) call z%alloc(olap%l_real,dimension%nbasfcn,dimension%neigd)
END IF call read_z(z,nk) !what about spin?
DEALLOCATE( n_q )
CALL timestop("core exchange calculation")
CALL timestart("time for performing T^-1*mat_ex*T^-1*")
!calculate trafo from wavefunctions to APW basis
IF( dimension%neigd .lt. hybrid%nbands(nk) ) STOP 'mhsfock: neigd < nbands(nk) ; &&
&trafo from wavefunctions to APW requires at least nbands(nk) '
call z%alloc(olap%l_real,dimension%nbasfcn,dimension%neigd)
call read_z(z,nk) !what about spin?
! calculate trafo ! calculate trafo
ic = lapw%nv(jsp) + atoms%nlotot ic = lapw%nv(jsp) + atoms%nlotot
z%matsize1=ic z%matsize1=ic
z%matsize2=hybrid%nbands(nk) z%matsize2=hybrid%nbands(nk)
olap%matsize1=ic olap%matsize1=ic
olap%matsize2=ic olap%matsize2=ic
call olap%multiply(z,trafo)
call invtrafo%alloc(olap%l_real,hybrid%nbands(nk),ic) call olap%multiply(z,trafo)
CALL trafo%TRANSPOSE(invtrafo)
DO i=1,hybrid%nbands(nk)
DO j=1,i-1
IF (ex%l_real) THEN
ex%data_r(i,j)=ex%data_r(j,i)
ELSE
ex%data_c(i,j)=conjg(ex%data_c(j,i))
END IF
ENDDO
ENDDO
call invtrafo%alloc(olap%l_real,hybrid%nbands(nk),ic)
CALL trafo%TRANSPOSE(invtrafo)
DO i=1,hybrid%nbands(nk)
DO j=1,i-1
IF (ex%l_real) THEN
ex%data_r(i,j)=ex%data_r(j,i)
ELSE
ex%data_c(i,j)=conjg(ex%data_c(j,i))
END IF
ENDDO
ENDDO
CALL ex%multiply(invtrafo,tmp)
CALL trafo%multiply(tmp,v_x)
CALL ex%multiply(invtrafo,tmp) CALL timestop("time for performing T^-1*mat_ex*T^-1*")
CALL trafo%multiply(tmp,v_x)
CALL timestop("time for performing T^-1*mat_ex*T^-1*")
CALL symmetrizeh(atoms,& CALL symmetrizeh(atoms,kpts%bkf(:,nk),dimension,jsp,lapw,gpt,sym,hybdat%kveclo_eig,cell,nsymop,psym,v_x)
& kpts%bkf(:,nk),dimension,jsp,lapw,gpt,& CALL write_v_x(v_x,kpts%nkpt*(jsp-1) + nk)
& sym,hybdat%kveclo_eig,& END IF ! hybrid%l_calhf
& cell,nsymop,psym,&
& v_x )
CALL write_v_x(v_x,kpts%nkpt*(jsp-1) + nk)
END IF ! hybrid%l_calhf
CALL timestop("total time hsfock")
END SUBROUTINE hsfock CALL timestop("total time hsfock")
END SUBROUTINE hsfock
END MODULE m_hsfock END MODULE m_hsfock
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_wavefproducts MODULE m_wavefproducts
USE m_judft USE m_judft
PRIVATE PRIVATE
......
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