Commit fa52c784 authored by Matthias Redies's avatar Matthias Redies

merge develop

parents 99f7e7e1 ba3caf3a
This diff is collapsed.
......@@ -45,7 +45,7 @@ CONTAINS
END IF
END SUBROUTINE init_mt_grid
SUBROUTINE mt_to_grid(xcpot, jspins, atoms, sphhar, den_mt, nsp, n, grad, ch)
SUBROUTINE mt_to_grid(xcpot, jspins, atoms, sphhar, den_mt, n, grad, ch)
USE m_grdchlh
USE m_mkgylm
IMPLICIT NONE
......@@ -53,7 +53,7 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
REAL, INTENT(IN) :: den_mt(:, 0:, :)
INTEGER, INTENT(IN) :: n, jspins, nsp
INTEGER, INTENT(IN) :: n, jspins
REAL, INTENT(OUT), OPTIONAL :: ch(:, :)
TYPE(t_gradients), INTENT(INOUT):: grad
......@@ -61,9 +61,10 @@ CONTAINS
REAL, ALLOCATABLE :: chdr(:, :), chdt(:, :), chdf(:, :), ch_tmp(:, :)
REAL, ALLOCATABLE :: chdrr(:, :), chdtt(:, :), chdff(:, :), chdtf(:, :)
REAL, ALLOCATABLE :: chdrt(:, :), chdrf(:, :)
INTEGER:: nd, lh, js, jr, kt, k
INTEGER:: nd, lh, js, jr, kt, k, nsp
nd = atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1)
nsp = atoms%nsp()
ALLOCATE (chlh(atoms%jmtd, 0:sphhar%nlhd, jspins))
ALLOCATE (ch_tmp(nsp, jspins))
......@@ -149,17 +150,20 @@ CONTAINS
END SUBROUTINE mt_to_grid
SUBROUTINE mt_from_grid(atoms, sphhar, nsp, n, jspins, v_in, vr)
SUBROUTINE mt_from_grid(atoms, sphhar, n, jspins, v_in, vr)
IMPLICIT NONE
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN):: sphhar
INTEGER, INTENT(IN) :: nsp, jspins, n
INTEGER, INTENT(IN) :: jspins, n
REAL, INTENT(IN) :: v_in(:, :)
REAL, INTENT(INOUT) :: vr(:, 0:, :)
REAL :: vpot(nsp), vlh
INTEGER :: js, kt, lh, jr, nd
REAL :: vpot(atoms%nsp()), vlh
INTEGER :: js, kt, lh, jr, nd, nsp
nsp = atoms%nsp()
nd = atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1)
DO js = 1, jspins
!
kt = 0
......
......@@ -26,14 +26,15 @@ CONTAINS
REAL :: rhotot,rho_up,rho_down,theta,phi
REAL,ALLOCATABLE :: ch(:,:)
REAL :: eps=1E-10
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd
ALLOCATE(ch(nsp,4),den%theta_mt(nsp,atoms%ntype),den%phi_mt(nsp,atoms%ntype))
nsp=nsp/atoms%jmtd
nsp=atoms%nsp()
ALLOCATE(ch(nsp*atoms%jmtd,4),&
den%theta_mt(nsp*atoms%jmtd,atoms%ntype),&
den%phi_mt(nsp*atoms%jmtd,atoms%ntype))
CALL xcpot%init("vwn",.FALSE.,1)
CALL init_mt_grid(nsp,4,atoms,sphhar,xcpot,sym)
DO n=1,atoms%ntype
CALL mt_to_grid(xcpot,4,atoms,sphhar,den%mt(:,0:,n,:),nsp,n,grad,ch)
CALL mt_to_grid(xcpot,4,atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
DO imesh = 1,nsp*atoms%jri(n)
rho_11 = ch(imesh,1)
......@@ -80,7 +81,7 @@ CONTAINS
den%phi_mt(imesh,n) = phi
ENDDO
den%mt(:,0:,n,:)=0.0
CALL mt_from_grid(atoms,sphhar,nsp,n,2,ch,den%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,n,2,ch,den%mt(:,0:,n,:))
DO i=1,atoms%jri(n)
den%mt(i,:,n,:)=den%mt(i,:,n,:)*atoms%rmsh(i,n)**2
ENDDO
......@@ -111,7 +112,7 @@ CONTAINS
CALL init_mt_grid(nsp,4,atoms,sphhar,xcpot,sym)
DO n=1,atoms%ntype
CALL mt_to_grid(xcpot,4,atoms,sphhar,vtot%mt(:,0:,n,:),nsp,n,grad,ch)
CALL mt_to_grid(xcpot,4,atoms,sphhar,vtot%mt(:,0:,n,:),n,grad,ch)
DO imesh = 1,nsp*atoms%jri(n)
vup = ch(imesh,1)
vdown = ch(imesh,2)
......@@ -125,7 +126,7 @@ CONTAINS
ch(imesh,4) = beff*SIN(theta)*SIN(phi)
ENDDO
vtot%mt(:,0:,n,:)=0.0
CALL mt_from_grid(atoms,sphhar,nsp,n,4,ch,vtot%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,n,4,ch,vtot%mt(:,0:,n,:))
DO i=1,atoms%jri(n)
vtot%mt(i,:,n,:)=vtot%mt(i,:,n,:)*atoms%rmsh(i,n)**2
ENDDO
......
......@@ -84,7 +84,7 @@ CONTAINS
l_libxc=.true. !libxc!!
END SELECT
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
nsp=atoms%nsp()
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%needs_grad()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
......@@ -111,7 +111,7 @@ CONTAINS
#endif
call save_npy("rmsh.npy", atoms%rmsh)
DO n = n_start,atoms%ntype,n_stride
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),nsp,n,grad,ch)
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
!
! calculate the ex.-cor. potential
CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc(:nsp*atoms%jri(n),:),v_x(:nsp*atoms%jri(n),:),grad)
......@@ -134,8 +134,8 @@ CONTAINS
!Add postprocessing for libxc
IF (l_libxc.AND.xcpot%needs_grad()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad, atom_num=n)
CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_xc,vTot%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_x,vx%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,n,input%jspins,v_xc,vxc%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,n,input%jspins,v_x,vx%mt(:,0:,n,:))
! use updated vTot for exc calculation
IF(perform_MetaGGA) THEN
......@@ -177,7 +177,7 @@ CONTAINS
nt=nt+nsp
END DO
ENDIF
CALL mt_from_grid(atoms,sphhar,nsp,n,1,e_xc,exc%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,n,1,e_xc,exc%mt(:,0:,n,:))
ENDIF
ENDDO
......
......@@ -31,12 +31,12 @@ CONTAINS
ALLOCATE(vsigma(nsp,n_sigma),vsigma_mt(atoms%jri(n),0:sphhar%nlhd,n_sigma))
vsigma_mt=0.0
vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
CALL mt_from_grid(atoms,sphhar,nsp/atoms%jmtd,n,n_sigma,vsigma,vsigma_mt)
CALL mt_from_grid(atoms,sphhar,n,n_sigma,vsigma,vsigma_mt)
DO i=1,atoms%jri(n)
vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2
ENDDO
ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,nsp/atoms%jmtd,n,grad=grad_vsigma)
CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,n,grad=grad_vsigma)
fname = merge("mt=" //int2str(atom_num) // "_lapl.npy","mt_lapl.npy", present(atom_num))
call save_npy(fname, grad%laplace)
......
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