Commit cb659010 authored by Gregor Michalicek's avatar Gregor Michalicek

Some more fixes to integrate the Wannier code

parent ab4e2969
......@@ -41,7 +41,7 @@ c*******************************************c
use m_abcof
use m_radfun
use m_radflo
use m_cdnread, only : cdn_read0, cdn_read
use m_cdnread
use m_loddop
use m_constants, only : pimach
use m_wann_projmethod
......@@ -941,24 +941,14 @@ c if (mod(i_rec-1,isize).eq.irank) then
call cpu_time(t0)
! get current bkpt vector
#if(!defined(CPP_HDF) && defined(CPP_MPI))
call wann_read_eig(
> lmaxd,ntypd,nlod,neigd,nvd,wannierspin,
> irank,isize,kptibz,jspin,nbasfcn,nlotot,
> l_ss,l_noco,nrec,irecl,
CALL cdn_read(
> eig_id,
> nvd,jspd,irank,isize,kptibz,jspin,nbasfcn, !wannierspin instead of jspd?
> l_ss,l_noco,neigd,n_start,n_end,
< nmat,nv,ello,evdu,epar,kveclo,
< k1,k2,k3,bkpt,wk,nbands,
< eigg,zz,cp_time,66,l_gwf,iqpt)
#else
call cdn_read(
> lmaxd,ntypd,nlod,neigd,nvd,jspd,!wannierspin,
> irank,isize,kptibz,jspin,nbasfcn,nlotot,
> l_ss,l_noco,nrec,kptibz,66,
> neigd,n_start,n_end,
< nmat,nv,ello,evdu,epar,kveclo,
< k1,k2,k3,bkpt,wk,nbands,
< eigg,zz,cp_time)
#endif
< k1,k2,k3,bkpt,wk,nbands,eigg,zzMat)
call cpu_time(t1)
t_eig = t_eig + t1 - t0
......@@ -978,25 +968,14 @@ c if (mod(i_rec-1,isize).eq.irank) then
eigg = 0.
call cpu_time(t0)
#if(!defined(CPP_HDF) && defined(CPP_MPI))
call wann_read_eig(
> lmaxd,ntypd,nlod,neigd,nvd,wannierspin,
> irank,isize,kptibz_b,jspin,nbasfcn,nlotot,
> l_ss,l_noco,nrec,irecl,
< nmat_b,nv_b,ello,evdu,epar,kveclo_b,
< k1_b,k2_b,k3_b,bkpt_b,wk_b,nbands_b,
< eigg,zz,cp_time,66,l_gwf,iqpt)
#else
call cdn_read(
> lmaxd,ntypd,nlod,neigd,nvd,jspd,!wannierspin,
> irank,isize,kptibz_b,jspin,nbasfcn,nlotot,
> l_ss,l_noco,nrec,kptibz_b,66,
> neigd,n_start,n_end,
CALL cdn_read(
> eig_id,
> nvd,jspd,irank,isize,kptibz_b,jspin,nbasfcn, !wannierspin instead of jspd?
> l_ss,l_noco,neigd,n_start,n_end,
< nmat_b,nv_b,ello,evdu,epar,kveclo_b,
< k1_b,k2_b,k3_b,bkpt_b,wk_b,nbands_b,
< eigg,zz,cp_time)
< k1_b,k2_b,k3_b,bkpt_b,wk_b,nbands_b,eigg,zzMat)
#endif
nslibd_b = 0
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
......@@ -1096,25 +1075,15 @@ c***********************************************************
eigg = 0.
call cpu_time(t0)
#if(!defined(CPP_HDF) && defined(CPP_MPI))
call wann_read_eig(
> lmaxd,ntypd,nlod,neigd,nvd,wannierspin,
> irank,isize,kptibz_b2,jspin_b,nbasfcn,nlotot,
> l_ss,l_noco,nrec_b,irecl,
< nmat_b2,nv_b2,ello,evdu,epar,kveclo_b2,
< k1_b2,k2_b2,k3_b2,bkpt_b2,wk_b2,nbands_b2,
< eigg,zz,cp_time,66,l_gwf,iqpt)
#else
call cdn_read(
> lmaxd,ntypd,nlod,neigd,nvd,jspd,!wannierspin,
> irank,isize,kptibz_b2,jspin_b,nbasfcn,nlotot,
> l_ss,l_noco,nrec_b,kptibz_b2,66,
> neigd,n_start,n_end,
< nmat_b2,nv_b2,ello,evdu,epar,kveclo_b2,
< k1_b2,k2_b2,k3_b2,bkpt_b2,wk_b2,nbands_b2,
< eigg,zz,cp_time)
#endif
CALL cdn_read(
> eig_id,
> nvd,jspd,irank,isize,kptibz_b2,jspin,nbasfcn, !wannierspin instead of jspd?
> l_ss,l_noco,neigd,n_start,n_end,
< nmat_b2,nv_b2,ello,evdu,epar,kveclo_b2,
< k1_b2,k2_b2,k3_b2,bkpt_b2,wk_b2,nbands_b2,
< eigg,zzMat)
nslibd_b2 = 0
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
......
......@@ -16,7 +16,7 @@ c*******************************************c
c J.-P. Hanke, Feb. 2016 c
c*******************************************c
MODULE m_wann_uHu_dmi
USE m_fleurenv
USE m_juDFT
CONTAINS
SUBROUTINE wann_uHu_dmi(
> l_dulo,l_noco,l_ss,lmaxd,ntypd,
......@@ -40,8 +40,8 @@ c*******************************************c
use m_abcof
use m_radfun
use m_radflo
use m_cdnread, only : cdn_read0, cdn_read
use m_od_types, only : od_inp, od_sym
use m_cdnread
use m_types
use m_loddop
use m_constants, only : pimach
use m_wann_projmethod
......@@ -216,7 +216,7 @@ c ..local scalars..
integer :: doublespin,doublespin_max,doublespin_start,nrec5
integer :: aoff,d1,d10,d100
real :: tpi,wronk,wk,wk_b,wk_b2
real :: t0,t00,t1,t_tlmplm,t_init
real :: t0,t00,t1,t_myTlmplm,t_init
real :: t_int,t_sph,t_vac,t_abcof,t_eig,t_total
real :: efermi,htr2ev
real :: theta_i, thetab_i, phi_i, phib_i,dth,dph
......@@ -234,7 +234,7 @@ c ..initializations..
call cpu_time(t00)
ci = cmplx(0.,1.)
t_init = 0.; t_tlmplm = 0.; t_eig = 0.
t_init = 0.; t_myTlmplm = 0.; t_eig = 0.
t_abcof = 0.; t_int = 0.; t_sph = 0.
t_vac = 0.; t_total = 0.
htr2ev = 27.2
......@@ -277,14 +277,14 @@ c-----read the input file to determine what to do
> l_p0,
< wann)
if(wann%l_byenergy.and.wann%l_byindex) CALL fleur_err
if(wann%l_byenergy.and.wann%l_byindex) CALL juDFT_error
+ ("byenergy.and.byindex",calledby ="wannier")
if(wann%l_byenergy.and.wann%l_bynumber) CALL fleur_err
if(wann%l_byenergy.and.wann%l_bynumber) CALL juDFT_error
+ ("byenergy.and.bynumber",calledby ="wannier")
if(wann%l_bynumber.and.wann%l_byindex) CALL fleur_err
if(wann%l_bynumber.and.wann%l_byindex) CALL juDFT_error
+ ("bynumber.and.byindex",calledby ="wannier")
if(.not.(wann%l_bynumber.or.wann%l_byindex.or.wann%l_byenergy))
& CALL fleur_err("no rule to sort bands",calledby ="wannier")
& CALL juDFT_error("no rule to sort bands",calledby ="wannier")
efermi=ef
......@@ -300,28 +300,28 @@ c**************************************************************
if (wann%l_bzsym) then
l_file=.false.
inquire(file='w90kpts',exist=l_file)
if(.not.l_file) CALL fleur_err
if(.not.l_file) CALL juDFT_error
+ ("w90kpts not found, needed if bzsym",calledby ="wannier")
open(412,file='w90kpts',form='formatted')
read(412,*)fullnkpts
close(412)
if(l_p0)print*,"fullnkpts=",fullnkpts
if(fullnkpts<nkpts) CALL fleur_err("fullnkpts.lt.nkpts"
if(fullnkpts<nkpts) CALL juDFT_error("fullnkpts.lt.nkpts"
+ ,calledby ="wannier")
allocate(irreduc(fullnkpts),mapkoper(fullnkpts))
allocate(shiftkpt(3,fullnkpts))
l_file=.false.
inquire(file='kptsmap',exist=l_file)
if(.not.l_file) CALL fleur_err
if(.not.l_file) CALL juDFT_error
+ ("kptsmap not found, needed if bzsym",calledby ="wannier")
open(713,file='kptsmap')
do i=1,fullnkpts
read(713,*)kpt,irreduc(i),mapkoper(i),shiftkpt(:,i)
if(kpt/=i) CALL fleur_err("kpt.ne.i",calledby ="wannier")
if(kpt/=i) CALL juDFT_error("kpt.ne.i",calledby ="wannier")
if(l_p0)print*,i,irreduc(i),mapkoper(i)
enddo
close(713)
if(maxval(irreduc(:))/=nkpts) CALL fleur_err
if(maxval(irreduc(:))/=nkpts) CALL juDFT_error
+ ("max(irreduc(:))/=nkpts",calledby ="wannier")
else
fullnkpts=nkpts
......@@ -357,7 +357,7 @@ ccccccccccccccc read in the bkpts file ccccccccccccccccc
c**********************************************************
l_bkpts = .false.
inquire (file='bkpts',exist=l_bkpts)
if (.not.l_bkpts) CALL fleur_err("need bkpts for matrixmmn"
if (.not.l_bkpts) CALL juDFT_error("need bkpts for matrixmmn"
+ ,calledby ="wannier")
open (202,file='bkpts',form='formatted',status='old')
rewind (202)
......@@ -372,9 +372,9 @@ c**********************************************************
do nn=1,nntot
read (202,'(2i6,3x,3i4)')
& ikpt_help,bpt(nn,ikpt),(gb(i,nn,ikpt),i=1,3)
if (ikpt/=ikpt_help) CALL fleur_err("ikpt.ne.ikpt_help"
if (ikpt/=ikpt_help) CALL juDFT_error("ikpt.ne.ikpt_help"
+ ,calledby ="wannier")
if (bpt(nn,ikpt)>fullnkpts) CALL fleur_err("bpt.gt.fullnkpts"
if (bpt(nn,ikpt)>fullnkpts) CALL juDFT_error("bpt.gt.fullnkpts"
+ ,calledby ="wannier")
enddo
enddo
......@@ -387,7 +387,7 @@ c**********************************************************
if (l_gwf.or.l_ms) then ! for Omega functional minimization
l_bqpts = .false.
inquire (file='bqpts',exist=l_bqpts)
if (.not.l_bqpts) CALL fleur_err("need bqpts for matrixmmn"
if (.not.l_bqpts) CALL juDFT_error("need bqpts for matrixmmn"
+ ,calledby ="wannier")
open (202,file='bqpts',form='formatted',status='old')
rewind (202)
......@@ -402,10 +402,10 @@ c**********************************************************
do nn=1,nntot_q
read (202,'(2i6,3x,3i4)')
& iqpt_help,bpt_q(nn,iqpt),(gb_q(i,nn,iqpt),i=1,3)
if (iqpt/=iqpt_help) CALL fleur_err("iqpt.ne.iqpt_help"
if (iqpt/=iqpt_help) CALL juDFT_error("iqpt.ne.iqpt_help"
+ ,calledby ="wannier")
if (bpt_q(nn,iqpt)>fullnqpts)
& CALL fleur_err("bpt_q.gt.fullnqpts",calledby ="wannier")
& CALL juDFT_error("bpt_q.gt.fullnqpts",calledby ="wannier")
enddo
enddo
close (202)
......@@ -711,7 +711,7 @@ c..reading the proj.1 / proj.2 / proj file
close (203)
elseif(wann%l_projmethod.or.wann%l_bestproj
& .or.wann%l_matrixamn)then
CALL fleur_err("no proj/proj.1/proj.2",calledby ="wannier")
CALL juDFT_error("no proj/proj.1/proj.2",calledby ="wannier")
endif
......@@ -825,7 +825,7 @@ c na = na + neq(n)
> tdulo(:,:,:,:,:,doublespin),tulod(:,:,:,:,:,doublespin),
> tuloulo(:,:,:,:,:,:,doublespin))
call cpu_time(t1)
t_tlmplm = t_tlmplm + t1-t0
t_myTlmplm = t_myTlmplm + t1-t0
endif!iqpt.eq.1
......@@ -863,7 +863,7 @@ c na = na + neq(n)
> tdulo_soc(:,:,:,:,:,tspin),tulod_soc(:,:,:,:,:,tspin),
> tuloulo_soc(:,:,:,:,:,:,tspin))
call cpu_time(t1)
t_tlmplm = t_tlmplm + t1-t0
t_myTlmplm = t_myTlmplm + t1-t0
enddo!tspin
endif!l_soc
......@@ -1412,7 +1412,7 @@ c************************************************c
t_total = t1-t00
if(l_p0) then
write(*,900)'t_init =',t_init
write(*,900)'t_tlmplm=',t_tlmplm
write(*,900)'t_myTlmplm=',t_myTlmplm
write(*,900)'t_eig =',t_eig
write(*,900)'t_abcof =',t_abcof
write(*,900)'t_int =',t_int
......
......@@ -8,7 +8,7 @@
CONTAINS
SUBROUTINE wann_mmk0_updown_sph(
> l_noco,alph,beta,
> llod,noccbd,nlod,natd,ntypd,lmaxd,lmd,
> llod,noccbd,nlod,natd,ntypd,lmaxd,lmax,lmd,
> ntype,neq,nlo,llo,
> radial1_ff,radial1_gg,
> radial1_fg,radial1_gf,
......@@ -26,6 +26,7 @@ c************************************************************
implicit none
logical, intent (in) :: l_noco
integer, intent (in) :: llod,nlod,natd,ntypd,lmaxd,lmd
integer, intent (in) :: lmax(:) !(ntypd)
integer, intent (in) :: ntype,noccbd
REAL, INTENT (IN) :: alph(ntypd),beta(ntypd)
integer, intent (in) :: neq(ntypd)
......@@ -72,7 +73,7 @@ c---> performs summations of the overlaps of the wavefunctions
ccchi(2,2) = conjg( exp(-ci*alph(n)/2)*cos(beta(n)/2))
endif
nt2 = nt1 + neq(n) - 1
do l = 0,lmaxd
do l = 0,lmax(n)
if(.not.l_noco)then
suma = cmplx(0.,0.)
sumb = cmplx(0.,0.)
......
......@@ -9,13 +9,19 @@
subroutine wann_mmkb_int(
> interchi,addnoco,addnoco2,nvd,k1d,k2d,k3d,
> n3d,k1,k2,k3,
> nv,neigd,nbasfcn,z,nslibd,
> nv,neigd,nbasfcn,zMat,nslibd,
> k1_b,k2_b,k3_b,
> nv_b,z_b,nslibd_b,
> nv_b,zMat_b,nslibd_b,
> nbnd,rgphs,ustep,ig,gb,
< mmnk)
USE m_types
#include "cpp_double.h"
implicit none
TYPE(t_zmat), INTENT(IN) :: zMat, zMat_b
integer, intent(in) :: addnoco,addnoco2
integer, intent(in) :: nvd,n3d,k1(nvd),k2(nvd),k3(nvd)
integer, intent(in) :: nv,neigd,nbasfcn,nslibd,nslibd_b
......@@ -26,35 +32,27 @@
complex, intent(in) :: ustep(n3d),interchi
integer, intent(in) :: ig(-k1d:k1d,-k2d:k2d,-k3d:k3d)
integer, intent(in) :: gb(3)
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
complex, intent(in) :: z(nbasfcn,neigd)
complex, intent(in) :: z_b(nbasfcn,neigd)
#else
real,intent(in) :: z(nbasfcn,neigd)
real,intent(in) :: z_b(nbasfcn,neigd)
#endif
complex,intent(inout) :: mmnk(nbnd,nbnd)
complex, intent(inout) :: mmnk(nbnd,nbnd)
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
complex,allocatable::stepf(:,:)
complex phasust
complex,allocatable::phasusbmat(:,:)
#else
real,allocatable::stepf(:,:)
real,allocatable::phasusbmat(:,:)
real phasust
complex,allocatable::stepf_c(:,:)
complex,allocatable::phasusbmat_c(:,:)
real,allocatable::stepf_r(:,:)
real,allocatable::phasusbmat_r(:,:)
real,allocatable::mmnk_tmp(:,:)
#endif
integer i,j1,j2,j3,i1,i2,i3,j,in,m,n
real phase
allocate(stepf(nv_b,nv))
allocate(phasusbmat(nv,nslibd_b))
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
#else
allocate(mmnk_tmp(nslibd,nslibd_b))
#endif
stepf(:,:)=0.0
IF(zMat%l_real) THEN
allocate(mmnk_tmp(nslibd,nslibd_b))
allocate(phasusbmat_r(nv,nslibd_b))
allocate(stepf_r(nv_b,nv))
stepf_r = 0.0
ELSE
allocate(phasusbmat_c(nv,nslibd_b))
allocate(stepf_c(nv_b,nv))
stepf_c = CMPLX(0.0,0.0)
END IF
do i =1,nv
j1 =-k1(i) - gb(1)
j2 =-k2(i) - gb(2)
......@@ -67,44 +65,43 @@ c--> determine index and phase factor
in = ig(i1,i2,i3)
if (in.eq.0) cycle
phase = rgphs(i1,i2,i3)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
phasust=conjg(phase*ustep(in))
#else
phasust=phase*real(ustep(in))
#endif
stepf(j,i)=phasust
IF (zMat%l_real) THEN
stepf_r(j,i) = phase*real(ustep(in))
ELSE
stepf_c(j,i) = conjg(phase*ustep(in))
END IF
enddo
enddo
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
call CPP_BLAS_cgemm('T','N',nv,nslibd_b,nv_b,cmplx(1.0),
& stepf,nv_b,z_b(1+addnoco2,1),
c & stepf,nv_b,z_b,
& nbasfcn,cmplx(0.0),
& phasusbmat,nv)
phasusbmat=conjg(phasusbmat)
call CPP_BLAS_cgemm('T','N',nslibd,nslibd_b,nv,interchi,
& z(1+addnoco,1),nbasfcn,phasusbmat,nv,cmplx(1.0),
c & z,nbasfcn,phasusbmat,nv,cmplx(1.0),
& mmnk,nbnd)
#else
call CPP_BLAS_sgemm('T','N',nv,nslibd_b,nv_b,real(1.0),
& stepf,nv_b,z_b(1+addnoco2,1),nbasfcn,real(0.0),
c & stepf,nv_b,z_b,nbasfcn,real(0.0),
& phasusbmat,nv)
call CPP_BLAS_sgemm('T','N',nslibd,nslibd_b,nv,real(1.0),
& z(1+addnoco,1),nbasfcn,phasusbmat,nv,real(0.0),
c & z,nbasfcn,phasusbmat,nv,real(0.0),
& mmnk_tmp,nbnd)
mmnk(1:nslibd,1:nslibd_b)=mmnk(1:nslibd,1:nslibd_b)+
& mmnk_tmp(1:nslibd,1:nslibd_b)*interchi
#endif
IF(zMat%l_real) THEN
call CPP_BLAS_sgemm('T','N',nv,nslibd_b,nv_b,real(1.0),
& stepf_r,nv_b,zMat_b%z_r(1+addnoco2,1),nbasfcn,
c & stepf_r,nv_b,zMat_b%z_r,nbasfcn,
& real(0.0),phasusbmat_r,nv)
call CPP_BLAS_sgemm('T','N',nslibd,nslibd_b,nv,real(1.0),
& zMat%z_r(1+addnoco,1),nbasfcn,phasusbmat_r,nv,
c & zMat%z_r,nbasfcn,phasusbmat_r,nv,
& real(0.0),mmnk_tmp,nbnd)
mmnk(1:nslibd,1:nslibd_b)=mmnk(1:nslibd,1:nslibd_b)+
& mmnk_tmp(1:nslibd,1:nslibd_b)*interchi
ELSE
call CPP_BLAS_cgemm('T','N',nv,nslibd_b,nv_b,cmplx(1.0),
& stepf_c,nv_b,zMat_b%z_c(1+addnoco2,1),
c & stepf_c,nv_b,zMat_b%z_c,
& nbasfcn,cmplx(0.0),
& phasusbmat_c,nv)
phasusbmat_c=conjg(phasusbmat_c)
call CPP_BLAS_cgemm('T','N',nslibd,nslibd_b,nv,interchi,
& zMat%z_c(1+addnoco,1),nbasfcn,phasusbmat_c,nv,
c & zMat%z_c,nbasfcn,phasusbmat_c,nv,
& cmplx(1.0),mmnk,nbnd)
END IF
IF(zMat%l_real) THEN
deallocate(mmnk_tmp)
deallocate(phasusbmat_r,stepf_r)
ELSE
deallocate(phasusbmat_c,stepf_c)
END IF
deallocate(stepf)
deallocate(phasusbmat)
#if (!defined(CPP_INVERSION)||defined(CPP_SOC))
#else
deallocate(mmnk_tmp)
#endif
end subroutine
end module m_wann_mmkb_int
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