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

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
......
......@@ -15,8 +15,8 @@ MODULE m_gen_wavf
CONTAINS
SUBROUTINE gen_wavf (nkpti,kpts,it,sym,atoms,el_eig,ello_eig,cell,dimension,hybrid,vr0,&
hybdat,noco,oneD,mpi,input,jsp,zmat)
SUBROUTINE gen_wavf(nkpti, kpts, it, sym, atoms, el_eig, ello_eig, cell, dimension, hybrid, vr0, &
hybdat, noco, oneD, mpi, input, jsp, zmat)
! nkpti :: number of irreducible k-points
! nkpt :: number of all k-points
......@@ -24,8 +24,8 @@ CONTAINS
USE m_radfun
USE m_radflo
USE m_abcof
USE m_trafo ,ONLY: waveftrafo_genwavf
USE m_util ,ONLY: modulo1
USE m_trafo, ONLY: waveftrafo_genwavf
USE m_util, ONLY: modulo1
USE m_olap
USE m_types
USE m_hyb_abcrot
......@@ -49,128 +49,124 @@ CONTAINS
INTEGER, INTENT(IN) :: nkpti, it
INTEGER, INTENT(IN) :: jsp
REAL, INTENT(IN) :: vr0(:,:,:)!(jmtd,ntype,jspd)
REAL, INTENT(IN) :: el_eig(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT(IN) :: ello_eig(atoms%nlod,atoms%ntype)
REAL, INTENT(IN) :: vr0(:, :, :)!(jmtd,ntype,jspd)
REAL, INTENT(IN) :: el_eig(0:atoms%lmaxd, atoms%ntype)
REAL, INTENT(IN) :: ello_eig(atoms%nlod, atoms%ntype)
! local scalars
INTEGER :: ilo,idum,m,irecl_cmt,irecl_z
INTEGER :: ilo, idum, m, irecl_cmt, irecl_z
COMPLEX :: cdum
TYPE(t_mat) :: zhlp
INTEGER :: ikpt0,ikpt,itype,iop,ispin,ieq,indx,iatom
INTEGER :: i,j,l ,ll,lm,ng,ok
COMPLEX :: img=(0.0,1.0)
INTEGER :: ikpt0, ikpt, itype, iop, ispin, ieq, indx, iatom
INTEGER :: i, j, l, ll, lm, ng, ok
COMPLEX :: img = (0.0, 1.0)
INTEGER :: nodem,noded
INTEGER :: nodem, noded
REAL :: wronk
INTEGER :: lower, upper
LOGICAL :: found
! local arrays
INTEGER :: rrot(3,3,sym%nsym)
INTEGER :: rrot(3, 3, sym%nsym)
INTEGER :: map_lo(atoms%nlod)
INTEGER :: iarr(0:atoms%lmaxd,atoms%ntype)
COMPLEX,ALLOCATABLE :: acof(:,:,:),bcof(:,:,:),ccof(:,:,:,:)
INTEGER :: iarr(0:atoms%lmaxd, atoms%ntype)
COMPLEX, ALLOCATABLE :: acof(:, :, :), bcof(:, :, :), ccof(:, :, :, :)
COMPLEX,ALLOCATABLE :: cmt(:,:,:),cmthlp(:,:,:)
COMPLEX, ALLOCATABLE :: cmt(:, :, :), cmthlp(:, :, :)
REAL :: vr(atoms%jmtd,atoms%ntype,input%jspins)
REAL,ALLOCATABLE :: f(:,:,:),df(:,:,:)
REAL :: vr(atoms%jmtd, atoms%ntype, input%jspins)
REAL, ALLOCATABLE :: f(:, :, :), df(:, :, :)
REAL :: flo(atoms%jmtd,2,atoms%nlod)
REAL :: uuilon(atoms%nlod,atoms%ntype),duilon(atoms%nlod,atoms%ntype)
REAL :: ulouilopn(atoms%nlod,atoms%nlod,atoms%ntype)
REAL :: flo(atoms%jmtd, 2, atoms%nlod)
REAL :: uuilon(atoms%nlod, atoms%ntype), duilon(atoms%nlod, atoms%ntype)
REAL :: ulouilopn(atoms%nlod, atoms%nlod, atoms%ntype)
REAL :: bkpt(3)
! local arrays for abcof1
! COMPLEX :: a(nvd,0:lmd,natd,nkpti),b(nvd,0:lmd,natd,nkpti)
TYPE(t_lapw) :: lapw(kpts%nkptf)
TYPE(t_usdus) :: usdus
CALL usdus%init(atoms,input%jspins)
CALL zhlp%alloc(zmat(1)%l_real,zmat(1)%matsize1,zmat(1)%matsize2)
CALL usdus%init(atoms, input%jspins)
CALL zhlp%alloc(zmat(1)%l_real, zmat(1)%matsize1, zmat(1)%matsize2)
! setup rotations in reciprocal space
DO iop = 1, sym%nsym
IF(iop.LE.sym%nop) THEN
rrot(:,:,iop) = transpose(sym%mrot(:,:,sym%invtab(iop)))
IF (iop <= sym%nop) THEN
rrot(:, :, iop) = transpose(sym%mrot(:, :, sym%invtab(iop)))
ELSE
rrot(:,:,iop) = -rrot(:,:,iop-sym%nop)
rrot(:, :, iop) = -rrot(:, :, iop - sym%nop)
END IF
END DO
! generate G-vectors, which fulfill |k+G|<rkmax
! for all k-points
DO ikpt = 1, kpts%nkptf
CALL lapw(ikpt)%init(input,noco,kpts,atoms,sym,ikpt,cell,sym%zrfs)
CALL lapw(ikpt)%init(input, noco, kpts, atoms, sym, ikpt, cell, sym%zrfs)
END DO
! set spherical component of the potential from the previous iteration vr
vr = vr0
! ALLOCATE ( z_out(nbasfcn,neigd,nkpti),stat=ok )
! IF ( ok .ne. 0) STOP 'gen_wavf: failure allocation z'
! z_out = 0
! z_out(:,:,:nkpti) = z_in
! calculate radial basis functions belonging to the
! potential vr stored in bas1 and bas2
! bas1 denotes the large component
! bas2 " " small component
ALLOCATE(f(atoms%jmtd,2,0:atoms%lmaxd),df(atoms%jmtd,2,0:atoms%lmaxd))
ALLOCATE (f(atoms%jmtd, 2, 0:atoms%lmaxd), df(atoms%jmtd, 2, 0:atoms%lmaxd))
f = 0
df = 0
iarr = 2
DO itype = 1, atoms%ntype
IF (mpi%irank == 0) WRITE (6,FMT=8000) itype
IF (mpi%irank == 0) WRITE (6, FMT=8000) itype
ng = atoms%jri(itype)
DO l=0,atoms%lmax(itype)
CALL radfun(l,itype,jsp,el_eig(l,itype),vr(:,itype,jsp),atoms,f(:,:,l),df(:,:,l),usdus,nodem,noded,wronk)
IF (mpi%irank == 0 ) WRITE (6,FMT=8010) l,el_eig(l,itype),usdus%us(l,itype,jsp),usdus%dus(l,itype,jsp),nodem,&
usdus%uds(l,itype,jsp),usdus%duds(l,itype,jsp),noded,usdus%ddn(l,itype,jsp),wronk
hybdat%bas1(1:ng,1,l,itype) = f(1:ng,1,l)
hybdat%bas2(1:ng,1,l,itype) = f(1:ng,2,l)
hybdat%bas1(1:ng,2,l,itype) = df(1:ng,1,l)
hybdat%bas2(1:ng,2,l,itype) = df(1:ng,2,l)
hybdat%bas1_MT(1,l,itype) = usdus%us(l,itype,jsp)
hybdat%drbas1_MT(1,l,itype) = usdus%dus(l,itype,jsp)
hybdat%bas1_MT(2,l,itype) = usdus%uds(l,itype,jsp)
hybdat%drbas1_MT(2,l,itype) = usdus%duds(l,itype,jsp)
DO l = 0, atoms%lmax(itype)
CALL radfun(l, itype, jsp, el_eig(l, itype), vr(:, itype, jsp), atoms, f(:, :, l), df(:, :, l), usdus, nodem, noded, wronk)
IF (mpi%irank == 0) WRITE (6, FMT=8010) l, el_eig(l, itype), usdus%us(l, itype, jsp), usdus%dus(l, itype, jsp), nodem, &
usdus%uds(l, itype, jsp), usdus%duds(l, itype, jsp), noded, usdus%ddn(l, itype, jsp), wronk
hybdat%bas1(1:ng, 1, l, itype) = f(1:ng, 1, l)
hybdat%bas2(1:ng, 1, l, itype) = f(1:ng, 2, l)
hybdat%bas1(1:ng, 2, l, itype) = df(1:ng, 1, l)
hybdat%bas2(1:ng, 2, l, itype) = df(1:ng, 2, l)
hybdat%bas1_MT(1, l, itype) = usdus%us(l, itype, jsp)
hybdat%drbas1_MT(1, l, itype) = usdus%dus(l, itype, jsp)
hybdat%bas1_MT(2, l, itype) = usdus%uds(l, itype, jsp)
hybdat%drbas1_MT(2, l, itype) = usdus%duds(l, itype, jsp)
END DO
IF (atoms%nlo(itype).GE.1) THEN
CALL radflo(atoms,itype,jsp,ello_eig,vr(:,itype,jsp),f,df,mpi,usdus,uuilon,duilon,ulouilopn,flo)
IF (atoms%nlo(itype) >= 1) THEN
CALL radflo(atoms, itype, jsp, ello_eig, vr(:, itype, jsp), f, df, mpi, usdus, uuilon, duilon, ulouilopn, flo)
DO ilo=1,atoms%nlo(itype)
iarr(atoms%llo(ilo,itype),itype) = iarr(atoms%llo(ilo,itype),itype) + 1
hybdat%bas1(1:ng,iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype) = flo(1:ng,1,ilo)
hybdat%bas2(1:ng,iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype) = flo(1:ng,2,ilo)
hybdat%bas1_MT(iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype) = usdus%ulos(ilo,itype,jsp)
hybdat%drbas1_MT(iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype) = usdus%dulos(ilo,itype,jsp)
DO ilo = 1, atoms%nlo(itype)
iarr(atoms%llo(ilo, itype), itype) = iarr(atoms%llo(ilo, itype), itype) + 1
hybdat%bas1(1:ng, iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = flo(1:ng, 1, ilo)
hybdat%bas2(1:ng, iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = flo(1:ng, 2, ilo)
hybdat%bas1_MT(iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = usdus%ulos(ilo, itype, jsp)
hybdat%drbas1_MT(iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = usdus%dulos(ilo, itype, jsp)
END DO
END IF
END DO
DEALLOCATE (f,df)
DEALLOCATE (f, df)
#if CPP_DEBUG
! consistency check
IF(.not.all(iarr.eq.hybrid%nindx)) STOP 'gen_wavf: counting error'
IF (.not. all(iarr == hybrid%nindx)) STOP 'gen_wavf: counting error'
#endif
8000 FORMAT (1x,/,/,' wavefunction parameters for atom type',i3,':',/,t32,'radial function',t79,&
'energy derivative',/,t3,'l',t8,'energy',t26,'value',t39,'derivative',t53,&
'nodes',t68,'value',t81,'derivative',t95,'nodes',t107,'norm',t119,'wronskian')
8010 FORMAT (i3,f10.5,2 (5x,1p,2e16.7,i5),1p,2e16.7)
8000 FORMAT(1x, /, /, ' wavefunction parameters for atom type', i3, ':', /, t32, 'radial function', t79, &
'energy derivative', /, t3, 'l', t8, 'energy', t26, 'value', t39, 'derivative', t53, &
'nodes', t68, 'value', t81, 'derivative', t95, 'nodes', t107, 'norm', t119, 'wronskian')
8010 FORMAT(i3, f10.5, 2(5x, 1p, 2e16.7, i5), 1p, 2e16.7)
! determine boundaries for parallel calculations
lower = 1
......@@ -178,7 +174,7 @@ CONTAINS
found = .false.
#ifdef CPP_MPI
DO ikpt = 1, nkpti
IF (.NOT.found) THEN
IF (.NOT. found) THEN
lower = ikpt
found = .true.
END IF
......@@ -186,7 +182,7 @@ CONTAINS
#else
found = .true.
#endif
IF (.NOT.found) THEN
IF (.NOT. found) THEN
upper = 0
END IF
......@@ -194,16 +190,16 @@ CONTAINS
! (acof,bcof,ccof) and APW-basis coefficients
! (a,b,bascofold_lo) at irred. kpoints
ALLOCATE(acof(dimension%neigd,0:dimension%lmd,atoms%nat),stat=ok)
IF (ok.NE.0) STOP 'gen_wavf: failure allocation acof'
ALLOCATE(bcof(dimension%neigd,0:dimension%lmd,atoms%nat),stat=ok)
IF (ok.NE.0) STOP 'gen_wavf: failure allocation bcof'
ALLOCATE(ccof(-atoms%llod:atoms%llod,dimension%neigd,atoms%nlod,atoms%nat),stat=ok)
IF (ok.NE.0) STOP 'gen_wavf: failure allocation ccof'
ALLOCATE (cmt(dimension%neigd,hybrid%maxlmindx,atoms%nat),stat=ok)
IF (ok.NE.0) STOP 'gen_wavf: Failure allocation cmt'
ALLOCATE (cmthlp(dimension%neigd,hybrid%maxlmindx,atoms%nat),stat=ok)
IF (ok.NE.0) STOP 'gen_wavf: failure allocation cmthlp'
ALLOCATE (acof(dimension%neigd, 0:dimension%lmd, atoms%nat),