Commit f1144931 authored by Gregor Michalicek's avatar Gregor Michalicek

Slight code beautifications in hybrid functionals code

parent 84c77200
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------
! Calculates the HF exchange term
!
! s s* s s*
......@@ -42,480 +48,418 @@
! The resulting formula
! vol/(4*pi**1.5*sqrt(expo)) * erf(sqrt(a)*q0) - sum(q,0<q<q0) exp(-expo*q**2)/q**2
! converges well with q0. (Should be the default.)
MODULE m_exchange_valence_hf
LOGICAL,PARAMETER:: zero_order=.false.,ibs_corr=.false.
INTEGER,PARAMETER:: maxmem=600
MODULE m_exchange_valence_hf
CONTAINS
LOGICAL,PARAMETER:: zero_order=.false.,ibs_corr=.false.
INTEGER,PARAMETER:: maxmem=600
SUBROUTINE 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,mat_ex)
CONTAINS
SUBROUTINE 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,mat_ex)
USE m_wrapper
USE m_constants
USE m_trafo
USE m_wavefproducts
USE m_olap
USE m_spmvec
USE m_hsefunctional ,ONLY: dynamic_hse_adjustment
USE m_types
USE m_wrapper
USE m_constants
USE m_trafo
USE m_wavefproducts
USE m_olap
USE m_spmvec
USE m_hsefunctional ,ONLY: dynamic_hse_adjustment
#if defined(CPP_MPI)&&defined(CPP_NEVER)
USE m_mpi_work_dist
USE m_mpi_tags
USE m_mpi_work_dist
USE m_mpi_tags
#endif
USE m_io_hybrid
USE m_kp_perturbation
USE m_types
IMPLICIT NONE
TYPE(t_hybdat),INTENT(IN) :: hybdat
TYPE(t_results),INTENT(IN) :: 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) :: it ,irank2 ,isize2,comm
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: nk ,nkpt_EIBZ
INTEGER,INTENT(IN) :: mnobd
! - arrays -
INTEGER,INTENT(IN) :: n_q(nkpt_EIBZ)
INTEGER,INTENT(IN) :: parent(kpts%nkptf)
INTEGER,INTENT(IN) :: pointer_EIBZ(nkpt_EIBZ)
INTEGER,INTENT(IN) :: nsest(hybrid%nbands(nk)),indx_sest(hybrid%nbands(nk),hybrid%nbands(nk))
USE m_io_hybrid
USE m_kp_perturbation
IMPLICIT NONE
TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_results), INTENT(IN) :: 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
TYPE(t_mat), INTENT(INOUT) :: mat_ex
! scalars
INTEGER, INTENT(IN) :: it,irank2,isize2,comm
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: nk,nkpt_EIBZ
INTEGER, INTENT(IN) :: mnobd
! arrays
INTEGER, INTENT(IN) :: n_q(nkpt_EIBZ)
INTEGER, INTENT(IN) :: parent(kpts%nkptf)
INTEGER, INTENT(IN) :: pointer_EIBZ(nkpt_EIBZ)
INTEGER, INTENT(IN) :: nsest(hybrid%nbands(nk))
INTEGER, INTENT(IN) :: indx_sest(hybrid%nbands(nk),hybrid%nbands(nk))
REAL ,INTENT(IN) :: eig_irr(dimension%neigd,kpts%nkpt)
REAL ,INTENT(IN) :: wl_iks(dimension%neigd,kpts%nkptf)
TYPE(t_mat),INTENT(INOUT):: mat_ex
! - local scalars -
INTEGER :: iband,iband1,ibando,ikpt,ikpt0
INTEGER :: i,ic,ix,iy,iz
INTEGER :: irecl_coulomb,irecl_coulomb1
INTEGER :: j
INTEGER :: m1,m2
INTEGER :: n,n1,n2,nn,nn2
INTEGER :: nkqpt
INTEGER :: npot
INTEGER :: ok
INTEGER :: psize
REAL :: rdum
REAL :: k0
REAL, INTENT(IN) :: eig_irr(dimension%neigd,kpts%nkpt)
REAL, INTENT(IN) :: wl_iks(dimension%neigd,kpts%nkptf)
! local scalars
INTEGER :: iband,iband1,ibando,ikpt,ikpt0
INTEGER :: i,ic,ix,iy,iz
INTEGER :: irecl_coulomb,irecl_coulomb1
INTEGER :: j
INTEGER :: m1,m2
INTEGER :: n,n1,n2,nn,nn2
INTEGER :: nkqpt
INTEGER :: npot
INTEGER :: ok
INTEGER :: psize
REAL :: rdum
REAL :: k0
REAL , SAVE :: divergence
REAL , SAVE :: divergence
COMPLEX :: cdum,cdum1,cdum2
COMPLEX :: exch0
COMPLEX :: cdum,cdum1,cdum2
COMPLEX :: exch0
LOGICAL, SAVE :: initialize = .true.
LOGICAL, SAVE :: initialize = .true.
! local arrays
INTEGER :: kcorner(3,8) = reshape((/ 0,0,0, 1,0,0, 0,1,0, 0,0,1, 1,1,0, 1,0,1, 0,1,1, 1,1,1 /), (/3,8/) )
COMPLEX :: exchcorrect(kpts%nkptf)
COMPLEX :: dcprod(hybrid%nbands(nk),hybrid%nbands(nk),3)
COMPLEX(8) :: exch_vv(hybrid%nbands(nk),hybrid%nbands(nk))
COMPLEX :: hessian(3,3)
COMPLEX :: proj_ibsc(3,mnobd,hybrid%nbands(nk))
COMPLEX :: olap_ibsc(3,3,mnobd,mnobd)
REAL :: carr1_v_r(hybrid%maxbasm1),carr1_c_r(hybrid%maxbasm1)
COMPLEX :: carr1_v_c(hybrid%maxbasm1),carr1_c_c(hybrid%maxbasm1)
COMPLEX, ALLOCATABLE :: phase_vv(:,:)
REAL, ALLOCATABLE :: cprod_vv_r(:,:,:),cprod_cv_r(:,:,:), carr3_vv_r(:,:,:),carr3_cv_r(:,:,:)
COMPLEX, ALLOCATABLE :: cprod_vv_c(:,:,:),cprod_cv_c(:,:,:), carr3_vv_c(:,:,:),carr3_cv_c(:,:,:)
! - local arrays -
INTEGER :: kcorner(3,8) = reshape((/ 0,0,0, 1,0,0, 0,1,0, 0,0,1,&
1,1,0, 1,0,1, 0,1,1, 1,1,1 /), (/3,8/) )
COMPLEX,ALLOCATABLE :: phase_vv(:,:)
COMPLEX :: exchcorrect(kpts%nkptf)
COMPLEX :: dcprod(hybrid%nbands(nk),hybrid%nbands(nk),3)
COMPLEX(8) :: exch_vv(hybrid%nbands(nk),hybrid%nbands(nk))
#if defined(CPP_MPI)&&defined(CPP_NEVER)
COMPLEX(8) :: buf_vv(hybrid%nbands(nk),nbands(nk))
COMPLEX(8) :: buf_vv(hybrid%nbands(nk),nbands(nk))
#endif
COMPLEX :: hessian(3,3)
COMPLEX :: proj_ibsc(3,mnobd,hybrid%nbands(nk))
COMPLEX :: olap_ibsc(3,3,mnobd,mnobd)
#if ( !defined CPP_NOSPMVEC && !defined CPP_IRAPPROX )
REAL :: coulomb_mt1(hybrid%maxindxm1-1,hybrid%maxindxm1-1, 0:hybrid%maxlcutm1,atoms%ntype)
REAL :: coulomb_mt2_r(hybrid%maxindxm1-1, -hybrid%maxlcutm1:hybrid%maxlcutm1, 0:hybrid%maxlcutm1+1,atoms%nat)
REAL :: coulomb_mt3_r(hybrid%maxindxm1-1,atoms%nat,atoms%nat)
COMPLEX :: coulomb_mt2_c(hybrid%maxindxm1-1, -hybrid%maxlcutm1:hybrid%maxlcutm1, 0:hybrid%maxlcutm1+1,atoms%nat)
COMPLEX :: coulomb_mt3_c(hybrid%maxindxm1-1,atoms%nat,atoms%nat)
#if ( !defined CPP_NOSPMVEC && !defined CPP_IRAPPROX )
REAL :: coulomb_mt1(hybrid%maxindxm1-1,hybrid%maxindxm1-1, 0:hybrid%maxlcutm1,atoms%ntype)
REAL :: coulomb_mt2_r(hybrid%maxindxm1-1,-hybrid%maxlcutm1:hybrid%maxlcutm1,0:hybrid%maxlcutm1+1,atoms%nat)
REAL :: coulomb_mt3_r(hybrid%maxindxm1-1,atoms%nat,atoms%nat)
COMPLEX :: coulomb_mt2_c(hybrid%maxindxm1-1,-hybrid%maxlcutm1:hybrid%maxlcutm1,0:hybrid%maxlcutm1+1,atoms%nat)
COMPLEX :: coulomb_mt3_c(hybrid%maxindxm1-1,atoms%nat,atoms%nat)
#else
REAL :: coulomb_r(hybrid%maxbasm1*(hybrid%maxbasm1+1)/2)
COMPLEX :: coulomb_c(hybrid%maxbasm1*(hybrid%maxbasm1+1)/2)
REAL :: coulomb_r(hybrid%maxbasm1*(hybrid%maxbasm1+1)/2)
COMPLEX :: coulomb_c(hybrid%maxbasm1*(hybrid%maxbasm1+1)/2)
#endif
REAL ,ALLOCATABLE :: cprod_vv_r(:,:,:),cprod_cv_r(:,:,:), carr3_vv_r(:,:,:),carr3_cv_r(:,:,:)
REAL :: carr1_v_r(hybrid%maxbasm1),carr1_c_r(hybrid%maxbasm1)
#ifdef CPP_IRCOULOMBAPPROX
REAL :: coulomb_mtir_r((hybrid%maxlcutm1+1)**2*atoms%nat , (hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm) )
REAL :: coulomb_mtir_r((hybrid%maxlcutm1+1)**2*atoms%nat,&
(hybrid%maxlcutm1+1)**2*atoms%nat+maxval(hybrid%ngptm))
#else
REAL :: coulomb_mtir_r(((hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm))* ((hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm)+1)/2 )
REAL :: coulomb_mtir_r(((hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm)) *&
((hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm)+1)/2)
#endif
COMPLEX,ALLOCATABLE :: cprod_vv_c(:,:,:),cprod_cv_c(:,:,:), carr3_vv_c(:,:,:),carr3_cv_c(:,:,:)
COMPLEX :: carr1_v_c(hybrid%maxbasm1),carr1_c_c(hybrid%maxbasm1)
#ifdef CPP_IRCOULOMBAPPROX
COMPLEX :: coulomb_mtir_c((hybrid%maxlcutm1+1)**2*atoms%nat , (hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm) )
COMPLEX :: coulomb_mtir_c((hybrid%maxlcutm1+1)**2*atoms%nat,&
(hybrid%maxlcutm1+1)**2*atoms%nat+maxval(hybrid%ngptm))
#else
COMPLEX :: coulomb_mtir_c(((hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm))* ((hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm)+1)/2 )
COMPLEX :: coulomb_mtir_c(((hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm)) *&
((hybrid%maxlcutm1+1)**2*atoms%nat +maxval(hybrid%ngptm)+1)/2)
#endif
LOGICAL :: occup(dimension%neigd)
LOGICAL :: occup(dimension%neigd)
#if defined(CPP_MPI)&&defined(CPP_NEVER)
INCLUDE "mpif.h"
INTEGER :: ierr,ierr2,length,rank
CHARACTER(LEN=MPI_MAX_ERROR_STRING) :: errmsg
INCLUDE "mpif.h"
INTEGER :: ierr,ierr2,length,rank
CHARACTER(LEN=MPI_MAX_ERROR_STRING) :: errmsg
#endif
IF( initialize ) THEN !it .eq. 1 .and. nk .eq. 1) THEN
call calc_divergence(cell,kpts,divergence)
PRINT *,"Divergence:",divergence
initialize = .false.
END IF
IF(initialize) THEN !it .eq. 1 .and. nk .eq. 1) THEN
call calc_divergence(cell,kpts,divergence)
PRINT *,"Divergence:",divergence
initialize = .false.
END IF
! calculate valence-valence-valence-valence, core-valence-valence-valence
! and core-valence-valence-core exchange at current k-point
! the sum over the inner occupied valence states is restricted to the EIBZ(k)
! the contribution of the Gamma-point is treated separately (see below)
! determine package size loop over the occupied bands
if (mat_ex%l_real) THEn
rdum = hybrid%maxbasm1*hybrid%nbands(nk)*4/1048576.
else
rdum = hybrid%maxbasm1*hybrid%nbands(nk)*4/1048576.
endif
psize = 1
DO iband = mnobd,1,-1
! ensure that the packages have equal size
IF( modulo(mnobd,iband) .eq. 0 ) THEN
! choose packet size such that cprod is smaller than memory threshold
IF( rdum*iband .le. maxmem ) THEN
! calculate valence-valence-valence-valence, core-valence-valence-valence
! and core-valence-valence-core exchange at current k-point
! the sum over the inner occupied valence states is restricted to the EIBZ(k)
! the contribution of the Gamma-point is treated separately (see below)
! determine package size loop over the occupied bands
if (mat_ex%l_real) THEn
rdum = hybrid%maxbasm1*hybrid%nbands(nk)*4/1048576.
else
rdum = hybrid%maxbasm1*hybrid%nbands(nk)*4/1048576.
endif
psize = 1
DO iband = mnobd,1,-1
! ensure that the packages have equal size
IF(modulo(mnobd,iband).eq.0) THEN
! choose packet size such that cprod is smaller than memory threshold
IF(rdum*iband.le.maxmem) THEN
psize = iband
EXIT
END IF
END IF
END DO
IF( psize .ne. mnobd ) THEN
WRITE(6,'(A,A,i3,A,f7.2,A)') ' Divide the loop over the occupied hybrid%bands in packages', ' of the size',psize,' (cprod=',rdum*psize,'MB)'
END IF
END IF
ALLOCATE( phase_vv(psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation phase'
phase_vv=0
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation phase'
if (mat_ex%l_real) THEN
ALLOCATE( cprod_vv_c(0,0,0), carr3_vv_c(0,0,0))
ALLOCATE( cprod_vv_r(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation cprod'
ALLOCATE( carr3_vv_r(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation carr3'
cprod_vv_r = 0 ; carr3_vv_r = 0
ELSE
ALLOCATE( cprod_vv_r(0,0,0), carr3_vv_r(0,0,0))
ALLOCATE( cprod_vv_c(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation cprod'
ALLOCATE( carr3_vv_c(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation carr3'
cprod_vv_c = 0 ; carr3_vv_c = 0
endif
END DO
IF(psize.ne.mnobd) THEN
WRITE(6,'(A,A,i3,A,f7.2,A)') ' Divide the loop over the occupied hybrid%bands in packages',&
' of the size',psize,' (cprod=',rdum*psize,'MB)'
END IF
ALLOCATE( phase_vv(psize,hybrid%nbands(nk)),stat=ok )
IF(ok.ne.0) STOP 'exchange_val_hf: error allocation phase'
phase_vv=0
IF(ok.ne.0) STOP 'exchange_val_hf: error allocation phase'
if (mat_ex%l_real) THEN
ALLOCATE( cprod_vv_c(0,0,0), carr3_vv_c(0,0,0))
ALLOCATE( cprod_vv_r(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation cprod'
ALLOCATE( carr3_vv_r(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation carr3'
cprod_vv_r = 0 ; carr3_vv_r = 0
ELSE
ALLOCATE( cprod_vv_r(0,0,0), carr3_vv_r(0,0,0))
ALLOCATE( cprod_vv_c(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation cprod'
ALLOCATE( carr3_vv_c(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation carr3'
cprod_vv_c = 0 ; carr3_vv_c = 0
END IF
exch_vv = 0
exch_vv = 0
DO ikpt = 1,nkpt_EIBZ
ikpt0 = pointer_EIBZ(ikpt)
DO ikpt = 1,nkpt_EIBZ
ikpt0 = pointer_EIBZ(ikpt)
n = hybrid%nbasp + hybrid%ngptm(ikpt0)
IF( hybrid%nbasm(ikpt0) .ne. n ) STOP 'error hybrid%nbasm'
nn = n*(n+1)/2
n = hybrid%nbasp + hybrid%ngptm(ikpt0)
IF( hybrid%nbasm(ikpt0).ne.n) STOP 'error hybrid%nbasm'
nn = n*(n+1)/2
! read in coulomb matrix from direct access file coulomb
! read in coulomb matrix from direct access file coulomb
#if( !defined CPP_NOSPMVEC && !defined CPP_IRAPPROX )
IF (mat_ex%l_real) THEN
CALL read_coulomb_spm_r(kpts%bkp(ikpt0),coulomb_mt1,coulomb_mt2_r,coulomb_mt3_r,coulomb_mtir_r)
ELSE
CALL read_coulomb_spm_c(kpts%bkp(ikpt0),coulomb_mt1,coulomb_mt2_c,coulomb_mt3_c,coulomb_mtir_c)
END IF
IF (mat_ex%l_real) THEN
CALL read_coulomb_spm_r(kpts%bkp(ikpt0),coulomb_mt1,coulomb_mt2_r,coulomb_mt3_r,coulomb_mtir_r)
ELSE
CALL read_coulomb_spm_c(kpts%bkp(ikpt0),coulomb_mt1,coulomb_mt2_c,coulomb_mt3_c,coulomb_mtir_c)
END IF
#else
call read_coulomb(kpts%bkp(ikpt0),coulomb)
call read_coulomb(kpts%bkp(ikpt0),coulomb)
#endif
IF( kpts%bkp(ikpt0) .ne. ikpt0 ) THEN
IF(kpts%bkp(ikpt0).ne.ikpt0) THEN
#if( !defined CPP_NOSPMVEC && !defined CPP_IRAPPROX )
IF( kpts%bksym(ikpt0) .gt. sym%nop.and..not.mat_ex%l_real ) THEN
IF((kpts%bksym(ikpt0).gt.sym%nop).and.(.not.mat_ex%l_real)) THEN
coulomb_mt2_c = conjg(coulomb_mt2_c)
coulomb_mtir_c= conjg(coulomb_mtir_c)
END IF
coulomb_mtir_c = conjg(coulomb_mtir_c)
END IF
#else
if (.not.mat_ex%l_real) THEN
IF( kpts%bksym(ikpt0) .gt. sym%nop ) coulomb = conjg(coulomb)
endif
if (.not.mat_ex%l_real) THEN
IF( kpts%bksym(ikpt0) .gt. sym%nop ) coulomb = conjg(coulomb)
endif
#endif
END IF
END IF
DO ibando = 1,mnobd,psize
if (mat_ex%l_real) THEN
DO ibando = 1, mnobd, psize
IF (mat_ex%l_real) THEN
#ifdef CPP_IRAPPROX
CALL wavefproducts_inv(&
1,hybdat,dimension,jsp,atoms,&
lapw,obsolete,kpts,&
nk,ikpt0,mnobd,hybrid, parent,cell, sym,&
nkqpt,cprod_vv)
CALL wavefproducts_inv(1,hybdat,dimension,jsp,atoms,lapw,obsolete,kpts,nk,ikpt0,&
mnobd,hybrid,parent,cell,sym,nkqpt,cprod_vv)
#else
CALL wavefproducts_inv5(&
1,hybrid%nbands(nk),ibando,ibando+psize-1,&
dimension,input,jsp,atoms,&
lapw,kpts,&
nk,ikpt0,hybdat,mnobd,hybrid,&
parent,cell,hybrid%nbasp,sym,&
noco,&
nkqpt,cprod_vv_r)
CALL wavefproducts_inv5(1,hybrid%nbands(nk),ibando,ibando+psize-1,dimension,input,jsp,atoms,&
lapw,kpts,nk,ikpt0,hybdat,mnobd,hybrid,parent,cell,hybrid%nbasp,sym,&
noco,nkqpt,cprod_vv_r)
#endif
else
ELSE
#ifdef CPP_IRAPPROX
CALL wavefproducts_noinv(&
1,hybdat,nk,ikpt0,dimension,jsp,&
cell,atoms,hybrid,
kpts,&
mnobd,&
lapw,sym,&
nkqpt,&
cprod_vv)
CALL wavefproducts_noinv(1,hybdat,nk,ikpt0,dimension,jsp,cell,atoms,hybrid,
kpts,mnobd,lapw,sym,nkqpt,cprod_vv)
#else
CALL wavefproducts_noinv5(&
1,hybrid%nbands(nk),ibando,ibando+psize-1,&
nk,ikpt0,dimension,input,jsp, &!jsp,&
cell,atoms,hybrid,hybdat, &
kpts,&
mnobd,&
lapw,sym, &
hybrid%nbasp,noco,&
nkqpt,cprod_vv_c)
CALL wavefproducts_noinv5(1,hybrid%nbands(nk),ibando,ibando+psize-1,nk,ikpt0,dimension,input,jsp,&!jsp,&
cell,atoms,hybrid,hybdat,kpts,mnobd,lapw,sym,hybrid%nbasp,noco,nkqpt,cprod_vv_c)
#endif
END IF
endif
! The sparse matrix technique is not feasible for the HSE
! functional. Thus, a dynamic adjustment is implemented
! The mixed basis functions and the potential difference
! are Fourier transformed, so that the exchange can be calculated
! in Fourier space
! The sparse matrix technique is not feasible for the HSE
! functional. Thus, a dynamic adjustment is implemented
! The mixed basis functions and the potential difference
! are Fourier transformed, so that the exchange can be calculated
! in Fourier space
#ifndef CPP_NOSPMVEC
IF ( xcpot%is_name("hse") .OR. xcpot%is_name("vhse") ) THEN
IF (xcpot%is_name("hse").OR.xcpot%is_name("vhse")) THEN
iband1 = hybrid%nobd(nkqpt)
exch_vv = exch_vv + dynamic_hse_adjustment(&
atoms%rmsh,atoms%rmt,atoms%dx,atoms%jri,atoms%jmtd,kpts%bkf(:,ikpt0),ikpt0,kpts%nkptf,&
cell%bmat,cell%omtil,atoms%ntype,atoms%neq,atoms%nat,atoms%taual,hybrid%lcutm1,hybrid%maxlcutm1,&
hybrid%nindxm1,hybrid%maxindxm1,hybrid%gptm,hybrid%ngptm(ikpt0),hybrid%pgptm(:,ikpt0),&
hybrid%gptmd,hybrid%basm1,hybrid%nbasm(ikpt0),iband1,hybrid%nbands(nk),nsest,&
ibando,psize,indx_sest,atoms%invsat,sym%invsatnr,mpi%irank,&
cprod_vv_r(:hybrid%nbasm(ikpt0),:,:),&
cprod_vv_c(:hybrid%nbasm(ikpt0),:,:),&
mat_ex%l_real,wl_iks(:iband1,nkqpt),n_q(ikpt))
END IF
exch_vv = exch_vv +&
dynamic_hse_adjustment(atoms%rmsh,atoms%rmt,atoms%dx,atoms%jri,atoms%jmtd,kpts%bkf(:,ikpt0),ikpt0,&
kpts%nkptf,cell%bmat,cell%omtil,atoms%ntype,atoms%neq,atoms%nat,atoms%taual,&
hybrid%lcutm1,hybrid%maxlcutm1,hybrid%nindxm1,hybrid%maxindxm1,hybrid%gptm,&
hybrid%ngptm(ikpt0),hybrid%pgptm(:,ikpt0),hybrid%gptmd,hybrid%basm1,&
hybrid%nbasm(ikpt0),iband1,hybrid%nbands(nk),nsest,ibando,psize,indx_sest,&
atoms%invsat,sym%invsatnr,mpi%irank,cprod_vv_r(:hybrid%nbasm(ikpt0),:,:),&
cprod_vv_c(:hybrid%nbasm(ikpt0),:,:),mat_ex%l_real,wl_iks(:iband1,nkqpt),n_q(ikpt))
END IF
#endif
! the Coulomb matrix is only evaluated at the irrecuible k-points
! bra_trafo transforms cprod instead of rotating the Coulomb matrix
! from IBZ to current k-point
IF( kpts%bkp(ikpt0) .ne. ikpt0 ) THEN
CALL bra_trafo2(&
mat_ex%l_real,carr3_vv_r(:hybrid%nbasm(ikpt0),:,:),cprod_vv_r(:hybrid%nbasm(ikpt0),:,:),&
carr3_vv_c(:hybrid%nbasm(ikpt0),:,:),cprod_vv_c(:hybrid%nbasm(ikpt0),:,:),&
hybrid%nbasm(ikpt0),psize,hybrid%nbands(nk),&
kpts%bkp(ikpt0),ikpt0,kpts%bksym(ikpt0),sym,&
hybrid,kpts,cell,atoms,&
phase_vv)
IF (mat_ex%l_real) THEN
cprod_vv_r(:hybrid%nbasm(ikpt0),:,:) = carr3_vv_r(:hybrid%nbasm(ikpt0),:,:)
ELSE
cprod_vv_c(:hybrid%nbasm(ikpt0),:,:) = carr3_vv_c(:hybrid%nbasm(ikpt0),:,:)
ENDIF
ELSE
! the Coulomb matrix is only evaluated at the irrecuible k-points
! bra_trafo transforms cprod instead of rotating the Coulomb matrix
! from IBZ to current k-point
IF( kpts%bkp(ikpt0) .ne. ikpt0 ) THEN
CALL bra_trafo2(mat_ex%l_real,carr3_vv_r(:hybrid%nbasm(ikpt0),:,:),cprod_vv_r(:hybrid%nbasm(ikpt0),:,:),&
carr3_vv_c(:hybrid%nbasm(ikpt0),:,:),cprod_vv_c(:hybrid%nbasm(ikpt0),:,:),&
hybrid%nbasm(ikpt0),psize,hybrid%nbands(nk),kpts%bkp(ikpt0),ikpt0,kpts%bksym(ikpt0),sym,&
hybrid,kpts,cell,atoms,phase_vv)
IF (mat_ex%l_real) THEN
cprod_vv_r(:hybrid%nbasm(ikpt0),:,:) = carr3_vv_r(:hybrid%nbasm(ikpt0),:,:)
ELSE
cprod_vv_c(:hybrid%nbasm(ikpt0),:,:) = carr3_vv_c(:hybrid%nbasm(ikpt0),:,:)
ENDIF
ELSE
phase_vv(:,:) = (1d0,0d0)
END IF
END IF
! calculate exchange matrix at ikpt0
! calculate exchange matrix at ikpt0
DO n1=1,hybrid%nbands(nk)
DO n1=1,hybrid%nbands(nk)
DO iband = 1,psize
IF( ibando + iband - 1 .gt. hybrid%nobd(nkqpt) ) CYCLE
cdum = wl_iks(ibando+iband-1,nkqpt)&
* conjg(phase_vv(iband,n1))/n_q(ikpt)
IF((ibando+iband-1).gt.hybrid%nobd(nkqpt)) CYCLE
cdum = wl_iks(ibando+iband-1,nkqpt) * conjg(phase_vv(iband,n1))/n_q(ikpt)
#if( !defined CPP_NOSPMVEC && !defined CPP_IRAPPROX )
if (mat_ex%l_real) THEN
carr1_v_r(:n) = 0
CALL spmvec_invs(atoms,hybrid,&
hybdat,ikpt0,kpts,&
cell,&
coulomb_mt1,coulomb_mt2_r,coulomb_mt3_r,&
coulomb_mtir_r,cprod_vv_r(:n,iband,n1),&
carr1_v_r(:n))
ELSE
carr1_v_c(:n) = 0
CALL spmvec_noinvs(atoms,hybrid,&
hybdat,ikpt0,kpts,&
cell,&
coulomb_mt1,coulomb_mt2_c,coulomb_mt3_c,&
coulomb_mtir_c,cprod_vv_c(:n,iband,n1),&
carr1_v_c(:n))
endif
IF (mat_ex%l_real) THEN
carr1_v_r(:n) = 0