Commit 7b393007 authored by Daniel Wortmann's avatar Daniel Wortmann

Fixed many SOC related bugs, more to come :-)

parent f5fc1ada
...@@ -98,17 +98,17 @@ CONTAINS ...@@ -98,17 +98,17 @@ CONTAINS
z(:,:,:)= 0. z(:,:,:)= 0.
zso(:,:,:)= CMPLX(0.,0.) zso(:,:,:)= CMPLX(0.,0.)
ALLOCATE(lapw%k1(DIMENSION%nvd,1)) ALLOCATE(lapw%k1(DIMENSION%nvd,input%jspins))
ALLOCATE(lapw%k2(DIMENSION%nvd,1)) ALLOCATE(lapw%k2(DIMENSION%nvd,input%jspins))
ALLOCATE(lapw%k3(DIMENSION%nvd,1)) ALLOCATE(lapw%k3(DIMENSION%nvd,input%jspins))
ALLOCATE(lapw%rk(DIMENSION%nvd,1)) ALLOCATE(lapw%rk(DIMENSION%nvd,input%jspins))
DO jsp = 1,input%jspins DO jsp = 1,input%jspins
CALL read_eig(& CALL read_eig(&
eig_id,nk,jsp,& eig_id,nk,jsp,&
bk=bkdu,el=epar,ello=ello(:,:,jsp),& bk=bkdu,el=epar,ello=ello(:,:,jsp),&
evac=evac,neig=ne,eig=eig(:,jsp),& evac=evac,neig=ne,eig=eig(:,jsp),&
nmat=lapw%nmat,nv=lapw%nv(1),k1=lapw%k1(:,1),k2=lapw%k2(:,1),k3=lapw%k3(:,1),kveclo=kveclo) nmat=lapw%nmat,nv=lapw%nv(jsp),k1=lapw%k1(:,jsp),k2=lapw%k2(:,jsp),k3=lapw%k3(:,jsp),kveclo=kveclo)
CALL read_eig(& CALL read_eig(&
eig_id,nk,jsp,& eig_id,nk,jsp,&
n_start=1,n_end=ne,& n_start=1,n_end=ne,&
...@@ -163,7 +163,7 @@ CONTAINS ...@@ -163,7 +163,7 @@ CONTAINS
! set up hamilton matrix ! set up hamilton matrix
! !
CALL timestop("alineso SOC: -ham") CALL timestart("alineso SOC: -ham")
ALLOCATE ( hsomtx(2,2,DIMENSION%neigd,DIMENSION%neigd) ) ALLOCATE ( hsomtx(2,2,DIMENSION%neigd,DIMENSION%neigd) )
CALL hsoham(& CALL hsoham(&
& atoms,noco,input,nsz,chelp,& & atoms,noco,input,nsz,chelp,&
......
...@@ -134,13 +134,8 @@ CONTAINS ...@@ -134,13 +134,8 @@ CONTAINS
soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2) ) soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2) )
soangl(:,:,:,:,:,:) = CMPLX(0.0,0.0) soangl(:,:,:,:,:,:) = CMPLX(0.0,0.0)
CALL spnorb(& CALL spnorb( atoms,noco,input,mpi, enpara,vr, rsopp,rsoppd,rsopdp,rsopdpd,usdus,&
atoms,noco,input,mpi,& rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl)
enpara,vr,&
input%sso_opt(atoms%ntype+2), &
rsopp,rsoppd,rsopdp,rsopdpd,usdus,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop,&
soangl)
! !
l_all = .FALSE. l_all = .FALSE.
INQUIRE (file='allbut',exist=l_all) INQUIRE (file='allbut',exist=l_all)
...@@ -271,6 +266,7 @@ CONTAINS ...@@ -271,6 +266,7 @@ CONTAINS
ELSE ELSE
DO jspin = 1,wannierspin DO jspin = 1,wannierspin
CALL timestart("eigenso: write_eig")
CALL write_eig(eig_id,& CALL write_eig(eig_id,&
nk,jspin,neig=nsz,neig_total=nsz,nmat=SIZE(zso,1),& nk,jspin,neig=nsz,neig_total=nsz,nmat=SIZE(zso,1),&
eig=eig_so(:nsz),z=zso(:,:nsz,jspin)) eig=eig_so(:nsz),z=zso(:,:nsz,jspin))
......
...@@ -16,7 +16,7 @@ CONTAINS ...@@ -16,7 +16,7 @@ CONTAINS
TYPE(t_enpara),INTENT(IN) :: enpara TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(OUT) :: usdus TYPE(t_usdus),INTENT(INOUT) :: usdus
! !
! .. Scalar Arguments .. ! .. Scalar Arguments ..
! .. ! ..
......
...@@ -20,7 +20,7 @@ CONTAINS ...@@ -20,7 +20,7 @@ CONTAINS
TYPE(t_enpara),INTENT(IN) :: enpara TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(OUT) :: usdus TYPE(t_usdus),INTENT(INOUT) :: usdus
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ntyp INTEGER, INTENT (IN) :: ntyp
...@@ -113,10 +113,10 @@ CONTAINS ...@@ -113,10 +113,10 @@ CONTAINS
IF (l.GT.0) THEN ! there is no spin-orbit for s-states IF (l.GT.0) THEN ! there is no spin-orbit for s-states
DO i = 1, 2 DO i = 1, 2
DO j = 1, 2 DO j = 1, 2
rsopp(ntyp,l,i,j) = radso( p(:,i), p(:,j),vso(:,i),atoms%rmsh(1,ntyp),atoms%dx(ntyp)) rsopp(ntyp,l,i,j) = radso( p(:,i), p(:,j),vso(:,i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsopdp(ntyp,l,i,j) = radso(pd(:,i), p(:,j),vso(:,i),atoms%rmsh(1,ntyp),atoms%dx(ntyp)) rsopdp(ntyp,l,i,j) = radso(pd(:,i), p(:,j),vso(:,i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsoppd(ntyp,l,i,j) = radso( p(:,i),pd(:,j),vso(:,i),atoms%rmsh(1,ntyp),atoms%dx(ntyp)) rsoppd(ntyp,l,i,j) = radso( p(:,i),pd(:,j),vso(:,i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
rsopdpd(ntyp,l,i,j) = radso(pd(:,i),pd(:,j),vso(:,i),atoms%rmsh(1,ntyp),atoms%dx(ntyp)) rsopdpd(ntyp,l,i,j) = radso(pd(:,i),pd(:,j),vso(:,i),atoms%dx(ntyp),atoms%rmsh(1,ntyp))
ENDDO ENDDO
ENDDO ENDDO
ENDIF ! l>0 ENDIF ! l>0
......
...@@ -6,7 +6,7 @@ MODULE m_spnorb ...@@ -6,7 +6,7 @@ MODULE m_spnorb
! using the functions anglso and sgml. ! using the functions anglso and sgml.
!********************************************************************* !*********************************************************************
CONTAINS CONTAINS
SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr,spav, rsopp,rsoppd,rsopdp,rsopdpd,& SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, rsopp,rsoppd,rsopdp,rsopdpd,&
usdus, rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl) usdus, rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl)
USE m_anglso USE m_anglso
...@@ -21,10 +21,8 @@ CONTAINS ...@@ -21,10 +21,8 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(OUT) :: usdus TYPE(t_usdus),INTENT(INOUT) :: usdus
! .. ! ..
! .. Scalar Arguments ..
LOGICAL, INTENT (IN) :: spav ! if T, spin-averaged pot is used
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntypd,dimension%jspd) REAL, INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntypd,dimension%jspd)
...@@ -49,8 +47,9 @@ CONTAINS ...@@ -49,8 +47,9 @@ CONTAINS
! .. ! ..
DATA ispjsp/1,-1/ DATA ispjsp/1,-1/
CALL soinit(atoms,input,enpara, vr,spav, rsopp,rsoppd,rsopdp,rsopdpd,& CALL soinit(atoms,input,enpara, vr,noco%soc_opt(atoms%ntype+2), &
usdus, rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop) rsopp,rsoppd,rsopdp,rsopdpd, usdus,rsoplop,rsoplopd,rsopdplo,&
rsopplo,rsoploplop)
! !
IF (mpi%irank.EQ.0) THEN IF (mpi%irank.EQ.0) THEN
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
......
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