Commit 18169e7a authored by Gregor Michalicek's avatar Gregor Michalicek

Implementation of basic Wannier input in inp.xml

...still buggy and very incomplete.

The new test does not pass yet but it might already work.
parent 238fc39a
...@@ -59,7 +59,7 @@ CONTAINS ...@@ -59,7 +59,7 @@ CONTAINS
INTEGER i,i1 ,j,jsp,jsp1,k,ne,nn,nn1,nrec,info INTEGER i,i1 ,j,jsp,jsp1,k,ne,nn,nn1,nrec,info
INTEGER idim_c,idim_r,jsp2,nbas,j1 INTEGER idim_c,idim_r,jsp2,nbas,j1
CHARACTER vectors CHARACTER vectors
LOGICAL l_file,l_socvec,l_qsgw,l_open,l_real LOGICAL l_socvec,l_qsgw,l_open,l_real
INTEGER irec,irecl_qsgw INTEGER irec,irecl_qsgw
COMPLEX cdum COMPLEX cdum
! .. ! ..
...@@ -316,14 +316,13 @@ else ...@@ -316,14 +316,13 @@ else
! i + ! i +
! reorder new e.w. in 2x2 spin space : zhelp(,1),zhelp(,2) ! reorder new e.w. in 2x2 spin space : zhelp(,1),zhelp(,2)
! !
INQUIRE (file='wann_inp',exist=l_file)
DO i1 = 1,2 DO i1 = 1,2
jsp = i1 jsp = i1
jsp2= i1 jsp2= i1
IF (input%jspins.EQ.1) jsp = 1 IF (input%jspins.EQ.1) jsp = 1
IF (input%jspins.EQ.1 .AND..NOT.(l_file.OR.l_socvec)) jsp2=1 IF (input%jspins.EQ.1 .AND..NOT.(input%l_wann.OR.l_socvec)) jsp2=1
IF (i1.EQ.1) nn = 0 IF (i1.EQ.1) nn = 0
IF (i1.EQ.2) nn = nsz(1) IF (i1.EQ.2) nn = nsz(1)
......
...@@ -51,7 +51,7 @@ CONTAINS ...@@ -51,7 +51,7 @@ CONTAINS
! .. Local Scalars .. ! .. Local Scalars ..
INTEGER i,j,nk,jspin,n ,l INTEGER i,j,nk,jspin,n ,l
INTEGER n_loc,n_plus,i_plus,n_end,nsz,nmat INTEGER n_loc,n_plus,i_plus,n_end,nsz,nmat
LOGICAL l_file,l_socvec !,l_all LOGICAL l_socvec !,l_all
INTEGER wannierspin INTEGER wannierspin
TYPE(t_enpara) :: enpara TYPE(t_enpara) :: enpara
TYPE(t_usdus):: usdus TYPE(t_usdus):: usdus
...@@ -90,8 +90,7 @@ CONTAINS ...@@ -90,8 +90,7 @@ CONTAINS
enpara%evac0(2,DIMENSION%jspd),enpara%ello0(atoms%nlod,atoms%ntype,DIMENSION%jspd),& enpara%evac0(2,DIMENSION%jspd),enpara%ello0(atoms%nlod,atoms%ntype,DIMENSION%jspd),&
enpara%el0(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd)) enpara%el0(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd))
INQUIRE (file='wann_inp',exist=l_file) IF (input%l_wann.OR.l_socvec) THEN
IF (l_file.OR.l_socvec) THEN
wannierspin = 2 wannierspin = 2
ELSE ELSE
wannierspin = input%jspins wannierspin = input%jspins
......
...@@ -39,23 +39,35 @@ contains ...@@ -39,23 +39,35 @@ contains
kpts%nkpt = kpts%nkpt3(1) * kpts%nkpt3(2) * kpts%nkpt3(3) kpts%nkpt = kpts%nkpt3(1) * kpts%nkpt3(2) * kpts%nkpt3(3)
END IF END IF
IF (input%l_wann) THEN
IF (kpts%specificationType.NE.2) THEN
CALL juDFT_error('l_wann only with kPointMesh', calledby = 'kpoints')
END IF
END IF
IF (.NOT.l_kpts) THEN IF (.NOT.l_kpts) THEN
IF (.NOT.oneD%odd%d1) THEN IF (.NOT.oneD%odd%d1) THEN
IF (jij%l_J) THEN IF (input%l_wann) THEN
sym_hlp=sym
sym_hlp%nop=1
sym_hlp%nop2=1
CALL kptgen_hybrid(kpts,sym_hlp%invs,noco%l_soc,sym_hlp%nop,sym_hlp%mrot,sym_hlp%tau)
ELSE IF ((jij%l_J)) THEN
sym_hlp=sym sym_hlp=sym
sym_hlp%nop=1 sym_hlp%nop=1
sym_hlp%nop2=1 sym_hlp%nop2=1
CALL julia(sym_hlp,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.) CALL julia(sym_hlp,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
ELSE IF(kpts%l_gamma .and. banddos%ndir .eq. 0) THEN ELSE IF (kpts%l_gamma.and.(banddos%ndir.eq.0)) THEN
CALL kptgen_hybrid(kpts,sym%invs,noco%l_soc,sym%nop,sym%mrot,sym%tau) CALL kptgen_hybrid(kpts,sym%invs,noco%l_soc,sym%nop,sym%mrot,sym%tau)
ELSE ELSE
CALL julia(sym,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.) CALL julia(sym,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
END IF END IF
ELSE ELSE
STOP 'Error: No kpoint set generation for 1D systems yet!' CALL juDFT_error('Error: No kpoint set generation for 1D systems yet!', calledby = 'kpoints')
CALL od_kptsgen (kpts%nkpt) CALL od_kptsgen (kpts%nkpt)
END IF END IF
END IF END IF
!Rescale weights and kpoints !Rescale weights and kpoints
kpts%wtkpt(:) = kpts%wtkpt(:) / sum(kpts%wtkpt) kpts%wtkpt(:) = kpts%wtkpt(:) / sum(kpts%wtkpt)
...@@ -63,7 +75,5 @@ contains ...@@ -63,7 +75,5 @@ contains
kpts%posScale = 1.0 kpts%posScale = 1.0
IF (kpts%nkpt3(3).EQ.0) kpts%nkpt3(3) = 1 IF (kpts%nkpt3(3).EQ.0) kpts%nkpt3(3) = 1
end subroutine kpoints end subroutine kpoints
end module m_kpoints end module m_kpoints
...@@ -1877,13 +1877,14 @@ SUBROUTINE r_inpXML(& ...@@ -1877,13 +1877,14 @@ SUBROUTINE r_inpXML(&
ELSE ELSE
wann%band_max(2) = wann%band_max(1) wann%band_max(2) = wann%band_max(1)
END IF END IF
wann%l_byindex = .TRUE.
END IF END IF
xPathA = '/fleurInput/output/wannier/jobList' xPathA = '/fleurInput/output/wannier/jobList'
numberNodes = xmlGetNumberOfNodes(xPathA) numberNodes = xmlGetNumberOfNodes(xPathA)
IF (numberNodes.EQ.1) THEN IF (numberNodes.EQ.1) THEN
xPathA = 'normalize-space(/fleurInput/output/wannier/jobList/text())[1]' xPathA = '/fleurInput/output/wannier/jobList/text()'
! Note: At the moment only 255 characters for the text in this node. Maybe this is not enough. ! Note: At the moment only 255 characters for the text in this node. Maybe this is not enough.
valueString = xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))) valueString = xmlGetAttributeValue(TRIM(ADJUSTL(xPathA)))
......
...@@ -109,7 +109,7 @@ CONTAINS ...@@ -109,7 +109,7 @@ CONTAINS
! .. Local Scalars .. ! .. Local Scalars ..
INTEGER:: eig_id, archiveType INTEGER:: eig_id, archiveType
INTEGER:: n,it,ithf,pc INTEGER:: n,it,ithf,pc
LOGICAL:: stop80,reap,l_endit,l_opti,l_cont,l_qfix, l_error LOGICAL:: stop80,reap,l_endit,l_opti,l_cont,l_qfix, l_error, l_wann_inp
REAL :: fermiEnergyTemp, fix REAL :: fermiEnergyTemp, fix
!--- J< !--- J<
INTEGER :: phn INTEGER :: phn
...@@ -152,11 +152,11 @@ CONTAINS ...@@ -152,11 +152,11 @@ CONTAINS
!+Wannier !+Wannier
input%l_wann = .FALSE. INQUIRE (file='wann_inp',exist=l_wann_inp)
INQUIRE (file='wann_inp',exist=input%l_wann) input%l_wann = input%l_wann.OR.l_wann_inp
IF (input%l_wann.AND.(mpi%irank==0).AND.(.NOT.wann%l_bs_comf)) THEN IF (input%l_wann.AND.(mpi%irank==0).AND.(.NOT.wann%l_bs_comf)) THEN
IF(mpi%isize.NE.1) CALL juDFT_error('No Wannier+MPI at the moment',calledby = 'fleur') IF(mpi%isize.NE.1) CALL juDFT_error('No Wannier+MPI at the moment',calledby = 'fleur')
CALL wann_optional(input,atoms,sym,cell,oneD,noco,wann) CALL wann_optional(input,kpts,atoms,sym,cell,oneD,noco,wann)
END IF END IF
IF (wann%l_gwf) input%itmax = 1 IF (wann%l_gwf) input%itmax = 1
...@@ -559,10 +559,8 @@ CONTAINS ...@@ -559,10 +559,8 @@ CONTAINS
! ----> charge density ! ----> charge density
! !
!+Wannier functions !+Wannier functions
input%l_wann = .FALSE.
INQUIRE (file='wann_inp',exist=input%l_wann)
IF ((input%l_wann).AND.(.NOT.wann%l_bs_comf)) THEN IF ((input%l_wann).AND.(.NOT.wann%l_bs_comf)) THEN
CALL wannier(DIMENSION,mpi,input,sym,atoms,stars,vacuum,sphhar,oneD,& CALL wannier(DIMENSION,mpi,input,kpts,sym,atoms,stars,vacuum,sphhar,oneD,&
wann,noco,cell,enpara,banddos,sliceplot,vTot,results,& wann,noco,cell,enpara,banddos,sliceplot,vTot,results,&
eig_idList,(sym%invs).AND.(.NOT.noco%l_soc).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 END IF
......
...@@ -137,6 +137,7 @@ ...@@ -137,6 +137,7 @@
ENDIF ENDIF
ENDIF ENDIF
input%l_wann = .FALSE.
CALL initWannierDefaults(wann) CALL initWannierDefaults(wann)
input%minDistance = 0.0 input%minDistance = 0.0
...@@ -574,17 +575,8 @@ ...@@ -574,17 +575,8 @@
END IF END IF
! Initializations for Wannier functions (start) ! Initializations for Wannier functions (start)
wann%l_ms=.false.
wann%l_sgwf=.false.
wann%l_socgwf=.false.
wann%l_gwf=.false.
wann%l_bs_comf=.false. !.true.
wann%scale_param = 1.0
wann%aux_latt_const = 8.0!5.5!5.45886450 !5.98136400 !8.0725882513951497 !5.4170 !1.0
wann%param_file='qpts'
wann%l_dim=.false.
IF (mpi%irank.EQ.0) THEN IF (mpi%irank.EQ.0) THEN
#ifdef CPP_WANN #ifdef CPP_WANN
INQUIRE(FILE='plotbscomf',EXIST=wann%l_bs_comf) INQUIRE(FILE='plotbscomf',EXIST=wann%l_bs_comf)
WRITE(*,*)'l_bs_comf=',wann%l_bs_comf WRITE(*,*)'l_bs_comf=',wann%l_bs_comf
WRITE(*,*) 'Logical variables for wannier functions to be read in!!' WRITE(*,*) 'Logical variables for wannier functions to be read in!!'
......
...@@ -17,8 +17,8 @@ endif() ...@@ -17,8 +17,8 @@ endif()
#Add Wannier tests if fleur is compiled with Wannier support #Add Wannier tests if fleur is compiled with Wannier support
if (${FLEUR_USE_WANN}) if (${FLEUR_USE_WANN})
set(Testdirs ${Testdirs} Cwann) set(Testdirs ${Testdirs} Cwann CwannXML)
set(ParTestdirs ${ParTestdirs} Cwann) set(ParTestdirs ${ParTestdirs} Cwann CwannXML)
endif() endif()
#The serial tests #The serial tests
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
$test_name="C: simple test for the Wannier code with inp.xml";
$test_code="Fleur";
$test_stages=3;
$test_desc=<<EOF
Simple test of Fleur with three steps:
1.Generate a starting density and run 1 iteration
2.Generate projections for Wannier functions
3.Generate input for Wannier90 code
Uses: Wannier
EOF
;
#juDFT Testscript
jt::copyfile("files/inp.xml",$workdir);
jt::testrun($executable,$workdir);
#now test output
$result=jt::test_fileexists("$workdir/out");
jt::stageresult($workdir,$result,"1");
#juDFT Testscript
#The following arguments are passed: executable, working directory
jt::copyfile("files/projgen_inp",$workdir);
jt::copyfile("files/wann_inp-1.xml","$workdir/inp.xml");
jt::testrun($executable,$workdir);
#now test output
$result=jt::test_grepexists("$workdir/proj"," 8 8");
$result+=jt::test_grepexists("$workdir/proj"," 1 -3 1 0");
$result+=jt::test_grepexists("$workdir/proj"," 2 -3 4 0");
$result+=jt::test_grepexists("$workdir/proj"," 0.000000 0.000000 0.000000 0.000000 1.00");
jt::stageresult($workdir,$result,"2");
#juDFT Testscript
#The following arguments are passed: executable, working directory
jt::copyfile("files/wann_inp-2.xml","$workdir/inp.xml");
jt::testrun($executable,$workdir);
#now test output
$result=jt::test_fileexists("$workdir/WF1.amn");
$result+=jt::test_fileexists("$workdir/WF1.mmn");
$result+=jt::test_fileexists("$workdir/WF1.eig");
$result+=jt::test_fileexists("$workdir/WF1.win");
$result+=jt::test_fileexists("$workdir/WF1.wout");
$result+=jt::test_grepexists("$workdir/WF1.eig"," 1 1 -9.96004957");
$result+=jt::test_grepexists("$workdir/WF1.eig"," 8 1 24.36259922");
$result+=jt::test_grepexists("$workdir/WF1.eig"," 8 8 27.60170066");
$result+=jt::test_grepexists("$workdir/WF1.eig"," 5 6 16.51363508");
#Note:WF1.amn and WF1.mmn seem to differ strongly from the reference result.
#But this does not seem to be relevant as invoking wannier90.x WF1 yields high precision results.
#$result+=jt::test_grepexists("$workdir/WF1.amn"," 8 8 8");
#$result+=jt::test_grepexists("$workdir/WF1.amn"," 1 1 1 -0.21709150");
#$result+=jt::test_grepexists("$workdir/WF1.amn"," 8 2 1 0.000000000000 0.29174760");
#$result+=jt::test_grepexists("$workdir/WF1.amn"," 2 6 2 0.000000000000 -0.01714566");
#$result+=jt::test_grepexists("$workdir/WF1.amn"," 3 5 2 -0.18082932");
#$result+=jt::test_grepexists("$workdir/WF1.amn"," 8 8 8 0.000000000000 -0.11210751");
#$result+=jt::test_grepexists("$workdir/WF1.amn"," 6 7 8 -0.33695808");
#$result+=jt::test_grepexists("$workdir/WF1.mmn"," 8 8 8");
#$result+=jt::test_grepexists("$workdir/WF1.mmn"," 1 2 0 0 0");
#$result+=jt::test_grepexists("$workdir/WF1.mmn"," -0.757938912603");
#$result+=jt::test_grepexists("$workdir/WF1.mmn"," 0.257799685127");
#$result+=jt::test_grepexists("$workdir/WF1.mmn"," 8 7 0 0 1");
jt::stageresult($workdir,$result,"3");
...@@ -73,7 +73,6 @@ wannier/wann_projmethod.F ...@@ -73,7 +73,6 @@ wannier/wann_projmethod.F
wannier/wann_radovlp_integrals.F wannier/wann_radovlp_integrals.F
wannier/wann_rad_twf.f wannier/wann_rad_twf.f
wannier/wann_readcenters.f wannier/wann_readcenters.f
wannier/wann_read_inp.f
wannier/wann_read_umatrix.F wannier/wann_read_umatrix.F
wannier/wann_real.F wannier/wann_real.F
wannier/wann_rmat.f wannier/wann_rmat.f
...@@ -99,4 +98,5 @@ wannier/bs_comfort.F ...@@ -99,4 +98,5 @@ wannier/bs_comfort.F
) )
set(fleur_F90 ${fleur_F90} set(fleur_F90 ${fleur_F90}
wannier/init_wannier_defaults.f90 wannier/init_wannier_defaults.f90
wannier/wann_read_inp.f90
) )
...@@ -143,11 +143,10 @@ SUBROUTINE initWannierDefaults(wann) ...@@ -143,11 +143,10 @@ SUBROUTINE initWannierDefaults(wann)
wann%fn_eig = '' wann%fn_eig = ''
wann%param_file = '' wann%param_file = ''
! REAL,ALLOCATABLE :: param_vec(:,:) wann%scale_param = 1.0
! REAL,ALLOCATABLE :: param_alpha(:,:) wann%aux_latt_const = 8.0!5.5!5.45886450 !5.98136400 !8.0725882513951497 !5.4170 !1.0
wann%param_file='qpts'
! CHARACTER(LEN=20), ALLOCATABLE :: jobList(:) wann%l_dim=.false.
END SUBROUTINE initWannierDefaults END SUBROUTINE initWannierDefaults
......
...@@ -19,8 +19,8 @@ c*******************************************c ...@@ -19,8 +19,8 @@ c*******************************************c
USE m_juDFT USE m_juDFT
CONTAINS CONTAINS
SUBROUTINE wann_uHu( SUBROUTINE wann_uHu(
> DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi,banddos, > DIMENSION,stars,vacuum,atoms,sphhar,input,kpts,sym,mpi,
> oneD,noco,cell,vTot,wann, > banddos,oneD,noco,cell,vTot,wann,
> eig_idList,l_real,l_dulo,l_noco,l_ss,lmaxd,ntypd, > eig_idList,l_real,l_dulo,l_noco,l_ss,lmaxd,ntypd,
> neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype, > neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype,
> omtil,nlo,llo,lapw_l,invtab,mrot,ngopr,neq,lmax, > omtil,nlo,llo,lapw_l,invtab,mrot,ngopr,neq,lmax,
...@@ -76,6 +76,7 @@ c*******************************************c ...@@ -76,6 +76,7 @@ c*******************************************c
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_banddos),INTENT(IN) :: banddos TYPE(t_banddos),INTENT(IN) :: banddos
...@@ -287,9 +288,7 @@ c ..initializations.. ...@@ -287,9 +288,7 @@ c ..initializations..
c-----read the input file to determine what to do c-----read the input file to determine what to do
call wann_read_inp( call wann_read_inp(input,l_p0,wann)
> l_p0,
< wann)
if(wann%l_byenergy.and.wann%l_byindex) CALL juDFT_error if(wann%l_byenergy.and.wann%l_byindex) CALL juDFT_error
+ ("byenergy.and.byindex",calledby ="wannier") + ("byenergy.and.byindex",calledby ="wannier")
...@@ -442,7 +441,7 @@ c find symmetry-related elements in mmkb ...@@ -442,7 +441,7 @@ c find symmetry-related elements in mmkb
c******************************************************** c********************************************************
allocate(maptopair(3,fullnkpts,nntot)) allocate(maptopair(3,fullnkpts,nntot))
allocate(pair_to_do(fullnkpts,nntot)) allocate(pair_to_do(fullnkpts,nntot))
call wann_mmnk_symm( call wann_mmnk_symm(input,kpts,
> fullnkpts,nntot,bpt,gb,wann%l_bzsym, > fullnkpts,nntot,bpt,gb,wann%l_bzsym,
> irreduc,mapkoper,l_p0,film,nop,invtab,mrot,odi%d1, > irreduc,mapkoper,l_p0,film,nop,invtab,mrot,odi%d1,
> tau, > tau,
...@@ -452,7 +451,7 @@ c******************************************************** ...@@ -452,7 +451,7 @@ c********************************************************
if(l_gwf)then if(l_gwf)then
allocate(maptopair_q(3,fullnqpts,nntot_q)) allocate(maptopair_q(3,fullnqpts,nntot_q))
allocate(pair_to_do_q(fullnqpts,nntot_q)) allocate(pair_to_do_q(fullnqpts,nntot_q))
call wann_mmnk_symm( call wann_mmnk_symm(input,kpts,
> fullnqpts,nntot_q,bpt_q,gb_q,wann%l_bzsym, > fullnqpts,nntot_q,bpt_q,gb_q,wann%l_bzsym,
> irreduc_q,mapqoper,l_p0,.false.,1,invtab(1),mrot(:,:,1), > irreduc_q,mapqoper,l_p0,.false.,1,invtab(1),mrot(:,:,1),
> .false.,tau, > .false.,tau,
......
...@@ -19,8 +19,8 @@ c*******************************************c ...@@ -19,8 +19,8 @@ c*******************************************c
USE m_juDFT USE m_juDFT
CONTAINS CONTAINS
SUBROUTINE wann_uHu_dmi( SUBROUTINE wann_uHu_dmi(
> DIMENSION,stars,vacuum,atoms,sphhar,input,sym,mpi,banddos, > DIMENSION,stars,vacuum,atoms,sphhar,input,kpts,sym,mpi,
> oneD,noco,cell,vTot,wann, > banddos,oneD,noco,cell,vTot,wann,
> eig_idList,l_real,l_dulo,l_noco,l_ss,lmaxd,ntypd, > eig_idList,l_real,l_dulo,l_noco,l_ss,lmaxd,ntypd,
> neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype, > neigd,natd,nop,nvd,jspd,nbasfcn,llod,nlod,ntype,
> omtil,nlo,llo,lapw_l,invtab,mrot,ngopr,neq,lmax, > omtil,nlo,llo,lapw_l,invtab,mrot,ngopr,neq,lmax,
...@@ -77,6 +77,7 @@ c*******************************************c ...@@ -77,6 +77,7 @@ c*******************************************c
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_banddos),INTENT(IN) :: banddos TYPE(t_banddos),INTENT(IN) :: banddos
...@@ -287,9 +288,7 @@ c ..initializations.. ...@@ -287,9 +288,7 @@ c ..initializations..
c-----read the input file to determine what to do c-----read the input file to determine what to do
call wann_read_inp( call wann_read_inp(input,l_p0,wann)
> l_p0,
< wann)
if(wann%l_byenergy.and.wann%l_byindex) CALL juDFT_error if(wann%l_byenergy.and.wann%l_byindex) CALL juDFT_error
+ ("byenergy.and.byindex",calledby ="wannier") + ("byenergy.and.byindex",calledby ="wannier")
...@@ -442,7 +441,7 @@ c find symmetry-related elements in mmkb ...@@ -442,7 +441,7 @@ c find symmetry-related elements in mmkb
c******************************************************** c********************************************************
allocate(maptopair(3,fullnkpts,nntot)) allocate(maptopair(3,fullnkpts,nntot))
allocate(pair_to_do(fullnkpts,nntot)) allocate(pair_to_do(fullnkpts,nntot))
call wann_mmnk_symm( call wann_mmnk_symm(input,kpts,
> fullnkpts,nntot,bpt,gb,wann%l_bzsym, > fullnkpts,nntot,bpt,gb,wann%l_bzsym,
> irreduc,mapkoper,l_p0,film,nop,invtab,mrot,odi%d1, > irreduc,mapkoper,l_p0,film,nop,invtab,mrot,odi%d1,
> tau, > tau,
...@@ -452,7 +451,7 @@ c******************************************************** ...@@ -452,7 +451,7 @@ c********************************************************
if(l_gwf)then if(l_gwf)then
allocate(maptopair_q(3,fullnqpts,nntot_q)) allocate(maptopair_q(3,fullnqpts,nntot_q))
allocate(pair_to_do_q(fullnqpts,nntot_q)) allocate(pair_to_do_q(fullnqpts,nntot_q))
call wann_mmnk_symm( call wann_mmnk_symm(input,kpts,
> fullnqpts,nntot_q,bpt_q,gb_q,wann%l_bzsym, > fullnqpts,nntot_q,bpt_q,gb_q,wann%l_bzsym,
> irreduc_q,mapqoper,l_p0,.false.,1,invtab(1),mrot(:,:,1), > irreduc_q,mapqoper,l_p0,.false.,1,invtab(1),mrot(:,:,1),
> .false.,tau, > .false.,tau,
......
...@@ -6,8 +6,9 @@ ...@@ -6,8 +6,9 @@
module m_wann_get_kpts module m_wann_get_kpts
use m_juDFT use m_juDFT
USE m_types
contains contains
subroutine wann_get_kpts( subroutine wann_get_kpts(input,kpts,
> l_bzsym,film,l_onedimens,l_readkpts, > l_bzsym,film,l_onedimens,l_readkpts,
< nkpts,kpoints) < nkpts,kpoints)
c******************************************************** c********************************************************
...@@ -16,6 +17,8 @@ c ...@@ -16,6 +17,8 @@ c
c Frank Freimuth c Frank Freimuth
c******************************************************** c********************************************************
implicit none implicit none
TYPE(t_input), INTENT(IN) :: input
TYPE(t_kpts), INTENT(IN) :: kpts
logical,intent(in) :: l_bzsym,film logical,intent(in) :: l_bzsym,film
logical,intent(in) :: l_onedimens,l_readkpts logical,intent(in) :: l_onedimens,l_readkpts
integer,intent(out) :: nkpts integer,intent(out) :: nkpts
...@@ -41,28 +44,39 @@ c******************************************************** ...@@ -41,28 +44,39 @@ c********************************************************
do iter=1,nkpts do iter=1,nkpts
read(987,*)kpoints(:,iter) read(987,*)kpoints(:,iter)
enddo enddo
endif endif
close(987)
else else
inquire(file='kpts',exist=l_file) IF(.NOT.input%l_inpXML) THEN
IF(.NOT.l_file) CALL juDFT_error("where is kpts?",calledby inquire(file='kpts',exist=l_file)
+ ="wann_get_kpts") IF(.NOT.l_file) CALL juDFT_error("where is kpts?",calledby
open(987,file='kpts',status='old',form='formatted') + ="wann_get_kpts")
read(987,*)nkpts,scale open(987,file='kpts',status='old',form='formatted')
write(6,*)"wann_get_kpts: nkpts=",nkpts read(987,*)nkpts,scale
if(l_readkpts)then write(6,*)"wann_get_kpts: nkpts=",nkpts
IF(SIZE(kpoints,1)/=3) CALL juDFT_error("wann_get_kpts: 1" if(l_readkpts)then
+ ,calledby ="wann_get_kpts") IF(SIZE(kpoints,1)/=3)
IF(SIZE(kpoints,2)/=nkpts)CALL juDFT_error("wann_get_kpts:2" + CALL juDFT_error("wann_get_kpts: 1",
+ ,calledby ="wann_get_kpts") + calledby ="wann_get_kpts")
do iter=1,nkpts IF(SIZE(kpoints,2)/=nkpts)
read(987,*)kpoints(:,iter) + CALL juDFT_error("wann_get_kpts:2",
enddo + calledby ="wann_get_kpts")
endif do iter=1,nkpts
read(987,*)kpoints(:,iter)
enddo
endif
close(987)
ELSE
nkpts = kpts%nkpt
if(l_readkpts)then
do iter=1,nkpts
kpoints(:,iter) = kpts%bk(:,iter)
enddo
endif
END IF
endif endif
close(987) if(l_readkpts.AND..NOT.input%l_inpXML)then
if(l_readkpts)then
kpoints=kpoints/scale kpoints=kpoints/scale
if(film.and..not.l_onedimens)then if(film.and..not.l_onedimens)then
kpoints(3,:)=0.0 kpoints(3,:)=0.0
......
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
module m_wann_mmnk_symm module m_wann_mmnk_symm
use m_juDFT use m_juDFT
USE m_types
private private
public:: wann_mmnk_symm public:: wann_mmnk_symm
contains contains
...@@ -15,13 +16,16 @@ c calculated; map symmetry-related k-point-pairs to this ...@@ -15,13 +16,16 @@ c calculated; map symmetry-related k-point-pairs to this
c minimal set. c minimal set.
c Frank Freimuth c Frank Freimuth
c****************************************************************** c******************************************************************
subroutine wann_mmnk_symm( subroutine wann_mmnk_symm(input,kpts,
> fullnkpts,nntot,bpt,gb,l_bzsym, > fullnkpts,nntot,bpt,gb,l_bzsym,
> irreduc,mapkoper,l_p0,film,nop, > irreduc,mapkoper,l_p0,film,nop,
> invtab,mrot,l_onedimens,tau, > invtab,mrot,l_onedimens,tau,
< pair_to_do,maptopair,kdiff,l_q,param_file) < pair_to_do,maptopair,kdiff,l_q,param_file)
implicit none implicit none
TYPE(t_input),INTENT(IN) :: input
TYPE(t_kpts),INTENT(IN) :: kpts
integer,intent(in) :: nop integer,intent(in) :: nop
integer,intent(in) :: mrot(3,3,nop) integer,intent(in) :: mrot(3,3,nop)
integer,intent(in) :: invtab(nop) integer,intent(in) :: invtab(nop)
...@@ -240,16 +244,28 @@ c***************************************************************** ...@@ -240,16 +244,28 @@ c*****************************************************************
close(412) close(412)
else else
IF(.not.l_q)THEN IF(.not.l_q)THEN
open(412,file='kpts',form='formatted') IF(.NOT.input%l_inpXML) THEN
read(412,*)fullnkpts_tmp,scale open(412,file='kpts',form='formatted')
read(412,*)fullnkpts_tmp,scale
do k=1,fullnkpts
read(412,*)kpoints(:,k)
enddo
kpoints(:,:)=kpoints/scale
ELSE
fullnkpts_tmp = kpts%nkpt
do k=1,fullnkpts
kpoints(:,k) = kpts%bk(:,k)
enddo
END IF
ELSE ELSE
open(412,file=param_file,form='formatted') open(412,file=param_file,form='formatted')
read(412,*)fullnkpts_tmp,scale read(412,*)fullnkpts_tmp,scale
do k=1,fullnkpts
read(412,*)kpoints(:,k)
enddo
kpoints(:,:)=kpoints/scale
ENDIF ENDIF
do k=1,fullnkpts