Skip to content

fleur
fleur
Commit 76cf0b83 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

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

parents 1feb910c ebc9fdb0
Hide whitespace changes
Inline Side-by-side
Showing with 42 additions and 337 deletions
global/types_rcmat.F90 deleted 100644 → 0
View file @ 1feb910c
module m_types_rcmat
use m_judft
IMPLICIT NONE
TYPE t_mat
LOGICAL :: l_real
INTEGER :: matsize1=-1
INTEGER :: matsize2=-1
REAL,ALLOCATABLE :: data_r(:,:)
COMPLEX,ALLOCATABLE :: data_c(:,:)
CONTAINS
PROCEDURE :: alloc => t_mat_alloc
PROCEDURE :: multiply=>t_mat_multiply
PROCEDURE :: transpose=>t_mat_transpose
PROCEDURE :: from_packed=>t_mat_from_packed
PROCEDURE :: inverse =>t_mat_inverse
PROCEDURE :: to_packed=>t_mat_to_packed
END type t_mat
CONTAINS
SUBROUTINE t_mat_alloc(mat,l_real,matsize1,matsize2,init)
CLASS(t_mat) :: mat
LOGICAL,INTENT(IN),OPTIONAL:: l_real
INTEGER,INTENT(IN),OPTIONAL:: matsize1,matsize2
REAL,INTENT(IN),OPTIONAL :: init
INTEGER:: err
IF (present(l_real)) mat%l_real=l_real
IF (present(matsize1)) mat%matsize1=matsize1
IF (present(matsize2)) mat%matsize2=matsize2
IF (mat%matsize1<0) CALL judft_error("Cannot allocate memory for mat datatype that is not initialized",hint="This is a BUG in FLEUR, please report")
IF (mat%matsize2<0) mat%matsize2=mat%matsize1 !Square by default
IF (allocated(mat%data_r)) deallocate(mat%data_r)
IF (allocated(mat%data_c)) deallocate(mat%data_c)
IF (mat%l_real) THEN
ALLOCATE(mat%data_r(mat%matsize1,mat%matsize2),STAT=err)
ALLOCATE(mat%data_c(0,0))
if (present(init)) mat%data_r=init
ELSE
ALLOCATE(mat%data_r(0,0))
ALLOCATE(mat%data_c(mat%matsize1,mat%matsize2),STAT=err)
IF (PRESENT(init)) mat%data_c=init
ENDIF
IF (err>0) CALL judft_error("Allocation of memmory failed for mat datatype",hint="You probably run out of memory")
END SUBROUTINE t_mat_alloc
SUBROUTINE t_mat_multiply(mat1,mat2,res)
CLASS(t_mat),INTENT(INOUT) ::mat1
TYPE(t_mat),INTENT(IN) ::mat2
TYPE(t_mat),INTENT(OUT),OPTIONAL ::res
if (mat1%matsize2.ne.mat2%matsize1) CALL judft_error("Cannot multiply matrices because of non-matching dimensions",hint="This is a BUG in FLEUR, please report")
IF (present(res)) THEN
call res%alloc(mat1%l_real,mat1%matsize1,mat2%matsize2)
IF (mat1%l_real) THEN
res%data_r=matmul(mat1%data_r(:mat1%matsize1,:mat1%matsize2),mat2%data_r(:mat2%matsize1,:mat2%matsize2))
ELSE
res%data_c=matmul(mat1%data_c(:mat1%matsize1,:mat1%matsize2),mat2%data_c(:mat2%matsize1,:mat2%matsize2))
ENDIF
else
if (mat1%matsize1.ne.mat1%matsize2) CALL judft_error("Cannot multiply matrices inplace because of non-matching dimensions",hint="This is a BUG in FLEUR, please report")
if (mat1%l_real) THEN
mat1%data_r(:mat1%matsize1,:mat1%matsize2)=matmul(mat1%data_r(:mat1%matsize1,:mat1%matsize2),mat2%data_r(:mat2%matsize1,:mat2%matsize2))
ELSE
mat1%data_c(:mat1%matsize1,:mat1%matsize2)=matmul(mat1%data_c(:mat1%matsize1,:mat1%matsize2),mat2%data_c(:mat2%matsize1,:mat2%matsize2))
ENDIF
end IF
end SUBROUTINE t_mat_multiply
SUBROUTINE t_mat_transpose(mat1,res)
CLASS(t_mat),INTENT(INOUT) ::mat1
TYPE(t_mat),INTENT(OUT),OPTIONAL ::res
IF (present(res)) THEN
call res%alloc(mat1%l_real,mat1%matsize2,mat1%matsize1)
IF (mat1%l_real) THEN
res%data_r=transpose(mat1%data_r(:mat1%matsize1,:mat1%matsize2))
ELSE
res%data_c=transpose(mat1%data_c(:mat1%matsize1,:mat1%matsize2))
ENDIF
else
if (mat1%matsize1.ne.mat1%matsize2) CALL judft_error("Cannot transpose matrices inplace because of non-matching dimensions",hint="This is a BUG in FLEUR, please report")
IF (mat1%l_real) THEN
mat1%data_r(:mat1%matsize1,:mat1%matsize2)=transpose(mat1%data_r(:mat1%matsize1,:mat1%matsize2))
ELSE
mat1%data_c(:mat1%matsize1,:mat1%matsize2)=transpose(mat1%data_c(:mat1%matsize1,:mat1%matsize2))
ENDIF
end IF
end SUBROUTINE t_mat_transpose
SUBROUTINE t_mat_from_packed(mat1,l_real,matsize,packed_r,packed_c)
CLASS(t_mat),INTENT(INOUT) :: mat1
INTEGER,INTENT(IN) :: matsize
LOGICAL,INTENT(IN) :: l_real
REAL,INTENT(IN) :: packed_r(:)
COMPLEX,INTENT(IN) :: packed_c(:)
INTEGER:: n,nn,i
CALL mat1%alloc(l_real,matsize,matsize,0.0)
i=1
DO n=1,matsize
DO nn=1,n
if (l_real) THEN
mat1%data_r(n,nn)=packed_r(i)
mat1%data_r(nn,n)=packed_r(i)
else
mat1%data_c(n,nn)=conjg(packed_c(i))
mat1%data_c(nn,n)=packed_c(i)
end if
i=i+1
end DO
end DO
end SUBROUTINE t_mat_from_packed
function t_mat_to_packed(mat)result(packed)
CLASS(t_mat),INTENT(IN) :: mat
COMPLEX :: packed(mat%matsize1*(mat%matsize1+1)/2)
integer :: n,nn,i
real,parameter :: tol=1e-5
if (mat%matsize1.ne.mat%matsize2) call judft_error("Could not pack no-square matrix",hint='This is a BUG, please report')
i=1
DO n=1,mat%matsize1
DO nn=1,n
if (mat%l_real) THEN
packed(i)=(mat%data_r(n,nn)+mat%data_r(nn,n))/2.
if (abs(mat%data_r(n,nn)-mat%data_r(nn,n))>tol) call judft_warn("Large unsymmetry in matrix packing")
else
packed(i)=(conjg(mat%data_c(n,nn))+mat%data_c(nn,n))/2.
if (abs(conjg(mat%data_c(n,nn))-mat%data_c(nn,n))>tol) call judft_warn("Large unsymmetry in matrix packing")
endif
i=i+1
end DO
end DO
end function t_mat_to_packed
subroutine t_mat_inverse(mat)
implicit none
CLASS(t_mat),INTENT(INOUT) :: mat
integer :: info
real, allocatable :: work_r(:)
integer, allocatable :: ipiv(:)
complex,allocatable :: work_c(:)
if (mat%matsize1.ne.mat%matsize2) call judft_error("Can only invert square matrices",hint="This is a BUG in FLEUR, please report")
ALLOCATE(ipiv(mat%matsize1))
if (mat%l_real) THEN
ALLOCATE(work_r(mat%matsize1))
call dgetrf(mat%matsize1,mat%matsize1,mat%data_r,size(mat%data_r,1),ipiv,info)
if(info.ne.0) call judft_error("Failed to invert matrix: dpotrf failed.")
call dgetri(mat%matsize1,mat%data_r,size(mat%data_r,1),ipiv,work_r,size(work_r),info)
if(info.ne.0) call judft_error("Failed to invert matrix: dpotrf failed.")
else
ALLOCATE(work_c(mat%matsize1))
call zgetrf(mat%matsize1,mat%matsize1,mat%data_c,size(mat%data_c,1),ipiv,info)
if(info.ne.0) call judft_error("Failed to invert matrix: dpotrf failed.")
call zgetri(mat%matsize1,mat%data_c,size(mat%data_c,1),ipiv,work_c,size(work_c),info)
if(info.ne.0) call judft_error("Failed to invert matrix: dpotrf failed.")
end if
end subroutine t_mat_inverse
end module m_types_rcmat
global/types_xcpot.F90 deleted 100644 → 0
View file @ 1feb910c
MODULE m_types_xcpot
IMPLICIT NONE
PRIVATE
CHARACTER(len=4),PARAMETER:: xc_names(20)=[&
'l91 ','x-a ','wign','mjw ','hl ','bh ','vwn ','pz ', &
'pw91','pbe ','rpbe','Rpbe','wc ','PBEs', &
'pbe0','hse ','vhse','lhse','exx ','hf ']
LOGICAL,PARAMETER:: priv_gga(20)=[&
.TRUE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,&
.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,&
.TRUE.,.TRUE.,.TRUE.,.TRUE.,.FALSE.,.FALSE.]
LOGICAL,PARAMETER:: priv_hybrid(20)=[&
.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,&
.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,&
.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.]
REAL, PARAMETER :: amix_pbe0 = 0.25
REAL, PARAMETER :: amix_hse = 0.25
REAL, PARAMETER :: amix_hf = 1.00
TYPE t_xcpot
#ifdef CPP_MPI
INTEGER :: icorr=0 !not private to allow bcasting it around
#else
INTEGER,PRIVATE :: icorr=0
#endif
!in the pbe case (exchpbe.F) lots of test are made
!in addition some constants are set
!to speed up this code precalculate things in init
LOGICAL :: is_rpbe !Rpbe
LOGICAL :: is_wc
LOGICAL :: is_hse !hse,lhse,vhse
REAL :: uk,um
LOGICAL,ALLOCATABLE :: lda_atom(:)
REAL :: gmaxxc
INTEGER :: krla !relativistic corrections
CONTAINS
PROCEDURE :: is_gga=>xcpot_is_gga
PROCEDURE :: get_name=>xcpot_get_name
PROCEDURE :: init=>xcpot_init
PROCEDURE :: is_hybrid=>xcpot_is_hybrid
PROCEDURE :: is_name=>xcpot_is_name
PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight
END TYPE t_xcpot
PUBLIC t_xcpot
CONTAINS
CHARACTER(len=4) FUNCTION xcpot_get_name(xcpot)
USE m_judft
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
IF (xcpot%icorr==0) CALL judft_error("xc-potential not initialized",calledby="types_xcpot.F90")
xcpot_get_name=xc_names(xcpot%icorr)
END FUNCTION xcpot_get_name
SUBROUTINE xcpot_init(xcpot,namex,relcor)
USE m_judft
IMPLICIT NONE
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
CHARACTER(len=*),INTENT(IN) :: namex
LOGICAL,INTENT(IN) :: relcor
INTEGER:: n
!Determine icorr from name
xcpot%icorr=0
DO n=1,SIZE(xc_names)
IF (TRIM(ADJUSTL(namex))==TRIM(xc_names(n))) THEN
xcpot%icorr=n
ENDIF
ENDDO
if (xcpot%icorr==0) CALL judft_error("Unkown xc-potential:"//namex,calledby="types_xcpot.F90")
xcpot%krla=MERGE(1,0,relcor)
!Code from exchpbe to speed up determination of constants
IF (xcpot%is_name("rpbe")) THEN
xcpot%uk=1.2450
ELSE
xcpot%uk=0.8040
ENDIF
IF (xcpot%is_name("PBEs")) THEN ! pbe_sol
xcpot%um=0.123456790123456d0
ELSE
xcpot%um=0.2195149727645171e0
ENDIF
xcpot%is_hse=xcpot%is_name("hse").OR.xcpot%is_name("lhse").OR.xcpot%is_name("vhse")
xcpot%is_rpbe=xcpot%is_name("Rpbe") !Rpbe
xcpot%is_wc=xcpot%is_name("wc")
END SUBROUTINE xcpot_init
LOGICAL FUNCTION xcpot_is_name(xcpot,name)
CLASS(t_xcpot),INTENT(IN):: xcpot
CHARACTER(len=*),INTENT(IN) :: name
xcpot_is_name=(trim(xc_names(xcpot%icorr))==trim((name)))
END FUNCTION xcpot_is_name
LOGICAL FUNCTION xcpot_is_gga(xcpot,icorr)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
INTEGER,OPTIONAL,INTENT(IN):: icorr
IF (PRESENT(icorr)) THEN
xcpot_is_gga=priv_gga(icorr)
ELSE
xcpot_is_gga=priv_gga(xcpot%icorr)
ENDIF
END FUNCTION xcpot_is_gga
LOGICAL FUNCTION xcpot_is_hybrid(xcpot,icorr)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
INTEGER,OPTIONAL,INTENT(IN):: icorr
IF (PRESENT(icorr)) THEN
xcpot_is_hybrid=priv_hybrid(icorr)
ELSE
xcpot_is_hybrid=priv_hybrid(xcpot%icorr)
ENDIF
END FUNCTION xcpot_is_hybrid
FUNCTION xcpot_get_exchange_weight(xcpot) RESULT(a_ex)
USE m_judft
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
REAL:: a_ex
a_ex=-1
IF (xcpot%is_name("pbe0")) a_ex=amix_pbe0
IF (xcpot%is_name("hf")) a_ex=amix_hf
IF (xcpot%is_name("hse")) a_ex=amix_hse
IF (xcpot%is_name("vhse")) a_ex=amix_hse
IF (a_ex==-1) CALL judft_error('xc functional can not be identified')
END FUNCTION xcpot_get_exchange_weight
END MODULE m_types_xcpot
init/kpoints.f90
View file @ 76cf0b83
......@@ -70,6 +70,11 @@ contains
kpts%bk(:,:) = kpts%bk(:,:) / kpts%posScale
kpts%posScale = 1.0
IF (kpts%nkpt3(3).EQ.0) kpts%nkpt3(3) = 1
ELSE
IF (banddos%unfoldband) THEN
CALL unfold_band_kpts(banddos,p_cell,cell,p_kpts,kpts)
CALL find_supercell_kpts(banddos,p_cell,cell,p_kpts,kpts)
END IF
END IF
end subroutine kpoints
......
init/unfoldBandKPTS.f90
View file @ 76cf0b83
......@@ -96,7 +96,6 @@ CONTAINS
eps = 1.0e-10
eps_r = 0.000000001
eps_kpt = 0.00000001
CALL inv3(cell%bmat,rez_inv_to_internal,rez_inv_det)
write(1088,*) p_kpts%specialPoints
......@@ -149,10 +148,9 @@ CONTAINS
m1=0
m2=0
m3=0
eps_kpt=0
sc_kpoint_i(1) = sc_kpoint_i(1) - m1 + eps_kpt
sc_kpoint_i(2) = sc_kpoint_i(2) - m2 + eps_kpt
sc_kpoint_i(3) = sc_kpoint_i(3) - m3 + eps_kpt
sc_kpoint_i(1) = sc_kpoint_i(1) - m1
sc_kpoint_i(2) = sc_kpoint_i(2) - m2
sc_kpoint_i(3) = sc_kpoint_i(3) - m3
!sc_kpoint_i(:) = sc_kpoint_i(:) - 0.5
list(4,i)=sc_kpoint_i(1)
list(5,i)=sc_kpoint_i(2)
......
main/fleur.F90
View file @ 76cf0b83
......@@ -103,7 +103,7 @@ CONTAINS
INTEGER :: eig_id,archiveType
INTEGER :: n,iter,iterHF
LOGICAL :: l_opti,l_cont,l_qfix,l_wann_inp,l_real
REAL :: fermiEnergyTemp,fix
REAL :: fix
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER :: ierr(2)
......@@ -145,12 +145,12 @@ CONTAINS
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
IF(mpi%irank.EQ.0) THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,inDen)
0,results%ef,l_qfix,inDen)
CALL timestart("Qfix")
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false.,fix)
CALL timestop("Qfix")
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,-1.0,fermiEnergyTemp,.FALSE.,inDen)
0,-1.0,results%ef,.FALSE.,inDen)
END IF
! Initialize and load inDen density (end)
......
types/types_lapw.F90
View file @ 76cf0b83
......@@ -164,6 +164,7 @@ CONTAINS
lapw%bkpt(:) = kpts%bk(:,nk)
ENDIF
CALL lapw%alloc(cell,input,noco)
ALLOCATE(gvec(3,SIZE(lapw%gvec,2)))
......@@ -461,7 +462,7 @@ CONTAINS
COMPLEX cwork(-2*atoms%llod:2*atoms%llod+1,2*(2*atoms%llod+1),atoms%nlod ,2)
! ..
! .. Data statements ..
REAL, PARAMETER :: eps = 1.0E-30
REAL, PARAMETER :: eps = 1.0E-8
REAL, PARAMETER :: linindq = 1.0e-4
con1=fpi_const/SQRT(cell%omtil)
......
types/types_xcpot.F90
View file @ 76cf0b83
......@@ -20,7 +20,8 @@ MODULE m_types_xcpot
REAL :: gmaxxc
CONTAINS
PROCEDURE :: is_gga=>xcpot_is_gga
procedure :: is_MetaGGA=>xcpot_is_MetaGGA
PROCEDURE :: is_MetaGGA=>xcpot_is_MetaGGA
PROCEDURE :: needs_grad=>xcpot_needs_grad
PROCEDURE :: is_hybrid=>xcpot_is_hybrid
PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight
PROCEDURE :: get_vxc=>xcpot_get_vxc
......@@ -59,6 +60,14 @@ CONTAINS
xcpot_is_MetaGGA=.false.
END FUNCTION xcpot_is_MetaGGA
LOGICAL FUNCTION xcpot_needs_grad(xcpot)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
xcpot_needs_grad= xcpot%is_gga() .or. xcpot%is_MetaGGA()
END FUNCTION xcpot_needs_grad
LOGICAL FUNCTION xcpot_is_hybrid(xcpot)
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot
......
vgen/mt_tofrom_grid.F90
View file @ 76cf0b83
......@@ -13,7 +13,7 @@ MODULE m_mt_tofrom_grid
REAL, ALLOCATABLE :: wt(:),rx(:,:),thet(:)
PUBLIC :: init_mt_grid,mt_to_grid,mt_from_grid,finish_mt_grid
CONTAINS
SUBROUTINE init_mt_grid(nsp,jspins,atoms,sphhar,xcpot,sym,l_grad)
SUBROUTINE init_mt_grid(nsp,jspins,atoms,sphhar,xcpot,sym)
USE m_gaussp
USE m_lhglptg
USE m_lhglpts
......@@ -23,7 +23,6 @@ CONTAINS
TYPE(t_sphhar),INTENT(IN) :: sphhar
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_sym),INTENT(IN) :: sym
LOGICAL,INTENT(IN) :: l_grad
! generate nspd points on a sherical shell with radius 1.0
! angular mesh equidistant in phi,
......@@ -32,29 +31,30 @@ CONTAINS
CALL gaussp(atoms%lmaxd, rx,wt)
! generate the lattice harmonics on the angular mesh
ALLOCATE ( ylh(nsp,0:sphhar%nlhd,sphhar%ntypsd))
IF (l_grad) ALLOCATE(ylht,MOLD=ylh )
IF (l_grad) ALLOCATE(ylhtt,MOLD=ylh )
IF (l_grad) ALLOCATE(ylhf,MOLD=ylh )
IF (l_grad) ALLOCATE(ylhff,MOLD=ylh )
IF (l_grad) ALLOCATE(ylhtf,MOLD=ylh )
IF (l_grad) THEN
CALL lhglptg(sphhar,atoms,rx,nsp,xcpot,sym,&
ylh,thet,ylht,ylhtt,ylhf,ylhff,ylhtf)
IF (xcpot%needs_grad()) THEN
ALLOCATE(ylht,MOLD=ylh )
ALLOCATE(ylhtt,MOLD=ylh )
ALLOCATE(ylhf,MOLD=ylh )
ALLOCATE(ylhff,MOLD=ylh )
ALLOCATE(ylhtf,MOLD=ylh )
CALL lhglptg(sphhar,atoms,rx,nsp,xcpot,sym,&
ylh,thet,ylht,ylhtt,ylhf,ylhff,ylhtf)
ELSE
CALL lhglpts( sphhar,atoms, rx,nsp, sym, ylh)
END IF
END SUBROUTINE init_mt_grid
SUBROUTINE mt_to_grid(atoms,sphhar,den_mt,nsp,jspins,n,l_grad,grad,ch)
SUBROUTINE mt_to_grid(xcpot,jspins,atoms,sphhar,den_mt,nsp,n,grad,ch)
! SUBROUTINE pw_to_grid(xcpot,jspins,l_noco,stars,cell,den_pw,grad,rho)
USE m_grdchlh
USE m_mkgylm
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
REAL,INTENT(IN) :: den_mt(:,0:,:)
INTEGER,INTENT(IN) :: n,jspins,nsp
LOGICAL,INTENT(IN) :: l_grad
REAL,INTENT(OUT),OPTIONAL :: ch(:,:)
TYPE(t_gradients),INTENT(INOUT):: grad
......@@ -68,7 +68,7 @@ CONTAINS
ALLOCATE ( chlh(atoms%jmtd,0:sphhar%nlhd,jspins))
ALLOCATE ( ch_tmp(nsp,jspins) )
IF (l_grad) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE(chdr(nsp,jspins),chdt(nsp,jspins),chdf(nsp,jspins),chdrr(nsp,jspins),&
chdtt(nsp,jspins),chdff(nsp,jspins),chdtf(nsp,jspins),chdrt(nsp,jspins),&
chdrf(nsp,jspins) )
......@@ -87,7 +87,7 @@ CONTAINS
DO jr = 1,atoms%jri(n)
chlh(jr,lh,js) = den_mt(jr,lh,js)/(atoms%rmsh(jr,n)*atoms%rmsh(jr,n))
ENDDO
IF (l_grad) CALL grdchlh(1,1,atoms%jri(n),atoms%dx(n),atoms%rmsh(1,n),&
IF (xcpot%needs_grad()) CALL grdchlh(1,1,atoms%jri(n),atoms%dx(n),atoms%rmsh(1,n),&
chlh(1,lh,js),ndvgrd, chlhdr(1,lh,js),chlhdrr(1,lh,js))
ENDDO ! js
......@@ -105,7 +105,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
IF (l_grad) THEN
IF (xcpot%needs_grad()) THEN
chdr(:,:) = 0.0 ! d(ch)/dr
chdt(:,:) = 0.0 ! d(ch)/dtheta
chdf(:,:) = 0.0 ! d(ch)/dfai
......
vgen/vmt_xc.F90
View file @ 76cf0b83
......@@ -81,7 +81,7 @@ CONTAINS
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym,xcpot%is_gga())
CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym)
#ifdef CPP_MPI
......@@ -98,7 +98,7 @@ CONTAINS
#endif
DO n = n_start,atoms%ntype,n_stride
CALL mt_to_grid(atoms,sphhar,den%mt(:,0:,n,:),nsp,input%jspins,n,xcpot%is_gga(),grad,ch)
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),nsp,n,grad,ch)
!
! calculate the ex.-cor. potential
CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc,v_x,grad)
......
xc-pot/libxc_postprocess_gga.f90
View file @ 76cf0b83
......@@ -33,7 +33,7 @@ CONTAINS
vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2
ENDDO
ALLOCATE(grad_sigma%gr(3,nsp,n_sigma))
CALL mt_to_grid(atoms,sphhar,vsigma_mt,nsp/atoms%jmtd,n_sigma,n,.TRUE.,grad=grad_sigma)
CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,nsp/atoms%jmtd,n,grad=grad_sigma)
CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_sigma,v_xc)
END SUBROUTINE libxc_postprocess_gga_mt
......
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