Skip to content

GitLab

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

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

parents c7ab8719 2550c016
Hide whitespace changes
Inline Side-by-side
Showing with 61 additions and 61 deletions
cdn_mt/rhomt21.f90
View file @ 93d7abd2
......@@ -22,10 +22,10 @@ CONTAINS
! .. Array Arguments ..
REAL, INTENT(IN) :: we(:)!(nobd)
COMPLEX, INTENT(INOUT) :: uu21(atoms%lmaxd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: ud21(atoms%lmaxd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: du21(atoms%lmaxd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: dd21(atoms%lmaxd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: uu21(0:atoms%lmaxd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: ud21(0:atoms%lmaxd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: du21(0:atoms%lmaxd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: dd21(0:atoms%lmaxd,atoms%ntype)
COMPLEX, INTENT(INOUT) :: uulo21(atoms%nlod,atoms%ntype)
COMPLEX, INTENT(INOUT) :: dulo21(atoms%nlod,atoms%ntype)
COMPLEX, INTENT(INOUT) :: ulou21(atoms%nlod,atoms%ntype)
......
eigen/hsvac.F90
View file @ 93d7abd2
......@@ -92,7 +92,7 @@ CONTAINS
jspin=jsp
CALL vacfun(&
vacuum,DIMENSION,stars,&
jsp,input,noco,ipot,&
jsp,input,noco,jspin1,jspin2,&
sym, cell,ivac,evac(1,1),lapw%bkpt,v%vacxy(:,:,ivac,ipot),v%vacz(:,:,:),kvac1,kvac2,nv2,&
tuuv,tddv,tudv,tduv,uz,duz,udz,dudz,ddnv,wronk)
!
......
eigen/tlmplm.F90
View file @ 93d7abd2
......@@ -31,7 +31,7 @@ CONTAINS
REAL dvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL uvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL uvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL f(atoms%jmtd,2,0:atoms%lmaxd),g(atoms%jmtd,2,0:atoms%lmaxd),x(atoms%jmtd)
REAL f(atoms%jmtd,2,0:atoms%lmaxd,2),g(atoms%jmtd,2,0:atoms%lmaxd,2),x(atoms%jmtd)
REAL flo(atoms%jmtd,2,atoms%nlod)
INTEGER:: indt(0:SIZE(td%tuu,1)-1)
......@@ -40,14 +40,21 @@ CONTAINS
COMPLEX :: cil
REAL :: temp
INTEGER i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl,lmplm,lmx,lmxx,lp,info,in
INTEGER lp1,lpl ,mem,mems,mp,mu,nh,na,m,nsym,s,i_u
INTEGER lp1,lpl ,mem,mems,mp,mu,nh,na,m,nsym,s,i_u,jspin1,jspin2
vr0=v%mt(:,:,n,jsp)
IF (jsp<3) vr0(:,0)=0.0
CALL genMTBasis(atoms,enpara,v,mpi,n,jspin,ud,f,g,flo)
DO i=MERGE(1,jspin,jspin>2),MERGE(2,jspin,jspin>2)
CALL genMTBasis(atoms,enpara,v,mpi,n,i,ud,f(:,:,:,i),g(:,:,:,i),flo)
ENDDO
IF (jspin>2) THEN
jspin1=1
jspin2=2
ELSE
jspin1=jspin;jspin2=jspin
END IF
na=SUM(atoms%neq(:n-1))+1
nsym = atoms%ntypsy(na)
nh = sphhar%nlh(nsym)
......@@ -73,22 +80,22 @@ CONTAINS
dvu(lpl,lh) = 0.0
ELSE
DO i = 1,atoms%jri(n)
x(i) = (f(i,1,lp)*f(i,1,l)+f(i,2,lp)*f(i,2,l))* vr0(i,lh)
x(i) = (f(i,1,lp,jspin1)*f(i,1,l,jspin2)+f(i,2,lp,jspin1)*f(i,2,l,jspin2))* vr0(i,lh)
END DO
CALL intgr3(x,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),temp)
uvu(lpl,lh) = temp
DO i = 1,atoms%jri(n)
x(i) = (g(i,1,lp)*f(i,1,l)+g(i,2,lp)*f(i,2,l))* vr0(i,lh)
x(i) = (g(i,1,lp,jspin1)*f(i,1,l,jspin2)+g(i,2,lp,jspin1)*f(i,2,l,jspin2))* vr0(i,lh)
END DO
CALL intgr3(x,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),temp)
dvu(lpl,lh) = temp
DO i = 1,atoms%jri(n)
x(i) = (f(i,1,lp)*g(i,1,l)+f(i,2,lp)*g(i,2,l))* vr0(i,lh)
x(i) = (f(i,1,lp,jspin1)*g(i,1,l,jspin2)+f(i,2,lp,jspin1)*g(i,2,l,jspin2))* vr0(i,lh)
END DO
CALL intgr3(x,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),temp)
uvd(lpl,lh) = temp
DO i = 1,atoms%jri(n)
x(i) = (g(i,1,lp)*g(i,1,l)+g(i,2,lp)*g(i,2,l))* vr0(i,lh)
x(i) = (g(i,1,lp,jspin1)*g(i,1,l,jspin2)+g(i,2,lp,jspin1)*g(i,2,l,jspin2))* vr0(i,lh)
END DO
CALL intgr3(x,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),temp)
dvd(lpl,lh) = temp
......
eigen/tlmplm_cholesky.F90
View file @ 93d7abd2
......@@ -112,31 +112,30 @@ CONTAINS
ENDDO
END DO
!Now add diagonal contribution to matrices
DO l = 0,atoms%lmax(n)
DO m = -l,l
lm = l* (l+1) + m
lmplm = (lm* (lm+3))/2
td%tuu(lmplm,n,jsp)=td%tuu(lmplm,n,jsp) + enpara%el0(l,n,jsp)
td%tdd(lmplm,n,jsp)=td%tdd(lmplm,n,jsp) + enpara%el0(l,n,jsp)*ud%ddn(l,n,jsp)
td%tud(lmplm,n,jsp)=td%tud(lmplm,n,jsp) + 0.5
td%tdu(lmplm,n,jsp)=td%tdu(lmplm,n,jsp) + 0.5
IF (jsp<3) THEN
DO l = 0,atoms%lmax(n)
DO m = -l,l
lm = l* (l+1) + m
lmplm = (lm* (lm+3))/2
td%tuu(lmplm,n,jsp)=td%tuu(lmplm,n,jsp) + enpara%el0(l,n,jsp)
td%tdd(lmplm,n,jsp)=td%tdd(lmplm,n,jsp) + enpara%el0(l,n,jsp)*ud%ddn(l,n,jsp)
td%tud(lmplm,n,jsp)=td%tud(lmplm,n,jsp) + 0.5
td%tdu(lmplm,n,jsp)=td%tdu(lmplm,n,jsp) + 0.5
ENDDO
ENDDO
ENDDO
!Create Cholesky decomposition of local hamiltonian
!---> Add diagonal terms to make matrix positive definite
DO lp = 0,atoms%lnonsph(n)
DO mp = -lp,lp
lmp = lp* (lp+1) + mp
td%h_loc(lmp,lmp,n,jsp)=td%e_shift(n,jsp)+td%h_loc(lmp,lmp,n,jsp)
td%h_loc(lmp+s,lmp+s,n,jsp)=td%e_shift(n,jsp)*ud%ddn(lp,n,jsp)+td%h_loc(lmp+s,lmp+s,n,jsp)
!Create Cholesky decomposition of local hamiltonian
!---> Add diagonal terms to make matrix positive definite
DO lp = 0,atoms%lnonsph(n)
DO mp = -lp,lp
lmp = lp* (lp+1) + mp
td%h_loc(lmp,lmp,n,jsp)=td%e_shift(n,jsp)+td%h_loc(lmp,lmp,n,jsp)
td%h_loc(lmp+s,lmp+s,n,jsp)=td%e_shift(n,jsp)*ud%ddn(lp,n,jsp)+td%h_loc(lmp+s,lmp+s,n,jsp)
END DO
END DO
END DO
IF (lmp+1.NE.s) CALL judft_error("BUG in tlmpln_cholesky")
!Perform cholesky decomposition
info=0
IF (jsp<3) THEN
IF (lmp+1.NE.s) CALL judft_error("BUG in tlmpln_cholesky")
!Perform cholesky decomposition
info=0
CALL zpotrf("L",2*s,td%h_loc(:,:,n,jsp),SIZE(td%h_loc,1),info)
!Upper part to zero
......
eigen/vacfun.f90
View file @ 93d7abd2
......@@ -2,7 +2,7 @@ MODULE m_vacfun
use m_juDFT
CONTAINS
SUBROUTINE vacfun(&
vacuum,dimension,stars, jsp,input,noco,ipot,&
vacuum,DIMENSION,stars, jsp,input,noco,jsp1,jsp2,&
sym, cell,ivac,evac,bkpt, vxy,vz,kvac1,kvac2,nv2,&
tuuv,tddv,tudv,tduv,uz,duz,udz,dudz,ddnv,wronk)
!*********************************************************************
......@@ -28,7 +28,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: jsp ,ivac,ipot
INTEGER, INTENT (IN) :: jsp ,ivac,jsp1,jsp2
REAL, INTENT (OUT) :: wronk
! ..
! .. Array Arguments ..
......@@ -46,7 +46,7 @@ CONTAINS
! .. Local Scalars ..
REAL ev,scale,xv,yv,vzero
COMPLEX phase
INTEGER i,i1,i2,i3,ik,ind2,ind3,jk,np1,jspin,jsp1,jsp2
INTEGER i,i1,i2,i3,ik,ind2,ind3,jk,np1,jspin
LOGICAL tail
! ..
! .. Local Arrays ..
......@@ -87,21 +87,6 @@ CONTAINS
enddo
ENDDO
!---> set up the tuuv, etc. matrices
IF (noco%l_noco) THEN
IF (ipot.EQ.1) THEN
jsp1 = 1
jsp2 = 1
ELSEIF (ipot.EQ.2) THEN
jsp1 = 2
jsp2 = 2
ELSEIF (ipot.EQ.3) THEN
jsp1 = 2
jsp2 = 1
ENDIF
ELSE
jsp1 = jsp
jsp2 = jsp
ENDIF
DO ik = 1,nv2(jsp1)
DO jk = 1,nv2(jsp2)
......@@ -175,7 +160,7 @@ CONTAINS
ELSE
!---> diagonal (film muffin-tin) terms
IF ((ipot.EQ.1) .OR. (ipot.EQ.2)) THEN
IF (jsp1==jsp2) THEN
tuuv(ik,ik) = cmplx(evac(ivac,jsp1),0.0)
tddv(ik,ik) = cmplx(evac(ivac,jsp1)*ddnv(ik,jsp1),0.0)
tudv(ik,ik) = cmplx(0.5,0.0)
......
init/postprocessInput.F90
View file @ 93d7abd2
......@@ -37,7 +37,9 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
USE m_od_kptsgen
USE m_gen_bz
USE m_nocoInputCheck
USE m_kpoints
USE m_kpoints
USE m_types_forcetheo_extended
IMPLICIT NONE
TYPE(t_mpi) ,INTENT (IN) :: mpi
......
main/fleur_init.F90
View file @ 93d7abd2
......@@ -215,6 +215,7 @@
CALL initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
DIMENSION,cell,sym,xcpot,noco,oneD,hybrid,&
kpts,enpara,sphhar,mpi,obsolete)
#endif
ELSE ! else branch of "IF (input%l_inpXML) THEN"
......
types/types_potden.f90
View file @ 93d7abd2
......@@ -86,7 +86,7 @@ CONTAINS
that%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)
IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
IF (SIZE(that%mt,4)==2) THEN
IF (SIZE(that%mt,4)>1) THEN
that%mt(:,0:,:,2)=this%mt(:,0:,:,1)
that%pw(:,2)=this%pw(:,1)
that%vacz(:,:,2)=this%vacz(:,:,1)
......
vgen/rotate_mt_den_tofrom_local.f90
View file @ 93d7abd2
......@@ -21,7 +21,7 @@ CONTAINS
TYPE(t_xcpot_inbuild) :: xcpot !local xcpot that is LDA to indicate we do not need gradients
TYPE(t_gradients) :: grad
INTEGER :: n,nsp,imesh
INTEGER :: n,nsp,imesh,i
REAL :: rho_11,rho_22,rho_21r,rho_21i,mx,my,mz,magmom
REAL :: rhotot,rho_up,rho_down,theta,phi
REAL,ALLOCATABLE :: ch(:,:)
......@@ -34,7 +34,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,den%mt(:,0:,n,:),nsp,n,grad,ch)
DO imesh = 1,nsp
DO imesh = 1,nsp*atoms%jri(n)
rho_11 = ch(imesh,1)
rho_22 = ch(imesh,2)
......@@ -80,6 +80,9 @@ CONTAINS
den%phi_mt(imesh,n) = phi
ENDDO
CALL mt_from_grid(atoms,sphhar,nsp,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
END DO
CALL finish_mt_grid()
END SUBROUTINE rotate_mt_den_to_local
......@@ -95,7 +98,7 @@ CONTAINS
TYPE(t_xcpot_inbuild) :: xcpot !local xcpot that is LDA to indicate we do not need gradients
TYPE(t_gradients) :: grad
INTEGER :: n,nsp,imesh
INTEGER :: n,nsp,imesh,i
REAL :: vup,vdown,veff,beff
REAL :: theta,phi
REAL,ALLOCATABLE :: ch(:,:)
......@@ -108,7 +111,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)
DO imesh = 1,nsp
DO imesh = 1,nsp*atoms%jri(n)
vup = ch(imesh,1)
vdown = ch(imesh,2)
theta = den%theta_mt(imesh,n)
......@@ -121,6 +124,9 @@ CONTAINS
ch(imesh,4) = beff*SIN(theta)*SIN(phi)
ENDDO
CALL mt_from_grid(atoms,sphhar,nsp,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
END DO
CALL finish_mt_grid()
END SUBROUTINE rotate_mt_den_from_local
......
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