Skip to content

GitLab

fleur
fleur
Commit addfc05e authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Merge branch 'develop' into mixer

parents ebcccf8e 0cf0bbf4
Hide whitespace changes
Inline Side-by-side
Showing with 703 additions and 741 deletions
cdn/rot_den_mat.f
View file @ addfc05e
...@@ -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
eigen/hsvac.F90
View file @ addfc05e
...@@ -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
......
eigen/vacfun.f90
View file @ addfc05e
...@@ -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)*