Skip to content

fleur
fleur
Commit 33d257d4 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

Merge branch 'wannier_patrick' into develop

parents 03b7c479 d14979f7
Hide whitespace changes
Inline Side-by-side
Showing with 261 additions and 42 deletions
main/fleur.F90
View file @ 33d257d4
......@@ -564,7 +564,7 @@ CONTAINS
IF ((input%l_wann).AND.(.NOT.wann%l_bs_comf)) THEN
CALL wannier(DIMENSION,mpi,input,sym,atoms,stars,vacuum,sphhar,oneD,&
wann,noco,cell,enpara,banddos,sliceplot,vTot,results,&
eig_idList,(sym%invs).AND.(.NOT.noco%l_noco),kpts%nkpt)
eig_idList,(sym%invs).AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco),kpts%nkpt)
END IF
IF (wann%l_gwf) CALL juDFT_error("provide wann_inp if l_gwf=T", calledby = "fleur")
!-Wannier
......
wannier/CMakeLists.txt
View file @ 33d257d4
......@@ -67,6 +67,7 @@ wannier/wann_postproc.F
wannier/wann_postproc_setup4.F
wannier/wann_postproc_setup5.F
wannier/wann_postproc_setup.F
wannier/wann_postproc_setup2.F
wannier/wann_projgen.F
wannier/wann_projmethod.F
wannier/wann_radovlp_integrals.F
......
wannier/wann_mmk0_sph.f
View file @ 33d257d4
......@@ -14,7 +14,7 @@ c Y.Mokrousov 15.6.06
c***********************************************************************
CONTAINS
SUBROUTINE wann_mmk0_sph(
> llod,noccbd,nlod,natd,ntypd,lmaxd,lmd,
> llod,noccbd,nlod,natd,ntypd,lmaxd,lmax,lmd,
> ntype,neq,nlo,llo,acof,bcof,ccof,
> ddn,uulon,dulon,uloulopn,
= mmn)
......@@ -23,6 +23,7 @@ c .. scalar arguments ..
integer, intent (in) :: llod,nlod,natd,ntypd,lmaxd,lmd
integer, intent (in) :: ntype,noccbd
c .. array arguments ..
integer, intent (in) :: lmax(:) !(ntypd)
integer, intent (in) :: neq(ntypd)
integer, intent (in) :: nlo(ntypd),llo(nlod,ntypd)
real, intent (in) :: ddn(0:lmaxd,ntypd)
......@@ -52,7 +53,7 @@ c---> performs summations of the overlaps of the wavefunctions
nt1 = 1
do 130 n = 1,ntype
nt2 = nt1 + neq(n) - 1
do 120 l = 0,lmaxd
do 120 l = 0,lmax(n)
suma = cmplx(0.,0.)
sumb = cmplx(0.,0.)
ll1 = l* (l+1)
......
wannier/wann_mmk0_updown_sph.f
View file @ 33d257d4
......@@ -53,14 +53,18 @@ c************************************************************
complex :: suma,sumb,sumc,sumd
complex :: suma12(2,2),sumb12(2,2)
complex :: sumc12(2,2),sumd12(2,2)
real, allocatable :: qlo(:,:,:,:,:)
real, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
complex, allocatable :: qlo(:,:,:,:,:)
complex, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
complex, allocatable :: qcloa(:,:,:,:),qclob(:,:,:,:)
COMPLEX :: ccchi(2,2),ci
ci = cmplx(0.0,1.0)
allocate (qlo(noccbd,noccbd,nlod,nlod,ntypd),
+ qaclo(noccbd,noccbd,nlod,ntypd),
+ qbclo(noccbd,noccbd,nlod,ntypd) )
+ qbclo(noccbd,noccbd,nlod,ntypd),
+ qcloa(noccbd,noccbd,nlod,ntypd),
+ qclob(noccbd,noccbd,nlod,ntypd))
c---> performs summations of the overlaps of the wavefunctions
do i = 1,noccbd
do j = 1,noccbd
......@@ -152,6 +156,9 @@ c---> initialize qlo arrays
qlo(:,:,:,:,:) = 0.0
qaclo(:,:,:,:) = 0.0
qbclo(:,:,:,:) = 0.0
qcloa(:,:,:,:) = 0.0
qclob(:,:,:,:) = 0.0
c---> prepare the coefficients
natom = 0
do ntyp = 1,ntype
......@@ -162,14 +169,21 @@ c---> prepare the coefficients
ll1 = l* (l+1)
do m = -l,l
lm = ll1 + m
do i = 1,noccbd
do j = 1,noccbd
qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) + real(
+ bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) +
+ ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2)) )
qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) + real(
+ acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) +
+ ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2)) )
do j = 1,noccbd
do i = 1,noccbd
qbclo(i,j,lo,ntyp) = qbclo(i,j,lo,ntyp) +
+ bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))
c + +ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2))
qaclo(i,j,lo,ntyp) = qaclo(i,j,lo,ntyp) +
+ acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))
c + +ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2))
qclob(i,j,lo,ntyp) = qclob(i,j,lo,ntyp)
c + bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))
+ +ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2))
qcloa(i,j,lo,ntyp) = qcloa(i,j,lo,ntyp)
c + acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2))+
+ +ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2))
enddo
enddo
enddo
......@@ -178,9 +192,9 @@ c---> prepare the coefficients
do m = -l,l
do i = 1,noccbd
do j = 1,noccbd
qlo(i,j,lop,lo,ntyp) = qlo(i,j,lop,lo,ntyp) +
+ real(conjg(ccof(m,j,lop,natom,2))
* *ccof(m,i,lo,natom,1))
qlo(i,j,lo,lop,ntyp) = qlo(i,j,lo,lop,ntyp) +
+ conjg(ccof(m,j,lop,natom,2))
* *ccof(m,i,lo,natom,1)
enddo
enddo
enddo
......@@ -193,28 +207,33 @@ c---> perform summation of the coefficients with the integrals
c---> of the radial basis functions
do ntyp = 1,ntype
do lo = 1,nlo(ntyp)
stop 'not yet finished'
l = llo(lo,ntyp)
do i = 1,noccbd
do j = 1,noccbd
do j = 1,noccbd
do i = 1,noccbd
mmn(i,j)= mmn(i,j) +
+ ( qaclo(i,j,lo,ntyp)*uulon(lo,ntyp,2) +
+ qbclo(i,j,lo,ntyp)*dulon(lo,ntyp,2) )
+ qaclo(i,j,lo,ntyp)*radial1_flo(1,2,l,lo,ntyp)
+ +
+ qbclo(i,j,lo,ntyp)*radial1_glo(1,2,l,lo,ntyp)
+ +
+ qcloa(i,j,lo,ntyp)*radial1_lof(1,2,lo,l,ntyp)
+ +
+ qclob(i,j,lo,ntyp)*radial1_log(1,2,lo,l,ntyp)
enddo
enddo
do lop = 1,nlo(ntyp)
if (llo(lop,ntyp).eq.l) then
do i = 1,noccbd
do j = 1,noccbd
do j = 1,noccbd
do i = 1,noccbd
mmn(i,j) = mmn(i,j) +
+ qlo(i,j,lop,lo,ntyp)*uloulopn(lop,lo,ntyp,2)
+ qlo(i,j,lop,lo,ntyp)*radial1_lolo(1,2,lop,lo,ntyp)
enddo
enddo
endif
enddo
enddo
enddo
deallocate ( qlo,qaclo,qbclo )
deallocate ( qlo,qaclo,qbclo,qcloa,qclob )
END SUBROUTINE wann_mmk0_updown_sph
END MODULE m_wann_mmk0_updown_sph
wannier/wann_optional.f
View file @ 33d257d4
......@@ -84,7 +84,8 @@ c-----generate WF1.win and bkpts
> atoms%nat,atoms%taual,atoms%zatom,atoms%ntype,
> atoms%ntype,atoms%neq,wann%l_bzsym,input%film,
> oneD%odi%d1,wann%l_ms,wann%l_sgwf,wann%l_socgwf,
> wann%aux_latt_const,wann%param_file,wann%l_dim)
> wann%aux_latt_const,wann%param_file,wann%l_dim,
> wann%wan90version)
endif
c-----calculate polarization, if not wannierize
......
wannier/wann_postproc_setup2.F 0 → 100644
View file @ 33d257d4
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_wann_postproc_setup2
#ifdef CPP_WANN
CONTAINS
SUBROUTINE wann_postproc_setup2(
> natd,nkpts,kpoints,amat,bmat,
> num,num_bands,ntype,neq,
> zatom,taual,namat,seed,bkpts_filename)
c******************************************************
c Call the Wannier90 setup routine.
c interface corresponding to wannier version 2.0
c Purpose: get the file of nearest-neighbor kpoints
c Frank Freimuth
c******************************************************
IMPLICIT NONE
integer, intent(in) :: natd
integer, intent(in) :: nkpts
real, intent(in) :: kpoints(3,nkpts)
real, intent(in) :: amat(3,3)
real, intent(in) :: bmat(3,3)
integer, intent(in) :: num(3)
integer, intent(in) :: num_bands
integer, intent(in) :: ntype
integer, intent(in) :: neq(ntype)
real, intent(in) :: zatom(ntype)
real, intent(in) :: taual(:,:)
character(len=2),intent(in) :: namat(0:103)
character(len=*),intent(in) :: seed ! QPOINTS
character(len=*),intent(in) :: bkpts_filename ! QPOINTS
integer :: i,j,at
character(len=50) :: seedname
integer :: num_atoms
character(len=2) :: atom_symbols(natd)
logical :: gamma_only
logical :: spinors
integer,parameter :: num_nnmax=12
integer :: nntot
integer :: nnlist(nkpts,num_nnmax)
integer :: nncell(3,nkpts,num_nnmax)
integer :: num_bands2
integer :: num_wann2
real :: proj_site(3,num_bands)
integer :: proj_l(num_bands)
integer :: proj_m(num_bands)
integer :: proj_radial(num_bands)
real :: proj_z(3,num_bands)
real :: proj_x(3,num_bands)
real :: proj_zona(num_bands)
integer :: exclude_bands(num_bands)
integer :: nn,ikpt
real :: pos(3,natd)
! Taken from wannier90-2.0/src/wannier_lib.F90
interface
subroutine wannier_setup(seed__name, mp_grid_loc, num_kpts_loc,
+ real_lattice_loc, recip_lattice_loc, kpt_latt_loc,
+ num_bands_tot, num_atoms_loc, atom_symbols_loc,
+ atoms_cart_loc, gamma_only_loc, spinors_loc, nntot_loc,
+ nnlist_loc, nncell_loc, num_bands_loc, num_wann_loc,
+ proj_site_loc, proj_l_loc, proj_m_loc, proj_radial_loc,
+ proj_z_loc, proj_x_loc, proj_zona_loc, exclude_bands_loc,
+ proj_s_loc,proj_s_qaxis_loc)
implicit none
integer, parameter :: dp = selected_real_kind(15,300)
integer, parameter :: num_nnmax=12
character(len=*), intent(in) :: seed__name
integer, dimension(3), intent(in) :: mp_grid_loc
integer, intent(in) :: num_kpts_loc
real(kind=dp), dimension(3,3), intent(in) :: real_lattice_loc
real(kind=dp), dimension(3,3), intent(in) :: recip_lattice_loc
real(kind=dp), dimension(3,num_kpts_loc), intent(in) ::
+ kpt_latt_loc
integer, intent(in) :: num_bands_tot
integer, intent(in) :: num_atoms_loc
character(len=*), dimension(num_atoms_loc), intent(in) ::
+ atom_symbols_loc
real(kind=dp), dimension(3,num_atoms_loc), intent(in) ::
+ atoms_cart_loc
logical, intent(in) :: gamma_only_loc
logical, intent(in) :: spinors_loc
integer, intent(out) :: nntot_loc
integer, dimension(num_kpts_loc,num_nnmax), intent(out) ::
+ nnlist_loc
integer,dimension(3,num_kpts_loc,num_nnmax), intent(out) ::
+ nncell_loc
integer, intent(out) :: num_bands_loc
integer, intent(out) :: num_wann_loc
real(kind=dp), dimension(3,num_bands_tot), intent(out) ::
+ proj_site_loc
integer, dimension(num_bands_tot), intent(out) :: proj_l_loc
integer, dimension(num_bands_tot), intent(out) :: proj_m_loc
integer, dimension(num_bands_tot), intent(out) ::
+ proj_radial_loc
real(kind=dp), dimension(3,num_bands_tot), intent(out) ::
+ proj_z_loc
real(kind=dp), dimension(3,num_bands_tot), intent(out) ::
+ proj_x_loc
real(kind=dp), dimension(num_bands_tot), intent(out) ::
+ proj_zona_loc
integer, dimension(num_bands_tot), intent(out) ::
+ exclude_bands_loc
integer, dimension(num_bands_tot), optional, intent(out) ::
+ proj_s_loc
real(kind=dp), dimension(3,num_bands_tot), optional,
+ intent(out) :: proj_s_qaxis_loc
end subroutine wannier_setup
end interface
do j=1,natd
pos(:,j)=matmul(amat(:,:),taual(:,j))
enddo
!seedname='WF1'
seedname=seed
gamma_only=.false.
spinors=.false.
num_atoms=0
do i=1,ntype
at=nint(zatom(i))
do j=1,neq(i)
num_atoms=num_atoms+1
atom_symbols(num_atoms)=namat(at)
enddo !j
enddo !i
c**********************************************************
c Call Wannier90 routine for preparation.
c**********************************************************
call wannier_setup(
> seedname,num,
> nkpts,
> transpose(amat),bmat,
> kpoints,num_bands,
> num_atoms,atom_symbols,pos,
> gamma_only,spinors,
> nntot,nnlist,nncell,num_bands2,
> num_wann2,
> proj_site,proj_l,proj_m,
> proj_radial,proj_z,
> proj_x,proj_zona,exclude_bands)
c******************************************************
c write bkpts
c******************************************************
open(202,file=bkpts_filename,form='formatted')
write (202,'(i4)') nntot
do ikpt=1,nkpts
do nn=1,nntot
write (202,'(2i6,3x,3i4)')
c & ikpt,bpt(nn,ikpt),(gb(i,nn,ikpt),i=1,3)
& ikpt,nnlist(ikpt,nn),(nncell(i,ikpt,nn),i=1,3)
enddo
enddo
close(202)
END SUBROUTINE wann_postproc_setup2
#endif
END MODULE m_wann_postproc_setup2
wannier/wann_updown.F
View file @ 33d257d4
......@@ -717,10 +717,12 @@ c****************************************************************
zzMat(jspin)%nbasfcn = nbasfcn
zzMat(jspin)%nbands = neigd
IF(l_real) THEN
ALLOCATE (zzMat(jspin)%z_r(zzMat(jspin)%nbasfcn,
IF(.not.allocated(zzmat(jspin)%z_r))
+ ALLOCATE (zzMat(jspin)%z_r(zzMat(jspin)%nbasfcn,
+ zzMat(jspin)%nbands))
ELSE
ALLOCATE (zzMat(jspin)%z_c(zzMat(jspin)%nbasfcn,
IF(.not.allocated(zzmat(jspin)%z_c))
+ ALLOCATE (zzMat(jspin)%z_c(zzMat(jspin)%nbasfcn,
+ zzMat(jspin)%nbands))
END IF
......@@ -746,11 +748,13 @@ c...we work only within the energy window
zMat(jspin)%nbasfcn = zzMat(jspin)%nbasfcn
zMat(jspin)%nbands = zzMat(jspin)%nbands
IF (zzMat(jspin)%l_real) THEN
ALLOCATE (zMat(jspin)%z_r(zMat(jspin)%nbasfcn,
IF(.not.allocated(zmat(jspin)%z_r))
+ ALLOCATE (zMat(jspin)%z_r(zMat(jspin)%nbasfcn,
+ zMat(jspin)%nbands))
zMat(jspin)%z_r = 0.0
ELSE
ALLOCATE (zMat(jspin)%z_c(zMat(jspin)%nbasfcn,
IF(.not.allocated(zMat(jspin)%z_c))
+ ALLOCATE (zMat(jspin)%z_c(zMat(jspin)%nbasfcn,
+ zMat(jspin)%nbands))
zMat(jspin)%z_c = CMPLX(0.0,0.0)
END IF
......
wannier/wann_wan90prep.F
View file @ 33d257d4
......@@ -15,9 +15,10 @@ c**********************************************************
SUBROUTINE wann_wan90prep(
> jspins,amat,bmat,natd,taual_inp,zatom,ntype,
> ntypd,neq,l_bzsym,film,l_onedimens,l_ms,l_sgwf,l_socgwf,
> aux_latt_const,param_file,l_dim)
> aux_latt_const,param_file,l_dim,wan90version)
USE m_wann_postproc_setup
USE m_wann_postproc_setup2
USE m_wann_postproc_setup4
USE m_wann_postproc_setup5
use m_wann_get_mp
......@@ -40,6 +41,8 @@ c**********************************************************
real,intent(in) :: zatom(ntype)
integer,intent(in) :: neq(ntypd)
logical,intent(in) :: l_onedimens
integer,intent(in) :: wan90version
character(len=20),intent(in) :: param_file
......@@ -200,10 +203,17 @@ c******************************************************
c call wannier90 routines to get bkpts
c******************************************************
#ifdef CPP_WANN
call wann_postproc_setup(
IF(wan90version.le.2)then !wanversion 1.1 and 1.2
call wann_postproc_setup(
> natd,nkpts,kpoints,amat_ang,bmat_ang,
> num,num_bands,ntype,neq,
> zatom,taual,namat,win_filename,'bkpts')
else !wanversion 2.0
call wann_postproc_setup2(
> natd,nkpts,kpoints,amat_ang,bmat_ang,
> num,num_bands,ntype,neq,
> zatom,taual,namat,win_filename,'bkpts')
endif
#else
WRITE(*,*) 'The code is supposed to perform the Wannier setup'
WRITE(*,*) 'but the Wannier90 library is not linked.'
......@@ -234,10 +244,17 @@ c******************************************************
> qpoints,zatom,taual_q,namat,3)
#ifdef CPP_WANN
call wann_postproc_setup(
if(wan90version.le.2)then !wanversion 1.1 and 1.2
call wann_postproc_setup(
> natd,nqpts,qpoints,amat_ang_q,bmat_ang_q,
> numq,num_bands,ntype,neq,
> zatom,taual_q,namat,'WF1_q','bqpts')
else !wanversion 2.0
call wann_postproc_setup2(
> natd,nqpts,qpoints,amat_ang_q,bmat_ang_q,
> numq,num_bands,ntype,neq,
> zatom,taual_q,namat,'WF1_q','bqpts')
endif
#else
WRITE(*,*) 'The code is supposed to perform the Wannier setup'
WRITE(*,*) 'but the Wannier90 library is not linked.'
......
wannier/wannier.F
View file @ 33d257d4
......@@ -1224,19 +1224,23 @@ c****************************************************************
zzMat%nbasfcn = DIMENSION%nbasfcn
zzMat%nbands = DIMENSION%neigd
IF(l_real) THEN
ALLOCATE (zzMat%z_r(zzMat%nbasfcn,zzMat%nbands))
IF(.not.ALLOCATED(zzMat%z_r))
> ALLOCATE (zzMat%z_r(zzMat%nbasfcn,zzMat%nbands))
ELSE
ALLOCATE (zzMat%z_c(zzMat%nbasfcn,zzMat%nbands))
IF(.not.ALLOCATED(zzMat%z_c))
> ALLOCATE (zzMat%z_c(zzMat%nbasfcn,zzMat%nbands))
END IF
zMat%l_real = zzMat%l_real
zMat%nbasfcn = zzMat%nbasfcn
zMat%nbands = zzMat%nbands
IF (zzMat%l_real) THEN
ALLOCATE (zMat%z_r(zMat%nbasfcn,zMat%nbands))
IF(.not.ALLOCATED(zMat%z_r))
> ALLOCATE (zMat%z_r(zMat%nbasfcn,zMat%nbands))
zMat%z_r = 0.0
ELSE
ALLOCATE (zMat%z_c(zMat%nbasfcn,zMat%nbands))
IF(.not.ALLOCATED(zMat%z_c))
> ALLOCATE (zMat%z_c(zMat%nbasfcn,zMat%nbands))
zMat%z_c = CMPLX(0.0,0.0)
END IF
......@@ -1244,10 +1248,12 @@ c****************************************************************
zMat_b%nbasfcn = zzMat%nbasfcn
zMat_b%nbands = zzMat%nbands
IF (zzMat%l_real) THEN
ALLOCATE (zMat_b%z_r(zMat_b%nbasfcn,zMat_b%nbands))
IF(.not.ALLOCATED(zMat_b%z_r))
> ALLOCATE (zMat_b%z_r(zMat_b%nbasfcn,zMat_b%nbands))
zMat_b%z_r = 0.0
ELSE
ALLOCATE (zMat_b%z_c(zMat_b%nbasfcn,zMat_b%nbands))
IF(.not.ALLOCATED(zMat_b%z_c))
> ALLOCATE (zMat_b%z_c(zMat_b%nbasfcn,zMat_b%nbands))
zMat_b%z_c = CMPLX(0.0,0.0)
END IF
......@@ -1605,8 +1611,8 @@ c---> spherical contribution to mmn0-matrix
call wann_mmk0_sph(
> atoms%llod,noccbd,atoms%nlod,atoms%nat,atoms%ntype,
> atoms%lmaxd,lmd,atoms%ntype,atoms%neq,atoms%nlo,
> atoms%llo,acof(1:noccbd,:,:),
> atoms%lmaxd,atoms%lmax,lmd,atoms%ntype,atoms%neq,
> atoms%nlo,atoms%llo,acof(1:noccbd,:,:),
> bcof(1:noccbd,:,:),ccof(:,1:noccbd,:,:),
> usdus%ddn(:,:,jspin),usdus%uulon(:,:,jspin),
> usdus%dulon(:,:,jspin),usdus%uloulopn,
......
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