Skip to content

GitLab

fleur
fleur
Commit dea084ba authored by Matthias Redies's avatar Matthias Redies
Browse files
Options

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 97362865 cf55ed4e
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 435 additions and 801 deletions
fleurinput/types_wannier.f90
View file @ dea084ba
This diff is collapsed.
greensf/CMakeLists.txt
View file @ dea084ba
......@@ -7,6 +7,7 @@ greensf/greensfCalcRealPart.F90
greensf/greensfUtils.f90
greensf/greensfPostProcess.F90
greensf/kkintgr.f90
greensf/lorentzian_smooth.f90
greensf/kk_cutoff.F90
greensf/hybridization.f90
greensf/occmtx.f90
......
greensf/greensfCalcRealPart.F90
View file @ dea084ba
......@@ -23,7 +23,7 @@ MODULE m_greensfCalcRealPart
IMPLICIT NONE
INTEGER, PARAMETER :: int_method(3) = (/method_direct,method_direct,method_maclaurin/)
INTEGER, PARAMETER :: int_method(3) = [method_direct,method_direct,method_maclaurin]
CONTAINS
......@@ -44,11 +44,12 @@ MODULE m_greensfCalcRealPart
INTEGER :: spin_cut,nn,natom,contourShape,dummy
INTEGER :: i_gf_start,i_gf_end,spin_start,spin_end
INTEGER :: n_gf_task,extra
LOGICAL :: l_onsite,l_fixedCutoffset
LOGICAL :: l_onsite,l_fixedCutoffset,l_skip
REAL :: fac,del,eb,et,fixedCutoff
REAL, ALLOCATABLE :: eMesh(:)
!Get the information on the real axis energy mesh
CALL gfinp%eMesh(ef,del,eb,et)
CALL gfinp%eMesh(ef,del_out=del,eb_out=eb,et_out=et,eMesh=eMesh)
nspins = MERGE(3,input%jspins,gfinp%l_mperp)
......@@ -99,13 +100,13 @@ MODULE m_greensfCalcRealPart
IF(i_gf.LT.1 .OR. i_gf.GT.gfinp%n) CYCLE !Make sure to not produce segfaults with mpi
!Get the information of ith current element
l = gfinp%elem(i_gf)%l
lp = gfinp%elem(i_gf)%lp
nType = gfinp%elem(i_gf)%atomType
l = gfinp%elem(i_gf)%l
lp = gfinp%elem(i_gf)%lp
nType = gfinp%elem(i_gf)%atomType
nTypep = gfinp%elem(i_gf)%atomTypep
contourShape = gfinp%contour(gfinp%elem(i_gf)%iContour)%shape
contourShape = gfinp%contour(gfinp%elem(i_gf)%iContour)%shape
l_fixedCutoffset = gfinp%elem(i_gf)%l_fixedCutoffset
fixedCutoff = gfinp%elem(i_gf)%fixedCutoff
fixedCutoff = gfinp%elem(i_gf)%fixedCutoff
CALL uniqueElements_gfinp(gfinp,dummy,ind=i_gf,indUnique=i_elem)
......@@ -124,11 +125,9 @@ MODULE m_greensfCalcRealPart
greensfImagPart%kkintgr_cutoff(i_gf,:,2) = INT((fixedCutoff+ef-eb)/del)+1
ELSE
!For all other elements we just use ef+elup as a hard cutoff
!(maybe give option to specify outside of changing the realAxis grid)
greensfImagPart%kkintgr_cutoff(i_gf,:,1) = 1
greensfImagPart%kkintgr_cutoff(i_gf,:,2) = gfinp%ne
ENDIF
!
!Perform the Kramers-Kronig-Integration if not already calculated
!
......@@ -136,23 +135,43 @@ MODULE m_greensfCalcRealPart
DO jspin = spin_start, spin_end
spin_cut = MERGE(1,jspin,jspin.GT.2)
kkcut = greensfImagPart%kkintgr_cutoff(i_gf,spin_cut,2)
!------------------------------------------------------------
! Set everything above the cutoff in the imaginary part to 0
! We do this explicitely because when we just use the hard cutoff index
! Things might get lost when the imaginary part is smoothed explicitely
!------------------------------------------------------------
IF(kkcut.ne.SIZE(eMesh)) THEN
greensfImagPart%sphavg(kkcut+1:,-l:l,-l:l,i_elem,jspin) = 0.0
ENDIF
DO ipm = 1, 2 !upper or lower half of the complex plane (G(E \pm i delta))
DO m= -l,l
DO mp= -lp,lp
!Don't waste time on empty elements
l_skip = .FALSE.
DO ie = 1, SIZE(eMesh)
IF(ABS(greensfImagPart%sphavg(ie,m,mp,i_elem,jspin)).GT.1e-12) EXIT
IF(ie==SIZE(eMesh)) l_skip = .TRUE.
ENDDO
IF(l_skip) THEN
g(i_gf)%gmmpMat(:,m,mp,jspin,ipm) = cmplx_0
CYCLE
ENDIF
IF(gfinp%l_sphavg) THEN
CALL kkintgr(greensfImagPart%sphavg(:,m,mp,i_elem,jspin),eb,del,kkcut,&
g(i_gf)%gmmpMat(:,m,mp,jspin,ipm),g(i_gf)%contour%e,(ipm.EQ.2),g(i_gf)%contour%nz,int_method(contourShape))
CALL kkintgr(greensfImagPart%sphavg(:,m,mp,i_elem,jspin),eMesh,g(i_gf)%contour%e,(ipm.EQ.2),&
g(i_gf)%gmmpMat(:,m,mp,jspin,ipm),int_method(contourShape))
ELSE
! In the case of radial dependence we perform the kramers-kronig-integration seperately for uu,dd,etc.
! We can do this because the radial functions are independent of E
CALL kkintgr(greensfImagPart%uu(:,m,mp,i_elem,jspin),eb,del,kkcut,&
g(i_gf)%uu(:,m,mp,jspin,ipm),g(i_gf)%contour%e,(ipm.EQ.2),g(i_gf)%contour%nz,int_method(contourShape))
CALL kkintgr(greensfImagPart%dd(:,m,mp,i_elem,jspin),eb,del,kkcut,&
g(i_gf)%dd(:,m,mp,jspin,ipm),g(i_gf)%contour%e,(ipm.EQ.2),g(i_gf)%contour%nz,int_method(contourShape))
CALL kkintgr(greensfImagPart%du(:,m,mp,i_elem,jspin),eb,del,kkcut,&
g(i_gf)%du(:,m,mp,jspin,ipm),g(i_gf)%contour%e,(ipm.EQ.2),g(i_gf)%contour%nz,int_method(contourShape))
CALL kkintgr(greensfImagPart%ud(:,m,mp,i_elem,jspin),eb,del,kkcut,&
g(i_gf)%ud(:,m,mp,jspin,ipm),g(i_gf)%contour%e,(ipm.EQ.2),g(i_gf)%contour%nz,int_method(contourShape))
CALL kkintgr(greensfImagPart%uu(:,m,mp,i_elem,jspin),eMesh,g(i_gf)%contour%e,(ipm.EQ.2),&
g(i_gf)%uu(:,m,mp,jspin,ipm),int_method(contourShape))
CALL kkintgr(greensfImagPart%ud(:,m,mp,i_elem,jspin),eMesh,g(i_gf)%contour%e,(ipm.EQ.2),&
g(i_gf)%ud(:,m,mp,jspin,ipm),int_method(contourShape))
CALL kkintgr(greensfImagPart%du(:,m,mp,i_elem,jspin),eMesh,g(i_gf)%contour%e,(ipm.EQ.2),&
g(i_gf)%du(:,m,mp,jspin,ipm),int_method(contourShape))
CALL kkintgr(greensfImagPart%dd(:,m,mp,i_elem,jspin),eMesh,g(i_gf)%contour%e,(ipm.EQ.2),&
g(i_gf)%dd(:,m,mp,jspin,ipm),int_method(contourShape))
ENDIF
ENDDO
ENDDO
......
greensf/kk_cutoff.F90
View file @ dea084ba
......@@ -26,36 +26,19 @@ MODULE m_kk_cutoff
REAL, INTENT(IN) :: e_top
INTEGER, INTENT(INOUT) :: cutoff(:,:)
CHARACTER(len=5) :: filename
INTEGER :: i,m,n_c,ispin,spins_cut
INTEGER :: m,ispin,spins_cut
REAL :: lowerBound,upperBound,integral,n_states,scale,e_cut
REAL :: projDOS(ne,jspins)
projDOS = 0.0
REAL, ALLOCATABLE :: projDOS(:,:)
!Calculate the trace over m,mp of the Imaginary Part matrix to obtain the projected DOS
!n_f(e) = -1/pi * TR[Im(G_f(e))]
ALLOCATE(projDOS(ne,jspins),source=0.0)
DO ispin = 1, jspins
DO m = -l , l
DO i = 1, ne
projDOS(i,ispin) = projDOS(i,ispin) + im(i,m,m,ispin)
ENDDO
projDOS(:,ispin) = projDOS(:,ispin) - 1/pi_const * im(:,m,m,ispin)
ENDDO
ENDDO
projDOS = -1/pi_const*projDOS
!#ifdef CPP_DEBUG
!DO ispin = 1, jspins
! WRITE(filename,9010) ispin
!9010 FORMAT("projDOS",I1)
! OPEN(unit=1337,file=filename,status="replace")
! DO i = 1, ne
! WRITE(1337,"(2f14.8)") (i-1)*del+e_bot,projDOS(i,ispin)
! ENDDO
! CLOSE(unit=1337)
!ENDDO
!#endif
spins_cut = MERGE(1,jspins,noco%l_noco.AND.l_mperp)
n_states = (2*l+1) * MERGE(2.0,2.0/jspins,noco%l_noco.AND.l_mperp)
......@@ -69,6 +52,8 @@ MODULE m_kk_cutoff
!Check the integral up to the hard cutoff
!----------------------------------------
IF(spins_cut.EQ.1 .AND.jspins.EQ.2) projDOS(:,1) = projDOS(:,1) + projDOS(:,2)
!Initial complete integral
integral = trapz(projDOS(:,ispin),del,ne)
#ifdef CPP_DEBUG
......@@ -91,19 +76,23 @@ MODULE m_kk_cutoff
! If the integral is to small we terminate here to avoid problems
CALL juDFT_warn("Integral over DOS too small for f -> increase elup(<1htr) or numbands", calledby="kk_cutoff")
ENDIF
ELSE IF((integral.GT.n_states).AND.((integral-n_states).GT.0.00001)) THEN
ELSE
!IF the integral is bigger than 2l+1, search for the cutoff using the bisection method
lowerBound = e_bot
upperBound = e_top
DO WHILE(upperBound-lowerBound.GT.del)
DO WHILE(ABS(upperBound-lowerBound).GT.del/2.0)
e_cut = (lowerBound+upperBound)/2.0
cutoff(ispin,2) = INT((e_cut-e_bot)/del)+1
!Integrate the DOS up to the cutoff
integral = trapz(projDOS(:,ispin),del,cutoff(ispin,2))
IF(integral.LT.n_states) THEN
IF(ABS(integral-n_states).LT.1e-12) THEN
EXIT
ELSE IF(integral.LT.n_states) THEN
!integral to small -> choose the right interval
lowerBound = e_cut
ELSE IF(integral.GT.n_states) THEN
......@@ -118,7 +107,8 @@ MODULE m_kk_cutoff
WRITE(*,*) "CORRESPONDING ENERGY", e_cut
WRITE(*,*) "INTEGRAL OVER projDOS with cutoff: ", integral
#endif
IF(spins_cut.EQ.1.AND.jspins.EQ.2) cutoff(2,2) = cutoff(1,2)
!Copy cutoff to second spin if only one was calculated
IF(spins_cut.EQ.1 .AND. jspins.EQ.2) cutoff(2,2) = cutoff(1,2)
ENDIF
ENDDO
......
greensf/kkintgr.f90
View file @ dea084ba
......@@ -14,7 +14,6 @@ MODULE m_kkintgr
! TODO: Look at FFT for Transformation
! How to do changing imaginary parts
!------------------------------------------------------------------------------
USE ieee_arithmetic
USE m_constants
USE m_juDFT
......@@ -25,15 +24,11 @@ MODULE m_kkintgr
INTEGER, PARAMETER :: method_direct = 3
INTEGER, PARAMETER :: method_fft = 4
CHARACTER(len=10), PARAMETER :: smooth_method = 'lorentzian' !(or gaussian)
!PARAMETER FOR LORENTZIAN SMOOTHING
REAL, PARAMETER :: cut = 1e-8
CHARACTER(len=10), PARAMETER :: smooth_method = 'lorentzian' !(lorentzian or gaussian)
CONTAINS
SUBROUTINE kkintgr(im,eb,del,ne,g,ez,l_conjg,nz,method)
SUBROUTINE kkintgr(im,eMesh,ez,l_conjg,g,method)
!calculates the Kramer Kronig Transformation on the same contour where the imaginary part was calculated
!Re(G(E+i * delta)) = -1/pi * int_bot^top dE' P(1/(E-E')) * Im(G(E'+i*delta))
......@@ -41,33 +36,30 @@ MODULE m_kkintgr
!The dominant source of error for this routine is a insufficiently dense energy mesh on the real axis
!TODO: Some way to estimate the error (maybe search for the sharpest peak and estimate from width)
USE m_smooth
USE m_lorentzian_smooth
!Information about the integrand
REAL, INTENT(IN) :: im(:) !Imaginary part of the green's function on the real axis
REAL, INTENT(IN) :: eb !Bottom energy cutoff
REAL, INTENT(IN) :: del !Energy step on the real axis
INTEGER, INTENT(IN) :: ne !Number of energy points on the real axis
!Information about the complex energy contour
COMPLEX, INTENT(INOUT) :: g(:) !Green's function on the complex plane
REAL, INTENT(IN) :: eMesh(:) !Energy grid on the real axis
COMPLEX, INTENT(IN) :: ez(:) !Complex energy contour
LOGICAL, INTENT(IN) :: l_conjg !Switch determines wether we calculate g on the complex conjugate of the contour ez
INTEGER, INTENT(IN) :: nz !Number of energy points on the complex contour
!Information about the method
COMPLEX, INTENT(INOUT) :: g(:) !Green's function on the complex plane
INTEGER, INTENT(IN) :: method !Integer associated with the method to be used (definitions above)
INTEGER :: iz,izp,n1,n2,i
INTEGER :: iz,izp,n1,n2,i,ne,nz
INTEGER :: ismooth,nsmooth
REAL :: e(ne)
REAL :: eb,del
REAL :: re_n1,re_n2,im_n1,im_n2
INTEGER :: smoothInd(nz)
REAL :: sigma(nz)
REAL, ALLOCATABLE :: smoothed(:,:)
INTEGER, ALLOCATABLE :: smoothInd(:)
REAL, ALLOCATABLE :: sigma(:)
REAL, ALLOCATABLE :: smoothed(:,:)
DO i = 1, ne
e(i) = (i-1) * del + eb
ENDDO
nz = SIZE(ez)
ne = SIZE(eMesh)
eb = eMesh(1)
del = eMesh(2) - eMesh(1)
ALLOCATE(smoothInd(nz),source=0)
ALLOCATE(sigma(nz),source=0.0)
IF(method.NE.method_direct) THEN
CALL timestart("kkintgr: smoothing")
......@@ -85,19 +77,19 @@ MODULE m_kkintgr
smoothInd(iz) = nsmooth
sigma(nsmooth) = AIMAG(ez(iz))
ENDDO outer
ALLOCATE(smoothed(nsmooth,ne), source=0.0)
ALLOCATE(smoothed(ne,nsmooth), source=0.0)
!$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(nsmooth,smoothed,sigma,ne,e,im) &
!$OMP SHARED(nsmooth,smoothed,sigma,ne,eMesh,im) &
!$OMP PRIVATE(ismooth)
!$OMP DO
DO ismooth = 1, nsmooth
smoothed(ismooth,:) = im(:ne)
smoothed(:,ismooth) = im(:ne)
IF(ABS(sigma(ismooth)).LT.1e-12) CYCLE
SELECT CASE (TRIM(ADJUSTL(smooth_method)))
CASE('lorentzian')
CALL lorentzian_smooth(e,smoothed(ismooth,:),sigma(ismooth),ne)
CALL lorentzian_smooth(eMesh,smoothed(:,ismooth),sigma(ismooth),ne)
CASE('gaussian')
CALL smooth(e,smoothed(ismooth,:),sigma(ismooth),ne)
CALL smooth(eMesh,smoothed(:,ismooth),sigma(ismooth),ne)
CASE DEFAULT
CALL juDFT_error("No valid smooth_method set",&
hint="This is a bug in FLEUR, please report",&
......@@ -113,14 +105,14 @@ MODULE m_kkintgr
CALL timestart("kkintgr: integration")
!$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(nz,ne,method,del,eb,l_conjg) &
!$OMP SHARED(g,ez,im,e,smoothed,smoothInd) &
!$OMP SHARED(g,ez,im,smoothed,smoothInd) &
!$OMP PRIVATE(iz,n1,n2,re_n1,re_n2,im_n1,im_n2)
!$OMP DO
DO iz = 1, nz
SELECT CASE(method)
CASE(method_direct)
g(iz) = g_circle(im,ne,MERGE(conjg(ez(iz)),ez(iz),l_conjg),del,eb)
g(iz) = kk_direct(im,ne,MERGE(conjg(ez(iz)),ez(iz),l_conjg),del,eb)
CASE(method_maclaurin, method_deriv)
!Use the previously smoothed version and interpolate after
!Next point to the left
......@@ -128,31 +120,28 @@ MODULE m_kkintgr
!next point to the right
n2 = n1 + 1
!Here we perform the Kramers-kronig-Integration
re_n2 = re_ire(smoothed(smoothInd(iz),:),ne,n2,method)
re_n1 = re_ire(smoothed(smoothInd(iz),:),ne,n1,method)
re_n2 = kk_num(smoothed(:,smoothInd(iz)),ne,n2,method)
re_n1 = kk_num(smoothed(:,smoothInd(iz)),ne,n1,method)
!Interpolate to the energy ez(iz)
!Real Part
g(iz) = (re_n2-re_n1)/del * (REAL(ez(iz))-(n1-1)*del-eb) + re_n1
!Imaginary Part (0 outside of the energy range)
IF(n1.LE.ne.AND.n1.GE.1) THEN
im_n1 = smoothed(smoothInd(iz),n1)
im_n1 = smoothed(n1,smoothInd(iz))
ELSE
im_n1 = 0.0
ENDIF
IF(n2.LE.ne.AND.n2.GE.1) THEN
im_n2 = smoothed(smoothInd(iz),n2)
im_n2 = smoothed(n2,smoothInd(iz))
ELSE
im_n2 = 0.0
ENDIF
g(iz) = g(iz) + ImagUnit *( (im_n2-im_n1)/del * (REAL(ez(iz))-(n1-1)*del-eb) + im_n1 )
IF(ieee_IS_NAN(AIMAG(g(iz))).OR.ieee_IS_NAN(REAL(g(iz)))) THEN
CALL juDFT_error("Kkintgr failed",calledby="kkintgr")
ENDIF
IF(l_conjg) g(iz) = conjg(g(iz))
CASE(method_fft)
CALL juDFT_error("Not implemented yet", calledby="kkintgr")
CASE DEFAULT
......@@ -165,7 +154,7 @@ MODULE m_kkintgr
END SUBROUTINE kkintgr
COMPLEX FUNCTION g_circle(im,ne,z,del,eb)
COMPLEX FUNCTION kk_direct(im,ne,z,del,eb)
USE m_trapz
......@@ -183,11 +172,11 @@ MODULE m_kkintgr
integrand(i) = 1.0/(z-(i-1)*del-eb) * im(i)
ENDDO
g_circle = -1/pi_const *( trapz(REAL(integrand(:)),del,ne) &
kk_direct = -1/pi_const *( trapz(REAL(integrand(:)),del,ne) &
+ ImagUnit * trapz(AIMAG(integrand(:)),del,ne))
END FUNCTION g_circle
END FUNCTION kk_direct
REAL FUNCTION re_ire(im,ne,ire,method)
REAL FUNCTION kk_num(im,ne,ire,method)
REAL, INTENT(IN) :: im(:) !Imaginary part
INTEGER, INTENT(IN) :: ne !Dimension of the energy grid
......@@ -196,7 +185,7 @@ MODULE m_kkintgr
INTEGER i,j
REAL y,im_ire
re_ire = 0.0
kk_num = 0.0
IF(ire.LE.ne.AND.ire.GE.1) THEN
im_ire = im(ire)
ELSE
......@@ -216,8 +205,8 @@ MODULE m_kkintgr
i = 2*j
ENDIF
y = - 1/pi_const * 2.0 * im(i)/REAL(ire-i)
IF(j.EQ.1.OR.j.EQ.INT(ne/2.0)) y = y/2.0
re_ire = re_ire + y
IF(j.EQ.1 .OR. j.EQ.INT(ne/2.0)) y = y/2.0
kk_num = kk_num + y
ENDDO
CASE (method_deriv)
......@@ -230,56 +219,17 @@ MODULE m_kkintgr
y = -1/pi_const * (im(2)-im(1))
ELSE IF(ire.EQ.ne) THEN
y = -1/pi_const * (im(ne)-im(ne-1))
ELSE IF((ire.LE.ne).AND.(ire.GE.1)) THEN
ELSE IF((ire.LT.ne).AND.(ire.GT.1)) THEN
y = -1/pi_const * (im(ire+1)-im(ire-1))/2.0
ENDIF
ENDIF
IF(j.EQ.1.OR.j.EQ.INT(ne/2.0)) y = y/2.0
re_ire = re_ire + y
IF(j.EQ.1 .OR. j.EQ.ne) y = y/2.0
kk_num = kk_num + y
ENDDO
CASE default
CALL juDFT_error("No valid method for KK-integration chosen",calledby="kkintgr")
END SELECT
END FUNCTION re_ire
!This is essentially smooth out of m_smooth but with a lorentzian distribution
SUBROUTINE lorentzian_smooth(e,f,sigma,n)
INTEGER, INTENT(IN) :: n
REAL, INTENT(INOUT) :: f(:)
REAL, INTENT(IN) :: sigma
REAL, INTENT(IN) :: e(:)
REAL :: dx
REAL :: f0(n), ee(n)
INTEGER :: ie , je , j1 , j2 , numPoints
f0 = f
f = 0.0
ee = 0.0
dx = e(2)-e(1)
DO ie =1, n
ee(ie) = 1/pi_const * sigma/dx * 1.0/((ie-1)**2+(sigma/dx)**2)
IF ( ee(ie).LT.cut ) EXIT
ENDDO
numPoints = ie - 1
DO ie = 1, n
j1 = ie - numPoints + 1
j1 = MERGE(1,j1,j1.LT.1)
j2 = ie + numPoints - 1
j2 = MERGE(n,j2,j2.GT.n)
DO je = j1 , j2
f(ie) = f(ie) + ee(IABS(je-ie)+1)*f0(je)
ENDDO
ENDDO
END SUBROUTINE lorentzian_smooth
END FUNCTION kk_num
END MODULE m_kkintgr
ldahia/hubbard1Distance.f90
View file @ dea084ba
......@@ -38,7 +38,7 @@ MODULE m_hubbard1Distance
END DO
ENDDO
results%last_occdistance = results%last_occdistance + ABS(n_out-n_in)
results%last_mmpMatdistance = MAXVAL(elementDistance)
results%last_mmpMatdistance = MAX(results%last_mmpMatdistance,MAXVAL(elementDistance))
!IO to out file
WRITE(oUnit,'(A)') "Hubbard 1 Distances:"
......
main/fleur.F90
View file @ dea084ba
......@@ -141,7 +141,7 @@ CONTAINS
!Warning on strange choice of switches before starting density is generated.
IF (fi%input%l_onlyMtStDen.AND..NOT.fi%noco%l_mtNocoPot) THEN
CALL juDFT_warn("l_onlyMtStDen='T' and l_mtNocoPot='F' makes no sense.",calledby='types_input')
CALL juDFT_warn("l_onlyMtStDen='T' and l_mtNocoPot='F' makes no sense.",calledby='types_input')
END IF
CALL inDen%init(stars,fi%atoms,sphhar,fi%vacuum,fi%noco,fi%input%jspins,POTDEN_TYPE_DEN)
......@@ -171,14 +171,11 @@ CONTAINS
! Initialize potentials (end)
! Initialize Green's function (start)
ALLOCATE(greensFunction(MAX(1,fi%gfinp%n)))
IF(fi%gfinp%n>0) THEN
ALLOCATE(greensFunction(fi%gfinp%n))
DO i_gf = 1, fi%gfinp%n
CALL greensFunction(i_gf)%init(i_gf,fi%gfinp,fi%input,fi%noco)
ENDDO
ELSE
ALLOCATE(greensFunction(0))
ENDIF
! Initialize Green's function (end)
IF(fi%atoms%n_hia>0) CALL hub1data%init(fi%atoms,fi%hub1inp)
......@@ -186,9 +183,9 @@ CONTAINS
! Open/allocate eigenvector storage (start)
l_real=fi%sym%invs.AND..NOT.fi%noco%l_noco.AND..NOT.(fi%noco%l_soc.AND.fi%atoms%n_u+fi%atoms%n_hia>0)
if(fi%noco%l_soc.and.fi%input%l_wann)then
!! Weed up and down spinor components for SOC MLWFs.
!! When jspins=1 Fleur usually writes only the up-spinor into the eig-file.
!! Make sure we always get up and down spinors when SOC=true.
!! Weed up and down spinor components for SOC MLWFs.
!! When jspins=1 Fleur usually writes only the up-spinor into the eig-file.
!! Make sure we always get up and down spinors when SOC=true.
wannierspin=2
else
wannierspin = fi%input%jspins
......@@ -205,14 +202,7 @@ CONTAINS
! Open/allocate eigenvector storage (end)
scfloop:DO WHILE (l_cont)
iter = iter + 1
IF(hub1data%l_runthisiter.AND.fi%atoms%n_hia>0) THEN
DO i_gf = 1, fi%gfinp%n
CALL greensFunction(i_gf)%mpi_bc(mpi%mpi_comm,mpi%irank)
ENDDO
hub1data%iter = hub1data%iter + 1
CALL hubbard1_setup(fi%atoms,fi%gfinp,fi%hub1inp,fi%input,mpi,fi%noco,vTot,&
greensFunction(fi%gfinp%hiaElem),hub1data,results,inDen)
ENDIF
IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber '/),&
(/iter,inden%iter/), RESHAPE((/19,13,5,5/),(/2,2/)))
......@@ -230,6 +220,16 @@ CONTAINS
8100 FORMAT (/,10x,' iter= ',i5)
ENDIF !mpi%irank.eq.0
IF(hub1data%l_runthisiter.AND.fi%atoms%n_hia>0) THEN
DO i_gf = 1, fi%gfinp%n
CALL greensFunction(i_gf)%mpi_bc(mpi%mpi_comm,mpi%irank)
ENDDO
hub1data%iter = hub1data%iter + 1
CALL hubbard1_setup(fi%atoms,fi%gfinp,fi%hub1inp,fi%input,mpi,fi%noco,vTot,&
greensFunction(fi%gfinp%hiaElem),hub1data,results,inDen)
ENDIF
#ifdef CPP_CHASE
CALL chase_distance(results%last_distance)
#endif
......@@ -371,11 +371,11 @@ END IF
IF (fi%input%gw.GT.0) THEN
IF (mpi%irank.EQ.0) THEN
CALL writeBasis(input_soc,fi%noco,nococonv,fi%kpts,fi%atoms,fi%sym,fi%cell,enpara,fi%hub1inp,vTot,vCoul,vx,mpi,&
results,eig_id,fi%oneD,sphhar,stars,fi%vacuum)
CALL writeBasis(input_soc,fi%noco,nococonv,fi%kpts,fi%atoms,fi%sym,fi%cell,enpara,fi%hub1inp,vTot,vCoul,vx,mpi,&
results,eig_id,fi%oneD,sphhar,stars,fi%vacuum)
END IF
IF (fi%input%gw.EQ.2) THEN
CALL juDFT_end("GW data written. Fleur ends.",mpi%irank)
CALL juDFT_end("GW data written. Fleur ends.",mpi%irank)
END IF
END IF
......
tests/tests/Gd_Hubbard1/files/inp.xml
View file @ dea084ba
This diff is collapsed.
tests/tests/Gd_Hubbard1/test.desc
View file @ dea084ba
$test_name="Fleur Gd Hubbard 1";
$test_name="Fleur Gd Hubbard 1 SOC";
$test_code="Fleur";
%test_requirements=("SOC",0);
%test_requirements=("SOC",1);
$test_stages=1;
$test_desc=<<EOF
Simple testthe Hubbard 1 method without SOC:
Simple testthe Hubbard 1 method with SOC:
1. Generate starting density, run 2 Iterations with one Hubbard iteration in between
for f-orbitals. Ensure that the density matrix is reasonable
EOF
......
tests/tests/Gd_Hubbard1/test.run1
View file @ dea084ba
......@@ -10,10 +10,12 @@ $result+=jt::test_grepexists("$workdir/out","Hubbard 1 it= 1 is completed");
#Test for the input file of the solver
$result+=jt::test_fileexists("$workdir/Hubbard1/hubbard1.cfg");
$result+=jt::test_fileexists("$workdir/Hubbard1/hloc.cfg");
#Test if the SOC parameter is correct
$result+=jt::test_grepnumber("$workdir/Hubbard1/hloc.cfg","xiSOC","xiSOC *([^ ]*)",0.21978,0.00001);
#test for one eigval file
$result+=jt::test_fileexists("$workdir/Hubbard1/eigval7part.dat");
#test density matrix
$result+=jt::test_grepnumber("$workdir/out","nmmp occupation distance:",": *([^ ]*)",7.00015383049998,0.00001);
$result+=jt::test_grepnumber("$workdir/out","nmmp element distance:",": *([^ ]*)",1.00023177097908,0.00001);
$result+=jt::test_grepnumber("$workdir/out","nmmp occupation distance:",": *([^ ]*)",6.99968080424677,0.0001);
$result+=jt::test_grepnumber("$workdir/out","nmmp element distance:",": *([^ ]*)",0.997526549354331,0.0001);
jt::stageresult($workdir,$result,"1");
tests/tests/Gd_Hubbard1_SOC/files/inp.xml deleted 100644 → 0
View file @ 97362865
This diff is collapsed.
tests/tests/Gd_Hubbard1_SOC/test.desc deleted 100644 → 0
View file @ 97362865
$test_name="Fleur Gd Hubbard 1 SOC";
$test_code="Fleur";
%test_requirements=("SOC",1);
$test_stages=1;
$test_desc=<<EOF
Simple testthe Hubbard 1 method with SOC:
1. Generate starting density, run 2 Iterations with one Hubbard iteration in between
for f-orbitals. Ensure that the density matrix is reasonable
EOF
;