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