Commit 1730364b authored by Matthias Redies's avatar Matthias Redies

format all the hybrid code

parent 567d369d
......@@ -4,76 +4,70 @@ MODULE m_hf_init
! preparations for HF and hybrid functional calculation
!
CONTAINS
SUBROUTINE hf_init(hybrid,kpts,atoms,input,DIMENSION,hybdat,l_real)
SUBROUTINE hf_init(hybrid, kpts, atoms, input, DIMENSION, hybdat, l_real)
USE m_types
USE m_read_core
USE m_util
USE m_io_hybrid
IMPLICIT NONE
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_hybdat),INTENT(OUT) :: hybdat
LOGICAL,INTENT(IN) :: l_real
INTEGER:: itype,ieq,l,m,i,nk,l1,l2,m1,m2,ok
TYPE(t_hybrid), INTENT(INOUT) :: hybrid
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_input), INTENT(IN) :: input
TYPE(t_dimension), INTENT(IN) :: DIMENSION
TYPE(t_hybdat), INTENT(OUT) :: hybdat
LOGICAL, INTENT(IN) :: l_real
INTEGER:: itype, ieq, l, m, i, nk, l1, l2, m1, m2, ok
!initialize hybdat%gridf for radial integration
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
CALL intgrf_init(atoms%ntype, atoms%jmtd, atoms%jri, atoms%dx, atoms%rmsh, hybdat%gridf)
!Alloc variables
ALLOCATE(hybdat%lmaxc(atoms%ntype))
ALLOCATE(hybdat%bas1(atoms%jmtd,hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
ALLOCATE(hybdat%bas2(atoms%jmtd,hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
ALLOCATE(hybdat%bas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
ALLOCATE(hybdat%drbas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
ALLOCATE (hybdat%lmaxc(atoms%ntype))
ALLOCATE (hybdat%bas1(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype))
ALLOCATE (hybdat%bas2(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype))
ALLOCATE (hybdat%bas1_MT(hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype))
ALLOCATE (hybdat%drbas1_MT(hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype))
!sym%tau = oneD%ods%tau
! preparations for core states
CALL core_init(dimension,input,atoms, hybdat%lmaxcd,hybdat%maxindxc)
ALLOCATE( hybdat%nindxc(0:hybdat%lmaxcd,atoms%ntype), stat = ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%nindxc'
ALLOCATE( hybdat%core1(atoms%jmtd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation core1'
ALLOCATE( hybdat%core2(atoms%jmtd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation core2'
ALLOCATE( hybdat%eig_c(hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%eig_c'
hybdat%nindxc = 0 ; hybdat%core1 = 0 ; hybdat%core2 = 0 ; hybdat%eig_c = 0
CALL core_init(dimension, input, atoms, hybdat%lmaxcd, hybdat%maxindxc)
ALLOCATE (hybdat%nindxc(0:hybdat%lmaxcd, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation hybdat%nindxc'
ALLOCATE (hybdat%core1(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation core1'
ALLOCATE (hybdat%core2(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation core2'
ALLOCATE (hybdat%eig_c(hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation hybdat%eig_c'
hybdat%nindxc = 0; hybdat%core1 = 0; hybdat%core2 = 0; hybdat%eig_c = 0
! pre-calculate gaunt coefficients
hybdat%maxfac = max(2*atoms%lmaxd+hybrid%maxlcutm1+1,2*hybdat%lmaxcd+2*atoms%lmaxd+1)
ALLOCATE ( hybdat%fac( 0:hybdat%maxfac),hybdat%sfac( 0:hybdat%maxfac),stat=ok)
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation fac,hybdat%sfac'
hybdat%maxfac = max(2*atoms%lmaxd + hybrid%maxlcutm1 + 1, 2*hybdat%lmaxcd + 2*atoms%lmaxd + 1)
ALLOCATE (hybdat%fac(0:hybdat%maxfac), hybdat%sfac(0:hybdat%maxfac), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation fac,hybdat%sfac'
hybdat%fac(0) = 1
hybdat%sfac(0) = 1
DO i=1,hybdat%maxfac
hybdat%fac(i) = hybdat%fac(i-1)*i ! hybdat%fac(i) = i!
hybdat%sfac(i) = hybdat%sfac(i-1)*sqrt(i*1.0) ! hybdat%sfac(i) = sqrt(i!)
DO i = 1, hybdat%maxfac
hybdat%fac(i) = hybdat%fac(i - 1)*i ! hybdat%fac(i) = i!
hybdat%sfac(i) = hybdat%sfac(i - 1)*sqrt(i*1.0) ! hybdat%sfac(i) = sqrt(i!)
END DO
ALLOCATE ( hybdat%gauntarr( 2, 0:atoms%lmaxd, 0:atoms%lmaxd, 0:hybrid%maxlcutm1, -atoms%lmaxd:atoms%lmaxd ,-hybrid%maxlcutm1:hybrid%maxlcutm1 ),stat=ok)
IF( ok .ne. 0 ) STOP 'eigen: failure allocation hybdat%gauntarr'
ALLOCATE (hybdat%gauntarr(2, 0:atoms%lmaxd, 0:atoms%lmaxd, 0:hybrid%maxlcutm1, -atoms%lmaxd:atoms%lmaxd, -hybrid%maxlcutm1:hybrid%maxlcutm1), stat=ok)
IF (ok /= 0) STOP 'eigen: failure allocation hybdat%gauntarr'
hybdat%gauntarr = 0
DO l2 = 0,atoms%lmaxd
DO l1 = 0,atoms%lmaxd
DO l = abs(l1-l2),min(l1+l2,hybrid%maxlcutm1)
DO m = -l,l
DO m1 = -l1,l1
DO l2 = 0, atoms%lmaxd
DO l1 = 0, atoms%lmaxd
DO l = abs(l1 - l2), min(l1 + l2, hybrid%maxlcutm1)
DO m = -l, l
DO m1 = -l1, l1
m2 = m1 + m ! Gaunt condition -m1+m2-m = 0
IF(abs(m2).le.l2) hybdat%gauntarr(1,l1,l2,l,m1,m) = gaunt(l1,l2,l,m1,m2,m,hybdat%maxfac,hybdat%fac,hybdat%sfac)
IF (abs(m2) <= l2) hybdat%gauntarr(1, l1, l2, l, m1, m) = gaunt(l1, l2, l, m1, m2, m, hybdat%maxfac, hybdat%fac, hybdat%sfac)
m2 = m1 - m ! switch role of l2-index
IF(abs(m2).le.l2) hybdat%gauntarr(2,l1,l2,l,m1,m) = gaunt(l2,l1,l,m2,m1,m,hybdat%maxfac,hybdat%fac,hybdat%sfac)
IF (abs(m2) <= l2) hybdat%gauntarr(2, l1, l2, l, m1, m) = gaunt(l2, l1, l, m2, m1, m, hybdat%maxfac, hybdat%fac, hybdat%sfac)
END DO
END DO
END DO
......
......@@ -40,17 +40,17 @@ MODULE m_add_vnonlocal
! 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
CONTAINS
CONTAINS
SUBROUTINE add_vnonlocal(nk,lapw,atoms,hybrid,dimension,kpts,jsp,results,xcpot,noco,hmat)
SUBROUTINE add_vnonlocal(nk, lapw, atoms, hybrid, dimension, kpts, jsp, results, xcpot, noco, hmat)
USE m_symm_hf, ONLY: symm_hf
USE m_util, ONLY: intgrf,intgrf_init
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_hsefunctional, ONLY: exchange_vccvHSE, exchange_ccccHSE
USE m_types
USE m_io_hybrid
......@@ -70,65 +70,65 @@ MODULE m_add_vnonlocal
INTEGER, INTENT(IN) :: nk
! local scalars
INTEGER :: n,nn,iband,nbasfcn
INTEGER :: n, nn, iband, nbasfcn
REAL :: a_ex
TYPE(t_mat) :: olap,tmp,v_x,z
COMPLEX :: exch(dimension%neigd,dimension%neigd)
TYPE(t_mat) :: olap, tmp, v_x, z
COMPLEX :: exch(dimension%neigd, dimension%neigd)
! initialize weighting factor for HF exchange part
a_ex=xcpot%get_exchange_weight()
a_ex = xcpot%get_exchange_weight()
nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
CALL v_x%init(hmat%l_real,nbasfcn,nbasfcn)
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
CALL v_x%init(hmat%l_real, nbasfcn, nbasfcn)
CALL read_v_x(v_x,kpts%nkpt*(jsp-1)+nk)
CALL read_v_x(v_x, kpts%nkpt*(jsp - 1) + nk)
! add non-local x-potential to the hamiltonian hmat
DO n = 1, v_x%matsize1
DO nn = 1, n
IF (hmat%l_real) THEN
hmat%data_r(nn,n) = hmat%data_r(nn,n) - a_ex*v_x%data_r(nn,n)
hmat%data_r(nn, n) = hmat%data_r(nn, n) - a_ex*v_x%data_r(nn, n)
ELSE
hmat%data_c(nn,n) = hmat%data_c(nn,n) - a_ex*v_x%data_c(nn,n)
hmat%data_c(nn, n) = hmat%data_c(nn, n) - a_ex*v_x%data_c(nn, n)
ENDIF
END DO
END DO
! calculate HF energy
IF(hybrid%l_calhf) THEN
WRITE(6,'(A)') new_line('n')//new_line('n')//' ### '// ' diagonal HF exchange elements (eV) ###'
IF (hybrid%l_calhf) THEN
WRITE (6, '(A)') new_line('n')//new_line('n')//' ### '//' diagonal HF exchange elements (eV) ###'
WRITE(6,'(A)') new_line('n') // ' k-point '// 'band tail pole total(valence+core)'
WRITE (6, '(A)') new_line('n')//' k-point '//'band tail pole total(valence+core)'
END IF
! read in lower triangle part of overlap matrix from direct acces file olap
CALL olap%init(hmat%l_real,nbasfcn,nbasfcn)
CALL read_olap(olap,kpts%nkpt*(jsp-1)+nk)
IF (.NOT.olap%l_real) olap%data_c=conjg(olap%data_c)
CALL olap%init(hmat%l_real, nbasfcn, nbasfcn)
CALL read_olap(olap, kpts%nkpt*(jsp - 1) + nk)
IF (.NOT. olap%l_real) olap%data_c = conjg(olap%data_c)
CALL z%init(olap%l_real,nbasfcn,dimension%neigd)
CALL z%init(olap%l_real, nbasfcn, dimension%neigd)
CALL read_z(z,kpts%nkpt*(jsp-1)+nk)
CALL read_z(z, kpts%nkpt*(jsp - 1) + nk)
! calculate exchange contribution of current k-point nk to total energy (te_hfex)
! in the case of a spin-unpolarized calculation the factor 2 is added in eigen.F90
IF (.NOT.v_x%l_real) v_x%data_c=conjg(v_x%data_c)
IF (.NOT. v_x%l_real) v_x%data_c = conjg(v_x%data_c)
exch = 0
z%matsize1=MIN(z%matsize1,v_x%matsize2)
z%matsize1 = MIN(z%matsize1, v_x%matsize2)
CALL v_x%multiply(z,tmp)
CALL v_x%multiply(z, tmp)
DO iband = 1, hybrid%nbands(nk)
IF (z%l_real) THEN
exch(iband,iband) = dot_product(z%data_r(:z%matsize1,iband),tmp%data_r(:,iband))
exch(iband, iband) = dot_product(z%data_r(:z%matsize1, iband), tmp%data_r(:, iband))
ELSE
exch(iband,iband) = dot_product(z%data_c(:z%matsize1,iband),tmp%data_c(:,iband))
exch(iband, iband) = dot_product(z%data_c(:z%matsize1, iband), tmp%data_c(:, iband))
END IF
IF(iband.LE.hybrid%nobd(nk)) THEN
results%te_hfex%valence = results%te_hfex%valence -a_ex*results%w_iks(iband,nk,jsp)*exch(iband,iband)
IF (iband <= hybrid%nobd(nk)) THEN
results%te_hfex%valence = results%te_hfex%valence - a_ex*results%w_iks(iband, nk, jsp)*exch(iband, iband)
END IF
IF(hybrid%l_calhf) THEN
WRITE(6, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F15.5)')&
kpts%bkf(:,nk),iband, (REAL(exch(iband,iband))-hybrid%div_vv(iband,nk,jsp))*(-27.211608),&
hybrid%div_vv(iband,nk,jsp)*(-27.211608),REAL(exch(iband,iband))*(-27.211608)
IF (hybrid%l_calhf) THEN
WRITE (6, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F15.5)') &
kpts%bkf(:, nk), iband, (REAL(exch(iband, iband)) - hybrid%div_vv(iband, nk, jsp))*(-27.211608), &
hybrid%div_vv(iband, nk, jsp)*(-27.211608), REAL(exch(iband, iband))*(-27.211608)
END IF
END DO
END SUBROUTINE add_vnonlocal
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -33,7 +33,7 @@ contains
! otherwise a Gauss-Laguerre expansion is better
else
res = exp(-arg) * gauss_laguerre(arg)
res = exp(-arg)*gauss_laguerre(arg)
endif
end subroutine calculateExponentialIntegral
......@@ -70,13 +70,13 @@ contains
! perform the summation
do i = ITERATION, 2, -1
! calculate 1/n
fact = 1.0 / i
fact = 1.0/i
! add next term of summation
res = arg * fact * (fact - res)
res = arg*fact*(fact - res)
end do
! calculate the final result
seriesExpansion = -EULER_GAMMA - log(arg) + arg * (1.0 - res)
seriesExpansion = -EULER_GAMMA - log(arg) + arg*(1.0 - res)
end function seriesExpansion
......@@ -100,13 +100,13 @@ contains
real, intent(in) :: arg
! the quadrature constants a_n and x_n from [1]
real, parameter :: a(1:15) = (/&
real, parameter :: a(1:15) = (/ &
0.2182348859400869e+00, 0.3422101779228833e+00, 0.2630275779416801e+00, &
0.1264258181059305e+00, 0.4020686492100091e-01, 0.8563877803611838e-02, &
0.1212436147214252e-02, 0.1116743923442519e-03, 0.6459926762022901e-05, &
0.2226316907096273e-06, 0.4227430384979365e-08, 0.3921897267041089e-10, &
0.1456515264073126e-12, 0.1483027051113301e-15, 0.1600594906211133e-19/)
real, parameter :: x(1:15) = (/&
real, parameter :: x(1:15) = (/ &
0.9330781201728180e-01, 0.4926917403018839e+00, 0.1215595412070949e+01, &
0.2269949526203743e+01, 0.3667622721751437e+01, 0.5425336627413553e+01, &
0.7565916226613068e+01, 0.1012022856801911e+02, 0.1313028248217572e+02, &
......@@ -114,7 +114,7 @@ contains
0.3140751916975394e+02, 0.3853068330648601e+02, 0.4802608557268579e+02/)
! Calculate the summation
gauss_laguerre = sum( a / (x + arg) )
gauss_laguerre = sum(a/(x + arg))
end function gauss_laguerre
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
MODULE m_hyb_abcrot
CONTAINS
SUBROUTINE hyb_abcrot(hybrid,atoms,neig,sym,cell,oneD,&
& acof,bcof,ccof)
CONTAINS
SUBROUTINE hyb_abcrot(hybrid, atoms, neig, sym, cell, oneD,&
& acof, bcof, ccof)
! ***************************************************************
! * This routine transforms a/b/cof which are given wrt rotated *
! * MT functions (according to invsat/ngopr) into a/b/cof wrt *
......@@ -13,31 +13,31 @@ MODULE m_hyb_abcrot
USE m_dwigner
USE m_types
IMPLICIT NONE
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_hybrid), INTENT(IN) :: hybrid
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_atoms), INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: neig
INTEGER, INTENT(IN) :: neig
! ..
! .. Array Arguments ..
COMPLEX, INTENT (INOUT) :: acof(:,0:,:) !(dimension%neigd,0:dimension%lmd,atoms%natd)
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:) !(dimension%neigd,0:dimension%lmd,atoms%natd)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,dimension%neigd,atoms%nlod,atoms%natd)
COMPLEX, INTENT(INOUT) :: acof(:, 0:, :) !(dimension%neigd,0:dimension%lmd,atoms%natd)
COMPLEX, INTENT(INOUT) :: bcof(:, 0:, :) !(dimension%neigd,0:dimension%lmd,atoms%natd)
COMPLEX, INTENT(INOUT) :: ccof(-atoms%llod:, :, :, :)!(-llod:llod,dimension%neigd,atoms%nlod,atoms%natd)
! ..
! .. Local Scalars ..
INTEGER itype,ineq,iatom,iop,ilo,i,l ,lm,lmp,ifac
INTEGER itype, ineq, iatom, iop, ilo, i, l, lm, lmp, ifac
! ..
! .. Local Arrays ..
!***** COMPLEX, ALLOCATABLE :: d_wgn(:,:,:,:) !put into module m_savewigner
!
IF ( .NOT.ALLOCATED(hybrid%d_wgn2) ) THEN !calculate sym%d_wgn only once
IF (.NOT. ALLOCATED(hybrid%d_wgn2)) THEN !calculate sym%d_wgn only once
#ifndef CPP_MPI
PRINT*,"calculate wigner-matrix"
PRINT *, "calculate wigner-matrix"
#endif
STOP "WIGNER MATRIX should be available in hybrid part"
!IF (.NOT.oneD%odi%d1) THEN
......@@ -49,39 +49,39 @@ MODULE m_hyb_abcrot
!ENDIF
ENDIF
iatom=0
DO itype=1,atoms%ntype
DO ineq=1,atoms%neq(itype)
iatom=iatom+1
IF (.NOT.oneD%odi%d1) THEN
iop=atoms%ngopr(iatom)
iatom = 0
DO itype = 1, atoms%ntype
DO ineq = 1, atoms%neq(itype)
iatom = iatom + 1
IF (.NOT. oneD%odi%d1) THEN
iop = atoms%ngopr(iatom)
ELSE
iop=oneD%ods%ngopr(iatom)
iop = oneD%ods%ngopr(iatom)
ENDIF
! l l l
! inversion of spherical harmonics: Y (pi-theta,pi+phi) = (-1) * Y (theta,phi)
! m m
ifac = 1
IF(atoms%invsat(iatom).EQ.2) THEN
IF (.NOT.oneD%odi%d1) THEN
iop=atoms%ngopr(sym%invsatnr(iatom))
IF (atoms%invsat(iatom) == 2) THEN
IF (.NOT. oneD%odi%d1) THEN
iop = atoms%ngopr(sym%invsatnr(iatom))
ELSE
iop=oneD%ods%ngopr(sym%invsatnr(iatom))
iop = oneD%ods%ngopr(sym%invsatnr(iatom))
ENDIF
ifac = -1
ENDIF
DO l=1,atoms%lmax(itype)
DO l = 1, atoms%lmax(itype)
! replaced d_wgn by conjg(d_wgn),FF October 2006
DO i=1,neig
acof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(conjg(hybrid%d_wgn2(-l:l,-l:l,l,iop)), acof(i,l**2:l*(l+2),iatom))
bcof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(conjg(hybrid%d_wgn2(-l:l,-l:l,l,iop)), bcof(i,l**2:l*(l+2),iatom))
DO i = 1, neig
acof(i, l**2:l*(l + 2), iatom) = ifac**l*matmul(conjg(hybrid%d_wgn2(-l:l, -l:l, l, iop)), acof(i, l**2:l*(l + 2), iatom))
bcof(i, l**2:l*(l + 2), iatom) = ifac**l*matmul(conjg(hybrid%d_wgn2(-l:l, -l:l, l, iop)), bcof(i, l**2:l*(l + 2), iatom))
ENDDO
ENDDO
DO ilo=1,atoms%nlo(itype)
l=atoms%llo(ilo,itype)
IF(l.gt.0) THEN
DO i=1,neig
ccof(-l:l,i,ilo,iatom) = ifac**l * matmul(conjg(hybrid%d_wgn2(-l:l,-l:l,l,iop)), ccof(-l:l,i,ilo,iatom))
DO ilo = 1, atoms%nlo(itype)
l = atoms%llo(ilo, itype)
IF (l > 0) THEN
DO i = 1, neig
ccof(-l:l, i, ilo, iatom) = ifac**l*matmul(conjg(hybrid%d_wgn2(-l:l, -l:l, l, iop)), ccof(-l:l, i, ilo, iatom))
ENDDO
ENDIF
ENDDO
......@@ -89,4 +89,4 @@ MODULE m_hyb_abcrot
ENDDO
END SUBROUTINE hyb_abcrot
END MODULE m_hyb_abcrot
END MODULE m_hyb_abcrot
......@@ -10,8 +10,8 @@ MODULE m_calc_hybrid
CONTAINS
SUBROUTINE calc_hybrid(eig_id,hybrid,kpts,atoms,input,DIMENSION,mpi,noco,cell,oneD,&
enpara,results,sym,xcpot,v,iter,iterHF)
SUBROUTINE calc_hybrid(eig_id, hybrid, kpts, atoms, input, DIMENSION, mpi, noco, cell, oneD, &
enpara, results, sym, xcpot, v, iter, iterHF)
USE m_types
USE m_mixedbasis
......@@ -44,31 +44,31 @@ CONTAINS
INTEGER, INTENT(IN) :: eig_id
! local variables
INTEGER :: jsp,nk,nred
INTEGER :: jsp, nk, nred
TYPE(t_hybdat) :: hybdat
type(t_lapw) :: lapw
LOGICAL :: init_vex=.TRUE. !In first call we have to init v_nonlocal
LOGICAL :: l_restart=.FALSE.
LOGICAL :: init_vex = .TRUE. !In first call we have to init v_nonlocal
LOGICAL :: l_restart = .FALSE.
LOGICAL :: l_zref
REAL :: bkpt(3)
REAL, ALLOCATABLE :: eig_irr(:,:)
REAL, ALLOCATABLE :: eig_irr(:, :)
CALL timestart("Hybrid code")
INQUIRE(file="v_x.mat",exist=hybrid%l_addhf)
CALL open_hybrid_io1(DIMENSION,sym%invs)
INQUIRE (file="v_x.mat", exist=hybrid%l_addhf)
CALL open_hybrid_io1(DIMENSION, sym%invs)
IF (kpts%nkptf==0) THEN
CALL judft_error("kpoint-set of full BZ not available",&
IF (kpts%nkptf == 0) THEN
CALL judft_error("kpoint-set of full BZ not available", &
hint="to generate kpts in the full BZ you should specify a k-mesh in inp.xml")
END IF
!Check if new non-local potential shall be generated
hybrid%l_subvxc = hybrid%l_hybrid.AND.(.NOT.xcpot%is_name("exx"))
hybrid%l_subvxc = hybrid%l_hybrid .AND. (.NOT. xcpot%is_name("exx"))
!If this is the first iteration loop we can not calculate a new non-local potential
hybrid%l_calhf = (results%last_distance.GE.0.0).AND.(results%last_distance.LT.input%minDistance)
IF(.NOT.hybrid%l_calhf) THEN
hybrid%l_subvxc = hybrid%l_subvxc.AND.hybrid%l_addhf
hybrid%l_calhf = (results%last_distance >= 0.0) .AND. (results%last_distance < input%minDistance)
IF (.NOT. hybrid%l_calhf) THEN
hybrid%l_subvxc = hybrid%l_subvxc .AND. hybrid%l_addhf
CALL timestop("Hybrid code")
RETURN
ENDIF
......@@ -78,22 +78,22 @@ CONTAINS
!Check if we are converged well enough to calculate a new potential
#if defined(CPP_MPI)&&defined(CPP_NEVER)
CALL judft_error("Hybrid functionals do not work in parallel version yet")
CALL MPI_BCAST(results%last_distance ....
CALL MPI_BCAST(results%last_distance....
#endif
CALL open_hybrid_io1b(DIMENSION,sym%invs)
CALL open_hybrid_io1b(DIMENSION, sym%invs)
hybrid%l_addhf = .TRUE.
!In first iteration allocate some memory
IF (init_vex) THEN
ALLOCATE(hybrid%ne_eig(kpts%nkpt),hybrid%nbands(kpts%nkpt),hybrid%nobd(kpts%nkptf))
ALLOCATE(hybrid%nbasm(kpts%nkptf))
ALLOCATE(hybrid%div_vv(DIMENSION%neigd,kpts%nkpt,input%jspins))
init_vex=.FALSE.
ALLOCATE (hybrid%ne_eig(kpts%nkpt), hybrid%nbands(kpts%nkpt), hybrid%nobd(kpts%nkptf))
ALLOCATE (hybrid%nbasm(kpts%nkptf))
ALLOCATE (hybrid%div_vv(DIMENSION%neigd, kpts%nkpt, input%jspins))
init_vex = .FALSE.
END IF
hybrid%l_subvxc = (hybrid%l_subvxc.AND.hybrid%l_addhf)
IF(.NOT.ALLOCATED(results%w_iks)) ALLOCATE (results%w_iks(DIMENSION%neigd2,kpts%nkpt,input%jspins))
hybrid%l_subvxc = (hybrid%l_subvxc .AND. hybrid%l_addhf)
IF (.NOT. ALLOCATED(results%w_iks)) ALLOCATE (results%w_iks(DIMENSION%neigd2, kpts%nkpt, input%jspins))
IF (hybrid%l_calhf) THEN
iterHF = iterHF + 1
......@@ -103,35 +103,34 @@ CONTAINS
!check if z-reflection trick can be used
l_zref = (sym%zrfs.AND.(SUM(ABS(kpts%bk(3,:kpts%nkpt))).LT.1e-9).AND..NOT.noco%l_noco)
l_zref = (sym%zrfs .AND. (SUM(ABS(kpts%bk(3, :kpts%nkpt))) < 1e-9) .AND. .NOT. noco%l_noco)
CALL timestart("Preparation for Hybrid functionals")
! CALL juDFT_WARN ("Hybrid functionals not working in this version")
!construct the mixed-basis
CALL timestart("generation of mixed basis")
CALL mixedbasis(atoms,kpts,dimension,input,cell,sym,xcpot,hybrid,enpara,mpi,v,l_restart)
CALL mixedbasis(atoms, kpts, dimension, input, cell, sym, xcpot, hybrid, enpara, mpi, v, l_restart)
CALL timestop("generation of mixed basis")
CALL open_hybrid_io2(hybrid,DIMENSION,atoms,sym%invs)
CALL open_hybrid_io2(hybrid, DIMENSION, atoms, sym%invs)
CALL coulombmatrix(mpi,atoms,kpts,cell,sym,hybrid,xcpot,l_restart)
CALL coulombmatrix(mpi, atoms, kpts, cell, sym, hybrid, xcpot, l_restart)
CALL hf_init(hybrid,kpts,atoms,input,DIMENSION,hybdat,sym%invs)
CALL hf_init(hybrid, kpts, atoms, input, DIMENSION, hybdat, sym%invs)
CALL timestop("Preparation for Hybrid functionals")
CALL timestart("Calculation of non-local HF potential")
DO jsp = 1,input%jspins
DO jsp = 1, input%jspins
call timestart("HF_setup")
CALL HF_setup(hybrid,input,sym,kpts,dimension,atoms,mpi,noco,cell,oneD,results,jsp,enpara,eig_id,&
hybdat,iterHF,sym%invs,v%mt(:,0,:,:),eig_irr)
CALL HF_setup(hybrid, input, sym, kpts, dimension, atoms, mpi, noco, cell, oneD, results, jsp, enpara, eig_id, &
hybdat, iterHF, sym%invs, v%mt(:, 0, :, :), eig_irr)
call timestop("HF_setup")
DO nk = 1,kpts%nkpt
DO nk = 1, kpts%nkpt
!DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride