Commit b7b9f318 authored by Matthias Redies's avatar Matthias Redies

move nbands, ne_eig, nobd from hybinp to hybdat

parent 3dc77cd3
......@@ -30,9 +30,7 @@ MODULE m_types_hybinp
INTEGER, ALLOCATABLE :: nbasm(:)
!REAL, ALLOCATABLE :: radbasfn_mt(:,:,:,:)
COMPLEX, ALLOCATABLE :: d_wgn2(:, :, :, :)
INTEGER, ALLOCATABLE :: ne_eig(:)
INTEGER, ALLOCATABLE :: nbands(:)
INTEGER, ALLOCATABLE :: nobd(:, :)
CONTAINS
PROCEDURE :: read_xml => read_xml_hybinp
PROCEDURE :: mpi_bc => mpi_bc_hybinp
......@@ -60,36 +58,16 @@ CONTAINS
CALL mpi_bc(this%lexp, rank, mpi_comm)
CALL mpi_bc(this%bands1, rank, mpi_comm)
CALL mpi_bc(this%nbasp, rank, mpi_comm)
!CALL mpi_bc(this%maxlcutm1,rank,mpi_comm)
!CALL mpi_bc(this%maxindxm1,rank,mpi_comm)
CALL mpi_bc(this%maxbasm1, rank, mpi_comm)
CALL mpi_bc(this%max_indx_p_1, rank, mpi_comm)
!CALL mpi_bc(this%maxindxp1,rank,mpi_comm)
!CALL mpi_bc(this%maxgptm,rank,mpi_comm)
!CALL mpi_bc(this%maxgptm1,rank,mpi_comm)
!CALL mpi_bc(this%maxindx,rank,mpi_comm)
CALL mpi_bc(this%maxlmindx, rank, mpi_comm)
!CALL mpi_bc(this%gptmd,rank,mpi_comm)
!CALL mpi_bc(this%nindx,rank,mpi_comm)
CALL mpi_bc(this%select1, rank, mpi_comm)
CALL mpi_bc(this%lcutm1, rank, mpi_comm)
!CALL mpi_bc(this%nindxm1,rank,mpi_comm)
!CALL mpi_bc(this%gptm,rank,mpi_comm)
!CALL mpi_bc(this%ngptm1,rank,mpi_comm)
!CALL mpi_bc(this%pgptm1,rank,mpi_comm)
!CALL mpi_bc(this%ngptm,rank,mpi_comm)
!CALL mpi_bc(this%pgptm,rank,mpi_comm)
CALL mpi_bc(this%lcutwf, rank, mpi_comm)
CALL mpi_bc(this%map, rank, mpi_comm)
CALL mpi_bc(this%tvec, rank, mpi_comm)
CALL mpi_bc(this%nbasm, rank, mpi_comm)
!CALL mpi_bc(this%gcutm1,rank,mpi_comm)
!CALL mpi_bc(this%tolerance1 ,rank,mpi_comm)
!CALL mpi_bc(this%basm1,rank,mpi_comm)
CALL mpi_bc(this%d_wgn2, rank, mpi_comm)
CALL mpi_bc(this%ne_eig, rank, mpi_comm)
CALL mpi_bc(this%nbands, rank, mpi_comm)
CALL mpi_bc(this%nobd, rank, mpi_comm)
END SUBROUTINE mpi_bc_hybinp
SUBROUTINE read_xml_hybinp(this, xml)
USE m_types_xml
......
......@@ -119,13 +119,13 @@ CONTAINS
CALL v_x%multiply(z, tmp)
DO iband = 1, hybinp%nbands(nk)
DO iband = 1, hybdat%nbands(nk)
IF (z%l_real) THEN
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))
END IF
IF (iband <= hybinp%nobd(nk,jsp)) THEN
IF (iband <= hybdat%nobd(nk,jsp)) THEN
results%te_hfex%valence = results%te_hfex%valence - a_ex*results%w_iks(iband, nk, jsp)*exch(iband, iband)
END IF
IF (hybinp%l_calhf) THEN
......
......@@ -55,7 +55,7 @@
REAL :: sphbes(0:atoms%lmaxd)
REAL :: q(3)
REAL :: integrand(atoms%jmtd)
REAL :: rarr(maxval(hybinp%nbands))
REAL :: rarr(maxval(hybdat%nbands))
REAL, ALLOCATABLE :: olapcb(:)
REAL, ALLOCATABLE :: olapcv_avg(:, :, :, :), olapcv_max(:, :, :, :)
TYPE(t_mat), ALLOCATABLE :: z(:)
......@@ -110,7 +110,7 @@
END DO
IF (mpi%irank == 0) WRITE (6, '(/A)') ' Overlap <core|basis>'
allocate(olapcb(maxval(mpdata%num_radfun_per_l)), olapcv(maxval(hybinp%nbands), nkpti),&
allocate(olapcb(maxval(mpdata%num_radfun_per_l)), olapcv(maxval(hybdat%nbands), nkpti),&
olapcv_avg(-hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype),&
olapcv_max(-hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype),&
olapcv_loc(2, -hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype))
......@@ -145,13 +145,13 @@
DO j = 1, mpdata%num_radfun_per_l(l, itype)
lm = lm + 1
olapcv(:, :) = olapcv(:, :) + &
olapcb(j)*cmt(:maxval(hybinp%nbands), lm, iatom, :nkpti)
olapcb(j)*cmt(:maxval(hybdat%nbands), lm, iatom, :nkpti)
END DO
rdum = sum(abs(olapcv(:, :))**2)
rdum1 = maxval(abs(olapcv(:, :)))
iarr = maxloc(abs(olapcv(:, :)))
olapcv_avg(m, i, l, itype) = &
sqrt(rdum/nkpti/sum(hybinp%nbands(:nkpti))*nkpti)
sqrt(rdum/nkpti/sum(hybdat%nbands(:nkpti))*nkpti)
olapcv_max(m, i, l, itype) = rdum1
olapcv_loc(:, m, i, l, itype) = iarr
END DO
......@@ -224,9 +224,9 @@
IF (mpi%irank == 0) WRITE (6, '(/A)') &
'Mismatch of wave functions at the MT-sphere boundaries'
allocate(carr1(maxval(hybinp%nbands), (atoms%lmaxd + 1)**2))
allocate(carr2(maxval(hybinp%nbands), (atoms%lmaxd + 1)**2))
allocate(carr3(maxval(hybinp%nbands), (atoms%lmaxd + 1)**2))
allocate(carr1(maxval(hybdat%nbands), (atoms%lmaxd + 1)**2))
allocate(carr2(maxval(hybdat%nbands), (atoms%lmaxd + 1)**2))
allocate(carr3(maxval(hybdat%nbands), (atoms%lmaxd + 1)**2))
DO ikpt = 1, nkpti
call read_z(z(ikpt), kpts%nkptf*(jsp - 1) + ikpt)
END DO
......@@ -263,7 +263,7 @@
cdum = 4*pi_const*img**l/sqrt(cell%omtil)*sphbes(l)*cexp
DO m = -l, l
lm = lm + 1
DO iband = 1, hybinp%nbands(ikpt)
DO iband = 1, hybdat%nbands(ikpt)
if (z(1)%l_real) THEN
carr2(iband, lm) = carr2(iband, lm) + cdum*z(ikpt)%data_r(igpt, iband)*y(lm)
Else
......@@ -283,7 +283,7 @@
DO n = 1, mpdata%num_radfun_per_l(l, itype)
lm1 = lm1 + 1
rdum = hybdat%bas1(atoms%jri(itype), n, l, itype)/atoms%rmt(itype)
DO iband = 1, hybinp%nbands(ikpt)
DO iband = 1, hybdat%nbands(ikpt)
carr3(iband, lm) = carr3(iband, lm) + cmt(iband, lm1, iatom, ikpt)*rdum
END DO
END DO
......
......@@ -66,7 +66,7 @@ CONTAINS
REAL, ALLOCATABLE :: integral(:, :)
COMPLEX :: cmt(input%neig, hybinp%maxlmindx, atoms%nat)
COMPLEX :: exchange(hybinp%nbands(nk), hybinp%nbands(nk))
COMPLEX :: exchange(hybdat%nbands(nk), hybdat%nbands(nk))
COMPLEX, ALLOCATABLE :: carr(:, :), carr2(:, :), carr3(:, :)
......@@ -115,7 +115,7 @@ CONTAINS
! Evaluate radial integrals (special part of Coulomb matrix : contribution from single MT)
allocate(integral(n, n), carr(n, hybinp%nbands(nk)), carr2(n, lapw%nv(jsp)), carr3(n, lapw%nv(jsp)))
allocate(integral(n, n), carr(n, hybdat%nbands(nk)), carr2(n, lapw%nv(jsp)), carr3(n, lapw%nv(jsp)))
DO i = 1, n
CALL primitivef(primf1, fprod(:atoms%jri(itype), i)*atoms%rmsh(:atoms%jri(itype), itype)**(l + 1), atoms%rmsh, atoms%dx, atoms%jri, atoms%jmtd, itype, atoms%ntype)
......@@ -136,7 +136,7 @@ CONTAINS
m2 = m1 + M
carr = 0
DO n1 = 1, hybinp%nbands(nk)
DO n1 = 1, hybdat%nbands(nk)
DO i = 1, n
ll = larr(i)
......@@ -173,7 +173,7 @@ CONTAINS
END IF
ENDIF
DO n1 = 1, hybinp%nobd(nk,jsp)
DO n1 = 1, hybdat%nobd(nk,jsp)
results%te_hfex%core = real(results%te_hfex%Core - a_ex*results%w_iks(n1, nk, jsp)*exchange(n1, n1))
END DO
......
......@@ -124,10 +124,10 @@ CONTAINS
! local arrays
COMPLEX :: exchcorrect(kpts%nkptf)
COMPLEX :: dcprod(hybinp%nbands(nk), hybinp%nbands(nk), 3)
COMPLEX :: exch_vv(hybinp%nbands(nk), hybinp%nbands(nk))
COMPLEX :: dcprod(hybdat%nbands(nk), hybdat%nbands(nk), 3)
COMPLEX :: exch_vv(hybdat%nbands(nk), hybdat%nbands(nk))
COMPLEX :: hessian(3, 3)
COMPLEX :: proj_ibsc(3, mnobd, hybinp%nbands(nk))
COMPLEX :: proj_ibsc(3, mnobd, hybdat%nbands(nk))
COMPLEX :: olap_ibsc(3, 3, mnobd, mnobd)
REAL :: carr1_v_r(hybinp%maxbasm1)
COMPLEX :: carr1_v_c(hybinp%maxbasm1)
......@@ -161,7 +161,7 @@ CONTAINS
! the contribution of the Gamma-point is treated separately (see below)
! determine package size loop over the occupied bands
rdum = hybinp%maxbasm1*hybinp%nbands(nk)*4/1048576.
rdum = hybinp%maxbasm1*hybdat%nbands(nk)*4/1048576.
psize = 1
DO iband = mnobd, 1, -1
! ensure that the packages have equal size
......@@ -178,23 +178,23 @@ CONTAINS
WRITE (6, '(A,A,i3,A,f7.2,A)') ' Divide the loop over the occupied hybinp%bands in packages', &
' of the size', psize, ' (cprod=', rdum*psize, 'MB)'
END IF
allocate(phase_vv(psize, hybinp%nbands(nk)), stat=ok)
allocate(phase_vv(psize, hybdat%nbands(nk)), stat=ok)
IF (ok /= 0) call judft_error('exchange_val_hf: error allocation phase')
phase_vv = 0
IF (ok /= 0) call judft_error('exchange_val_hf: error allocation phase')
if (mat_ex%l_real) THEN
allocate(cprod_vv_c(hybinp%maxbasm1, 0, 0), carr3_vv_c(hybinp%maxbasm1, 0, 0))
allocate(cprod_vv_r(hybinp%maxbasm1, psize, hybinp%nbands(nk)), stat=ok)
allocate(cprod_vv_r(hybinp%maxbasm1, psize, hybdat%nbands(nk)), stat=ok)
IF (ok /= 0) call judft_error('exchange_val_hf: error allocation cprod')
allocate(carr3_vv_r(hybinp%maxbasm1, psize, hybinp%nbands(nk)), stat=ok)
allocate(carr3_vv_r(hybinp%maxbasm1, psize, hybdat%nbands(nk)), stat=ok)
IF (ok /= 0) call judft_error('exchange_val_hf: error allocation carr3')
cprod_vv_r = 0; carr3_vv_r = 0
ELSE
allocate(cprod_vv_r(hybinp%maxbasm1, 0, 0), carr3_vv_r(hybinp%maxbasm1, 0, 0))
allocate(cprod_vv_c(hybinp%maxbasm1, psize, hybinp%nbands(nk)), stat=ok)
allocate(cprod_vv_c(hybinp%maxbasm1, psize, hybdat%nbands(nk)), stat=ok)
IF (ok /= 0) call judft_error('exchange_val_hf: error allocation cprod')
allocate(carr3_vv_c(hybinp%maxbasm1, psize, hybinp%nbands(nk)), stat=ok)
allocate(carr3_vv_c(hybinp%maxbasm1, psize, hybdat%nbands(nk)), stat=ok)
IF (ok /= 0) call judft_error('exchange_val_hf: error allocation carr3')
cprod_vv_c = 0; carr3_vv_c = 0
END IF
......@@ -226,11 +226,11 @@ CONTAINS
DO ibando = 1, mnobd, psize
IF (mat_ex%l_real) THEN
CALL wavefproducts_inv5(1, hybinp%nbands(nk), ibando, ibando + psize - 1, input, jsp, atoms, &
CALL wavefproducts_inv5(1, hybdat%nbands(nk), ibando, ibando + psize - 1, input, jsp, atoms, &
lapw, kpts, nk, ikpt0, hybdat, mpdata, hybinp, cell, hybinp%nbasp, sym, &
noco, nkqpt, cprod_vv_r)
ELSE
CALL wavefproducts_noinv5(1, hybinp%nbands(nk), ibando, ibando + psize - 1, nk, ikpt0, input, jsp, &!jsp,&
CALL wavefproducts_noinv5(1, hybdat%nbands(nk), ibando, ibando + psize - 1, nk, ikpt0, input, jsp, &!jsp,&
cell, atoms, mpdata, hybinp, hybdat, kpts, lapw, sym, hybinp%nbasp, noco, nkqpt, cprod_vv_c)
END IF
......@@ -240,14 +240,14 @@ CONTAINS
! are Fourier transformed, so that the exchange can be calculated
! in Fourier space
IF (xcpot%is_name("hse") .OR. xcpot%is_name("vhse")) THEN
iband1 = hybinp%nobd(nkqpt,jsp)
iband1 = hybdat%nobd(nkqpt,jsp)
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, &
hybinp%lcutm1, maxval(hybinp%lcutm1), mpdata%num_radbasfn, maxval(mpdata%num_radbasfn), mpdata%g, &
mpdata%n_g(ikpt0), mpdata%gptm_ptr(:, ikpt0), mpdata%num_gpts(), mpdata%radbasfn_mt, &
hybinp%nbasm(ikpt0), iband1, hybinp%nbands(nk), nsest, ibando, psize, indx_sest, &
hybinp%nbasm(ikpt0), iband1, hybdat%nbands(nk), nsest, ibando, psize, indx_sest, &
sym%invsat, sym%invsatnr, mpi%irank, cprod_vv_r(:hybinp%nbasm(ikpt0), :, :), &
cprod_vv_c(:hybinp%nbasm(ikpt0), :, :), mat_ex%l_real, wl_iks(:iband1, nkqpt), n_q(ikpt))
END IF
......@@ -258,7 +258,7 @@ CONTAINS
IF (kpts%bkp(ikpt0) /= ikpt0) THEN
CALL bra_trafo2(mat_ex%l_real, carr3_vv_r(:hybinp%nbasm(ikpt0), :, :), cprod_vv_r(:hybinp%nbasm(ikpt0), :, :), &
carr3_vv_c(:hybinp%nbasm(ikpt0), :, :), cprod_vv_c(:hybinp%nbasm(ikpt0), :, :), &
hybinp%nbasm(ikpt0), psize, hybinp%nbands(nk), kpts%bkp(ikpt0), ikpt0, kpts%bksym(ikpt0), sym, &
hybinp%nbasm(ikpt0), psize, hybdat%nbands(nk), kpts%bkp(ikpt0), ikpt0, kpts%bksym(ikpt0), sym, &
mpdata, hybinp, kpts, atoms, phase_vv)
IF (mat_ex%l_real) THEN
cprod_vv_r(:hybinp%nbasm(ikpt0), :, :) = carr3_vv_r(:hybinp%nbasm(ikpt0), :, :)
......@@ -272,9 +272,9 @@ CONTAINS
! calculate exchange matrix at ikpt0
call timestart("exchange matrix")
DO n1 = 1, hybinp%nbands(nk)
DO n1 = 1, hybdat%nbands(nk)
DO iband = 1, psize
IF ((ibando + iband - 1) > hybinp%nobd(nkqpt,jsp)) CYCLE
IF ((ibando + iband - 1) > hybdat%nobd(nkqpt,jsp)) CYCLE
cdum = wl_iks(ibando + iband - 1, nkqpt)*conjg(phase_vv(iband, n1))/n_q(ikpt)
call timestart("sparse matrix products")
......@@ -311,7 +311,7 @@ CONTAINS
END DO !ikpt
! WRITE(7001,'(a,i7)') 'nk: ', nk
! DO n1=1,hybinp%nbands(nk)
! DO n1=1,hybdat%nbands(nk)
! DO n2=1,n1
! WRITE(7001,'(2i7,2f15.8)') n2, n1, exch_vv(n2,n1)
! END DO
......@@ -329,11 +329,11 @@ CONTAINS
END IF
IF (zero_order) THEN
CALL dwavefproducts(dcprod, nk, 1, hybinp%nbands(nk), 1, hybinp%nbands(nk), .false., input,atoms, mpdata,hybinp, &
CALL dwavefproducts(dcprod, nk, 1, hybdat%nbands(nk), 1, hybdat%nbands(nk), .false., input,atoms, mpdata,hybinp, &
cell, hybdat, kpts, kpts%nkpt, lapw, jsp, eig_irr)
! make dcprod hermitian
DO n1 = 1, hybinp%nbands(nk)
DO n1 = 1, hybdat%nbands(nk)
DO n2 = 1, n1
dcprod(n1, n2, :) = (dcprod(n1, n2, :) - conjg(dcprod(n2, n1, :)))/2
dcprod(n2, n1, :) = -conjg(dcprod(n1, n2, :))
......@@ -348,7 +348,7 @@ CONTAINS
!This should be done with w_iks I guess!TODO
occup = .false.
DO i = 1, hybinp%ne_eig(nk)
DO i = 1, hybdat%ne_eig(nk)
IF (results%ef >= eig_irr(i, nk)) THEN
occup(i) = .true.
ELSE IF ((eig_irr(i, nk) - results%ef) <= 1E-06) THEN
......@@ -356,7 +356,7 @@ CONTAINS
END IF
END DO
DO n1 = 1, hybinp%nbands(nk)
DO n1 = 1, hybdat%nbands(nk)
DO n2 = 1, nsest(n1)!n1
nn2 = indx_sest(n2, n1)
exchcorrect = 0
......@@ -374,7 +374,7 @@ CONTAINS
IF (occup(n1) .and. occup(nn2)) THEN
DO i = 1, 3
j = i
DO iband = 1, hybinp%nbands(nk)
DO iband = 1, hybdat%nbands(nk)
IF (occup(iband)) THEN
hessian(i, j) = hessian(i, j) + conjg(dcprod(iband, n1, i))*dcprod(iband, nn2, j)
END IF
......@@ -384,7 +384,7 @@ CONTAINS
! ibs correction
IF (ibs_corr) THEN
hessian(i, j) = hessian(i, j) - olap_ibsc(i, j, n1, nn2)/cell%omtil
DO iband = 1, hybinp%nbands(nk)
DO iband = 1, hybdat%nbands(nk)
hessian(i, j) = hessian(i, j) + conjg(proj_ibsc(i, nn2, iband))*proj_ibsc(j, n1, iband)/cell%omtil
END DO
END IF
......@@ -392,7 +392,7 @@ CONTAINS
ELSE
DO i = 1, 3
j = i
DO iband = 1, hybinp%nbands(nk)
DO iband = 1, hybdat%nbands(nk)
IF (occup(iband)) THEN
hessian(i, j) = hessian(i, j) + conjg(dcprod(iband, n1, i))*dcprod(iband, nn2, j)
END IF
......@@ -430,14 +430,14 @@ CONTAINS
END IF
! WRITE(7000,'(a,i7)') 'nk: ', nk
! DO n1=1,hybinp%nbands(nk)
! DO n1=1,hybdat%nbands(nk)
! DO n2=1,n1
! WRITE(7000,'(2i7,2f15.8)') n2, n1, exch_vv(n2,n1)
! END DO
! END DO
! write exch_vv in mat_ex
CALL mat_ex%alloc(matsize1=hybinp%nbands(nk))
CALL mat_ex%alloc(matsize1=hybdat%nbands(nk))
IF (mat_ex%l_real) THEN
mat_ex%data_r = exch_vv
ELSE
......
......@@ -188,14 +188,14 @@ CONTAINS
! abcof calculates the wavefunction coefficients
! stored in acof,bcof,ccof
lapw(ikpt0)%nmat = lapw(ikpt0)%nv(jsp) + atoms%nlotot
CALL abcof(input, atoms, sym, cell, lapw(ikpt0), hybinp%nbands(ikpt0), usdus, noco, jsp, &!hybdat%kveclo_eig(:,ikpt0),&
oneD, acof(:hybinp%nbands(ikpt0), :, :), bcof(:hybinp%nbands(ikpt0), :, :), &
ccof(:, :hybinp%nbands(ikpt0), :, :), zmat(ikpt0))
CALL abcof(input, atoms, sym, cell, lapw(ikpt0), hybdat%nbands(ikpt0), usdus, noco, jsp, &!hybdat%kveclo_eig(:,ikpt0),&
oneD, acof(:hybdat%nbands(ikpt0), :, :), bcof(:hybdat%nbands(ikpt0), :, :), &
ccof(:, :hybdat%nbands(ikpt0), :, :), zmat(ikpt0))
! MT wavefunction coefficients are calculated in a local coordinate system rotate them in the global one
CALL hyb_abcrot(hybinp, atoms, hybinp%nbands(ikpt0), sym, acof(:hybinp%nbands(ikpt0), :, :), &
bcof(:hybinp%nbands(ikpt0), :, :), ccof(:, :hybinp%nbands(ikpt0), :, :))
CALL hyb_abcrot(hybinp, atoms, hybdat%nbands(ikpt0), sym, acof(:hybdat%nbands(ikpt0), :, :), &
bcof(:hybdat%nbands(ikpt0), :, :), ccof(:, :hybdat%nbands(ikpt0), :, :))
! decorate acof, bcof, ccof with coefficient i**l and store them
! in the field cmt(neigd,nkpt,maxlmindx,nat), i.e.
......@@ -262,7 +262,7 @@ CONTAINS
iop = kpts%bksym(ikpt)
CALL waveftrafo_genwavf(cmthlp, zhlp%data_r, zhlp%data_c, cmt(:, :, :), zmat(1)%l_real, zmat(ikpt0)%data_r(:, :), &
zmat(ikpt0)%data_c(:, :), ikpt0, iop, atoms, mpdata, hybinp, kpts, sym, jsp, zmat(ikpt0)%matsize1,input, &
hybinp%nbands(ikpt0), lapw(ikpt0), lapw(ikpt), .true.)
hybdat%nbands(ikpt0), lapw(ikpt0), lapw(ikpt), .true.)
CALL write_cmt(cmthlp, ikpt)
CALL write_z(zhlp, kpts%nkptf*(jsp - 1) + ikpt)
......
......@@ -101,7 +101,7 @@ CONTAINS
END IF
eig_irr(:, nk) = results%eig(:, nk, jsp)
hybinp%ne_eig(nk) = results%neig(nk, jsp)
hybdat%ne_eig(nk) = results%neig(nk, jsp)
END DO
IF(l_exist) CLOSE(993)
......@@ -123,57 +123,57 @@ CONTAINS
WRITE (6, '(A)') " k-point | number of occupied bands | maximal number of bands"
END IF
degenerat = 1
hybinp%nobd(:,jsp) = 0
hybdat%nobd(:,jsp) = 0
DO nk = 1, kpts%nkpt
DO i = 1, hybinp%ne_eig(nk)
DO j = i + 1, hybinp%ne_eig(nk)
DO i = 1, hybdat%ne_eig(nk)
DO j = i + 1, hybdat%ne_eig(nk)
IF (ABS(results%eig(i, nk, jsp) - results%eig(j, nk, jsp)) < 1E-07) THEN !0.015
degenerat(i, nk) = degenerat(i, nk) + 1
END IF
END DO
END DO
DO i = 1, hybinp%ne_eig(nk)
DO i = 1, hybdat%ne_eig(nk)
IF ((degenerat(i, nk) /= 1) .OR. (degenerat(i, nk) /= 0)) degenerat(i + 1:i + degenerat(i, nk) - 1, nk) = 0
END DO
! set the size of the exchange matrix in the space of the wavefunctions
hybinp%nbands(nk) = hybinp%bands1
IF (hybinp%nbands(nk) > hybinp%ne_eig(nk)) THEN
hybdat%nbands(nk) = hybinp%bands1
IF (hybdat%nbands(nk) > hybdat%ne_eig(nk)) THEN
IF (mpi%irank == 0) THEN
WRITE (*, *) ' maximum for hybinp%nbands is', hybinp%ne_eig(nk)
WRITE (*, *) ' maximum for hybdat%nbands is', hybdat%ne_eig(nk)
WRITE (*, *) ' increase energy window to obtain enough eigenvalues'
WRITE (*, *) ' set hybinp%nbands equal to hybinp%ne_eig'
WRITE (*, *) ' set hybdat%nbands equal to hybdat%ne_eig'
END IF
hybinp%nbands(nk) = hybinp%ne_eig(nk)
hybdat%nbands(nk) = hybdat%ne_eig(nk)
END IF
DO i = hybinp%nbands(nk) - 1, 1, -1
IF ((degenerat(i, nk) >= 1) .AND. (degenerat(i, nk) + i - 1 /= hybinp%nbands(nk))) THEN
hybinp%nbands(nk) = i + degenerat(i, nk) - 1
DO i = hybdat%nbands(nk) - 1, 1, -1
IF ((degenerat(i, nk) >= 1) .AND. (degenerat(i, nk) + i - 1 /= hybdat%nbands(nk))) THEN
hybdat%nbands(nk) = i + degenerat(i, nk) - 1
EXIT
END IF
END DO
DO i = 1, hybinp%ne_eig(nk)
IF (results%w_iks(i, nk, jsp) > 0.0) hybinp%nobd(nk,jsp) = hybinp%nobd(nk,jsp) + 1
DO i = 1, hybdat%ne_eig(nk)
IF (results%w_iks(i, nk, jsp) > 0.0) hybdat%nobd(nk,jsp) = hybdat%nobd(nk,jsp) + 1
END DO
IF (hybinp%nobd(nk,jsp) > hybinp%nbands(nk)) THEN
IF (hybdat%nobd(nk,jsp) > hybdat%nbands(nk)) THEN
WRITE (*, *) 'k-point: ', nk
WRITE (*, *) 'number of bands: ', hybinp%nbands(nk)
WRITE (*, *) 'number of occupied bands: ', hybinp%nobd(nk,jsp)
WRITE (*, *) 'number of bands: ', hybdat%nbands(nk)
WRITE (*, *) 'number of occupied bands: ', hybdat%nobd(nk,jsp)
CALL judft_warn("More occupied bands than total no of bands!?")
hybinp%nbands(nk) = hybinp%nobd(nk,jsp)
hybdat%nbands(nk) = hybdat%nobd(nk,jsp)
END IF
PRINT *, "bands:", nk, hybinp%nobd(nk,jsp), hybinp%nbands(nk), hybinp%ne_eig(nk)
PRINT *, "bands:", nk, hybdat%nobd(nk,jsp), hybdat%nbands(nk), hybdat%ne_eig(nk)
END DO
! spread hybinp%nobd from IBZ to whole BZ
! spread hybdat%nobd from IBZ to whole BZ
DO nk = 1, kpts%nkptf
i = kpts%bkp(nk)
hybinp%nobd(nk,jsp) = hybinp%nobd(i,jsp)
hybdat%nobd(nk,jsp) = hybdat%nobd(i,jsp)
END DO
! generate eigenvectors z and MT coefficients from the previous iteration at all k-points
......@@ -267,12 +267,12 @@ CONTAINS
!DO nk = n_start,kpts%nkpt,n_stride
DO nk = 1, kpts%nkpt, 1
hybinp%ne_eig(nk) = results%neig(nk, jsp)
hybinp%nobd(nk,jsp) = COUNT(results%w_iks(:hybinp%ne_eig(nk), nk, jsp) > 0.0)
hybdat%ne_eig(nk) = results%neig(nk, jsp)
hybdat%nobd(nk,jsp) = COUNT(results%w_iks(:hybdat%ne_eig(nk), nk, jsp) > 0.0)
END DO
hybinp%maxlmindx = MAXVAL([(SUM([(mpdata%num_radfun_per_l(l, itype)*(2*l + 1), l=0, atoms%lmax(itype))]), itype=1, atoms%ntype)])
hybinp%nbands = MIN(hybinp%bands1, input%neig)
hybdat%nbands = MIN(hybinp%bands1, input%neig)
ENDIF ! hybinp%l_calhf
......
......@@ -93,7 +93,7 @@ CONTAINS
REAL :: a_ex
! local arrays
INTEGER :: nsest(hybinp%nbands(nk)), indx_sest(hybinp%nbands(nk), hybinp%nbands(nk))
INTEGER :: nsest(hybdat%nbands(nk)), indx_sest(hybdat%nbands(nk), hybdat%nbands(nk))
INTEGER :: rrot(3, 3, sym%nsym)
INTEGER :: psym(sym%nsym) ! Note: psym is only filled up to index nsymop
......@@ -183,19 +183,19 @@ CONTAINS
CALL timestart("time for performing T^-1*mat_ex*T^-1*")
!calculate trafo from wavefunctions to APW basis
IF (input%neig < hybinp%nbands(nk)) call judft_error(' mhsfock: neigd < nbands(nk) ;trafo from wavefunctions to APW requires at least nbands(nk)')
IF (input%neig < hybdat%nbands(nk)) call judft_error(' mhsfock: neigd < nbands(nk) ;trafo from wavefunctions to APW requires at least nbands(nk)')
call z%init(olap%l_real, nbasfcn, input%neig)
call read_z(z, kpts%nkptf*(jsp - 1) + nk)
z%matsize2 = hybinp%nbands(nk) ! reduce "visible matsize" for the following computations
z%matsize2 = hybdat%nbands(nk) ! reduce "visible matsize" for the following computations
call olap%multiply(z, trafo)
CALL invtrafo%alloc(olap%l_real, hybinp%nbands(nk), nbasfcn)
CALL invtrafo%alloc(olap%l_real, hybdat%nbands(nk), nbasfcn)
CALL trafo%TRANSPOSE(invtrafo)
IF (.NOT. invtrafo%l_real) invtrafo%data_c = CONJG(invtrafo%data_c)
DO i = 1, hybinp%nbands(nk)
DO i = 1, hybdat%nbands(nk)
DO j = 1, i - 1
IF (ex%l_real) THEN
ex%data_r(i, j) = ex%data_r(j, i)
......
......@@ -82,21 +82,21 @@ CONTAINS
!In first iteration allocate some memory
IF (init_vex) THEN
if(allocated(hybinp%ne_eig)) deallocate(hybinp%ne_eig)
allocate(hybinp%ne_eig(kpts%nkpt), source=0)
if(allocated(hybdat%ne_eig)) deallocate(hybdat%ne_eig)
allocate(hybdat%ne_eig(kpts%nkpt), source=0)
if(allocated(hybinp%nbands)) then
deallocate(hybinp%nbands, stat=err, errmsg=msg)
if(allocated(hybdat%nbands)) then
deallocate(hybdat%nbands, stat=err, errmsg=msg)
if(err /= 0) THEN
write (*,*) "errorcode", err
write (*,*) "errormessage", msg
endif
endif
allocate(hybinp%nbands(kpts%nkpt), source=0)
allocate(hybdat%nbands(kpts%nkpt), source=0)
if(allocated(hybinp%nobd)) deallocate(hybinp%nobd)
allocate(hybinp%nobd(kpts%nkptf, input%jspins), source=0)
if(allocated(hybdat%nobd)) deallocate(hybdat%nobd)
allocate(hybdat%nobd(kpts%nkptf, input%jspins), source=0)
if(allocated(hybinp%nbasm)) deallocate(hybinp%nbasm)
allocate(hybinp%nbasm(kpts%nkptf), source=0)
......@@ -146,7 +146,7 @@ CONTAINS
!DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
CALL lapw%init(input, noco, kpts, atoms, sym, nk, cell, l_zref)
CALL hsfock(nk, atoms, mpdata, hybinp, lapw, kpts, jsp, input, hybdat, eig_irr, sym, cell, &
noco, results, MAXVAL(hybinp%nobd(:,jsp)), xcpot, mpi)
noco, results, MAXVAL(hybdat%nobd(:,jsp)), xcpot, mpi)
END DO
END DO
CALL timestop("Calculation of non-local HF potential")
......
......@@ -40,7 +40,7 @@ CONTAINS
! - arrays -
COMPLEX, INTENT(INOUT):: olap_ibsc(:,:,:,:)
COMPLEX, INTENT(INOUT):: proj_ibsc(:, :, :)!(3,mnobd,hybinp%nbands(nk))
COMPLEX, INTENT(INOUT):: proj_ibsc(:, :, :)!(3,mnobd,hybdat%nbands(nk))
! - local scalars -
INTEGER :: i, itype, ieq, iatom, iatom1, iband, iband1
INTEGER :: iband2, ilo, ibas, ic, ikpt, ikvec, invsfct
......@@ -79,7 +79,7 @@ CONTAINS
integrand(atoms%jmtd)
COMPLEX :: f(atoms%jmtd, mnobd)
COMPLEX :: carr(3), carr2(3, hybinp%nbands(nk))
COMPLEX :: carr(3), carr2(3, hybdat%nbands(nk))
COMPLEX :: ylm((atoms%lmaxd + 2)**2)
COMPLEX, ALLOCATABLE :: u1(:, :, :, :, :), u2(:, :, :, :, :)
COMPLEX, ALLOCATABLE :: cmt_lo(:, :, :, :)
......@@ -182,7 +182,7 @@ CONTAINS
cdum2 = cdum1*conjg(ylm(lm))
if (z%l_real) THEN
work_r = z%data_r(ibas, :)
DO iband = 1, hybinp%nbands(nk)
DO iband = 1, hybdat%nbands(nk)
cmt_lo(iband, M, ilo, iatom) = cmt_lo(iband, M, ilo, iatom) + cdum2*work_r(iband)
IF (invsfct == 2) THEN
! the factor (-1)**l is necessary as we do not calculate
......@@ -192,7 +192,7 @@ CONTAINS
END DO
else
work_c = z%data_c(ibas, :)
DO iband = 1, hybinp%nbands(nk)
DO iband = 1, hybdat%nbands(nk)
cmt_lo(iband, M, ilo, iatom) = cmt_lo(iband, M, ilo, iatom) + cdum2*work_c(iband)
IF (invsfct == 2) THEN
! the factor (-1)**l is necessary as we do not calculate
......@@ -266,12 +266,12 @@ CONTAINS
cdum = (-1)**(p + 1)*enum/denom
if (z%l_real) THEN
work_r = z%data_r(i, :)
DO iband = 1, hybinp%nbands(nk)
DO iband = 1, hybdat%nbands(nk)
cmt_apw(iband, lmp, iatom) = cmt_apw(iband, lmp, iatom) + cdum*work_r(iband)
END DO
else