Commit addfc05e authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' into mixer

parents ebcccf8e 0cf0bbf4
...@@ -15,6 +15,7 @@ c This subroutine rotates the direction of the magnetization of the ...@@ -15,6 +15,7 @@ c This subroutine rotates the direction of the magnetization of the
c density matrix by multiplying with the unitary 2x2 spin rotation c density matrix by multiplying with the unitary 2x2 spin rotation
c matrix. --> U*rho*U^dagger c matrix. --> U*rho*U^dagger
c Philipp Kurz 2000-02-03 c Philipp Kurz 2000-02-03
c new method for improved stability (l_new=t) gb'19
c*********************************************************************** c***********************************************************************
use m_constants use m_constants
...@@ -28,11 +29,29 @@ C .. Scalar Arguments .. ...@@ -28,11 +29,29 @@ C .. Scalar Arguments ..
C .. C ..
C .. Local Scalars .. C .. Local Scalars ..
INTEGER ispin INTEGER ispin
REAL eps REAL eps,r11n,r22n
COMPLEX r21n
LOGICAL l_new
C .. C ..
C .. Local Arrays .. C .. Local Arrays ..
COMPLEX u2(2,2),rho(2,2),rhoh(2,2) COMPLEX u2(2,2),rho(2,2),rhoh(2,2)
C .. C ..
l_new = .true.
IF (l_new) THEN
r11n = 0.5*(1.0+cos(beta))*rho11 - sin(beta)*real(rho21) +
+ 0.5*(1.0-cos(beta))*rho22
r22n = 0.5*(1.0-cos(beta))*rho11 + sin(beta)*real(rho21) +
+ 0.5*(1.0+cos(beta))*rho22
r21n = CMPLX(cos(alph),-sin(alph))*(sin(beta)*(rho11-rho22) +
+ 2.0*(cos(beta)*real(rho21)-cmplx(0.0,aimag(rho21))))*0.5
rho11 = r11n
rho22 = r22n
rho21 = r21n
ELSE
eps = 1.0e-10 eps = 1.0e-10
...@@ -79,6 +98,8 @@ c---> are real. ...@@ -79,6 +98,8 @@ c---> are real.
rho22 = real(rho(2,2)) rho22 = real(rho(2,2))
rho21 = rho(2,1) rho21 = rho(2,1)
ENDIF
END SUBROUTINE rot_den_mat END SUBROUTINE rot_den_mat
END MODULE m_rotdenmat END MODULE m_rotdenmat
...@@ -29,7 +29,7 @@ CONTAINS ...@@ -29,7 +29,7 @@ CONTAINS
TYPE(t_lapw),INTENT(IN) :: lapw TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_potden),INTENT(IN) :: v TYPE(t_potden),INTENT(IN) :: v
CLASS(t_mat),INTENT(INOUT) :: hmat(:,:),smat(:,:) CLASS(t_mat),INTENT(INOUT) :: hmat(:,:),smat(:,:)
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: jsp INTEGER, INTENT (IN) :: jsp
...@@ -40,14 +40,14 @@ CONTAINS ...@@ -40,14 +40,14 @@ CONTAINS
! .. Local Scalars .. ! .. Local Scalars ..
COMPLEX hij,sij,apw_lo,c_1 COMPLEX hij,sij,apw_lo,c_1
REAL d2,gz,sign,th,wronk REAL d2,gz,sign,th,wronk
INTEGER i,i2,ii,jj,ik,j,jk,k,jspin,ipot,ii0,i0 INTEGER i,i2,ii,jj,ik,j,jk,k,jspin,ii0,i0
INTEGER ivac,irec,imz,igvm2,igvm2i,s1,s2 INTEGER ivac,irec,imz,igvm2,igvm2i,s1,s2
INTEGER jspin1,jspin2,jmax,jsp_start,jsp_end INTEGER jspin1,jspin2,jmax,jsp_start,jsp_end
INTEGER i_start,nc,nc_0 INTEGER i_start,nc,nc_0
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
INTEGER:: nv2(input%jspins) INTEGER:: nv2(input%jspins)
INTEGER kvac1(DIMENSION%nv2d,input%jspins),kvac2(DIMENSION%nv2d,input%jspins) INTEGER kvac(2,DIMENSION%nv2d,input%jspins)
INTEGER map2(DIMENSION%nvd,input%jspins) INTEGER map2(DIMENSION%nvd,input%jspins)
COMPLEX tddv(DIMENSION%nv2d,DIMENSION%nv2d),tduv(DIMENSION%nv2d,DIMENSION%nv2d) COMPLEX tddv(DIMENSION%nv2d,DIMENSION%nv2d),tduv(DIMENSION%nv2d,DIMENSION%nv2d)
COMPLEX tudv(DIMENSION%nv2d,DIMENSION%nv2d),tuuv(DIMENSION%nv2d,DIMENSION%nv2d) COMPLEX tudv(DIMENSION%nv2d,DIMENSION%nv2d),tuuv(DIMENSION%nv2d,DIMENSION%nv2d)
...@@ -66,16 +66,14 @@ CONTAINS ...@@ -66,16 +66,14 @@ CONTAINS
nv2(jspin) = 0 nv2(jspin) = 0
k_loop:DO k = 1,lapw%nv(jspin) k_loop:DO k = 1,lapw%nv(jspin)
DO j = 1,nv2(jspin) DO j = 1,nv2(jspin)
IF (lapw%k1(k,jspin).EQ.kvac1(j,jspin)& IF (all(lapw%gvec(1:2,k,jspin)==kvac(1:2,j,jspin))) THEN
.AND. lapw%k2(k,jspin).EQ.kvac2(j,jspin)) THEN
map2(k,jspin) = j map2(k,jspin) = j
CYCLE k_loop CYCLE k_loop
END IF END IF
ENDDO ENDDO
nv2(jspin) = nv2(jspin) + 1 nv2(jspin) = nv2(jspin) + 1
IF (nv2(jspin)>DIMENSION%nv2d) CALL juDFT_error("hsvac:dimension%nv2d",calledby ="hsvac") IF (nv2(jspin)>DIMENSION%nv2d) CALL juDFT_error("hsvac:dimension%nv2d",calledby ="hsvac")
kvac1(nv2(jspin),jspin) = lapw%k1(k,jspin) kvac(1:2,nv2(jspin),jspin) = lapw%gvec(1:2,k,jspin)
kvac2(nv2(jspin),jspin) = lapw%k2(k,jspin)
map2(k,jspin) = nv2(jspin) map2(k,jspin) = nv2(jspin)
ENDDO k_loop ENDDO k_loop
ENDDO ENDDO
...@@ -86,20 +84,16 @@ CONTAINS ...@@ -86,20 +84,16 @@ CONTAINS
s1=MIN(SIZE(hmat,1),jspin1) !in colinear case s1=1 s1=MIN(SIZE(hmat,1),jspin1) !in colinear case s1=1
DO jspin2=MERGE(1,jsp,noco%l_noco),MERGE(2,jsp,noco%l_noco) !loop over global spin DO jspin2=MERGE(1,jsp,noco%l_noco),MERGE(2,jsp,noco%l_noco) !loop over global spin
s2=MIN(SIZE(hmat,1),jspin2) !in colinear case s2=1 s2=MIN(SIZE(hmat,1),jspin2) !in colinear case s2=1
ipot=3
IF (jspin1==jspin2) ipot=jspin1
!---> get the wavefunctions and set up the tuuv, etc matrices !---> get the wavefunctions and set up the tuuv, etc matrices
jspin=jsp CALL vacfun(&
CALL vacfun(& vacuum,stars,&
vacuum,DIMENSION,stars,& input,noco,jspin1,jspin2,&
jsp,input,noco,jspin1,jspin2,& sym, cell,ivac,evac,lapw%bkpt,v%vacxy,v%vacz,kvac,nv2,&
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)
tuuv,tddv,tudv,tduv,uz,duz,udz,dudz,ddnv,wronk)
! !
!---> generate a and b coeffficients !---> generate a and b coeffficients
! !
IF (noco%l_noco) THEN DO jspin = MIN(jspin1,jspin2),MAX(jspin1,jspin2)
DO jspin = 1,input%jspins
DO k = 1,lapw%nv(jspin) DO k = 1,lapw%nv(jspin)
gz = sign*cell%bmat(3,3)*lapw%k3(k,jspin) gz = sign*cell%bmat(3,3)*lapw%k3(k,jspin)
i2 = map2(k,jspin) i2 = map2(k,jspin)
...@@ -109,16 +103,6 @@ CONTAINS ...@@ -109,16 +103,6 @@ CONTAINS
b(k,jspin) = c_1 * CMPLX(duz(i2,jspin), gz* uz(i2,jspin) ) b(k,jspin) = c_1 * CMPLX(duz(i2,jspin), gz* uz(i2,jspin) )
ENDDO ENDDO
ENDDO ENDDO
ELSE
DO k = 1,lapw%nv(jsp)
gz = sign*cell%bmat(3,3)*lapw%gvec(3,k,jsp)
i2 = map2(k,jsp)
th = gz*cell%z1
c_1 = CMPLX( COS(th), SIN(th) )/ (d2*wronk)
a(k,jsp) = - c_1 * CMPLX(dudz(i2,jsp), gz*udz(i2,jsp) )
b(k,jsp) = c_1 * CMPLX(duz(i2,jsp), gz* uz(i2,jsp) )
ENDDO
ENDIF
!---> update hamiltonian and overlap matrices !---> update hamiltonian and overlap matrices
IF (jspin1==jspin2) THEN IF (jspin1==jspin2) THEN
DO i = mpi%n_rank+1,lapw%nv(jspin2),mpi%n_size DO i = mpi%n_rank+1,lapw%nv(jspin2),mpi%n_size
...@@ -153,30 +137,25 @@ CONTAINS ...@@ -153,30 +137,25 @@ CONTAINS
!Diagonal term of Overlapp matrix, Hamiltonian later !Diagonal term of Overlapp matrix, Hamiltonian later
sij = CONJG(a(i,jspin2))*a(i,jspin2) + CONJG(b(i,jspin2))*b(i,jspin2)*ddnv(ik,jspin2) sij = CONJG(a(i,jspin2))*a(i,jspin2) + CONJG(b(i,jspin2))*b(i,jspin2)*ddnv(ik,jspin2)
IF (hmat(1,1)%l_real) THEN IF (hmat(1,1)%l_real) THEN
smat(s1,s2)%data_r(j,i0) = smat(s1,s2)%data_r(j,i0) + REAL(sij) smat(s2,s1)%data_r(j,i0) = smat(s1,s2)%data_r(j,i0) + REAL(sij)
ELSE ELSE
smat(s1,s2)%data_c(j,i0) = smat(s1,s2)%data_c(j,i0) + sij smat(s2,s1)%data_c(j,i0) = smat(s1,s2)%data_c(j,i0) + sij
ENDIF ENDIF
ENDDO ENDDO
ENDIF ENDIF
!---> hamiltonian update !---> hamiltonian update
DO i = mpi%n_rank+1,lapw%nv(jspin2),mpi%n_size DO i = mpi%n_rank+1,lapw%nv(jspin1),mpi%n_size
i0=(i-1)/mpi%n_size+1 !local column index i0=(i-1)/mpi%n_size+1 !local column index
ik = map2(i,jspin2) ik = map2(i,jspin1)
DO j = 1,MIN(i,lapw%nv(jspin1)) DO j = 1,MERGE(i,lapw%nv(jspin2),jspin1==jspin2)
jk = map2(j,jspin1) jk = map2(j,jspin2)
IF (jspin2>jspin1) THEN hij = CONJG(a(i,jspin1))* (tuuv(ik,jk)*a(j,jspin2) +tudv(ik,jk)*b(j,jspin2))&
hij = CONJG(CONJG(a(j,jspin1))* (tuuv(jk,ik)*a(i,jspin2) +tudv(jk,ik)*b(i,jspin2))& + CONJG(b(i,jspin1))* (tddv(ik,jk)*b(j,jspin2) +tduv(ik,jk)*a(j,jspin2))
+ CONJG(b(j,jspin1))* (tddv(jk,ik)*b(i,jspin2) +tduv(jk,ik)*a(i,jspin2)))
ELSE
hij = CONJG(a(i,jspin2))* (tuuv(ik,jk)*a(j,jspin1) +tudv(ik,jk)*b(j,jspin1))&
+ CONJG(b(i,jspin2))* (tddv(ik,jk)*b(j,jspin1) +tduv(ik,jk)*a(j,jspin1))
ENDIF
IF (hmat(1,1)%l_real) THEN IF (hmat(1,1)%l_real) THEN
hmat(s1,s2)%data_r(j,i0) = hmat(s1,s2)%data_r(j,i0) + REAL(hij) hmat(s2,s1)%data_r(j,i0) = hmat(s2,s1)%data_r(j,i0) + REAL(hij)
ELSE ELSE
hmat(s1,s2)%data_c(j,i0) = hmat(s1,s2)%data_c(j,i0) + hij hmat(s2,s1)%data_c(j,i0) = hmat(s2,s1)%data_c(j,i0) + hij
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO
......
...@@ -2,8 +2,8 @@ MODULE m_vacfun ...@@ -2,8 +2,8 @@ MODULE m_vacfun
use m_juDFT use m_juDFT
CONTAINS CONTAINS
SUBROUTINE vacfun(& SUBROUTINE vacfun(&
vacuum,DIMENSION,stars, jsp,input,noco,jsp1,jsp2,& vacuum,stars,input,noco,jspin1,jspin2,&
sym, cell,ivac,evac,bkpt, vxy,vz,kvac1,kvac2,nv2,& sym, cell,ivac,evac,bkpt, vxy,vz,kvac,nv2,&
tuuv,tddv,tudv,tduv,uz,duz,udz,dudz,ddnv,wronk) tuuv,tddv,tudv,tduv,uz,duz,udz,dudz,ddnv,wronk)
!********************************************************************* !*********************************************************************
! determines the necessary values and derivatives on the vacuum ! determines the necessary values and derivatives on the vacuum
...@@ -19,7 +19,6 @@ CONTAINS ...@@ -19,7 +19,6 @@ CONTAINS
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
...@@ -28,31 +27,35 @@ CONTAINS ...@@ -28,31 +27,35 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: jsp ,ivac,jsp1,jsp2 INTEGER, INTENT (IN) :: ivac,jspin1,jspin2
REAL, INTENT (OUT) :: wronk REAL, INTENT (OUT) :: wronk
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
INTEGER, INTENT (IN) :: nv2(input%jspins) INTEGER, INTENT (IN) :: nv2(:)!(input%jspins)
INTEGER, INTENT (IN) :: kvac1(dimension%nv2d,input%jspins),kvac2(dimension%nv2d,input%jspins) INTEGER, INTENT (IN) :: kvac(:,:,:)!(2,dimension%nv2d,input%jspins)
COMPLEX, INTENT (IN) :: vxy(vacuum%nmzxyd,stars%ng2-1) COMPLEX, INTENT (IN) :: vxy(:,:,:,:) !(vacuum%nmzxyd,stars%ng2-1,nvac,:)
COMPLEX, INTENT (OUT):: tddv(dimension%nv2d,dimension%nv2d),tduv(dimension%nv2d,dimension%nv2d) COMPLEX, INTENT (OUT):: tddv(:,:),tduv(:,:)!(dimension%nv2d,dimension%nv2d)
COMPLEX, INTENT (OUT):: tudv(dimension%nv2d,dimension%nv2d),tuuv(dimension%nv2d,dimension%nv2d) COMPLEX, INTENT (OUT):: tudv(:,:),tuuv(:,:)!(dimension%nv2d,dimension%nv2d)
REAL, INTENT (IN) :: vz(vacuum%nmzd,2,4) ,evac(2,input%jspins) REAL,ALLOCATABLE,INTENT (IN) :: vz(:,:,:) !(vacuum%nmzd,2,4) ,
REAL, INTENT (IN) :: evac(:,:)!(2,input%jspins)
REAL, INTENT (IN) :: bkpt(3) REAL, INTENT (IN) :: bkpt(3)
REAL, INTENT (OUT):: udz(dimension%nv2d,input%jspins),uz(dimension%nv2d,input%jspins) REAL, INTENT (OUT):: udz(:,:),uz(:,:)!(dimension%nv2d,input%jspins)
REAL, INTENT (OUT):: dudz(dimension%nv2d,input%jspins),duz(dimension%nv2d,input%jspins) REAL, INTENT (OUT):: dudz(:,:),duz(:,:)!(dimension%nv2d,input%jspins)
REAL, INTENT (OUT):: ddnv(dimension%nv2d,input%jspins) REAL, INTENT (OUT):: ddnv(:,:)!(dimension%nv2d,input%jspins)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
REAL ev,scale,xv,yv,vzero REAL ev,scale,xv,yv,vzero,fac
COMPLEX phase COMPLEX phase
INTEGER i,i1,i2,i3,ik,ind2,ind3,jk,np1,jspin INTEGER i,i1,i2,i3,ik,ind2,ind3,jk,np1,jspin,ipot
LOGICAL tail LOGICAL tail
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
REAL u(vacuum%nmzd,dimension%nv2d,input%jspins),ud(vacuum%nmzd,dimension%nv2d,input%jspins) REAL u(vacuum%nmzd,size(duz,1),input%jspins),ud(vacuum%nmzd,size(duz,1),input%jspins)
REAL v(3),x(vacuum%nmzd), qssbti(2,2) REAL v(3),x(vacuum%nmzd), qssbti(2,2)
! .. ! ..
fac=MERGE(1.0,-1.0,jspin1<=jspin2)
ipot=MERGE(jspin1,3,jspin1==jspin2)
tuuv=0.0;tudv=0.0;tddv=0.0;tduv=0.0 tuuv=0.0;tudv=0.0;tddv=0.0;tduv=0.0
udz=0.0;duz=0.0;ddnv=0.0;udz=0.;uz=0. udz=0.0;duz=0.0;ddnv=0.0;udz=0.;uz=0.
tail = .true. tail = .true.
...@@ -60,15 +63,12 @@ CONTAINS ...@@ -60,15 +63,12 @@ CONTAINS
!---> wronksian for the schrodinger equation given by an identity !---> wronksian for the schrodinger equation given by an identity
wronk = 2.0 wronk = 2.0
!---> setup the spin-spiral q-vector !---> setup the spin-spiral q-vector
qssbti(1,1) = - noco%qss(1)/2 qssbti(1:2,1) = - noco%qss(1:2)/2
qssbti(2,1) = - noco%qss(2)/2 qssbti(1:2,2) = + noco%qss(1:2)/2
qssbti(1,2) = + noco%qss(1)/2
qssbti(2,2) = + noco%qss(2)/2
!---> generate basis functions for each 2-d k+g !---> generate basis functions for each 2-d k+g
DO jspin = 1,input%jspins DO jspin = MIN(jspin1,jspin2),MAX(jspin1,jspin2)
DO ik = 1,nv2(jspin) DO ik = 1,nv2(jspin)
v(1) = bkpt(1) + kvac1(ik,jspin) + qssbti(1,jspin) v(1:2) = bkpt(1:2) + kvac(:,ik,jspin) + qssbti(1:2,jspin)
v(2) = bkpt(2) + kvac2(ik,jspin) + qssbti(2,jspin)
v(3) = 0.0 v(3) = 0.0
ev = evac(ivac,jspin) - 0.5*dot_product(v,matmul(v,cell%bbmat)) ev = evac(ivac,jspin) - 0.5*dot_product(v,matmul(v,cell%bbmat))
vzero = vz(vacuum%nmzd,ivac,jspin) vzero = vz(vacuum%nmzd,ivac,jspin)
...@@ -80,19 +80,19 @@ CONTAINS ...@@ -80,19 +80,19 @@ CONTAINS
!---> make sure the solutions satisfy the wronksian !---> make sure the solutions satisfy the wronksian
scale = wronk/ (udz(ik,jspin)*duz(ik,jspin)-& scale = wronk/ (udz(ik,jspin)*duz(ik,jspin)-&
& dudz(ik,jspin)*uz(ik,jspin)) & dudz(ik,jspin)*uz(ik,jspin))
udz(ik,jspin) = scale*udz(ik,jspin) udz(ik,jspin) = scale*udz(ik,jspin)
dudz(ik,jspin) = scale*dudz(ik,jspin) dudz(ik,jspin) = scale*dudz(ik,jspin)
ddnv(ik,jspin) = scale*ddnv(ik,jspin) ddnv(ik,jspin) = scale*ddnv(ik,jspin)
ud(:,ik,jspin) = scale*ud(:,ik,jspin) ud(:,ik,jspin) = scale*ud(:,ik,jspin)
enddo enddo
ENDDO ENDDO
!---> set up the tuuv, etc. matrices !---> set up the tuuv, etc. matrices
DO ik = 1,nv2(jsp1) DO ik = 1,nv2(jspin1)
DO jk = 1,nv2(jsp2) DO jk = 1,nv2(jspin2)
!---> determine the warping component of the potential !---> determine the warping component of the potential
i1 = kvac1(ik,jsp1) - kvac1(jk,jsp2) i1 = kvac(1,ik,jspin1) - kvac(1,jk,jspin2)
i2 = kvac2(ik,jsp1) - kvac2(jk,jsp2) i2 = kvac(2,ik,jspin1) - kvac(2,jk,jspin2)
i3 = 0 i3 = 0
ind3 = stars%ig(i1,i2,i3) ind3 = stars%ig(i1,i2,i3)
IF (ind3.EQ.0) CYCLE IF (ind3.EQ.0) CYCLE
...@@ -114,98 +114,96 @@ CONTAINS ...@@ -114,98 +114,96 @@ CONTAINS
!---> tuuv !---> tuuv
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
x(np1-i) = u(i,ik,jsp1)*u(i,jk,jsp2)*real(vxy(i,ind2)) x(np1-i) = u(i,ik,jspin1)*u(i,jk,jspin2)*REAL(vxy(i,ind2,ivac,ipot))
enddo enddo
CALL intgz0(x,vacuum%delz,vacuum%nmzxy,xv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmzxy,xv,tail)
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
x(np1-i) = u(i,ik,jsp1)*u(i,jk,jsp2)*aimag(vxy(i,ind2)) x(np1-i) = u(i,ik,jspin1)*u(i,jk,jspin2)*fac*AIMAG(vxy(i,ind2,ivac,ipot))
enddo enddo
CALL intgz0(x,vacuum%delz,vacuum%nmzxy,yv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmzxy,yv,tail)
tuuv(ik,jk) = phase*cmplx(xv,yv) tuuv(ik,jk) = phase*cmplx(xv,yv)
!---> tddv !---> tddv
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
x(np1-i) = ud(i,ik,jsp1)*ud(i,jk,jsp2)*real(vxy(i,ind2)) x(np1-i) = ud(i,ik,jspin1)*ud(i,jk,jspin2)*REAL(vxy(i,ind2,ivac,ipot))
enddo enddo
CALL intgz0(x,vacuum%delz,vacuum%nmzxy,xv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmzxy,xv,tail)
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
x(np1-i) =ud(i,ik,jsp1)*ud(i,jk,jsp2)*aimag(vxy(i,ind2)) x(np1-i) =ud(i,ik,jspin1)*ud(i,jk,jspin2)*fac*AIMAG(vxy(i,ind2,ivac,ipot))
enddo enddo
CALL intgz0(x,vacuum%delz,vacuum%nmzxy,yv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmzxy,yv,tail)
tddv(ik,jk) = phase*cmplx(xv,yv) tddv(ik,jk) = phase*cmplx(xv,yv)
!---> tudv !---> tudv
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
x(np1-i) = u(i,ik,jsp1)*ud(i,jk,jsp2)*real(vxy(i,ind2)) x(np1-i) = u(i,ik,jspin1)*ud(i,jk,jspin2)*real(vxy(i,ind2,ivac,ipot))
enddo enddo
CALL intgz0(x,vacuum%delz,vacuum%nmzxy,xv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmzxy,xv,tail)
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
x(np1-i) = u(i,ik,jsp1)*ud(i,jk,jsp2)*aimag(vxy(i,ind2)) x(np1-i) = u(i,ik,jspin1)*ud(i,jk,jspin2)*fac*AIMAG(vxy(i,ind2,ivac,ipot))
enddo enddo
CALL intgz0(x,vacuum%delz,vacuum%nmzxy,yv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmzxy,yv,tail)
tudv(ik,jk) = phase*cmplx(xv,yv) tudv(ik,jk) = phase*cmplx(xv,yv)
!---> tduv !---> tduv
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
x(np1-i) = ud(i,ik,jsp1)*u(i,jk,jsp2)*real(vxy(i,ind2)) x(np1-i) = ud(i,ik,jspin1)*u(i,jk,jspin2)*real(vxy(i,ind2,ivac,ipot))
enddo enddo
CALL intgz0(x,vacuum%delz,vacuum%nmzxy,xv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmzxy,xv,tail)
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
x(np1-i) = ud(i,ik,jsp1)*u(i,jk,jsp2)*aimag(vxy(i,ind2)) x(np1-i) = ud(i,ik,jspin1)*u(i,jk,jspin2)*fac*AIMAG(vxy(i,ind2,ivac,ipot))
enddo enddo
CALL intgz0(x,vacuum%delz,vacuum%nmzxy,yv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmzxy,yv,tail)
tduv(ik,jk) = phase*cmplx(xv,yv) tduv(ik,jk) = phase*cmplx(xv,yv)
ELSE ELSE
!---> diagonal (film muffin-tin) terms !---> diagonal (film muffin-tin) terms
IF (jsp1==jsp2) THEN IF (jspin1==jspin2) THEN
tuuv(ik,ik) = cmplx(evac(ivac,jsp1),0.0) tuuv(ik,ik) = cmplx(evac(ivac,jspin1),0.0)
tddv(ik,ik) = cmplx(evac(ivac,jsp1)*ddnv(ik,jsp1),0.0) tddv(ik,ik) = cmplx(evac(ivac,jspin1)*ddnv(ik,jspin1),0.0)
tudv(ik,ik) = cmplx(0.5,0.0) tudv(ik,ik) = cmplx(0.5,0.0)
tduv(ik,ik) = cmplx(0.5,0.0) tduv(ik,ik) = cmplx(0.5,0.0)
ELSE ELSE
!---> tuuv !---> tuuv
DO i = 1,vacuum%nmz DO i = 1,vacuum%nmz
x(vacuum%nmz+1-i) = u(i,ik,jsp1)*u(i,jk,jsp2)*vz(i,ivac,3) x(vacuum%nmz+1-i) = u(i,ik,jspin1)*u(i,jk,jspin2)*vz(i,ivac,3)
ENDDO ENDDO
CALL intgz0(x,vacuum%delz,vacuum%nmz,xv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmz,xv,tail)
DO i = 1,vacuum%nmz DO i = 1,vacuum%nmz
x(vacuum%nmz+1-i) = u(i,ik,jsp1)*u(i,jk,jsp2)*vz(i,ivac,4) x(vacuum%nmz+1-i) = u(i,ik,jspin1)*u(i,jk,jspin2)*fac*vz(i,ivac,4)
ENDDO ENDDO
CALL intgz0(x,vacuum%delz,vacuum%nmz,yv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmz,yv,tail)
tuuv(ik,jk) = cmplx(xv,yv) tuuv(ik,jk) = cmplx(xv,yv)
!---> tddv !---> tddv
DO i = 1,vacuum%nmz DO i = 1,vacuum%nmz
x(vacuum%nmz+1-i) = ud(i,ik,jsp1)*ud(i,jk,jsp2)*vz(i,ivac,3) x(vacuum%nmz+1-i) = ud(i,ik,jspin1)*ud(i,jk,jspin2)*vz(i,ivac,3)
ENDDO ENDDO
CALL intgz0(x,vacuum%delz,vacuum%nmz,xv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmz,xv,tail)
DO i = 1,vacuum%nmz DO i = 1,vacuum%nmz
x(vacuum%nmz+1-i) = ud(i,ik,jsp1)*ud(i,jk,jsp2)*vz(i,ivac,4) x(vacuum%nmz+1-i) = ud(i,ik,jspin1)*ud(i,jk,jspin2)*fac*vz(i,ivac,4)
ENDDO ENDDO
CALL intgz0(x,vacuum%delz,vacuum%nmz,yv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmz,yv,tail)
tddv(ik,jk) = cmplx(xv,yv) tddv(ik,jk) = cmplx(xv,yv)
!---> tudv !---> tudv
DO i = 1,vacuum%nmz DO i = 1,vacuum%nmz
x(vacuum%nmz+1-i) = u(i,ik,jsp1)*ud(i,jk,jsp2)*vz(i,ivac,3) x(vacuum%nmz+1-i) = u(i,ik,jspin1)*ud(i,jk,jspin2)*vz(i,ivac,3)
ENDDO ENDDO
CALL intgz0(x,vacuum%delz,vacuum%nmz,xv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmz,xv,tail)
DO i = 1,vacuum%nmz DO i = 1,vacuum%nmz
x(vacuum%nmz+1-i) = u(i,ik,jsp1)*ud(i,jk,jsp2)*vz(i,ivac,4) x(vacuum%nmz+1-i) = u(i,ik,jspin1)*ud(i,jk,jspin2)*fac*vz(i,ivac,4)
ENDDO ENDDO
CALL intgz0(x,vacuum%delz,vacuum%nmz,yv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmz,yv,tail)
tudv(ik,jk) = cmplx(xv,yv) tudv(ik,jk) = cmplx(xv,yv)
!---> tduv !---> tduv
DO i = 1,vacuum%nmz DO i = 1,vacuum%nmz
x(vacuum%nmz+1-i) = ud(i,ik,jsp1)*u(i,jk,jsp2)*vz(i,ivac,3) x(vacuum%nmz+1-i) = ud(i,ik,jspin1)*u(i,jk,jspin2)*vz(i,ivac,3)
ENDDO ENDDO
CALL intgz0(x,vacuum%delz,vacuum%nmz,xv,tail) CALL intgz0(x,vacuum%delz,vacuum%nmz,xv,tail)
DO i = 1,vacuum%nmz DO i = 1,vacuum%nmz
x(vacuum%nmz+1-i) = ud(i,ik,jsp1)*u(i,jk,jsp2)*vz(i,ivac,4) x(vacuum%nmz+1-i) = ud(i,ik,jspin1)*u(i,jk,jspin2)*