Commit c07789ce authored by Gregor Michalicek's avatar Gregor Michalicek

First adaptions to the Wannier code as provided by JPH

parent d380b0c8
......@@ -14,10 +14,11 @@ c********************************************************
SUBROUTINE wann_2dvacabcof(
>nv2d,nslibd,nvac,nmzd,nmz,omtil,vz,nv,bkpt,z1,
>nvd,k1,k2,k3,evac,bbmat,delz,bmat,nbasfcn,neigd,z,
<ac,bc,u,ue)
<ac,bc,u,ue,addnoco,l_ss,qss,jspin)
implicit none
integer,intent(in)::nv2d
logical,intent(in)::l_ss
integer,intent(in)::nv2d,jspin,addnoco
integer,intent(in)::nslibd
integer,intent(in)::nvac
integer,intent(in)::nmzd
......@@ -28,14 +29,14 @@ c********************************************************
real,intent(in)::evac(2)
real,intent(in)::bbmat(3,3)
real,intent(in)::delz
real,intent(in)::bmat(3,3)
real,intent(in)::bmat(3,3)
real,intent(in)::z1
integer,intent(in)::nv
integer,intent(in)::nvd
integer,intent(in)::k1(nvd)
integer,intent(in)::k2(nvd)
integer,intent(in)::k3(nvd)
real,intent(in)::bkpt(3)
real,intent(in)::bkpt(3),qss(3)
complex,intent(out)::ac(nv2d,nslibd,2)
complex,intent(out)::bc(nv2d,nslibd,2)
real,intent(out)::u(nmzd,nv2d,nvac)
......@@ -52,6 +53,7 @@ c********************************************************
integer ivac,n2,k,nv2,ik,jvac,symvac,symvacvac,n,l
real vz0(2),evacp,sign,v(3),ev,scale,zks,arg
integer kvac1(nv2d),kvac2(nv2d),map2(nvd),i,j
real :: qss1,qss2
wronk = 2.0
const = 1.0 / ( sqrt(omtil)*wronk )
......@@ -80,12 +82,23 @@ c********************************************************
map2(k) = n2
40 continue
nv2=n2
qss1=0.0
qss2=0.0
if(l_ss.and.jspin.eq.1)then
qss1=-qss(1)/2.0
qss2=-qss(2)/2.0
elseif(l_ss.and.jspin.eq.2)then
qss1=qss(1)/2.0
qss2=qss(2)/2.0
endif
do ivac=1,nvac
evacp=evac(ivac)
sign=3-2*ivac
do ik = 1,nv2
v(1) = bkpt(1) + kvac1(ik)
v(2) = bkpt(2) + kvac2(ik)
v(1) = bkpt(1) + kvac1(ik)+qss1
v(2) = bkpt(2) + kvac2(ik)+qss2
v(3) = 0.
ev = evacp - 0.5*dot_product(matmul(v,bbmat),v)
call vacuz(ev,vz(1,ivac),vz0(ivac),nmz,delz,t(ik),
......@@ -139,8 +152,8 @@ c enddo
bv = c_1 * cmplx( dt(l),zks* t(l) )
c-----> loop over basis functions
do n = 1,nslibd
ac(l,n,jvac) = ac(l,n,jvac) + z(k,n)*av
bc(l,n,jvac) = bc(l,n,jvac) + z(k,n)*bv
ac(l,n,jvac) = ac(l,n,jvac) + z(k+addnoco,n)*av
bc(l,n,jvac) = bc(l,n,jvac) + z(k+addnoco,n)*bv
enddo
enddo
......
......@@ -8,7 +8,7 @@
use m_juDFT
contains
subroutine wann_amn(
> nslibd,nwfsd,ntypd,nlod,llod,llo,nlo,
> chi,nslibd,nwfsd,ntypd,nlod,llod,llo,nlo,
> lmaxd,jmtd,lmd,neq,natd,ikpt,nbnd,
> rmsh,rmt,jri,dx,lmax,
> us,dus,uds,duds,flo,
......@@ -82,6 +82,7 @@ c*********************************************************************
logical, intent (inout) :: l_amn2_in
complex, intent (inout) :: amn(nbnd,nwfsd)
real,intent(in),optional:: bkpt(3)
complex, intent (in) :: chi
c...local
integer :: nwf,nwfs,nat,j,ntyp,ne,l,m,lm,iatom,i,mp,lo
integer :: ind(nwfsd),ntp(natd),banddummy
......@@ -273,6 +274,8 @@ c...sum by wfs, each of them is localized at a certain mt
else
factor=1.0
endif
factor = factor*chi
nat = ind(nwf)
ntyp = ntp(nat)
c...sum by bands
......@@ -302,7 +305,7 @@ c..constructing the radial part, therefore, we do it anyway
lm = l*(l+1) + m
amn(ne,nwf) = amn(ne,nwf) +
+ tlmwft(l,m,nwf)*conjg(( acof(ne,lm,nat)*vl +
+ bcof(ne,lm,nat)*vld )*(ci)**l)*factor
+ bcof(ne,lm,nat)*vld )*(ci)**l)*factor
enddo
enddo
......
......@@ -13,17 +13,18 @@ c Frank Freimuth
c***********************************************************************
CONTAINS
SUBROUTINE wann_anglmom(
> llod,noccbd,nlod,natd,ntypd,lmaxd,lmd,
> llod,noccbd,nlod,natd,ntypd,lmax,lmd,
> ntype,neq,nlo,llo,acof,bcof,ccof,
> ddn,uulon,dulon,uloulopn,
= mmn)
implicit none
c .. scalar arguments ..
integer, intent (in) :: llod,nlod,natd,ntypd,lmaxd,lmd
integer, intent (in) :: llod,nlod,natd,ntypd,lmd
integer, intent (in) :: ntype,noccbd
c .. array arguments ..
integer, intent (in) :: neq(:)!neq(ntypd)
integer, intent (in) :: nlo(:)!nlo(ntypd)
integer, intent (in) :: lmax(:)!lmax(ntypd)
integer, intent (in) :: llo(:,:)!llo(nlod,ntypd)
real, intent (in) :: ddn(0:,:)!ddn(0:lmaxd,ntypd)
real, intent (in) :: uloulopn(:,:,:)!uloulopn(nlod,nlod,ntypd)
......@@ -34,8 +35,9 @@ c .. array arguments ..
complex, intent (in) :: bcof(:,0:,:)!bcof(noccbd,0:lmd,natd)
complex, intent (inout) :: mmn(:,:,:)!mmn(3,noccbd,noccbd)
c .. local scalars ..
logical :: l_select
integer :: i,j,l,lo,lop,m,natom,nn,ntyp
integer :: nt1,nt2,lm,n,ll1
integer :: nt1,nt2,lm,n,ll1,indat
complex :: suma_z,sumb_z
complex :: suma_p,sumb_p
complex :: suma_m,sumb_m
......@@ -66,16 +68,28 @@ C .. intrinsic functions ..
+ qaclo_m(noccbd,noccbd,nlod,ntypd),
+ qbclo_m(noccbd,noccbd,nlod,ntypd) )
inquire(file='select_anglmom',exist=l_select)
write(*,*)'select_anglmom: ',l_select
if(l_select) then
open(866,file='select_anglmom')
read(866,*)indat
close(866)
write(*,*)'anglmom for atom=',indat
write(*,*)ntype
write(*,*)neq(indat)
endif
c-----> lapw-lapw-Terms
do i = 1,noccbd
do j = 1,noccbd
nt1 = 1
do n = 1,ntype
nt2 = nt1 + neq(n) - 1
do l = 0,lmaxd
do l = 0,lmax(n)
suma_z = cmplx(0.,0.); sumb_z = cmplx(0.,0.)
suma_m = cmplx(0.,0.); sumb_m = cmplx(0.,0.)
suma_p = cmplx(0.,0.); sumb_p = cmplx(0.,0.)
if(l_select .and. (n.ne.indat)) cycle
ll1 = l* (l+1)
do m = -l,l
lm = ll1 + m
......@@ -125,6 +139,7 @@ c---> Terms involving local orbitals.
do ntyp = 1,ntype
do nn = 1,neq(ntyp)
natom = natom + 1
if(l_select .and. (ntyp.ne.indat)) cycle
do lo = 1,nlo(ntyp)
l = llo(lo,ntyp)
ll1 = l* (l+1)
......@@ -197,6 +212,7 @@ c---> Terms involving local orbitals.
c---> perform summation of the coefficients with the integrals
c---> of the radial basis functions
do ntyp = 1,ntype
if(l_select .and. (ntyp.ne.indat) ) cycle
do lo = 1,nlo(ntyp)
l = llo(lo,ntyp)
do j = 1,noccbd
......
This diff is collapsed.
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