Skip to content

fleur
fleur
Commit ab6dd87f authored by Gregor Michalicek's avatar Gregor Michalicek
1 Browse files
Options

Initial commit for the implementation of multiple U parameters on each atom type 

This is not yet tested.
parent 774881a1
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 730 additions and 741 deletions
cdn/n_mat.f90
View file @ ab6dd87f
......@@ -11,6 +11,7 @@ MODULE m_nmat
! all atoms are stored in lda_u(), if lda_u()<0, no +U is used.
! For details see Eq.(12) of Shick et al. PRB 60, 10765 (1999)
! Part of the LDA+U package G.B., Oct. 2000
! Extension to multiple U per atom type by G.M. 2017
! ************************************************************
CONTAINS
SUBROUTINE n_mat(atoms,sym, ne,usdus,jspin,we, acof,bcof,ccof, n_mmp)
......@@ -34,7 +35,7 @@ CONTAINS
! ..
! .. Local Scalars ..
COMPLEX c_0
INTEGER i,j,k,l ,mp,n,it,is,isi,natom,n_ldau,lp,m
INTEGER i,j,k,l ,mp,n,it,is,isi,natom,natomTemp,n_ldau,lp,m,i_u
INTEGER ilo,ilop,ll1,nn,lmp,lm
REAL fac
! ..
......@@ -45,16 +46,17 @@ CONTAINS
!
! calculate n_mat:
!
n_ldau = 0
natom = 0
i_u = 1
DO n = 1,atoms%ntype
IF (atoms%lda_u(n)%l.GE.0) THEN
n_ldau = n_ldau + 1
n_tmp(:,:) =cmplx(0.0,0.0)
l = atoms%lda_u(n)%l
DO WHILE (i_u.LE.atoms%n_u)
IF (atoms%lda_u(i_u)%atomType.GT.n) EXIT
natomTemp = natom
n_tmp(:,:) = cmplx(0.0,0.0)
l = atoms%lda_u(i_u)%l
ll1 = (l+1)*l
DO nn = 1, atoms%neq(n)
natom = natom + 1
natomTemp = natomTemp + 1
!
! prepare n_mat in local frame (in noco-calculations this depends
! also on alpha(n) and beta(n) )
......@@ -66,8 +68,8 @@ CONTAINS
c_0 = cmplx(0.0,0.0)
DO i = 1,ne
c_0 = c_0 + we(i) * ( usdus%ddn(l,n,jspin) *&
conjg(bcof(i,lmp,natom))*bcof(i,lm,natom) +&
conjg(acof(i,lmp,natom))*acof(i,lm,natom) )
conjg(bcof(i,lmp,natomTemp))*bcof(i,lm,natomTemp) +&
conjg(acof(i,lmp,natomTemp))*acof(i,lm,natomTemp) )
ENDDO
n_tmp(m,mp) = c_0
ENDDO
......@@ -85,17 +87,17 @@ CONTAINS
c_0 = cmplx(0.0,0.0)
DO i = 1,ne
c_0 = c_0 + we(i) * ( usdus%uulon(ilo,n,jspin) * (&
conjg(acof(i,lmp,natom))*ccof(m,i,ilo,natom) +&
conjg(ccof(mp,i,ilo,natom))*acof(i,lm,natom) )&
conjg(acof(i,lmp,natomTemp))*ccof(m,i,ilo,natomTemp) +&
conjg(ccof(mp,i,ilo,natomTemp))*acof(i,lm,natomTemp) )&
+ usdus%dulon(ilo,n,jspin) * (&
conjg(bcof(i,lmp,natom))*ccof(m,i,ilo,natom) +&
conjg(ccof(mp,i,ilo,natom))*bcof(i,lm,natom)))
conjg(bcof(i,lmp,natomTemp))*ccof(m,i,ilo,natomTemp) +&
conjg(ccof(mp,i,ilo,natomTemp))*bcof(i,lm,natomTemp)))
ENDDO
DO ilop = 1, atoms%nlo(n)
IF (atoms%llo(ilop,n).EQ.l) THEN
DO i = 1,ne
c_0 = c_0 + we(i) * usdus%uloulopn(ilo,ilop,n,jspin) *&
conjg(ccof(mp,i,ilop,natom)) *ccof(m ,i,ilo ,natom)
conjg(ccof(mp,i,ilop,natomTemp)) *ccof(m ,i,ilo ,natomTemp)
ENDDO
ENDIF
ENDDO
......@@ -108,10 +110,10 @@ CONTAINS
!
! n_mmp should be rotated by D_mm' ; compare force_a21
!
DO it = 1, sym%invarind(natom)
DO it = 1, sym%invarind(natomTemp)
fac = 1.0 / ( sym%invarind(natom) * atoms%neq(n) )
is = sym%invarop(natom,it)
fac = 1.0 / ( sym%invarind(natomTemp) * atoms%neq(n) )
is = sym%invarop(natomTemp,it)
isi = sym%invtab(is)
d_tmp(:,:) = cmplx(0.0,0.0)
DO m = -l,l
......@@ -123,16 +125,16 @@ CONTAINS
n1_tmp = matmul( nr_tmp, d_tmp )
DO m = -l,l
DO mp = -l,l
n_mmp(m,mp,n_ldau) = n_mmp(m,mp,n_ldau) +conjg(n1_tmp(m,mp)) * fac
n_mmp(m,mp,i_u) = n_mmp(m,mp,i_u) + conjg(n1_tmp(m,mp)) * fac
ENDDO
ENDDO
ENDDO
ENDDO ! sum over equivalent atoms
ELSE
natom = natom + atoms%neq(n)
ENDIF
i_u = i_u + 1
END DO
natom = natom + atoms%neq(n)
ENDDO ! loop over atom types
! do m=-l,l
......
eigen/hsmt.F90
View file @ ab6dd87f
......@@ -229,7 +229,7 @@ CONTAINS
#endif
IF (.NOT.input%secvar) THEN
CALL timestart("hsmt extra")
IF (ANY(atoms%nlo>0).OR.ANY(atoms%lda_u%l.GE.0)) &
IF (ANY(atoms%nlo>0).OR.(atoms%n_u.GT.0)) &
CALL hsmt_extra(DIMENSION,atoms,sym,isp,n_size,n_rank,input,nintsp,sub_comm,&
hlpmsize,lmaxb,gwc,noco,l_socfirst,lapw,cell,enpara%el0,&
fj,gj,gk,vk,tlmplm,usdus, vs_mmp,oneD,& !in
......
eigen/hsmt_extra.F90
View file @ ab6dd87f
......@@ -64,12 +64,11 @@ CONTAINS
COMPLEX chi11,chi21,chi22
INTEGER k,i,spin2,&
l,ll1,lo,jd,&
m,n,na,nn,np,&
iiloh,iilos,nkvecprevath,nkvecprevats,&
iintsp,jintsp
INTEGER k,i,spin2,l,ll1,lo,jd
INTEGER m,n,na,nn,np,i_u
INTEGER iiloh,iilos,nkvecprevath,nkvecprevats,iintsp,jintsp
INTEGER nc,locolh,locols,nkvecprevatu,iilou,locolu
INTEGER nkvecprevatuTemp,iilouTemp,locoluTemp
INTEGER ab_dim,nkvec_sv,fjstart
LOGICAL enough,l_lo1
! ..
......@@ -105,6 +104,7 @@ CONTAINS
na = 0
nkvecprevats = 0
nkvecprevath = 0
nkvecprevatu = 0
nkvec_sv = 0
!Determine index of first LO
locols = lapw%nv(1)
......@@ -123,7 +123,10 @@ CONTAINS
iiloh = lapw%nv(1)* (lapw%nv(1)+1)/2
#endif
iilou = iilos
locolu = locols
i_u = 1
ntype_loop: DO n=1,atoms%ntype
IF (noco%l_noco) THEN
......@@ -268,29 +271,42 @@ CONTAINS
ENDIF
END IF
IF (atoms%n_u>0.and.atoms%lda_u(n)%l.GE.0.AND.gwc.EQ.1) THEN
IF ( noco%l_noco .AND. (.NOT.noco%l_ss) ) THEN
CALL u_ham(&
atoms,input,lapw,isp,n,invsfct,&
ar,ai,br,bi,vs_mmp,lmaxb,&
alo,blo,clo,&
n_size,n_rank,isp,usdus,noco,&
1,1,chi11,chi22,chi21,&
nkvecprevatu,iilou,locolu,.false.,aa_c=aahlp)
ELSE
DO iintsp = 1,nintsp
DO jintsp = 1,iintsp
CALL u_ham(&
atoms,input,lapw,isp,n,invsfct,&
ar,ai,br,bi,vs_mmp,lmaxb,&
alo,blo,clo,&
n_size,n_rank,isp,usdus,noco,&
iintsp,jintsp,chi11,chi22,chi21,&
nkvecprevatu,iilou,locolu,l_real,aa_r,aa_c)
ENDDO
ENDDO
ENDIF
ENDIF
IF ((gwc.EQ.1).AND.(atoms%n_u.GT.0)) THEN
nkvecprevatuTemp = nkvecprevatu
iilouTemp = iilou
locoluTemp = locolu
DO WHILE (i_u.LE.atoms%n_u)
IF (atoms%lda_u(i_u)%atomType.GT.n) EXIT
nkvecprevatuTemp = nkvecprevatu
iilouTemp = iilou
locoluTemp = locolu
IF (atoms%lda_u(i_u)%atomType.EQ.n) THEN
IF ((noco%l_noco).AND.(.NOT.noco%l_ss)) THEN
CALL u_ham(atoms,input,lapw,isp,n,i_u,invsfct,&
ar,ai,br,bi,vs_mmp,lmaxb,&
alo,blo,clo,&
n_size,n_rank,isp,usdus,noco,&
1,1,chi11,chi22,chi21,&
nkvecprevatuTemp,iilouTemp,locoluTemp,.false.,aa_c=aahlp)
ELSE
DO iintsp = 1,nintsp
DO jintsp = 1,iintsp
CALL u_ham(atoms,input,lapw,isp,n,i_u,invsfct,&
ar,ai,br,bi,vs_mmp,lmaxb,&
alo,blo,clo,&
n_size,n_rank,isp,usdus,noco,&
iintsp,jintsp,chi11,chi22,chi21,&
nkvecprevatuTemp,iilouTemp,locoluTemp,l_real,aa_r,aa_c)
END DO
END DO
END IF
END IF
i_u = i_u + 1
END DO
nkvecprevatu = nkvecprevatuTemp
iilou = iilouTemp
locolu = locoluTemp
END IF
ENDIF ! atoms%invsat(na) = 0 or 1
!---> end loop over equivalent atoms
......
eigen/tlmplm_store.F90
View file @ ab6dd87f
......@@ -14,7 +14,7 @@ MODULE m_tlmplm_store
PRIVATE
TYPE(t_tlmplm) :: td_stored
COMPLEX,ALLOCATABLE :: vs_mmp_stored(:,:,:,:)
PUBLIC write_tlmplm,read_tlmplm
PUBLIC write_tlmplm, read_tlmplm, read_tlmplm_vs_mmp
CONTAINS
SUBROUTINE write_tlmplm(td,vs_mmp,ldau,ispin,jspin,jspins)
TYPE(t_tlmplm),INTENT(IN) :: td
......@@ -58,15 +58,13 @@ CONTAINS
END SUBROUTINE write_tlmplm
SUBROUTINE read_tlmplm(n,jspin,nlo,ldau,tuu,tud,tdu,tdd,ind,tuulo,tuloulo,tdulo,vs_mmp)
SUBROUTINE read_tlmplm(n,jspin,nlo,tuu,tud,tdu,tdd,ind,tuulo,tuloulo,tdulo)
COMPLEX,INTENT(OUT)::tuu(:),tdd(:),tud(:),tdu(:)
INTEGER,INTENT(OUT)::ind(:,:)
COMPLEX,INTENT(OUT)::tuulo(:,:,:),tdulo(:,:,:),tuloulo(:,:,:)
COMPLEX,INTENT(OUT)::vs_mmp(:,:)
INTEGER,INTENT(IN) :: n,jspin,nlo(:)
LOGICAL,INTENT(IN) :: ldau(:)
INTEGER:: mlo,mlolo,nn
INTEGER:: mlo,mlolo
tuu=td_stored%tuu(:size(tuu,1),n,jspin)
tud=td_stored%tud(:size(tuu,1),n,jspin)
tdu=td_stored%tdu(:size(tuu,1),n,jspin)
......@@ -83,10 +81,18 @@ CONTAINS
tuloulo(:,:,mlolo:mlolo+nlo(n)*(nlo(n)+1)/2-1)=&
td_stored%tuloulo(:size(tuloulo,1),:size(tuloulo,2),mlolo:mlolo+nlo(n)*(nlo(n)+1)/2-1,jspin)
ENDIF
IF(ldau(n)) THEN
nn=count(ldau(:n-1))+1
vs_mmp=vs_mmp_stored(size(vs_mmp,1),size(vs_mmp,2),nn,jspin)
ENDIF
END SUBROUTINE read_tlmplm
SUBROUTINE read_tlmplm_vs_mmp(jspin,n_u,vs_mmp)
INTEGER, INTENT(IN) :: jspin, n_u
COMPLEX, INTENT(OUT) :: vs_mmp(:,:,:)
IF(n_u.GT.0) THEN
vs_mmp(:,:,:) = vs_mmp_stored(:,:,:,jspin)
END IF
END SUBROUTINE read_tlmplm_vs_mmp
END MODULE m_tlmplm_store
force/force_a21.F90
View file @ ab6dd87f
......@@ -57,13 +57,13 @@ CONTAINS
INTEGER, PARAMETER :: lmaxb=3
COMPLEX dtd,dtu,utd,utu
INTEGER lo, mlotot, mlolotot, mlot_d, mlolot_d
INTEGER i,ie,im,in,l1,l2,ll1,ll2,lm1,lm2,m1,m2,n,natom,m
INTEGER i,ie,im,in,l1,l2,ll1,ll2,lm1,lm2,m1,m2,n,natom,m,i_u
INTEGER natrun,is,isinv,j,irinv,it
REAL ,PARAMETER:: zero=0.0
COMPLEX,PARAMETER:: czero=CMPLX(0.,0.)
! ..
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: v_mmp(:,:)
COMPLEX, ALLOCATABLE :: v_mmp(:,:,:)
REAL, ALLOCATABLE :: a21(:,:),b4(:,:)
COMPLEX forc_a21(3),forc_b4(3)
REAL starsum(3),starsum2(3),gvint(3),gvint2(3)
......@@ -85,9 +85,15 @@ CONTAINS
tlmplm%tuulo(0:DIMENSION%lmd,-atoms%llod:atoms%llod,mlot_d,1),&
tlmplm%tdulo(0:DIMENSION%lmd,-atoms%llod:atoms%llod,mlot_d,1),&
tlmplm%tuloulo(-atoms%llod:atoms%llod,-atoms%llod:atoms%llod,mlolot_d,1),&
v_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb),&
a21(3,atoms%nat),b4(3,atoms%nat),tlmplm%ind(0:DIMENSION%lmd,0:DIMENSION%lmd,atoms%ntype,1) )
!
IF(atoms%n_u.GT.0) THEN
ALLOCATE(v_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u))
v_mmp = CMPLX(0.0,0.0)
CALL read_tlmplm_vs_mmp(jsp,atoms%n_u,v_mmp)
END IF
i_u = 1
natom = 1
DO n = 1,atoms%ntype
IF (atoms%l_geo(n)) THEN
......@@ -95,9 +101,9 @@ CONTAINS
forc_b4(:) = czero
CALL read_tlmplm(n,jsp,atoms%nlo,atoms%lda_u%l.GE.0,&
CALL read_tlmplm(n,jsp,atoms%nlo,&
tlmplm%tuu(:,n,1),tlmplm%tud(:,n,1),tlmplm%tdu(:,n,1),tlmplm%tdd(:,n,1),&
tlmplm%ind(:,:,n,1),tlmplm%tuulo(:,:,:,1),tlmplm%tuloulo(:,:,:,1),tlmplm%tdulo(:,:,:,1),v_mmp)
tlmplm%ind(:,:,n,1),tlmplm%tuulo(:,:,:,1),tlmplm%tuloulo(:,:,:,1),tlmplm%tdulo(:,:,:,1))
DO natrun = natom,natom + atoms%neq(n) - 1
a21(:,natrun) = zero
......@@ -190,9 +196,11 @@ CONTAINS
acof,bcof,ccof,aveccof,bveccof,&
cveccof, tlmplm,usdus, a21)
CALL force_a21_U(nobd,atoms,lmaxb,n,jsp,we,ne,&
usdus,v_mmp,acof,bcof,ccof,&
aveccof,bveccof,cveccof, a21)
IF ((atoms%n_u.GT.0).AND.(i_u.LE.atoms%n_u)) THEN
CALL force_a21_U(nobd,atoms,lmaxb,i_u,n,jsp,we,ne,&
usdus,v_mmp,acof,bcof,ccof,&
aveccof,bveccof,cveccof, a21)
END IF
IF (input%l_useapw) THEN
! -> B4 force
DO ie = 1,ne
......@@ -352,7 +360,7 @@ CONTAINS
natom = natom + atoms%neq(n)
ENDDO
!
DEALLOCATE (tlmplm%tdd,tlmplm%tuu,tlmplm%tdu,tlmplm%tud,tlmplm%tuulo,tlmplm%tdulo,tlmplm%tuloulo,v_mmp,tlmplm%ind,a21,b4)
DEALLOCATE (tlmplm%tdd,tlmplm%tuu,tlmplm%tdu,tlmplm%tud,tlmplm%tuulo,tlmplm%tdulo,tlmplm%tuloulo,tlmplm%ind,a21,b4)
END SUBROUTINE force_a21
END MODULE m_forcea21
force/force_a21_U.f90
View file @ ab6dd87f
MODULE m_forcea21U
CONTAINS
SUBROUTINE force_a21_U(nobd,atoms,lmaxb, itype,isp,we,ne,&
SUBROUTINE force_a21_U(nobd,atoms,lmaxb,i_u,itype,isp,we,ne,&
usdus,v_mmp, acof,bcof,ccof,aveccof,bveccof,cveccof, a21)
!
!***********************************************************************
......@@ -16,12 +16,14 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: itype,isp,ne,lmaxb
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: itype,isp,ne,lmaxb
INTEGER, INTENT (INOUT) :: i_u ! on input: index for the first U for atom type "itype or higher"
! on exit: index for the first U for atom type "itype+1 or higher"
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(nobd)
COMPLEX, INTENT (IN) :: v_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb)
COMPLEX, INTENT (IN) :: v_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u)
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
......@@ -42,8 +44,12 @@ CONTAINS
! comments in setlomap.
!***********************************************************************
IF (atoms%lda_u(itype)%l.GE.0) THEN
l = atoms%lda_u(itype)%l
IF (atoms%lda_u(i_u)%atomType.GT.itype) RETURN
DO WHILE (atoms%lda_u(i_u)%atomType.EQ.itype)
l = atoms%lda_u(i_u)%l
!
! Add contribution for the regular LAPWs (like force_a21, but with
! the potential matrix, v_mmp, instead of the tuu, tdd ...)
......@@ -52,77 +58,52 @@ CONTAINS
lm = l* (l+1) + m
DO mp = -l,l
lmp = l* (l+1) + mp
v_a = v_mmp(m,mp)
v_b = v_mmp(m,mp) * usdus%ddn(l,itype,isp)
v_a = v_mmp(m,mp,i_u)
v_b = v_mmp(m,mp,i_u) * usdus%ddn(l,itype,isp)
DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
DO ie = 1,ne
DO i = 1,3
p1 = (CONJG(acof(ie,lm,iatom)) * v_a) * aveccof(i,ie,lmp,iatom)
p2 = (CONJG(bcof(ie,lm,iatom)) * v_b) * bveccof(i,ie,lmp,iatom)
a21(i,iatom) = a21(i,iatom) + 2.0*AIMAG(p1 + p2) * we(ie)/atoms%neq(itype)
END DO
END DO
END DO
END DO ! mp
END DO ! m
p1 = ( CONJG(acof(ie,lm,iatom)) * v_a )&
* aveccof(i,ie,lmp,iatom)
p2 = ( CONJG(bcof(ie,lm,iatom)) * v_b )&
* bveccof(i,ie,lmp,iatom)
a21(i,iatom) = a21(i,iatom) + 2.0*AIMAG(&
p1 + p2 ) *we(ie)/atoms%neq(itype)
! no idea, why this did not work with ifort:
! a21(i,iatom) = a21(i,iatom) + 2.0*aimag(
! + conjg(acof(ie,lm,iatom)) * v_a *
! + *aveccof(i,ie,lmp,iatom) +
! + conjg(bcof(ie,lm,iatom)) * v_b *
! + *bveccof(i,ie,lmp,iatom) )
! + *we(ie)/neq
ENDDO
ENDDO
ENDDO
ENDDO ! mp
ENDDO ! m
!
! If there are also LOs on this atom, with the same l as
! the one of LDA+U, add another few terms
!
DO lo = 1,atoms%nlo(itype)
l = atoms%llo(lo,itype)
IF ( l == atoms%lda_u(itype)%l ) THEN
IF (l == atoms%llo(lo,itype)) THEN
DO m = -l,l
lm = l* (l+1) + m
DO mp = -l,l
lmp = l* (l+1) + mp
v_a = v_mmp(m,mp)
v_b = v_mmp(m,mp) * usdus%uulon(lo,itype,isp)
v_c = v_mmp(m,mp) * usdus%dulon(lo,itype,isp)
v_a = v_mmp(m,mp,i_u)
v_b = v_mmp(m,mp,i_u) * usdus%uulon(lo,itype,isp)
v_c = v_mmp(m,mp,i_u) * usdus%dulon(lo,itype,isp)
DO iatom = sum(atoms%neq(:itype-1))+1,sum(atoms%neq(:itype))
DO ie = 1,ne
DO i = 1,3
p1 = v_a * (CONJG(ccof(m,ie,lo,iatom)) * cveccof(i,mp,ie,lo,iatom))
p2 = v_b * (CONJG(acof(ie,lm,iatom)) * cveccof(i,mp,ie,lo,iatom) + &
CONJG(ccof(m,ie,lo,iatom)) * aveccof(i,ie,lmp,iatom))
p3 = v_c * (CONJG(bcof(ie,lm,iatom)) * cveccof(i,mp,ie,lo,iatom) + &
CONJG(ccof(m,ie,lo,iatom)) * bveccof(i,ie,lmp,iatom))
a21(i,iatom) = a21(i,iatom) + 2.0*AIMAG(p1 + p2 + p3)*we(ie)/atoms%neq(itype)
END DO
END DO
END DO
END DO
END DO
END IF ! l == atoms%llo(lo,itype)
END DO ! lo = 1,atoms%nlo
p1 = v_a * ( CONJG(ccof(m,ie,lo,iatom)) &
* cveccof(i,mp,ie,lo,iatom) )
p2 = v_b * ( CONJG(acof(ie,lm,iatom))&
* cveccof(i,mp,ie,lo,iatom) +&
CONJG(ccof(m,ie,lo,iatom))&
* aveccof(i,ie,lmp,iatom) )
p3 = v_c * ( CONJG(bcof(ie,lm,iatom))&
* cveccof(i,mp,ie,lo,iatom) +&
CONJG(ccof(m,ie,lo,iatom))&
* bveccof(i,ie,lmp,iatom) )
a21(i,iatom) = a21(i,iatom) + 2.0*AIMAG(&
p1 + p2 + p3 )*we(ie)/atoms%neq(itype)
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF ! l == atoms%lda_u
ENDDO ! lo = 1,atoms%nlo
ENDIF
i_u = i_u + 1
END DO
END SUBROUTINE force_a21_U
END MODULE m_forcea21U
global/types.F90
View file @ ab6dd87f
......@@ -139,9 +139,10 @@
!
TYPE t_utype
SEQUENCE
REAL u,j
INTEGER l
LOGICAL :: l_amf
REAL u,j ! the actual U and J parameters
INTEGER l ! the l quantum number to which this U parameter belongs
INTEGER atomType ! The atom type to which this U parameter belongs
LOGICAL :: l_amf ! logical switch to choose the "around mean field" LDA+U limit
END TYPE t_utype
!
......
init/inped.F90
View file @ ab6dd87f
......@@ -520,18 +520,15 @@
!
! Check for LDA+U:
!
atoms%n_u = 0
DO n = 1,atoms%ntype
IF (atoms%lda_u(n)%l.GE.0) THEN
atoms%n_u = atoms%n_u + 1
IF (atoms%nlo(n).GE.1) THEN
DO j = 1, atoms%nlo(n)
IF ((ABS(atoms%llo(j,n)).EQ.atoms%lda_u(n)%l) .AND. (.NOT.atoms%l_dulo(j,n)) ) &
WRITE (*,*) 'LO and LDA+U for same l not implemented'
ENDDO
ENDIF
ENDIF
ENDDO
DO i = 1, atoms%n_u
n = atoms%lda_u(i)%atomType
IF (atoms%nlo(n).GE.1) THEN
DO j = 1, atoms%nlo(n)
IF ((ABS(atoms%llo(j,n)).EQ.atoms%lda_u(i)%l) .AND. (.NOT.atoms%l_dulo(j,n)) ) &
WRITE (*,*) 'LO and LDA+U for same l not implemented'
END DO
END IF
END DO
IF (atoms%n_u.GT.0) THEN
IF (input%secvar) CALL juDFT_error ("LDA+U and sevcar not implemented",calledby ="inped")
IF (input%isec1<input%itmax) CALL juDFT_error("LDA+U and Wu not implemented",calledby ="inped")
......
io/r_inpXML.F90
View file @ ab6dd87f
......@@ -148,7 +148,7 @@ SUBROUTINE r_inpXML(&
INTEGER :: latticeDef, symmetryDef, nop48, firstAtomOfType, errorStatus
INTEGER :: loEDeriv, ntp1, ios, ntst, jrc, minNeigd, providedCoreStates, providedStates
INTEGER :: nv, nv2, kq1, kq2, kq3, nprncTemp, kappaTemp
INTEGER :: ldau_l, numVac
INTEGER :: ldau_l(4), numVac, numU
INTEGER :: speciesEParams(0:3)
INTEGER :: mrotTemp(3,3,48)
REAL :: tauTemp(3,48)
......@@ -156,9 +156,9 @@ SUBROUTINE r_inpXML(&
LOGICAL :: flipSpin, l_eV, invSym, l_qfix, relaxX, relaxY, relaxZ, l_gga, l_kpts
LOGICAL :: l_vca, coreConfigPresent, l_enpara, l_orbcomp
REAL :: magMom, radius, logIncrement, qsc(3), latticeScale, dr
REAL :: aTemp, zp, rmtmax, sumWeight, ldau_u, ldau_j, tempReal
REAL :: aTemp, zp, rmtmax, sumWeight, ldau_u(4), ldau_j(4), tempReal
REAL :: weightScale, eParamUp, eParamDown
LOGICAL :: l_amf
LOGICAL :: l_amf(4)
REAL, PARAMETER :: boltzmannConst = 3.1668114e-6 ! value is given in Hartree/Kelvin
......@@ -260,7 +260,7 @@ SUBROUTINE r_inpXML(&
ALLOCATE(atoms%lnonsph(atoms%ntype))
ALLOCATE(atoms%nflip(atoms%ntype))
ALLOCATE(atoms%l_geo(atoms%ntype))
ALLOCATE(atoms%lda_u(atoms%ntype))
ALLOCATE(atoms%lda_u(4*atoms%ntype))
ALLOCATE(atoms%bmu(atoms%ntype))
ALLOCATE(atoms%relax(3,atoms%ntype))
ALLOCATE(atoms%neq(atoms%ntype))
......@@ -1264,6 +1264,7 @@ SUBROUTINE r_inpXML(&
atoms%numStatesProvided = 0
atoms%lapw_l(:) = -1
atoms%n_u = 0
DO iSpecies = 1, numSpecies
! Attributes of species
......@@ -1288,20 +1289,17 @@ SUBROUTINE r_inpXML(&
lmaxAPW = evaluateFirstIntOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/atomicCutoffs/@lmaxAPW'))
END IF
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/ldaU')
numU = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/ldaU')
IF (numU.GT.4) CALL juDFT_error("Too many U parameters provided for a certain species (maximum is 4).",calledby ="r_inpXML")
ldau_l = -1
ldau_u = 0.0
ldau_j = 0.0
l_amf = .FALSE.
DO i = 1, numberNodes
IF (i.GT.1) THEN
WRITE (*,*) 'Not yet implemented:'
STOP 'ERROR: More than 1 U parameter provided for a certain species.'
END IF
ldau_l = evaluateFirstIntOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/ldaU/@l'))
ldau_u = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/ldaU/@U'))
ldau_j = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/ldaU/@J'))
l_amf = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/ldaU/@l_amf'))
DO i = 1, numU
ldau_l(i) = evaluateFirstIntOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/ldaU/@l'))
ldau_u(i) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/ldaU/@U'))
ldau_j(i) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/ldaU/@J'))
l_amf(i) = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/ldaU/@l_amf'))
END DO
speciesNLO(iSpecies) = 0
......@@ -1345,10 +1343,14 @@ SUBROUTINE r_inpXML(&
atoms%nflip(iType) = 0
ENDIF
atoms%bmu(iType) = magMom
atoms%lda_u(iType)%l = ldau_l
atoms%lda_u(iType)%u = ldau_u
atoms%lda_u(iType)%j = ldau_j
atoms%lda_u(iType)%l_amf = l_amf
DO i = 1, numU
atoms%n_u = atoms%n_u + 1
atoms%lda_u(atoms%n_u)%l = ldau_l(i)
atoms%lda_u(atoms%n_u)%u = ldau_u(i)
atoms%lda_u(atoms%n_u)%j = ldau_j(i)
atoms%lda_u(atoms%n_u)%l_amf = l_amf(i)
atoms%lda_u(atoms%n_u)%atomType = iType
END DO
atomTypeSpecies(iType) = iSpecies
IF(speciesRepAtomType(iSpecies).EQ.-1) speciesRepAtomType(iSpecies) = iType
END IF
......@@ -1897,20 +1899,16 @@ SUBROUTINE r_inpXML(&
! Check lda+u stuff (from inped)
atoms%n_u = 0
DO iType = 1,atoms%ntype
IF (atoms%lda_u(iType)%l.GE.0) THEN
atoms%n_u = atoms%n_u + 1
IF (atoms%nlo(iType).GE.1) THEN
DO iLLO = 1, atoms%nlo(iType)
IF ((abs(atoms%llo(iLLO,iType)).EQ.atoms%lda_u(iType)%l).AND.&
.NOT.atoms%l_dulo(iLLO,iType)) THEN
WRITE (*,*) 'LO and LDA+U for same l not implemented'
END IF
END DO
END IF
DO i = 1, atoms%n_u
n = atoms%lda_u(i)%atomType
IF (atoms%nlo(n).GE.1) THEN
DO j = 1, atoms%nlo(n)
IF ((ABS(atoms%llo(j,n)).EQ.atoms%lda_u(i)%l) .AND. (.NOT.atoms%l_dulo(j,n)) ) &
WRITE (*,*) 'LO and LDA+U for same l not implemented'
END DO
END IF
END DO
IF (atoms%n_u.GT.0) THEN
IF (input%secvar) CALL juDFT_error("LDA+U and sevcar not implemented",calledby ="r_inpXML")
IF (input%isec1<input%itmax) CALL juDFT_error("LDA+U and Wu not implemented",calledby ="r_inpXML")
......
io/rw_inp.f90
View file @ ab6dd87f
......@@ -55,7 +55,7 @@
!+lda+u
REAL u,j
INTEGER l
INTEGER l, i_u
LOGICAL l_amf
CHARACTER(len=3) ch_test
NAMELIST /ldaU/ l,u,j,l_amf
......@@ -375,6 +375,7 @@
na = 0
READ (UNIT=5,FMT=7110,END=99,ERR=99)
WRITE (6,9060)