Commit ab4e2969 authored by Gregor Michalicek's avatar Gregor Michalicek

Even more work to integrate the Wannier code

parent cdf4da44
......@@ -16,7 +16,10 @@ MODULE m_eig66_io
PUBLIC read_dos,write_dos
CONTAINS
FUNCTION open_eig(mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,l_noco,l_create,l_real,l_soc,l_readonly,n_size,mode_in,filename,layers,nstars,ncored,nsld,nat,l_dos,l_mcd,l_orb)RESULT(id)
FUNCTION open_eig(mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,nlotot,&
l_noco,l_create,l_real,l_soc,l_readonly,n_size,mode_in,&
filename,layers,nstars,ncored,nsld,nat,l_dos,l_mcd,l_orb)&
RESULT(id)
USE m_eig66_hdf,ONLY:open_eig_hdf=>open_eig
USE m_eig66_DA ,ONLY:open_eig_DA=>open_eig
USE m_eig66_mem,ONLY:open_eig_mem=>open_eig
......
......@@ -55,7 +55,7 @@ wannier/wann_nocoplot.F
wannier/wann_optional.f
wannier/wann_orbcomp.f
wannier/wann_orbmag.F
wannier/wann_pauli_rs.f
wannier/wann_pauli_rs.F
wannier/wann_perpmag_rs.f
wannier/wann_plot.F
wannier/wann_plot_from_lapw.f
......
......@@ -16,10 +16,11 @@ c*******************************************c
c J.-P. Hanke, Dec. 2015 c
c*******************************************c
MODULE m_wann_uHu
USE m_fleurenv
USE m_juDFT
CONTAINS
SUBROUTINE wann_uHu(
> l_dulo,l_noco,l_ss,lmaxd,ntypd,
> DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi,banddos,
> l_real,l_dulo,l_noco,l_ss,lmaxd,ntypd,
> neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype,
> nwdd,omtil,nlo,llo,lapw_l,invtab,mrot,ngopr,neq,lmax,
> invsat,invsatnr,nkpt,taual,rmt,amat,bmat,bbmat,alph,
......@@ -41,7 +42,6 @@ c*******************************************c
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_loddop
use m_constants, only : pimach
use m_wann_projmethod
......@@ -59,6 +59,7 @@ c*******************************************c
use m_wann_uHu_util
use m_wann_uHu_commat
use m_wann_write_uHu
USE m_eig66_io
IMPLICIT NONE
#include "cpp_double.h"
......@@ -68,12 +69,23 @@ c*******************************************c
integer cpu_index
integer stt(MPI_STATUS_SIZE)
#endif
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_banddos),INTENT(IN) :: banddos
c ..scalar arguments..
character(len=20),intent(in) :: param_file
type (od_inp), intent (in) :: odi
type (od_sym), intent (in) :: ods
logical, intent (in) :: invs,invs2,film,slice,symor,zrfs
logical, intent (in) :: l_noco,l_ss,l_soc
logical, intent (in) :: l_real,l_noco,l_ss,l_soc
logical, intent (in) :: l_ms,l_sgwf,l_socgwf
integer, intent (in) :: lmaxd,ntypd,neigd,nkptd,kk,nnne
integer, intent (in) :: natd,nop,nvd,jspd,nbasfcn,nq2,nop2
......@@ -215,21 +227,24 @@ c ..local scalars..
integer :: funit_start,band_help,sign2
integer :: doublespin,doublespin_max,nrec5
integer :: aoff,d1,d10,d100
integer :: eig_id
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
complex :: nsfactor,nsfactor_b,nsfactor_b2
complex :: ci
TYPE(t_usdus) :: usdus
c ..initializations..
call cpu_time(t00)
ci = cmplx(0.,1.)
t_init = 0.
t_tlmplm = 0.
t_myTlmplm = 0.
t_eig = 0.
t_abcof = 0.
t_int = 0.
......@@ -277,14 +292,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 +315,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 +372,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 +387,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 +402,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 +417,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)
......@@ -463,11 +478,9 @@ c*********************************************************
open (8,file='pottot',form='unformatted',status='old')
rewind (8)
call loddop(
> jspd,n3d,odi%n2d,nmzxyd,nmzd,jmtd,nlhd,ntypd,
> jspins,nq3,odi%nq2,nvac,ntype,invs,invs2,film,
> nlh,jri,ntypsd,ntypsy,8,natd,neq,
< iop,dop,iter,vrf,vpw,vz,vzxy,name)
call loddop(stars,vacuum,atoms,sphhar,input,sym,
> 8,
< iter,vrf,vpw,vz,vzxy)
close (8)
......@@ -668,12 +681,34 @@ c*****************************************************************c
> form='unformatted',recl=irecl,status='old')
enddo
WRITE(fending,'("_",i4.4)')qptibz
OPEN(66,file=trim(fstart)//fending,access='direct',
> form='unformatted',recl=irecl,status='old')
eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,
+ nkpts,wannierspin,atoms%lmaxd,
+ atoms%nlod,atoms%ntype,atoms%nlotot,
+ l_noco,.FALSE.,l_real,l_soc,.FALSE.,
+ mpi%n_size,filename=trim(fstart)//fending,
+ layers=vacuum%layers,nstars=vacuum%nstars,
+ ncored=DIMENSION%nstd,nsld=atoms%nat,
+ nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,
+ l_mcd=banddos%l_mcd,l_orb=banddos%l_orb)
! OPEN(66,file=trim(fstart)//fending,access='direct',
! > form='unformatted',recl=irecl,status='old')
ELSEIF(l_ms) THEN
WRITE(fending,'("_",i4.4)')qptibz
OPEN(66,file=trim(fstart)//fending,access='direct',
> form='unformatted',recl=irecl,status='old')
eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,
+ nkpts,wannierspin,atoms%lmaxd,
+ atoms%nlod,atoms%ntype,atoms%nlotot,
+ l_noco,.FALSE.,l_real,l_soc,.FALSE.,
+ mpi%n_size,filename=trim(fstart)//fending,
+ layers=vacuum%layers,nstars=vacuum%nstars,
+ ncored=DIMENSION%nstd,nsld=atoms%nat,
+ nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,
+ l_mcd=banddos%l_mcd,l_orb=banddos%l_orb)
! OPEN(66,file=trim(fstart)//fending,access='direct',
! > form='unformatted',recl=irecl,status='old')
ELSE
fending=''
ENDIF ! l_gwf.or.l_ms
......@@ -725,7 +760,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
......@@ -738,11 +773,10 @@ cccccccccccc read in the eigenvalues and vectors cccccc
jsp_start=jspin5; jsp_end=jspin5
nrec5=0
if(.not.l_noco) nrec5 = (jspin5-1)*nkpts
call cdn_read0(
> lmaxd,ntypd,nlod,neigd,jspd,!wannierspin,
> irank,isize,jspin5,jsp_start,jsp_end,
> l_noco,nrec5,66, !nrec
< ello,evac,epar,bkpt,wk,n_bands,nrec1,n_size)
call cdn_read0(eig_id,irank,isize,jspin5,wannierspin,l_noco,
< ello,evac,epar,bkpt,wk,n_bands,n_size)
enddo
c.. now we want to define the maximum number of the bands by all kpts
......@@ -751,6 +785,7 @@ c.. now we want to define the maximum number of the bands by all kpts
if(l_p0)then
call wann_maxbnd(
> eig_id,
> lmaxd,ntypd,nlod,neigd,nvd,wannierspin,
> isize,jspin,nbasfcn,nlotot,
> l_ss,l_noco,nrec,fullnkpts,irecl,
......@@ -804,26 +839,21 @@ c uHuold = cmplx(0.,0.)
do 40 n = 1,ntype
do 30 l = 0,lmax(n)
c...compute the l-dependent, k-independent radial MT- basis functions
call radfun(
> l,epar(l,n,jspin3),vr(1,n,jspin3),jri(n),rmsh(1,n),
> dx(n),jmtd,
< ff(n,:,:,l,jspin4),gg(n,:,:,l,jspin4),
> us(l,n,jspin4),
< dus(l,n,jspin4),uds(l,n,jspin4),duds(l,n,jspin4),
< ddn(l,n,jspin4),nodeu,noded,wronk)
> l,n,jspin4,epar(l,n,jspin3),vr(1,n,jspin3),atoms,
< ff(n,:,:,l,jspin4),gg(n,:,:,l,jspin4),usdus,
< nodeu,noded,wronk)
30 continue
c...and the local orbital radial functions
do ilo = 1, nlo(n)
call radflo(
> ntypd,nlod,jspd,jmtd,lmaxd,n,jspin, !jspin not important
> ello(1,1,jspin3),vr(1,n,jspin3),
> jri(n),rmsh(1,n),dx(n),ff(n,1:,1:,0:,jspin4),
> gg(n,1:,1:,0:,jspin4),llo,nlo,l_dulo(1,n),
> irank,ulo_der,
< ulos(1,1,jspin4),dulos(1,1,jspin4),uulon(1,1,jspin4),
> dulon(1,1,jspin4),
< uloulopn(1,1,1,jspin4),uuilon,duilon,ulouilopn,
> flo(n,:,:,:,jspin4))
> atoms,n,jspin4,ello(:,:,jspin3),vr(1,n,jspin3),
> ff(n,1:,1:,0:,jspin4),gg(n,1:,1:,0:,jspin4),mpi,
< usdus,uuilon,duilon,ulouilopn,flo(n,:,:,:,jspin4))
enddo
c na = na + neq(n)
40 continue
......@@ -852,7 +882,7 @@ c na = na + neq(n)
> tdulo(:,:,:,:,:,tspin2),tulod(:,:,:,:,:,tspin2),
> tuloulo(:,:,:,:,:,:,tspin2))
call cpu_time(t1)
t_tlmplm = t_tlmplm + t1-t0
t_myTlmplm = t_myTlmplm + t1-t0
endif
endif!iqpt.eq.1
......@@ -868,6 +898,7 @@ c na = na + neq(n)
tuloulo_soc = cmplx(0.,0.)
call cpu_time(t0)
call wann_uHu_soc(
> input,atoms,
> ntypd,jmtd,lmaxd,jspd,
> ntype,dx,rmsh,jri,lmax,natd,
> lmd,lmplmd,neq,irank,
......@@ -883,7 +914,7 @@ c na = na + neq(n)
> tdulo_soc,tulod_soc,
> tuloulo_soc)
call cpu_time(t1)
t_tlmplm = t_tlmplm + t1-t0
t_myTlmplm = t_myTlmplm + t1-t0
endif!l_soc
......@@ -1372,7 +1403,10 @@ c endif
! close eig files
IF (l_gwf) THEN
CLOSE(66)
CALL close_eig(eig_id)
! CLOSE(66)
DO iqpt_b=1,nntot_q
CLOSE(funit_start+iqpt_b)
ENDDO
......@@ -1441,7 +1475,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
......
MODULE m_wann_maxbnd
USE m_fleurenv
c****************************************************************
c determine maximum of number of bands
c****************************************************************
CONTAINS
SUBROUTINE wann_maxbnd(
> eig_id,
> lmaxd,ntypd,nlod,neigd,nvd,jspd,
> isize,jspin,nbasfcn,nlotot,
> l_ss,l_noco,nrec,fullnkpts,irecl,
......@@ -13,11 +14,11 @@ c****************************************************************
> e1s,e2s,ef,nkpt,nbnd,l_gwf,iqpt)
use m_cdnread, only:cdn_read
use m_od_types,only:od_inp
use m_types
use m_wann_rw_eig
IMPLICIT NONE
integer,intent(in) :: lmaxd,ntypd,nlod,neigd,nvd,jspd
integer,intent(in) :: lmaxd,ntypd,nlod,neigd,nvd,jspd,eig_id
integer,intent(in) :: isize,jspin,nbasfcn,nlotot,iqpt
logical,intent(in) :: l_ss,l_noco,l_gwf
integer,intent(in) :: nrec,fullnkpts,irecl
......@@ -41,12 +42,9 @@ c****************************************************************
INTEGER :: kveclo(nlotot)
integer :: n_start,n_end,co
integer :: num_bands
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX :: z(nbasfcn,neigd)
#else
REAL :: z(nbasfcn,neigd)
#endif
TYPE(t_zmat) :: zMat
n_start=1
n_end=neigd
......@@ -55,12 +53,13 @@ c****************************************************************
kptibz=ikpt
if(l_bzsym) kptibz=irreduc(ikpt)
call wann_read_eig(
call wann_read_eig(
> eig_id,
> lmaxd,ntypd,nlod,neigd,nvd,jspd,
> 0,isize,kptibz,jspin,nbasfcn,nlotot,
> l_ss,l_noco,nrec,irecl,
> l_ss,l_noco,nrec,
< nmat,nv,ello,evdu,epar,kveclo,
< k1,k2,k3,bkpt,wk,nbands,eig,z,cp_time,66,
< k1,k2,k3,bkpt,wk,nbands,eig,zMat,
> l_gwf,iqpt)
nkbnd = 0
......
......@@ -50,6 +50,14 @@ c******************************************************************
implicit none
#include "cpp_double.h"
#ifdef CPP_MPI
include 'mpif.h'
integer mpiierr(3)
integer cpu_index
integer stt(MPI_STATUS_SIZE)
#endif
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
......@@ -63,14 +71,6 @@ c******************************************************************
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_cell),INTENT(IN) :: cell
#include "cpp_double.h"
#ifdef CPP_MPI
include 'mpif.h'
integer mpiierr(3)
integer cpu_index
integer stt(MPI_STATUS_SIZE)
#endif
integer, intent (in) :: band_min(2),band_max(2),mpi_comm,eig_id
logical, intent (in) :: l_soc
logical, intent (in) :: invs,invs2,film,slice,symor
......
......@@ -458,7 +458,7 @@ c > volint,symor,pos,ef,wann%l_bzsym,irecl)
if(wann%l_lapw.and.l_p0)then
call wannier_to_lapw(
> mpi_comm,eig_id,
> input,lapw,oneD,noco,sym,cell,atoms,
> input,lapw,oneD,noco,sym,cell,atoms,stars,vacuum,sphhar,
> l_soc,wann%unigrid,i,wann%band_min,wann%band_max,
> l_dulo,l_noco,l_ss,lmaxd,ntypd,
> neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype,
......@@ -540,7 +540,7 @@ c write(*,*)'alph',alph
c write(*,*)'beta',beta
c nkqpts=fullnkpts
c if(l_sgwf) nkqpts=fullnkpts*fullnqpts
call wann_nocoplot(slice,nnne,!nslibd
call wann_nocoplot(atoms,slice,nnne,!nslibd
> amat,bmat,fullnkpts,odi,film,
> natd,ntypd,jmtd,ntype,neq,pos,
> jri,rmsh,alph,beta,fullnqpts,qss,
......
......@@ -17,7 +17,7 @@ c******************************************************************
contains
subroutine wannier_to_lapw(
> mpi_comm,eig_id,
> input,lapw,oneD,noco,sym,cell,atoms,
> input,lapw,oneD,noco,sym,cell,atoms,stars,vacuum,sphhar,
> l_soc,unigrid,sortrule,band_min,band_max,
> l_dulo,l_noco,l_ss,lmaxd,ntypd,
> neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype,
......@@ -53,6 +53,9 @@ c******************************************************************
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_sphhar),INTENT(IN) :: sphhar
#ifdef CPP_MPI
include 'mpif.h'
......@@ -237,15 +240,11 @@ cccccccccccccccc initialize the potential cccccccccccc
open (8,file='pottot',form='unformatted',status='old')
rewind (8)
#ifdef CPP_NEVER
call loddop(
> jspd,n3d,odi%n2d,nmzxyd,nmzd,jmtd,nlhd,ntypd,
> jspins,nq3,odi%nq2,nvac,ntype,invs,invs2,film,
> nlh,jri,ntypsd,ntypsy,8,natd,neq,
< iop,dop,iter,vrf,vpw,vz,vzxy,name)
#else
call judft_error("NOT implemented")
#endif
call loddop(stars,vacuum,atoms,sphhar,input,sym,
> 8,
< iter,vrf,vpw,vz,vzxy)
close (8)
do jspin = 1,jspins
......
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