Commit 5fc9552e authored by Gregor Michalicek's avatar Gregor Michalicek

Some adjustments of the Wannier code to the new fleur

parent da702ccb
......@@ -27,7 +27,7 @@ c*****************************************c
> bkpt,bbmat,vpw,z_b,z_b2,
> rgphs,ustep,ig,l_kin,sign,uHu)
#include "cpp_double.h"
use m_dotir, ONLY : dotirp
implicit none
c ..arguments..
......@@ -80,7 +80,8 @@ c ..local variables..
s(1) = bkpt(1) + k1_b(i) - gb(1)
s(2) = bkpt(2) + k2_b(i) - gb(2)
s(3) = bkpt(3) + k3_b(i) - gb(3)
rk_b(i) = dotirp(s,s,bbmat)
rk_b(i) = dot_product(s,matmul(bbmat,s))
! rk_b(i) = dotirp(s,s,bbmat)
enddo
! set up |k+G'-G(k+b2)|^2
......@@ -88,7 +89,8 @@ c ..local variables..
s(1) = bkpt(1) + k1_b2(i) - gb2(1)
s(2) = bkpt(2) + k2_b2(i) - gb2(2)
s(3) = bkpt(3) + k3_b2(i) - gb2(3)
rk_b2(i) = dotirp(s,s,bbmat)
rk_b2(i) = dot_product(s,matmul(bbmat,s))
! rk_b2(i) = dotirp(s,s,bbmat)
enddo
! construct vstep(g,g') ~ V(g-g')
......
......@@ -6,7 +6,7 @@ c*********************************************c
module m_wann_uHu_symcheck
contains
subroutine wann_uHu_symcheck(uHu,nbnd,nntot,nntot2,fullnkpts)
use m_fleurenv
implicit none
integer,intent(in) :: nbnd,nntot,nntot2,fullnkpts
complex,intent(in) :: uHu(nbnd,nbnd,nntot2,nntot,fullnkpts)
......
......@@ -3,7 +3,7 @@ c routine to set up the c
c composite matrix anglmom c
c*************************c
module m_wann_gwf_anglmom
USE m_fleurenv
implicit none
contains
......
......@@ -4,7 +4,7 @@ c composite matrices as c
c input for wannier90 c
c*************************c
module m_wann_gwf_commat
USE m_fleurenv
USE m_juDFT
implicit none
contains
......@@ -72,8 +72,8 @@ c*************************c
write(*,*)'dimension:',arr_len
write(*,*)'x?,y?,z? :',l_dim(1:3)
if(arr_len.le.3) call fleur_err("dimension<4",
> calledby='wann_gwf_commat')
if(arr_len.le.3) call juDFT_error("dimension<4",
> calledby='wann_gwf_commat')
nkqpts=nkpts*nqpts
tpi = 2.0*pimach()
......@@ -170,7 +170,7 @@ c > latt_const_q,mmn_arti)
inquire(file='proj',exist=l_proj)
if(.not.l_proj) write(*,*)'missing: proj'
if(l_miss.or.(.not.l_exist).or.(.not.l_proj))
> call fleur_err("missing file(s) for HDWFs")
> call juDFT_error("missing file(s) for HDWFs")
! get number of bands and wfs from proj
open(405,file='proj',status='old')
......@@ -317,8 +317,8 @@ c*****************************c
mmn(:,:,nn,ikqpt)=mmnq(:,:,nq,k)
!write(*,*)'q neig',q,qb,nq
else ! otherwise problem
call fleur_err("problem in overlap mmn gwf",
> calledby="wann_gwf_commat")
call juDFT_error("problem in overlap mmn gwf",
> calledby="wann_gwf_commat")
endif
enddo!nn
enddo!k
......@@ -398,8 +398,8 @@ c*****************************c
enddo
enddo
else ! otherwise problem
call fleur_err("problem in overlap mmn gwf",
> calledby="wann_gwf_commat")
call juDFT_error("problem in overlap mmn gwf",
> calledby="wann_gwf_commat")
endif
enddo!nn
enddo!k
......
module m_wann_gwf_commat
USE m_fleurenv
USE m_juDFT
implicit none
contains
......@@ -58,7 +58,7 @@
c inquire(file='WF1_arti.mmn',exist=l_file)
c if(.not.l_file)
c > call fleur_err("provide WF1_arti.mmn",calledby ="wann_gwf_mmkb")
c > call juDFT_error("provide WF1_arti.mmn",calledby ="wann_gwf_mmkb")
c
c open(200,file='WF1_arti.mmn',status='old',action='read')
c read(200,*)!header
......@@ -67,8 +67,8 @@ c
c if(nbnd_arti.ne.1 .or. nqpts_arti.ne.nqpts
c > .or. nntot_arti.ne.nntot_q) then
c close(200)
c call fleur_err("check format WF1_arti.mmn",
c > calledby="wann_gwf_mmkb")
c call juDFT_error("check format WF1_arti.mmn",
c > calledby="wann_gwf_mmkb")
c endif
c
c do iqpt=1,nqpts
......@@ -88,7 +88,7 @@ c close(200)
c inquire(file='WF1_arti.amn',exist=l_file)
c if(.not.l_file)
c > call fleur_err("provide WF1_arti.amn",calledby ="wann_gwf_mmkb")
c > call juDFT_error("provide WF1_arti.amn",calledby ="wann_gwf_mmkb")
c
c open(200,file='WF1_arti.amn',status='old',action='read')
c read(200,*)!header
......@@ -97,25 +97,25 @@ c
c if(nbnd_arti.ne.1 .or. nqpts_arti.ne.nqpts
c > .or. nntot_arti.ne.1) then
c close(200)
c call fleur_err("check format WF1_arti.amn",
c call juDFT_error("check format WF1_arti.amn",
c > calledby="wann_gwf_mmkb")
c endif
c do iqpt=1,nqpts
c read(200,*)nbnd_arti,nbnd_arti,iqpt_help,mmn_r,mmn_i
c if(iqpt_help.ne.iqpt) call fleur_err("iqpt_help.ne.iqpt",
c if(iqpt_help.ne.iqpt) call juDFT_error("iqpt_help.ne.iqpt",
c > calledby="wann_gwf_mmkb")
c amn_arti(iqpt) = cmplx(mmn_r,mmn_i)
c enddo
c close(200)
c call fleur_end("stop in wann_gwf_mmkb")
c call juDFT_end("stop in wann_gwf_mmkb")
! read in bkqpts
nkqpts=nkpts*nqpts
inquire (file='bkqpts',exist=l_file)
if (.not.l_file) CALL fleur_err("need bkqpts for l_gwf"
if (.not.l_file) CALL juDFT_error("need bkqpts for l_gwf"
+ ,calledby ="wann_gwf_mmkb")
open (202,file='bkqpts',form='formatted',status='old')
rewind (202)
......@@ -127,18 +127,18 @@ c call fleur_end("stop in wann_gwf_mmkb")
do nn=1,nntot_kq
read (202,'(2i6,3x,4i4)')
& ikqpt_help,bpt_kq(nn,ikqpt),(gb_kq(i,nn,ikqpt),i=1,4)
if (ikqpt/=ikqpt_help) CALL fleur_err("ikqpt.ne.ikqpt_help"
if (ikqpt/=ikqpt_help) CALL juDFT_error("ikqpt.ne.ikqpt_help"
+ ,calledby ="wann_gwf_mmkb")
if (bpt_kq(nn,ikqpt)>nkqpts)
& CALL fleur_err("bpt_kq.gt.nkqpts",
> calledby ="wann_gwf_mmkb")
& CALL juDFT_error("bpt_kq.gt.nkqpts",
> calledby ="wann_gwf_mmkb")
c write(*,'(2i6,3x,4i4)')ikqpt_help,bpt_kq(nn,ikqpt),
c > (gb_kq(i,nn,ikqpt),i=1,4)
enddo
enddo
close (202)
!call fleur_end("stop")
!call juDFT_end("stop")
! construct composite mmn and amn matrices and eig
allocate(mmn_comp(nbnd,nbnd,nntot_kq,nkqpts))
......@@ -179,7 +179,7 @@ c write(*,*)'k neighbor nr.',nn
c write(*,*)'q neighbor nr.',nn
c do nn_arti=1,nntot_q
c if(bpt_arti(nn_arti,iqpt).eq.bpt_q(nn,iqpt)) exit
c if(nn_arti.eq.nntot_q) call fleur_err(
c if(nn_arti.eq.nntot_q) call juDFT_error(
c > "nn_arti not found",calledby="wann_gwf_mmkb")
c enddo
c write(*,*)'q nn',nn,'arti nn',nn_arti
......@@ -187,8 +187,8 @@ c write(*,*)'q nn',nn,'arti nn',nn_arti
> * temp_mmn
c > * mmn_arti(nn_arti,iqpt)
else !problem
call fleur_err("overlap mmn gwf",
> calledby="wann_gwf_mmkb")
call juDFT_error("overlap mmn gwf",
> calledby="wann_gwf_mmkb")
endif
!write(*,*)
......
......@@ -133,15 +133,15 @@ c write(*,*)'nn not found!'
subroutine gwf_plottemplate()
use m_fleurenv
use m_juDFT
implicit none
integer :: i,nwfs,numbands
logical :: l_exist
inquire(file='proj',exist=l_exist)
if(.not.l_exist) then
call fleur_err('Where is proj?',
> calledby='gwf_plottemplate')
call juDFT_error('Where is proj?',
> calledby='gwf_plottemplate')
endif
open(8888,file='proj',status='old')
......
......@@ -26,7 +26,7 @@ c***************************************************************
< mmn)
use m_constants, only : pimach
use m_od_types, only : od_inp
use m_types
use m_od_abvac
use m_cylbes
use m_dcylbs
......
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