Skip to content

GitLab

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

Merge branch 'develop' of fleur-git:fleur into develop 

Conflicts:
	eigen/hsmt_sph.F90
parents 475e6968 5c6dc2c0
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 438 additions and 408 deletions
cdn/cdnval.F90
View file @ e5456adc
......@@ -164,8 +164,6 @@ CONTAINS
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:) ,kveclo(:)
INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
COMPLEX, ALLOCATABLE :: z_c(:,:)
REAL, ALLOCATABLE :: z_r(:,:)
REAL, ALLOCATABLE :: aclo(:,:,:),acnmt(:,:,:,:,:)
REAL, ALLOCATABLE :: bclo(:,:,:),bcnmt(:,:,:,:,:)
REAL, ALLOCATABLE :: cclo(:,:,:,:),ccnmt(:,:,:,:,:),we(:)
......@@ -192,7 +190,8 @@ CONTAINS
TYPE (t_orblo),ALLOCATABLE :: orblo(:,:,:,:,:)
TYPE (t_mt21), ALLOCATABLE :: mt21(:,:)
TYPE (t_lo21), ALLOCATABLE :: lo21(:,:)
TYPE (t_usdus):: usdus
TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat
LOGICAL :: l_real
l_real=sym%invs.or.noco%l_soc
......@@ -521,24 +520,33 @@ CONTAINS
n_end = noccbd
END IF
END IF
zMat%l_real = l_real
IF (l_real) THEN
IF (.NOT.ALLOCATED(z_r)) ALLOCATE (z_r(dimension%nbasfcn,dimension%neigd))
z_r = 0
IF (.NOT.ALLOCATED(zMat%z_r)) THEN
ALLOCATE (zMat%z_r(dimension%nbasfcn,dimension%neigd))
zMat%nbasfcn = dimension%nbasfcn
zMat%nbands = dimension%neigd
END IF
zMat%z_r = 0
CALL cdn_read(&
eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,&
ikpt,jspin,dimension%nbasfcn,noco%l_ss,noco%l_noco,&
noccbd,n_start,n_end,&
lapw%nmat,lapw%nv,ello,evdu,epar,kveclo,&
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,z_r)
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,zMat%z_r)
ELSE
IF (.NOT.ALLOCATED(z_c)) ALLOCATE (z_c(dimension%nbasfcn,dimension%neigd))
z_c = 0
IF (.NOT.ALLOCATED(zMat%z_c)) THEN
ALLOCATE (zMat%z_c(dimension%nbasfcn,dimension%neigd))
zMat%nbasfcn = dimension%nbasfcn
zMat%nbands = dimension%neigd
END IF
zMat%z_c = 0
CALL cdn_read(&
eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,&
ikpt,jspin,dimension%nbasfcn,noco%l_ss,noco%l_noco,&
noccbd,n_start,n_end,&
lapw%nmat,lapw%nv,ello,evdu,epar,kveclo,&
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,z_c)
lapw%k1,lapw%k2,lapw%k3,bkpt,wk,nbands,eig,zMat%z_c)
endif
!IF (l_evp.AND.(isize.GT.1)) THEN
! eig(1:noccbd) = eig(n_start:n_end)
......@@ -576,9 +584,9 @@ CONTAINS
eig(nslibd) = eig(i)
we(nslibd) = we(i)
if (l_real) THEN
z_r(:,nslibd) = z_r(:,i)
zMat%z_r(:,nslibd) = zMat%z_r(:,i)
else
z_c(:,nslibd) = z_c(:,i)
zMat%z_c(:,nslibd) = zMat%z_c(:,i)
endif
END IF
END DO
......@@ -592,9 +600,9 @@ CONTAINS
eig(nslibd) = eig(sliceplot%nnne)
we(nslibd) = we(sliceplot%nnne)
if (l_real) Then
z_r(:,nslibd) = z_r(:,sliceplot%nnne)
zMat%z_r(:,nslibd) = zMat%z_r(:,sliceplot%nnne)
else
z_c(:,nslibd) = z_c(:,sliceplot%nnne)
zMat%z_c(:,nslibd) = zMat%z_c(:,sliceplot%nnne)
endif
ELSE
DO i = 1,nbands
......@@ -603,9 +611,9 @@ CONTAINS
eig(nslibd) = eig(i)
we(nslibd) = we(i)
if (l_real) THEN
z_r(:,nslibd) = z_r(:,i)
zMat%z_r(:,nslibd) = zMat%z_r(:,i)
else
z_c(:,nslibd) = z_c(:,i)
zMat%z_c(:,nslibd) = zMat%z_c(:,i)
endif
END IF
END DO
......@@ -632,17 +640,17 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: pwden")
CALL pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,igq_fft,we, eig,bkpt,qpw,cdom,qis,results%force,f_b8,z_r,z_c,l_real)
jspin,lapw,noccbd,igq_fft,we, eig,bkpt,qpw,cdom,qis,results%force,f_b8,zMat,l_real)
CALL timestop("cdnval: pwden")
END IF
!+new
!---> charge of each valence state in this k-point of the SBZ
!---> in the layer interstitial region of the film
!
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL q_int_sl(jspin,stars,atoms,sym, volsl,volintsl,&
cell,noccbd,lapw, nsl,zsl,nmtsl,oneD, qintsl(:,:),z_r,z_c,l_real)
cell,noccbd,lapw, nsl,zsl,nmtsl,oneD, qintsl(:,:),zMat,l_real)
!
END IF
......@@ -654,7 +662,7 @@ CONTAINS
CALL timestart("cdnval: vacden")
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,&
gvac1d,gvac2d, we,ikpt,jspin,vz,vz0, noccbd,bkpt,lapw, evac,eig,&
rhtxy,rht,qvac,qvlay, qstars,cdomvz,cdomvxy,z_r,z_c,l_real)
rhtxy,rht,qvac,qvlay, qstars,cdomvz,cdomvxy,zMat,l_real)
CALL timestop("cdnval: vacden")
END IF
!---> perform Brillouin zone integration and summation over the
......@@ -693,13 +701,13 @@ CONTAINS
cveccof(3,-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%natd) )
CALL to_pulay(input,atoms,noccbd,sym, lapw, noco,cell,bkpt,noccbd,eig,usdus,&
kveclo,ispin,oneD, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof,z_r,z_c,l_real)
e1cof,e2cof,aveccof,bveccof, ccof(-atoms%llod,1,1,1,ispin),acoflo,bcoflo,cveccof,zMat,l_real)
CALL timestop("cdnval: to_pulay")
ELSE
CALL timestart("cdnval: abcof")
CALL abcof(input,atoms,noccbd,sym, cell, bkpt,lapw,noccbd,usdus, noco,ispin,kveclo,oneD,&
acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),z_r,z_c,l_real)
acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),zMat,l_real)
CALL timestop("cdnval: abcof")
END IF
......@@ -828,7 +836,7 @@ CONTAINS
cartk=matmul(bkpt,cell%bmat)
IF (banddos%ndir.GT.0) THEN
CALL sympsi(bkpt,lapw%nv(jspin),lapw%k1(:,jspin),lapw%k2(:,jspin),&
lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,z_r,z_c,l_real)
lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,zMat,l_real)
END IF
!
!--dw now write k-point data to tmp_dos
......@@ -843,10 +851,10 @@ CONTAINS
!---> end of loop over PE's
IF (l_real) THEN
DEALLOCATE (z_r)
else
DEALLOCATE (z_c)
endif
DEALLOCATE (zMat%z_r)
ELSE
DEALLOCATE (zMat%z_c)
END IF
END IF ! --> end "IF ((mod(i_rec-1,mpi%isize).EQ.mpi%irank).OR.l_evp) THEN"
END DO !---> end of k-point loop
DEALLOCATE (we,f,g,usdus%us,usdus%dus,usdus%duds,usdus%uds,usdus%ddn)
......
cdn/pwden.F90
View file @ e5456adc
......@@ -7,7 +7,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, &
ikpt,jspin,lapw,ne, igq_fft,we,eig,bkpt, qpw,cdom, qis,forces,f_b8,z_r,z_c,realdata)
ikpt,jspin,lapw,ne, igq_fft,we,eig,bkpt, qpw,cdom, qis,forces,f_b8,zMat,realdata)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
......@@ -78,7 +78,7 @@ CONTAINS
USE m_cfft
USE m_types
IMPLICIT NONE
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
......@@ -89,14 +89,14 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1d*stars%kq2d*stars%kq3d-1)
REAL,INTENT(IN) :: we(:) !(nobd)
REAL,INTENT(IN) :: eig(:)!(dimension%neigd)
REAL,INTENT(IN) :: bkpt(3)
!-----> BASIS FUNCTION INFORMATION
INTEGER,INTENT(IN):: ne
COMPLEX,OPTIONAL, INTENT (IN) :: z_c(:,:) !(dimension%nbasfcn,dimension%neigd)
REAL, OPTIONAL, INTENT (IN) :: z_r(:,:) !(dimension%nbasfcn,dimension%neigd)
LOGICAL,OPTIONAL,INTENT(IN)::realdata
!-----> CHARGE DENSITY INFORMATION
INTEGER,INTENT(IN) :: ikpt,jspin
......@@ -138,7 +138,7 @@ CONTAINS
IF (PRESENT(realdata)) THEN
l_real=realdata
ELSE
l_real=PRESENT(z_r)
l_real=zMat%l_real
ENDIF
!-------> ABBREVIATIONS
......@@ -234,8 +234,8 @@ CONTAINS
q0_22 = zero
IF (.NOT.l_real ) THEN
DO nu = 1 , ne
q0_11 = q0_11 + we(nu) * CPP_BLAS_cdotc(lapw%nv(1),z_c(1,nu),1,z_c(1,nu),1)
q0_22 = q0_22 + we(nu) * CPP_BLAS_cdotc(lapw%nv(2),z_c(lapw%nv(1)+atoms%nlotot+1,nu),1, z_c(lapw%nv(1)+atoms%nlotot+1,nu),1)
q0_11 = q0_11 + we(nu) * CPP_BLAS_cdotc(lapw%nv(1),zMat%z_c(1,nu),1,zMat%z_c(1,nu),1)
q0_22 = q0_22 + we(nu) * CPP_BLAS_cdotc(lapw%nv(2),zMat%z_c(lapw%nv(1)+atoms%nlotot+1,nu),1, zMat%z_c(lapw%nv(1)+atoms%nlotot+1,nu),1)
ENDDO
ENDIF
q0_11 = q0_11/cell%omtil
......@@ -243,11 +243,11 @@ CONTAINS
ELSE
IF (l_real) THEN
DO nu = 1 , ne
q0=q0+we(nu)*CPP_BLAS_sdot(lapw%nv(jspin),z_r(1,nu),1,z_r(1,nu),1)
q0=q0+we(nu)*CPP_BLAS_sdot(lapw%nv(jspin),zMat%z_r(1,nu),1,zMat%z_r(1,nu),1)
ENDDO
ELSE
DO nu = 1 , ne
q0=q0+we(nu) *REAL(CPP_BLAS_cdotc(lapw%nv(jspin),z_c(1,nu),1,z_c(1,nu),1))
q0=q0+we(nu) *REAL(CPP_BLAS_cdotc(lapw%nv(jspin),zMat%z_c(1,nu),1,zMat%z_c(1,nu),1))
ENDDO
ENDIF
q0 = q0/cell%omtil
......@@ -317,19 +317,19 @@ CONTAINS
!------> map WF into FFTbox
IF (noco%l_ss) THEN
DO iv = 1 , lapw%nv(1)
psi1r( iv1d(iv,1) ) = REAL( z_c(iv,nu) )
psi1i( iv1d(iv,1) ) = AIMAG( z_c(iv,nu) )
psi1r( iv1d(iv,1) ) = REAL( zMat%z_c(iv,nu) )
psi1i( iv1d(iv,1) ) = AIMAG( zMat%z_c(iv,nu) )
ENDDO
DO iv = 1 , lapw%nv(2)
psi2r( iv1d(iv,2) ) = REAL(z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i( iv1d(iv,2) ) = AIMAG(z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2r( iv1d(iv,2) ) = REAL(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i( iv1d(iv,2) ) = AIMAG(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
ENDDO
ELSE
DO iv = 1 , lapw%nv(jspin)
psi1r( iv1d(iv,jspin) ) = REAL( z_c(iv,nu) )
psi1i( iv1d(iv,jspin) ) = AIMAG( z_c(iv,nu) )
psi2r(iv1d(iv,jspin))=REAL( z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i(iv1d(iv,jspin))=AIMAG(z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi1r( iv1d(iv,jspin) ) = REAL( zMat%z_c(iv,nu) )
psi1i( iv1d(iv,jspin) ) = AIMAG( zMat%z_c(iv,nu) )
psi2r(iv1d(iv,jspin))=REAL( zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
psi2i(iv1d(iv,jspin))=AIMAG(zMat%z_c(lapw%nv(1)+atoms%nlotot+iv,nu))
ENDDO
ENDIF
......@@ -339,12 +339,12 @@ CONTAINS
!------> map WF into FFTbox
IF (l_real) THEN
DO iv = 1 , lapw%nv(jspin)
psir( iv1d(iv,jspin) ) = z_r(iv,nu)
psir( iv1d(iv,jspin) ) = zMat%z_r(iv,nu)
ENDDO
ELSE
DO iv = 1 , lapw%nv(jspin)
psir( iv1d(iv,jspin) ) = REAL(z_c(iv,nu))
psii( iv1d(iv,jspin) ) = AIMAG(z_c(iv,nu))
psir( iv1d(iv,jspin) ) = REAL(zMat%z_c(iv,nu))
psii( iv1d(iv,jspin) ) = AIMAG(zMat%z_c(iv,nu))
ENDDO
ENDIF
ENDIF
......@@ -388,7 +388,7 @@ CONTAINS
DO i = 1,3
s = s + xk(i)*cell%bmat(i,j)
ENDDO
kpsir( iv1d(iv,jspin) ) = s * z_r(iv,nu)
kpsir( iv1d(iv,jspin) ) = s * zMat%z_r(iv,nu)
ENDDO
CALL rfft(isn,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft+1,stars%kq1_fft,stars%kq2_fft,stars%kq3_fft,&
nw1,nw2,nw3,wsave,kpsir(ifftq3d), kpsir(-ifftq2))
......@@ -421,8 +421,8 @@ CONTAINS
DO i = 1,3
s = s + xk(i)*cell%bmat(i,j)
ENDDO
kpsir( iv1d(iv,jspin) ) = s * REAL(z_c(iv,nu))
kpsii( iv1d(iv,jspin) ) = s * AIMAG(z_c(iv,nu))
kpsir( iv1d(iv,jspin) ) = s * REAL(zMat%z_c(iv,nu))
kpsii( iv1d(iv,jspin) ) = s * AIMAG(zMat%z_c(iv,nu))
ENDDO
CALL cfft(kpsir,kpsii,ifftq3,stars%kq1_fft,ifftq1,isn)
......@@ -620,12 +620,12 @@ CONTAINS
IF ( ABS( q0 - REAL(cwk(1)) )/q0 .GT. tol_3 ) THEN
WRITE(99,*) "XX:",ne,lapw%nv
IF (l_real) THEN
DO istr=1,SIZE(z_r,2)
WRITE(99,*) "X:",istr,z_r(:,istr)
DO istr=1,SIZE(zMat%z_r,2)
WRITE(99,*) "X:",istr,zMat%z_r(:,istr)
ENDDO
ELSE
DO istr=1,SIZE(z_c,2)
WRITE(99,*) "X:",istr,z_c(:,istr)
DO istr=1,SIZE(zMat%z_c,2)
WRITE(99,*) "X:",istr,zMat%z_c(:,istr)
ENDDO
ENDIF
WRITE ( 6,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
......
cdn/q_int_sl.F90
View file @ e5456adc
......@@ -2,7 +2,7 @@ MODULE m_qintsl
USE m_juDFT
CONTAINS
SUBROUTINE q_int_sl(isp,stars,atoms,sym, volsl,volintsl, cell,&
ne,lapw, nsl,zsl,nmtsl,oneD, qintslk,z_r,z_c,realdata)
ne,lapw, nsl,zsl,nmtsl,oneD, qintslk,zMat,realdata)
! *******************************************************
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
......@@ -20,6 +20,7 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
!
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne,isp ,nsl
......@@ -29,8 +30,6 @@ CONTAINS
REAL, INTENT (IN) :: volintsl(atoms%natd)
REAL, INTENT (IN) :: zsl(2,atoms%natd) ,volsl(atoms%natd)
REAL, INTENT (OUT):: qintslk(:,:)!(nsl,dimension%neigd)
REAL, OPTIONAL, INTENT (IN) :: z_r(:,:)!(dimension%nbasfcn,dimension%neigd)
COMPLEX,OPTIONAL, INTENT (IN) :: z_c(:,:)
LOGICAL,OPTIONAL, INTENT (IN) :: realdata
! ..
! .. Local Scalars ..
......@@ -45,7 +44,7 @@ CONTAINS
IF (PRESENT(realdata)) THEN
l_real=realdata
ELSE
l_real=PRESENT(z_r)
l_real=zMat%l_real
ENDIF
! ..
IF (oneD%odi%d1) CALL juDFT_error("well, does not work with 1D. Not clear how to define a layer.",calledby ="q_int_sl")
......@@ -79,11 +78,11 @@ CONTAINS
q1 = 0.0
IF (l_real) THEN
DO i = 1,lapw%nv(isp)
q1 = q1 + z_r(i,n)*z_r(i,n)
q1 = q1 + zMat%z_r(i,n)*zMat%z_r(i,n)
ENDDO
ELSE
DO i = 1,lapw%nv(isp)
q1 = q1 + REAL(z_c(i,n)*CONJG(z_c(i,n)))
q1 = q1 + REAL(zMat%z_c(i,n)*CONJG(zMat%z_c(i,n)))
ENDDO
ENDIF
z_z(1) = q1/cell%omtil
......@@ -104,11 +103,11 @@ CONTAINS
phase = stars%rgphs(ix1,iy1,iz1)/ (stars%nstr(ind)*cell%omtil)
phasep = stars%rgphs(-ix1,-iy1,-iz1)/ (stars%nstr(indp)*cell%omtil)
IF (l_real) THEN
z_z(ind) = z_z(ind) + z_r(j,n)*z_r(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + z_r(i,n)*z_r(j,n)*REAL(phasep)
z_z(ind) = z_z(ind) + zMat%z_r(j,n)*zMat%z_r(i,n)*REAL(phase)
z_z(indp) = z_z(indp) + zMat%z_r(i,n)*zMat%z_r(j,n)*REAL(phasep)
ELSE
z_z(ind) = z_z(ind) +z_c(j,n)*CONJG(z_c(i,n))*phase
z_z(indp)= z_z(indp)+z_c(i,n)*CONJG(z_c(j,n))*phasep
z_z(ind) = z_z(ind) +zMat%z_c(j,n)*CONJG(zMat%z_c(i,n))*phase
z_z(indp)= z_z(indp)+zMat%z_c(i,n)*CONJG(zMat%z_c(j,n))*phasep
ENDIF
ENDDO
ENDDO
......
cdn/vacden.F90
View file @ e5456adc
......@@ -12,7 +12,7 @@ CONTAINS
we,ikpt,jspin,vz,vz0,&
ne,bkpt,lapw,&
evac,eig,rhtxy,rht,qvac,qvlay,&
stcoeff,cdomvz,cdomvxy,z_r,z_c,realdata)
stcoeff,cdomvz,cdomvxy,zMat,realdata)
!***********************************************************************
! ****** change vacden(....,q) for vacuum density of states shz Jan.96
......@@ -64,6 +64,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: jspin
INTEGER, INTENT (IN) :: ne
......@@ -73,8 +74,6 @@ CONTAINS
! .. Array Arguments ..
REAL, INTENT (IN) :: bkpt(3)
REAL, INTENT (IN) :: evac(2,DIMENSION%jspd)
COMPLEX,OPTIONAL, INTENT (IN):: z_c(DIMENSION%nbasfcn,DIMENSION%neigd)
REAL, OPTIONAL, INTENT (IN):: z_r(DIMENSION%nbasfcn,DIMENSION%neigd)
COMPLEX, INTENT (INOUT):: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,DIMENSION%jspd)
REAL, INTENT (INOUT):: rht(vacuum%nmzd,2,DIMENSION%jspd)
REAL, INTENT (OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkptd,DIMENSION%jspd)
......@@ -127,7 +126,7 @@ CONTAINS
IF (PRESENT(realdata)) THEN
l_real=realdata
ELSE
l_real=PRESENT(z_r)
l_real=zMat%l_real
ENDIF
! ..
......@@ -339,11 +338,11 @@ CONTAINS
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil))
IF (l_real) THEN
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) +z_r(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) +z_r(kspin,:ne)*bv_1
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%z_r(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%z_r(kspin,:ne)*bv_1
ELSE
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) +z_c(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) +z_c(kspin,:ne)*bv_1
ac_1(l,m,:ne,ispin) = ac_1(l,m,:ne,ispin) + zMat%z_c(kspin,:ne)*av_1
bc_1(l,m,:ne,ispin) = bc_1(l,m,:ne,ispin) + zMat%z_c(kspin,:ne)*bv_1
END IF
END DO ! -mb:mb
END IF
......@@ -382,11 +381,11 @@ CONTAINS
bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions
IF (l_real) THEN
ac(l,:ne,ispin) = ac(l,:ne,ispin) + z_r(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + z_r(kspin,:ne)*bv
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%z_r(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%z_r(kspin,:ne)*bv
ELSE
ac(l,:ne,ispin) = ac(l,:ne,ispin) + z_c(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + z_c(kspin,:ne)*bv
ac(l,:ne,ispin) = ac(l,:ne,ispin) + zMat%z_c(kspin,:ne)*av
bc(l,:ne,ispin) = bc(l,:ne,ispin) + zMat%z_c(kspin,:ne)*bv
ENDIF
ENDDO
!---> end of spin loop
......@@ -439,11 +438,11 @@ CONTAINS
t_1(l,m)*stars%sk2(irec2)*dbss(m),0.0)/&
((wronk_1)*SQRT(cell%omtil))
IF (l_real) THEN
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) +z_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) +z_r(k,:ne)*bv_1
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%z_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%z_r(k,:ne)*bv_1
ELSE
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) +z_r(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) +z_r(k,:ne)*bv_1
ac_1(l,m,:ne,jspin) = ac_1(l,m,:ne,jspin) + zMat%z_c(k,:ne)*av_1
bc_1(l,m,:ne,jspin) = bc_1(l,m,:ne,jspin) + zMat%z_c(k,:ne)*bv_1
ENDIF
END DO ! -mb:mb
END IF
......@@ -477,11 +476,11 @@ CONTAINS
bv = c_1 * CMPLX( dt(l),zks* t(l) )
! -----> loop over basis functions
IF (l_real) THEN
ac(l,:ne,jspin) = ac(l,:ne,jspin) + z_r(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + z_r(k,:ne)*bv
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%z_r(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%z_r(k,:ne)*bv
ELSE
ac(l,:ne,jspin) = ac(l,:ne,jspin) + z_c(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + z_c(k,:ne)*bv
ac(l,:ne,jspin) = ac(l,:ne,jspin) + zMat%z_c(k,:ne)*av
bc(l,:ne,jspin) = bc(l,:ne,jspin) + zMat%z_c(k,:ne)*bv
ENDIF
ENDDO
END IF ! D1
......
cdn_mt/abclocdn.F90
View file @ e5456adc
......@@ -21,13 +21,14 @@ MODULE m_abclocdn
!*********************************************************************
CONTAINS
SUBROUTINE abclocdn(atoms, sym, noco,ccchi,kspin,iintsp,con1,phase,ylm,&
ntyp,na,k,s,nv,ne,nbasf0,alo1,blo1,clo1,kvec,nkvec,enough,acof,bcof,ccof,z_r,z_c)
ntyp,na,k,s,nv,ne,nbasf0,alo1,blo1,clo1,kvec,nkvec,enough,acof,bcof,ccof,zMat)
!
USE m_types
IMPLICIT NONE
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: kspin,iintsp
......@@ -47,8 +48,6 @@ CONTAINS
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%natd)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%natd)
INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%natd)
COMPLEX,OPTIONAL, INTENT (IN) :: z_c(:,:)!(dimension%nbasfcn,dimension%neigd)
REAL,OPTIONAL, INTENT (IN) :: z_r(:,:)!(dimension%nbasfcn,dimension%neigd)
! ..
! .. Local Scalars ..
COMPLEX ctmp,term1
......@@ -59,7 +58,7 @@ CONTAINS
COMPLEX clotmp(-atoms%llod:atoms%llod)
! ..
LOGICAL :: l_real
l_real=PRESENT(z_r)
l_real=zMat%l_real
! ..
enough(na) = .TRUE.
term1 = con1 * ((atoms%rmt(ntyp)**2)/2) * phase
......@@ -89,15 +88,15 @@ CONTAINS
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)*ccchi(iintsp)*z_c(kspin+nbasf,i)
ctmp = clotmp(m)*ccchi(iintsp)*zMat%z_c(kspin+nbasf,i)
ELSE
ctmp = clotmp(m)*( ccchi(1)*z_c(nbasf,i)+ccchi(2)*z_c(kspin+nbasf,i) )
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,i)+ccchi(2)*zMat%z_c(kspin+nbasf,i) )
ENDIF
ELSE
IF (l_real) THEN
ctmp = z_r(nbasf,i)*clotmp(m)
ctmp = zMat%z_r(nbasf,i)*clotmp(m)
ELSE
ctmp = z_c(nbasf,i)*clotmp(m)
ctmp = zMat%z_c(nbasf,i)*clotmp(m)
ENDIF
ENDIF
acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo,ntyp)
......@@ -136,22 +135,22 @@ CONTAINS
!+gu_con
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)*ccchi(iintsp)*z_c(kspin+nbasf,i)
ctmp = clotmp(m)*ccchi(iintsp)*zMat%z_c(kspin+nbasf,i)
ELSE
ctmp = clotmp(m)*( ccchi(1)*z_c(nbasf,i)+ ccchi(2)*z_c(kspin+nbasf,i) )
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,i)+ ccchi(2)*zMat%z_c(kspin+nbasf,i) )
ENDIF
ELSE
IF (l_real) THEN
ctmp = z_r(nbasf,i)*clotmp(m)
ctmp = zMat%z_r(nbasf,i)*clotmp(m)
ELSE
ctmp = z_c(nbasf,i)*clotmp(m)
ctmp = zMat%z_c(nbasf,i)*clotmp(m)
ENDIF
ENDIF
acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo,ntyp)
bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo,ntyp)
ccof(m,i,lo,na) = ccof(m,i,lo,na) +ctmp*clo1(lo,ntyp)
IF (noco%l_soc.AND.sym%invs) THEN
ctmp = z_c(nbasf,i)*CONJG(clotmp(m))*(-1)**(l-m)
ctmp = zMat%z_c(nbasf,i)*CONJG(clotmp(m))*(-1)**(l-m)
na2 = sym%invsatnr(na)
lmp = ll1 - m
acof(i,lmp,na2) = acof(i,lmp,na2) +ctmp*alo1(lo,ntyp)
......
cdn_mt/abclocdn_pulay.F90
View file @ e5456adc
......@@ -13,7 +13,7 @@ CONTAINS
& con1,phase,ylm,ntyp,na,k,fgp,&
& s,nv,ne,nbasf0,alo1,blo1,clo1,&
& kvec,nkvec,enough,acof,bcof,ccof,&
& acoflo,bcoflo,aveccof,bveccof,cveccof,z_r,z_c,realdata)
& acoflo,bcoflo,aveccof,bveccof,cveccof,zMat,realdata)
!
!*********************************************************************
! for details see abclocdn; calles by to_pulay
......@@ -24,6 +24,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: iintsp
......@@ -48,8 +49,6 @@ CONTAINS
COMPLEX, INTENT (INOUT) :: cveccof(:,-atoms%llod:,:,:,:)!(3,-atoms%llod:llod,nobd,atoms%nlod,atoms%natd)
LOGICAL, INTENT (OUT) :: enough(atoms%natd)
INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%natd)
REAL, OPTIONAL,INTENT (IN) :: z_r(:,:)!(dimension%nbasfcn,dimension%neigd)
COMPLEX, OPTIONAL,INTENT (IN) :: z_c(:,:)!(dimension%nbasfcn,dimension%neigd)
LOGICAL,OPTIONAL,INTENT(IN) ::realdata
! ..
! .. Local Scalars ..
......@@ -62,7 +61,7 @@ CONTAINS
COMPLEX clotmp(-atoms%llod:atoms%llod)
! ..
LOGICAL:: l_real
l_real=PRESENT(z_r)
l_real=zMat%l_real
IF (PRESENT(realdata)) l_real=realdata
enough(na) = .TRUE.
term1 = con1* ((atoms%rmt(ntyp)**2)/2)*phase
......@@ -92,15 +91,15 @@ CONTAINS
lm = ll1 + m
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
ctmp = clotmp(m)* ccchi(iintsp)*z_c(kspin+nbasf,ie)
ctmp = clotmp(m)* ccchi(iintsp)*zMat%z_c(kspin+nbasf,ie)
ELSE
ctmp = clotmp(m)*( ccchi(1)*z_c(nbasf,ie)+ccchi(2)*z_c(kspin+nbasf,ie) )
ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,ie)+ccchi(2)*zMat%z_c(kspin+nbasf,ie) )
ENDIF
ELSE
IF (l_real) THEN
ctmp = z_r(nbasf,ie)*clotmp(m)
ctmp = zMat%z_r(nbasf,ie)*clotmp(m)
ELSE
ctmp = z_c(nbasf,ie)*clotmp(m)
ctmp = zMat%z_c(nbasf,ie)*clotmp(m)