Commit de9938dd authored by Henning Janssen's avatar Henning Janssen

Added some missing atoms%n_hia

parent 2d9ea399
......@@ -88,10 +88,10 @@ CONTAINS
tlmplm%tuloulo(-atoms%llod:atoms%llod,-atoms%llod:atoms%llod,mlolot_d,1),&
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(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u))
IF(atoms%n_u+atoms%n_hia.GT.0) THEN
ALLOCATE(v_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u+atoms%n_hia))
v_mmp = CMPLX(0.0,0.0)
CALL read_tlmplm_vs_mmp(jsp,atoms%n_u,v_mmp)
CALL read_tlmplm_vs_mmp(jsp,atoms%n_u+atoms%n_hia,v_mmp)
END IF
i_u = 1
......@@ -203,7 +203,7 @@ CONTAINS
!
CALL force_a21_lo(atoms,jsp,n,we,eig,ne,eigVecCoeffs,aveccof,bveccof,cveccof,tlmplm,usdus,a21)
IF ((atoms%n_u.GT.0).AND.(i_u.LE.atoms%n_u)) THEN
IF ((atoms%n_u+atoms%n_hia.GT.0).AND.(i_u.LE.atoms%n_u+atoms%n_hia)) THEN
CALL force_a21_U(atoms,i_u,n,jsp,we,ne,usdus,v_mmp,eigVecCoeffs,aveccof,bveccof,cveccof,a21)
END IF
IF (input%l_useapw) THEN
......
......@@ -102,7 +102,7 @@ CONTAINS
END DO ! lo = 1,atoms%nlo
i_u = i_u + 1
IF(i_u.GT.atoms%n_u) EXIT
IF(i_u.GT.atoms%n_u+atoms%n_hia) EXIT
END DO
END SUBROUTINE force_a21_U
......
......@@ -54,7 +54,7 @@ CONTAINS
ENDDO
!In the case of a spin-polarized calculation with Hubbard 1 we want to treat
!the correlated orbitals with a non-spin-polarized basis
!the correlated orbitals with a non-spin-polarized basis
IF(l_hia.AND.SIZE(vTot%mt,4).GT.1.AND..NOT.l_dftspinpol) THEN
vrTmp = (vTot%mt(:,0,iType,1) + vTot%mt(:,0,iType,2))/2.0
ELSE
......
......@@ -102,7 +102,7 @@ MODULE m_gfcalc
CALL crystal_field(atoms,input,greensfCoeffs,hub1,vTot)
ENDIF
IF(input%jspins.EQ.2) THEN
CALL eff_excinteraction(greensf,atoms,input,greensfCoeffs)
CALL eff_excinteraction(greensf,atoms,input,results%ef,greensfCoeffs)
ENDIF
DO i_gf = 1, atoms%n_gf
l = atoms%gfelem(i_gf)%l
......
......@@ -10,12 +10,13 @@ MODULE m_j0
CONTAINS
SUBROUTINE eff_excinteraction(g0,atoms,input,g0Coeffs)
SUBROUTINE eff_excinteraction(g0,atoms,input,ef,g0Coeffs)
TYPE(t_greensf), INTENT(IN) :: g0
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_greensfCoeffs), INTENT(IN) :: g0Coeffs !For determining the onsite exchange splitting from the difference in the COM of the bands
TYPE(t_input), INTENT(IN) :: input
REAL, INTENT(IN) :: ef
COMPLEX integrand, sumup, sumdwn, sumupdwn
INTEGER i,iz,m,l,mp,ispin,n,i_gf,matsize,ipm,ie,n_cut
......@@ -33,7 +34,6 @@ MODULE m_j0
l_matinv = .FALSE. !Determines how the onsite exchange splitting is calculated
DO i_j0 = 1, atoms%n_j0
nType = atoms%j0(i_j0)%atomType
......@@ -150,7 +150,7 @@ MODULE m_j0
j0(l) = j0(l) + AIMAG(integrand)
IF(atoms%j0(i_j0)%l_eDependence) THEN
WRITE(1337,"(5f14.8)") REAL(g0%e(iz)), -1/(2.0*fpi_const)*hartree_to_ev_const *j0(l),&
WRITE(1337,"(5f14.8)") REAL(g0%e(iz)-ef)*hartree_to_ev_const, -1/(2.0*fpi_const)*hartree_to_ev_const *j0(l),&
AIMAG(sumup),AIMAG(sumdwn),AIMAG(sumupdwn)
ENDIF
......
......@@ -1032,7 +1032,8 @@ MODULE m_cdnpot_io_hdf
CALL io_write_attint0(groupID,'nat',atoms%nat)
CALL io_write_attint0(groupID,'lmaxd',atoms%lmaxd)
CALL io_write_attint0(groupID,'jmtd',atoms%jmtd)
CALL io_write_attint0(groupID,'n_u',atoms%n_u+atoms%n_hia)
CALL io_write_attint0(groupID,'n_u',atoms%n_u)
CALL io_write_attint0(groupID,'n_hia',atoms%n_hia)
CALL io_write_attint0(groupID,'nmz',vacuum%nmz)
CALL io_write_attint0(groupID,'nmzd',vacuum%nmzd)
......@@ -1361,8 +1362,9 @@ MODULE m_cdnpot_io_hdf
IF(fileFormatVersion.GE.29) THEN
CALL io_read_attint0(groupID,'n_u',atoms%n_u)
CALL io_read_attint0(groupID,'n_hia',atoms%n_hia)
IF(ALLOCATED(atoms%lda_u)) DEALLOCATE(atoms%lda_u)
ALLOCATE(atoms%lda_u(atoms%n_u))
ALLOCATE(atoms%lda_u(atoms%n_u+atoms%n_hia))
END IF
IF(ALLOCATED(atoms%nz)) DEALLOCATE(atoms%nz)
......@@ -1492,36 +1494,36 @@ MODULE m_cdnpot_io_hdf
CALL h5dclose_f(tauSetID, hdfError)
!LDA+U data (start)
IF((fileFormatVersion.GE.29).AND.(atoms%n_u.GT.0)) THEN
ALLOCATE(ldau_AtomType(atoms%n_u), ldau_l(atoms%n_u), ldau_l_amf(atoms%n_u))
ALLOCATE(ldau_U(atoms%n_u), ldau_J(atoms%n_u))
IF((fileFormatVersion.GE.29).AND.(atoms%n_u+atoms%n_hia.GT.0)) THEN
ALLOCATE(ldau_AtomType(atoms%n_u+atoms%n_hia), ldau_l(atoms%n_u+atoms%n_hia), ldau_l_amf(atoms%n_u+atoms%n_hia))
ALLOCATE(ldau_U(atoms%n_u+atoms%n_hia), ldau_J(atoms%n_u+atoms%n_hia))
dimsInt(:1)=(/atoms%n_u/)
dimsInt(:1)=(/atoms%n_u+atoms%n_hia/)
CALL h5dopen_f(groupID, 'ldau_AtomType', ldau_AtomTypeSetID, hdfError)
CALL io_read_integer1(ldau_AtomTypeSetID,(/1/),dimsInt(:1),ldau_AtomType)
CALL h5dclose_f(ldau_AtomTypeSetID, hdfError)
dimsInt(:1)=(/atoms%n_u/)
dimsInt(:1)=(/atoms%n_u+atoms%n_hia/)
CALL h5dopen_f(groupID, 'ldau_l', ldau_lSetID, hdfError)
CALL io_read_integer1(ldau_lSetID,(/1/),dimsInt(:1),ldau_l)
CALL h5dclose_f(ldau_lSetID, hdfError)
dimsInt(:1)=(/atoms%n_u/)
dimsInt(:1)=(/atoms%n_u+atoms%n_hia/)
CALL h5dopen_f(groupID, 'ldau_l_amf', ldau_l_amfSetID, hdfError)
CALL io_read_integer1(ldau_l_amfSetID,(/1/),dimsInt(:1),ldau_l_amf)
CALL h5dclose_f(ldau_l_amfSetID, hdfError)
dimsInt(:1)=(/atoms%n_u/)
dimsInt(:1)=(/atoms%n_u+atoms%n_hia/)
CALL h5dopen_f(groupID, 'ldau_U', ldau_USetID, hdfError)
CALL io_read_real1(ldau_USetID,(/1/),dimsInt(:1),ldau_U)
CALL h5dclose_f(ldau_USetID, hdfError)
dimsInt(:1)=(/atoms%n_u/)
dimsInt(:1)=(/atoms%n_u+atoms%n_hia/)
CALL h5dopen_f(groupID, 'ldau_J', ldau_JSetID, hdfError)
CALL io_read_real1(ldau_JSetID,(/1/),dimsInt(:1),ldau_J)
CALL h5dclose_f(ldau_JSetID, hdfError)
DO i = 1, atoms%n_u
DO i = 1, atoms%n_u+atoms%n_hia
atoms%lda_u(i)%atomType = ldau_AtomType(i)
atoms%lda_u(i)%l = ldau_l(i)
atoms%lda_u(i)%u = ldau_U(i)
......@@ -1555,7 +1557,7 @@ MODULE m_cdnpot_io_hdf
INTEGER :: i, iVac
INTEGER :: ntype,jmtd,nmzd,nmzxyd,nlhd,ng3,ng2
INTEGER :: nmz,nvac,od_nq2,nmzxy,n_u
INTEGER :: nmz,nvac,od_nq2,nmzxy,n_u,n_hia
INTEGER :: hdfError, fileFormatVersion
LOGICAL :: l_film,l_exist,l_delete
INTEGER(HID_T) :: archiveID, groupID, generalGroupID
......@@ -1598,8 +1600,10 @@ MODULE m_cdnpot_io_hdf
CALL io_read_attint0(groupID,'nvac',nvac)
CALL io_read_attint0(groupID,'od_nq2',od_nq2)
n_u = 0
n_hia = 0
IF(fileFormatVersion.GE.29) THEN
CALL io_read_attint0(groupID,'n_u',n_u)
CALL io_read_attint0(groupID,'n_hia',n_hia)
END IF
CALL h5gclose_f(groupID, hdfError)
......@@ -1738,8 +1742,8 @@ MODULE m_cdnpot_io_hdf
END IF
END IF
IF ((fileFormatVersion.GE.29).AND.(n_u.GT.0)) THEN
dimsInt(:5)=(/2,2*lmaxU_const+1,2*lmaxU_const+1,n_u,input%jspins/)
IF ((fileFormatVersion.GE.29).AND.(n_u+n_hia.GT.0)) THEN
dimsInt(:5)=(/2,2*lmaxU_const+1,2*lmaxU_const+1,n_u+n_hia,input%jspins/)
CALL h5dopen_f(groupID, 'mmpMat', mmpMatSetID, hdfError)
CALL io_write_complex4(mmpMatSetID,(/-1,1,1,1,1/),dimsInt(:5),den%mmpMat)
CALL h5dclose_f(mmpMatSetID, hdfError)
......@@ -1823,8 +1827,8 @@ MODULE m_cdnpot_io_hdf
END IF
END IF
IF ((fileFormatVersion.GE.29).AND.(n_u.GT.0)) THEN
dims(:5)=(/2,2*lmaxU_const+1,2*lmaxU_const+1,n_u,input%jspins/)
IF ((fileFormatVersion.GE.29).AND.(n_u+n_hia.GT.0)) THEN
dims(:5)=(/2,2*lmaxU_const+1,2*lmaxU_const+1,n_u+n_hia,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(5,dims(:5),mmpMatSpaceID,hdfError)
CALL h5dcreate_f(groupID, "mmpMat", H5T_NATIVE_DOUBLE, mmpMatSpaceID, mmpMatSetID, hdfError)
......@@ -1927,8 +1931,8 @@ MODULE m_cdnpot_io_hdf
END IF
END IF
IF ((fileFormatVersion.GE.29).AND.(n_u.GT.0)) THEN
dims(:5)=(/2,2*lmaxU_const+1,2*lmaxU_const+1,n_u,input%jspins/)
IF ((fileFormatVersion.GE.29).AND.(n_u+n_hia.GT.0)) THEN
dims(:5)=(/2,2*lmaxU_const+1,2*lmaxU_const+1,n_u+n_hia,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(5,dims(:5),mmpMatSpaceID,hdfError)
CALL h5dcreate_f(groupID, "mmpMat", H5T_NATIVE_DOUBLE, mmpMatSpaceID, mmpMatSetID, hdfError)
......@@ -2204,7 +2208,7 @@ MODULE m_cdnpot_io_hdf
INTEGER :: starsIndex, latharmsIndex, structureIndex, stepfunctionIndex
INTEGER :: previousDensityIndex, jspins
INTEGER :: ntype,jmtd,nmzd,nmzxyd,nlhd,ng3,ng2
INTEGER :: nmz, nvac, od_nq2, nmzxy, n_u, i, j
INTEGER :: nmz, nvac, od_nq2, nmzxy, n_u, n_hia, i, j
INTEGER :: localDensityType
LOGICAL :: l_film, l_exist, l_mmpMatDimEquals, l_amf_Temp
INTEGER(HID_T) :: archiveID, groupID, groupBID, generalGroupID
......@@ -2312,31 +2316,32 @@ MODULE m_cdnpot_io_hdf
CALL io_read_attint0(groupBID,'od_nq2',od_nq2)
IF(fileFormatVersion.GE.29) THEN
CALL io_read_attint0(groupBID,'n_u',n_u)
IF(n_u.GT.0) THEN
ALLOCATE(ldau_AtomType(n_u), ldau_l(n_u), ldau_l_amf(n_u))
ALLOCATE(ldau_U(n_u), ldau_J(n_u))
CALL io_read_attint0(groupBID,'n_hia',n_hia)
IF(n_u+n_hia.GT.0) THEN
ALLOCATE(ldau_AtomType(n_u+n_hia), ldau_l(n_u+n_hia), ldau_l_amf(n_u+n_hia))
ALLOCATE(ldau_U(n_u+n_hia), ldau_J(n_u+n_hia))
dimsInt(:1)=(/n_u/)
dimsInt(:1)=(/n_u+n_hia/)
CALL h5dopen_f(groupBID, 'ldau_AtomType', ldau_AtomTypeSetID, hdfError)
CALL io_read_integer1(ldau_AtomTypeSetID,(/1/),dimsInt(:1),ldau_AtomType)
CALL h5dclose_f(ldau_AtomTypeSetID, hdfError)
dimsInt(:1)=(/n_u/)
dimsInt(:1)=(/n_u+n_hia/)
CALL h5dopen_f(groupBID, 'ldau_l', ldau_lSetID, hdfError)
CALL io_read_integer1(ldau_lSetID,(/1/),dimsInt(:1),ldau_l)
CALL h5dclose_f(ldau_lSetID, hdfError)
dimsInt(:1)=(/n_u/)
dimsInt(:1)=(/n_u+n_hia/)
CALL h5dopen_f(groupBID, 'ldau_l_amf', ldau_l_amfSetID, hdfError)
CALL io_read_integer1(ldau_l_amfSetID,(/1/),dimsInt(:1),ldau_l_amf)
CALL h5dclose_f(ldau_l_amfSetID, hdfError)
dimsInt(:1)=(/n_u/)
dimsInt(:1)=(/n_u+n_hia/)
CALL h5dopen_f(groupBID, 'ldau_U', ldau_USetID, hdfError)
CALL io_read_real1(ldau_USetID,(/1/),dimsInt(:1),ldau_U)
CALL h5dclose_f(ldau_USetID, hdfError)
dimsInt(:1)=(/n_u/)
dimsInt(:1)=(/n_u+n_hia/)
CALL h5dopen_f(groupBID, 'ldau_J', ldau_JSetID, hdfError)
CALL io_read_real1(ldau_JSetID,(/1/),dimsInt(:1),ldau_J)
CALL h5dclose_f(ldau_JSetID, hdfError)
......@@ -2395,11 +2400,11 @@ MODULE m_cdnpot_io_hdf
l_mmpMatDimEquals = .TRUE.
IF(fileFormatVersion.GE.29) THEN
IF(atoms%n_u+atoms%n_hia.NE.n_u) THEN
IF(atoms%n_u+atoms%n_hia.NE.n_u+n_hia) THEN
l_DimChange = .TRUE.
l_mmpMatDimEquals = .FALSE.
ELSE
DO i = 1, n_u
DO i = 1, n_u+n_hia
IF (atoms%lda_u(i)%atomType.NE.ldau_AtomType(i)) l_mmpMatDimEquals = .FALSE.
IF (atoms%lda_u(i)%l.NE.ldau_l(i)) l_mmpMatDimEquals = .FALSE.
l_amf_Temp = .FALSE.
......@@ -2488,9 +2493,9 @@ MODULE m_cdnpot_io_hdf
END IF
END IF
IF((fileFormatVersion.GE.29).AND.(n_u.GT.0)) THEN
ALLOCATE (mmpMatTemp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,n_u,jspins))
dimsInt(:5)=(/2,2*lmaxU_const+1,2*lmaxU_const+1,n_u,jspins/)
IF((fileFormatVersion.GE.29).AND.(n_u+n_hia.GT.0)) THEN
ALLOCATE (mmpMatTemp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,n_u+n_hia,jspins))
dimsInt(:5)=(/2,2*lmaxU_const+1,2*lmaxU_const+1,n_u+n_hia,jspins/)
CALL h5dopen_f(groupID, 'mmpMat', mmpMatSetID, hdfError)
CALL io_read_complex4(mmpMatSetID,(/-1,1,1,1,1/),dimsInt(:5),mmpMatTemp)
CALL h5dclose_f(mmpMatSetID, hdfError)
......@@ -2499,7 +2504,7 @@ MODULE m_cdnpot_io_hdf
IF(l_mmpMatDimEquals) THEN
den%mmpMat(:,:,:,1:jspinsOut) = mmpMatTemp(:,:,:,1:jspinsOut)
ELSE
DO i = 1, n_u
DO i = 1, n_u+n_hia
DO j = 1, atoms%n_u+atoms%n_hia
IF (atoms%lda_u(j)%atomType.NE.ldau_AtomType(i)) CYCLE
IF (atoms%lda_u(j)%l.NE.ldau_l(i)) CYCLE
......
......@@ -1666,7 +1666,7 @@ CONTAINS
ENDIF
ENDDO
ENDDO
IF(atoms%n_gf>0) input%l_gf = .true.
IF(atoms%n_gf>0) input%l_gf = .true. !This switch enforces the consideration of unoccuied states in cdnval.f90
atoms%lmaxd = MAXVAL(atoms%lmax(:))
atoms%llod = 0
......
......@@ -40,8 +40,9 @@ SUBROUTINE writeOutParameters(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
WRITE(attributes(2),'(i0)') atoms%ntype
WRITE(attributes(3),'(i0)') atoms%jmtd
WRITE(attributes(4),'(i0)') atoms%n_u
CALL writeXMLElementFormPoly('atomsInCell',(/'nat ','ntype','jmtd ','n_u '/),&
attributes(:4),reshape((/3,6,6,6,8,8,8,8/),(/4,2/)))
WRITE(attributes(4),'(i0)') atoms%n_hia
CALL writeXMLElementFormPoly('atomsInCell',(/'nat ','ntype','jmtd ','n_u ','n_hia'/),&
attributes(:5),reshape((/3,6,6,6,6,8,8,8,8,8/),(/5,2/)))
WRITE(attributes(1),'(i0)') dimension%nvd
WRITE(attributes(2),'(i0)') atoms%lmaxd
......
......@@ -316,6 +316,7 @@ MODULE m_hubbard1_setup
ELSE
!occupation matrix is zero and LDA+Hubbard 1 shouldn't be run yet
!There is nothing to be done yet just set the potential correction to 0
WRITE(*,*) "No density matrix and GF found -> skipping LDA+HIA"
pot%mmpMat(:,:,atoms%n_u+1:atoms%n_hia+atoms%n_u,:) = CMPLX(0.0,0.0)
results%e_ldau = 0.0
ENDIF
......
......@@ -519,7 +519,7 @@
END IF
END IF
IF (atoms%n_gf>0) THEN
IF(.NOT.input%tria.AND..NOT.input%film) THEN
IF(.NOT.input%tria.AND..NOT.input%film.AND..NOT.input%l_hist) THEN
!Calculate regular decomposition into tetrahedra (make_tetra doesnt seem to work for most meshes)
IF(kpts%nkptf.EQ.0) CALL gen_bz(kpts,sym)
CALL calc_tetra(kpts,cell,input,sym)
......
......@@ -211,7 +211,7 @@ CONTAINS
mem = mem + (dimension%lmd+1)*(2*atoms%llod+1)*max(mlotot,1)*2 ! tlmplm%tuulo ...
mem = mem + (2*atoms%llod+1)**2 * max(mlolotot,1) ! tlmplm%tuloulo
IF (noco%l_noco) mem = mem * 2 ! both spins
mem = mem + 49*atoms%n_u*input%jspins*2 ! lda+U, *2 for complex
mem = mem + 49*(atoms%n_u+atoms%n_hia)*input%jspins*2 ! lda+U, *2 for complex
mem = mem+INT((dimension%nbasfcn*2+(dimension%lmd+1)*atoms%ntype)*0.5)+1 ! tlmplm%ind, *0.5 for integer
matsz = dimension%nbasfcn * CEILING(REAL(dimension%nbasfcn)/n_size) ! size of a, b
......
......@@ -86,8 +86,8 @@ SUBROUTINE flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell)
END DO
! for LDA+U: flip density matrix
IF (ANY(den%mmpMat(:,:,:,:).NE.0.0).AND.atoms%n_u>0) THEN
DO i_u = 1, atoms%n_u
IF (ANY(den%mmpMat(:,:,:,:).NE.0.0).AND.atoms%n_u+atoms%n_hia>0) THEN
DO i_u = 1, atoms%n_u+atoms%n_hia
itype = atoms%lda_u(i_u)%atomType
IF (atoms%nflip(itype).EQ.-1) THEN
DO m = -3,3
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment