Commit 59ebb62c authored by Daniel Wortmann's avatar Daniel Wortmann

More fixes for vacuum potential in noco case.

parent 536795a2
......@@ -89,35 +89,14 @@ CONTAINS
nkvec(:,:) = 0
cwork(:,:,:,:) = CMPLX(0.0,0.0)
enough=.FALSE.
DO k = 2,MIN(lapw%nv(1),lapw%nv(nintsp))
DO k = 1,MIN(lapw%nv(1),lapw%nv(nintsp))
IF (lapw%rk(k,iintsp).LT.eps) CYCLE
IF (.NOT.enough) THEN
DO iintsp = 1,nintsp
!--> generate spherical harmonics
vmult(:) = gkrot(k,:,iintsp)
CALL ylm4(atoms%lnonsph(ntyp),vmult, ylm)
!!$ l_lo1=.FALSE.
!!$ IF ((lapw%rk(k,iintsp).LT.eps).AND.(.NOT.noco%l_ss)) THEN
!!$ l_lo1=.TRUE.
!!$ ELSE
!!$ l_lo1=.FALSE.
!!$ ENDIF
!!$ ! --> here comes a part of abccoflo()
!!$ IF ( l_lo1) THEN
!!$ DO lo = 1,atoms%nlo(ntyp)
!!$ IF ((nkvec(lo,iintsp).EQ.0).AND.(atoms%llo(lo,ntyp).EQ.0)) THEN
!!$ enough = .FALSE.
!!$ nkvec(lo,iintsp) = 1
!!$ kvec(nkvec(lo,iintsp),lo) = k
!!$ term1 = con1* ((atoms%rmt(ntyp)**2)/2)
!!$ cwork(0,1,lo,iintsp) = term1 / SQRT(2*tpi_const)
!!$ IF((atoms%invsat(na).EQ.1).OR.(atoms%invsat(na).EQ.2)) THEN
!!$ cwork(1,1,lo,iintsp) = CONJG(term1) / SQRT(2*tpi_const)
!!$ ENDIF
!!$ ENDIF
!!$ ENDDO
!!$ ELSE
enough = .TRUE.
term1 = con1* ((atoms%rmt(ntyp)**2)/2)* CMPLX(rph(k,iintsp),cph(k,iintsp))
DO lo = 1,atoms%nlo(ntyp)
......@@ -174,7 +153,6 @@ CONTAINS
WRITE(*,*) na,k,lapw%nv
CALL juDFT_error("not enough lin. indep. clo-vectors" ,calledby ="vec_for_lo")
END IF
!ENDIF
! -- > end of abccoflo-part
ENDDO
ENDIF
......
......@@ -924,7 +924,7 @@ CONTAINS
END SUBROUTINE usdus_init
SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,oneD,jsp)
SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,oneD,jsp,l_noco)
USE m_judft
IMPLICIT NONE
CLASS(t_potden),INTENT(OUT):: pd
......@@ -933,16 +933,17 @@ CONTAINS
TYPE(t_sphhar),INTENT(IN):: sphhar
TYPE(t_vacuum),INTENT(IN):: vacuum
TYPE(t_oneD),INTENT(IN) :: oneD
INTEGER,INTENT(IN) :: jsp
CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,jsp,vacuum%nmzd,vacuum%nmzxyd,oneD%odi%n2d)
INTEGER,INTENT(IN) :: jsp
LOGICAL,INTENT(IN) :: l_noco
CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,jsp,l_noco,vacuum%nmzd,vacuum%nmzxyd,oneD%odi%n2d)
END SUBROUTINE init_potden_types
SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,jsp,nmzd,nmzxyd,n2d)
SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,jsp,l_noco,nmzd,nmzxyd,n2d)
USE m_judft
IMPLICIT NONE
CLASS(t_potden),INTENT(OUT) :: pd
INTEGER,INTENT(IN) :: ng3,jmtd,nlhd,ntype,jsp
LOGICAL,INTENT(IN) :: l_noco
INTEGER,INTENT(IN),OPTIONAL :: nmzd,nmzxyd,n2d
INTEGER:: err(4)
......@@ -952,7 +953,7 @@ CONTAINS
ALLOCATE(pd%pw(ng3,jsp),stat=err(1))
ALLOCATE(pd%mt(jmtd,0:nlhd,ntype,jsp),stat=err(2))
IF (PRESENT(nmzd)) THEN
ALLOCATE(pd%vacz(nmzd,2,jsp),stat=err(3))
ALLOCATE(pd%vacz(nmzd,2,MERGE(jsp,4,l_noco)),stat=err(3))
ALLOCATE(pd%vacxy(nmzxyd,n2d-1,2,jsp),stat=err(4))
ENDIF
IF (ANY(err>0)) CALL judft_error("Not enough memory allocating potential or density")
......
......@@ -124,8 +124,7 @@ CONTAINS
! ivac=1: upper (positive z) vacuum
! units: hartrees
!
call v%init(stars,atoms,sphhar,vacuum,oneD,dimension%jspd)
CALL v%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,noco%l_noco)
ALLOCATE ( alphm(stars%ng2,2),excpw(stars%ng3),excxy(vacuum%nmzxyd,oneD%odi%n2d-1,2),&
vbar(dimension%jspd),af1(3*stars%mx3),bf1(3*stars%mx3),xp(3,dimension%nspd),&
rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd),rht(vacuum%nmzd,2,dimension%jspd),&
......@@ -134,7 +133,7 @@ CONTAINS
excz(vacuum%nmzd,2),excr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype),&
vpw_w(stars%ng3,dimension%jspd),vxpw_w(stars%ng3,dimension%jspd),psq(stars%ng3) )
CALL vx%init(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,dimension%jspd)
CALL vx%init(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,DIMENSION%jspd,.false.)
IF (noco%l_noco) THEN
ALLOCATE ( cdom(stars%ng3), cdomvz(vacuum%nmzd,2),cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2) )
......
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