Commit ada79934 authored by Daniel Wortmann's avatar Daniel Wortmann

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

parents ff489e95 bd5f2ab2
......@@ -507,7 +507,7 @@ CONTAINS
END IF
990 FORMAT(2(f8.4,1x),i3,1x,i3)
1000 FORMAT(e10.4)
1001 FORMAT(e12.4)
1010 FORMAT(2(2e20.8,1x))
!
! ------------------------------------------------------------
......
......@@ -54,7 +54,7 @@ contains
if(num >= 1e-1 .and. num <= 1e4) then
write (ret_str,"(F10.5)") num
else
write (ret_str,"(ES10.4)") num
write (ret_str,"(ES12.4)") num
endif
ret_str = strip(ret_str)
end function float2str
......
......@@ -87,9 +87,11 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
REAL :: fix, potDenInt, fermiEnergyTemp, spinDegenFac
REAL :: rdmftFunctionalValue, occStateI, gradSum
REAL :: exchangeTerm, lagrangeMultiplier, equalityCriterion
REAL :: mixParam, convCrit, rdmftEnergy
REAL :: mixParam, rdmftEnergy
REAL :: sumOcc, tempOcc, addCharge, subCharge, addChargeWeight, subChargeWeight
REAL, PARAMETER :: degenEps = 0.00001
REAL, PARAMETER :: convCrit = 1.0e-6
REAL, PARAMETER :: minOcc = 1.0e-8
LOGICAL :: converged, l_qfix, l_restart, l_zref
CHARACTER(LEN=20) :: filename
......@@ -134,7 +136,6 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
! General initializations
mixParam = 0.0001
convCrit = 1.0e-6
lagrangeMultiplier = 0.1 !results%ef
spinDegenFac = 2.0 / input%jspins ! This factor is used to compensate the missing second spin in non-spinpolarized calculations
......@@ -574,7 +575,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
DO ikpt = 1, kpts%nkpt
DO iBand = 1, highestState(ikpt,isp)
occStateI = results%w_iks(iBand,ikpt,isp) / (kpts%wtkpt(ikpt))!*kpts%nkptf)
occStateI = MAX(occStateI,1.0e-9)
occStateI = MAX(occStateI,minOcc)
! IF(occStateI.LT.1.0e-7) occStateI = 5.0e-4 ! This is preliminary. I have to discuss what do do here.
! occStateI = cdnvalJob%weights(iBand,ikpt)
rdmftFunctionalValue = 0.5*0.5*SQRT(1.0/occStateI) ! for Müller functional derivative
......@@ -624,6 +625,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
DO iBand = lowestState(ikpt,isp), highestState(ikpt,isp)
iState = iState + 1
occStateI = results%w_iks(iBand,ikpt,isp) / kpts%wtkpt(ikpt)
occStateI = MAX(occStateI,minOcc)
equalityLinCombi(iState) = kpts%wtkpt(ikpt)
gradient(iState) = dEdOcc(iBand,ikpt,isp) + lagrangeMultiplier
gradient(numStates+1) = gradient(numStates+1) + occStateI * kpts%wtkpt(ikpt)
......@@ -648,7 +650,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
DO ikpt = 1, kpts%nkpt
DO iBand = lowestState(ikpt,isp), highestState(ikpt,isp)
iState = iState + 1
results%w_iks(iBand,ikpt,isp) = parameters(iState) * kpts%wtkpt(ikpt)
results%w_iks(iBand,ikpt,isp) = MERGE(parameters(iState) * kpts%wtkpt(ikpt),0.0,parameters(iState).GT.minOcc)
END DO
END DO
END DO
......
......@@ -17,9 +17,17 @@ MODULE m_types_xcpot
PRIVATE
PUBLIC :: t_xcpot,t_gradients
TYPE t_kinED
real, allocatable :: is(:,:) ! (nsp*jmtd, jspins)
real, allocatable :: mt(:,:,:) ! (nsp*jmtd, jspins, local num of types)
contains
procedure :: alloc_mt => kED_alloc_mt
END TYPE t_kinED
TYPE,ABSTRACT :: t_xcpot
REAL :: gmaxxc
TYPE(t_potden) :: core_den, val_den
TYPE(t_kinED) :: kinED
CONTAINS
PROCEDURE :: vxc_is_LDA => xcpot_vxc_is_LDA
PROCEDURE :: vxc_is_GGA => xcpot_vxc_is_GGA
......@@ -60,8 +68,22 @@ MODULE m_types_xcpot
REAL,ALLOCATABLE :: gr(:,:,:)
REAL,ALLOCATABLE :: laplace(:,:)
END TYPE t_gradients
CONTAINS
subroutine kED_alloc_mt(kED,nsp_x_jmtd, jspins, n_start, n_types, n_stride)
implicit none
class(t_kinED), intent(inout) :: kED
integer, intent(in) :: nsp_x_jmtd, jspins, n_start, n_types, n_stride
integer :: cnt, n
if(.not. allocated(kED%mt)) then
cnt = 0
do n = n_start,n_types,n_stride
cnt = cnt + 1
enddo
allocate(kED%mt(nsp_x_jmtd, jspins, cnt))
endif
end subroutine kED_alloc_mt
! LDA
LOGICAL FUNCTION xcpot_vc_is_LDA(xcpot)
IMPLICIT NONE
......
......@@ -47,7 +47,7 @@ CONTAINS
TYPE(t_potden),INTENT(INOUT) :: vTot,vx,exc
TYPE(t_gradients) :: grad, tmp_grad
REAL, ALLOCATABLE :: rho(:,:), ED_rs(:,:), vTot_rs(:,:), kinED_rs(:,:)
REAL, ALLOCATABLE :: rho(:,:), ED_rs(:,:), vTot_rs(:,:)
REAL, ALLOCATABLE :: rho_conv(:,:), ED_conv(:,:), vTot_conv(:,:)
COMPLEX, ALLOCATABLE :: den_pw_w(:,:), EnergyDen_pw_w(:,:), vtot_pw_norm(:,:)
REAL, ALLOCATABLE :: v_x(:,:),v_xc(:,:),e_xc(:,:)
......@@ -84,7 +84,7 @@ CONTAINS
CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
cell, vTot%pw, tmp_grad, vTot_rs)
CALL calc_kinEnergyDen_pw(ED_rs, vTot_rs, rho, kinED_rs)
CALL calc_kinEnergyDen_pw(ED_rs, vTot_rs, rho, xcpot%kinED%is)
ENDIF
!calculate the ex.-cor energy density
......@@ -92,7 +92,7 @@ CONTAINS
ALLOCATE ( e_xc(SIZE(rho,1),1) ); e_xc=0.0
IF(ALLOCATED(EnergyDen%pw) .AND. xcpot%exc_is_MetaGGA()) THEN
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, kinED_rs, mt_call=.False.)
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, xcpot%kinED%is, mt_call=.False.)
ELSE
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, mt_call=.False.)
ENDIF
......
......@@ -54,8 +54,8 @@
TYPE(t_potden) :: vTot_tmp
TYPE(t_sphhar) :: tmp_sphhar
REAL, ALLOCATABLE :: ch(:,:), core_den_rs(:,:), val_den_rs(:,:), ED_rs(:,:), &
vTot_rs(:,:), vTot0_rs(:,:), kinED_rs(:,:)
INTEGER :: n,nsp,nt,jr
vTot_rs(:,:), vTot0_rs(:,:)
INTEGER :: n,nsp,nt,jr, loc_n
INTEGER :: i, j, idx, cnt
REAL :: divi
......@@ -70,7 +70,8 @@
REAL,ALLOCATABLE:: xcl(:,:)
LOGICAL :: lda_atom(atoms%ntype),l_libxc, perform_MetaGGA
!.....------------------------------------------------------------------
perform_MetaGGA = ALLOCATED(EnergyDen%mt) .AND. xcpot%exc_is_MetaGGA()
perform_MetaGGA = ALLOCATED(EnergyDen%mt) &
.AND. (xcpot%exc_is_MetaGGA() .or. xcpot%vx_is_MetaGGA())
lda_atom=.FALSE.; l_libxc=.FALSE.
SELECT TYPE(xcpot)
TYPE IS(t_xcpot_inbuild)
......@@ -96,7 +97,6 @@
ALLOCATE(vTot0_rs, mold=vTot_rs)
ALLOCATE(core_den_rs, mold=ch)
ALLOCATE(val_den_rs, mold=ch)
ALLOCATE(kinED_RS, mold=ch)
ENDIF
CALL init_mt_grid(input%jspins,atoms,sphhar,xcpot,sym)
......@@ -113,7 +113,10 @@
n_start=1
n_stride=1
#endif
loc_n = 0
call xcpot%kinED%alloc_mt(nsp*atoms%jmtd,input%jspins, n_start, atoms%ntype, n_stride)
DO n = n_start,atoms%ntype,n_stride
loc_n = loc_n + 1
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
!
......@@ -163,7 +166,7 @@
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, &
xcpot%val_den%mt(:,0:,n,:), n, tmp_grad, val_den_rs)
CALL calc_kinEnergyDen_mt(ED_rs, vTot_rs, vTot0_rs, &
core_den_rs, val_den_rs, n, nsp, kinED_rs)
core_den_rs, val_den_rs, n, nsp, xcpot%kinED%mt(:,:,loc_n))
ENDIF
IF (ALLOCATED(exc%mt)) THEN
......@@ -173,7 +176,7 @@
IF(perform_MetaGGA) THEN
CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),&
e_xc(:nsp*atoms%jri(n),1),grad, kinED_rs, mt_call=.True.)
e_xc(:nsp*atoms%jri(n),1),grad, xcpot%kinED%mt(:,:,loc_n), mt_call=.True.)
ELSE
CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),&
e_xc(:nsp*atoms%jri(n),1),grad, mt_call=.True.)
......
......@@ -34,7 +34,7 @@ CONTAINS
implicit none
REAL, INTENT(in) :: EnergyDen_RS(:,:), vTot_rs(:,:), vTot0_rs(:,:), core_den_rs(:,:), val_den_rs(:,:)
INTEGER, intent(in) :: atm_idx, nsp
REAL, INTENT(inout), allocatable :: kinEnergyDen_RS(:,:)
REAL, INTENT(inout) :: kinEnergyDen_RS(:,:)
#ifdef CPP_LIBXC
kinEnergyDen_RS = EnergyDen_RS - (vTot0_rs * core_den_rs + vTot_rs * val_den_rs)
......
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