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