From 2d909a8692e01154bbd554c77188efddec082142 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Thu, 28 Feb 2019 17:11:21 +0100
Subject: [PATCH 01/24] A few minor fixes to documentation
---
CPV/Doc/user_guide.tex | 18 ++++++++++--------
Doc/release-notes | 21 +++++++++------------
PHonon/Doc/user_guide.tex | 2 +-
PP/Doc/user_guide.tex | 2 +-
dev-tools/release-checklist.md | 2 +-
5 files changed, 22 insertions(+), 23 deletions(-)
diff --git a/CPV/Doc/user_guide.tex b/CPV/Doc/user_guide.tex
index 93c54ffe49..90ce24a2a8 100644
--- a/CPV/Doc/user_guide.tex
+++ b/CPV/Doc/user_guide.tex
@@ -1,5 +1,5 @@
\documentclass[12pt,a4paper]{article}
-\def\version{6.3}
+\def\version{6.4}
\def\qe{{\sc Quantum ESPRESSO}}
\usepackage{html}
@@ -124,16 +124,18 @@ \section{Compilation}
As a final check that compilation was successful,
you may want to run some or all of the tests
-and examples. Please see the general User's Guide for their setup. Automated tests for \cpx\ are in directory
-\texttt{tests/} and can be run via the
-script \texttt{check\_cp.x.j}
+and examples.
+Automated tests for \cpx\ are in directory
+\texttt{test-suite/} and can be run via the
+\texttt{Makefile} found there.
+Please see the general User's Guide for their setup.
You may take the tests and examples distributed
with \CP\ as templates for writing your own input
-files. Input files for tests are contained
-in \texttt{tests/} subdirectory with file type
-\texttt{*.in1}, \texttt{*.in2}, ... . Input file for examples
-are produced if you run the examples in the
+files. Input files for tests are contained in
+subdirectories \texttt{test-suite/cp\_*} with file type
+\texttt{*.in1}, \texttt{*.in2}, ... . Input files for examples
+are produced, if you run the examples, in the
\texttt{results/} subdirectories, with names ending
with \texttt{.in}.
diff --git a/Doc/release-notes b/Doc/release-notes
index aa42774bc7..d893a6bf63 100644
--- a/Doc/release-notes
+++ b/Doc/release-notes
@@ -1,13 +1,10 @@
New in version 6.4:
- * Experimental and specific for gamma_only case: specifing nscdm the SCDM localization is performed
- only for iterations multiples of nscdm, in the intermediate iterations the localized orbitals are
- derived with parallel transport from the last SCDM localization.
- * Added experimental version of SCDM localization with many K_POINTS. The calculation using SCDM
- is set as in the gamma-only case just specifing localization_thr to any value greater than 0 in
- the system namelist.
- * It is now possible to limit the number of xml step elements printed out for relaxation or
- molecular dynamics simulation setting the envinroment variable MAX_XML_STEPS, useful in case
- of very long trajectories to avoid issues due to too large file size.
+ * Experimental version of SCDM localization with k-points, activated like for
+ k=0 by specifying in &system namelist a value > 0 for "localization_thr".
+ * It is now possible to limit the number of xml step elements printed out
+ for relaxation or molecular dynamics simulation, by setting the environment
+ variable MAX_XML_STEPS. Useful in case of very long trajectories to avoid
+ issues due to too large file size.
* EPW works with ultrasoft pseudopotentials (F. Giustino, S. Poncé, R. Margine)
* New code hp.x to compute Hubbard parameters using density-functional
perturbation theory (experimental stage) (I. Timrov, N. Marzari, and M. Cococcioni,
@@ -19,7 +16,7 @@ New in version 6.4:
and M. Cococcioni, in preparation)
* XDM now works also for USPP and norm-conserving PP
-Problems fixed in development version (+ = in qe-6.3-backports as well) :
+Problems fixed in version 6.4 (+ = in qe-6.3-backports as well) :
+ index not correctly initialized in LSDA phonon with core corrections
+ GTH pseudopotentials in analytical form wrongly computed in some cases
+ projwfc.x not working with new xml format in noncolinear/spinorbit case
@@ -40,7 +37,7 @@ Problems fixed in development version (+ = in qe-6.3-backports as well) :
pseudopotentials was not working.
+ bad format in upf%comment when writing the PP_INFO section of UPF v2 PPs
-Incompatible changes in development version:
+Incompatible changes in version 6.4 version:
* Charge density in the LSDA case is stored as (up+down, up-down) and no longer
as (up,down). Output data format is unchanged to (up+down, up-down)
* Non-symmorphic operations are always allowed and the FFT grid is made
@@ -56,7 +53,7 @@ Incompatible changes in development version:
variables of turbo_lanczos.x and turbo_davidson.x. Instead, they are read
from the XML file produced by pw.x. The variable real_space_debug was removed.
-Known problems in development version:
+Known problems in version 6.4:
* Frequent "dexx is negative" errors with hybrid functionals
New in 6.3 version:
diff --git a/PHonon/Doc/user_guide.tex b/PHonon/Doc/user_guide.tex
index 859163d4e6..250e90317f 100644
--- a/PHonon/Doc/user_guide.tex
+++ b/PHonon/Doc/user_guide.tex
@@ -1,5 +1,5 @@
\documentclass[12pt,a4paper]{article}
-\def\version{6.3}
+\def\version{6.4}
\def\qe{{\sc Quantum ESPRESSO}}
\usepackage{html}
diff --git a/PP/Doc/user_guide.tex b/PP/Doc/user_guide.tex
index 986af02c86..09a5bdd72c 100644
--- a/PP/Doc/user_guide.tex
+++ b/PP/Doc/user_guide.tex
@@ -1,5 +1,5 @@
\documentclass[12pt,a4paper]{article}
-\def\version{6.3}
+\def\version{6.4}
\def\qe{{\sc Quantum ESPRESSO}}
\usepackage{html}
diff --git a/dev-tools/release-checklist.md b/dev-tools/release-checklist.md
index 840d943ec1..2cbbe5f42a 100644
--- a/dev-tools/release-checklist.md
+++ b/dev-tools/release-checklist.md
@@ -10,7 +10,7 @@
8. verify that install/configure is updated and aligned with install/configure.ac
9. update version number in Modules/version.f90
10. set a git branch "qe-x.y[.z]" for version x.y[.z]
-11. align github to gitlab
+11. align master to develop, github to gitlab
12. make packages on gitlab and github
13. if there are changes to che schema, copy the new schema to
quantumespresso@qe.safevps.it:/storage/vhosts/quantum-espresso.org/ns/qes
From 08719c93f08ea7af206dae4e543557b5cfc17618 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Thu, 28 Feb 2019 17:17:32 +0100
Subject: [PATCH 02/24] configure configured
---
install/configure | 18 +++++++++---------
install/configure.ac | 2 +-
2 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/install/configure b/install/configure
index a9f3647535..e9169d7b4e 100755
--- a/install/configure
+++ b/install/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for ESPRESSO 6.3.
+# Generated by GNU Autoconf 2.69 for ESPRESSO 6.4.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
@@ -577,8 +577,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='ESPRESSO'
PACKAGE_TARNAME='espresso'
-PACKAGE_VERSION='6.3'
-PACKAGE_STRING='ESPRESSO 6.3'
+PACKAGE_VERSION='6.4'
+PACKAGE_STRING='ESPRESSO 6.4'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
@@ -1328,7 +1328,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures ESPRESSO 6.3 to adapt to many kinds of systems.
+\`configure' configures ESPRESSO 6.4 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1393,7 +1393,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of ESPRESSO 6.3:";;
+ short | recursive ) echo "Configuration of ESPRESSO 6.4:";;
esac
cat <<\_ACEOF
@@ -1522,7 +1522,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-ESPRESSO configure 6.3
+ESPRESSO configure 6.4
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
@@ -1988,7 +1988,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by ESPRESSO $as_me 6.3, which was
+It was created by ESPRESSO $as_me 6.4, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -10575,7 +10575,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by ESPRESSO $as_me 6.3, which was
+This file was extended by ESPRESSO $as_me 6.4, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -10637,7 +10637,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-ESPRESSO config.status 6.3
+ESPRESSO config.status 6.4
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
diff --git a/install/configure.ac b/install/configure.ac
index f54fc2b14f..bd89f05309 100644
--- a/install/configure.ac
+++ b/install/configure.ac
@@ -6,7 +6,7 @@
# of the License. See the file `License' in the root directory
# of the present distribution.
-AC_INIT(ESPRESSO, 6.3, , espresso)
+AC_INIT(ESPRESSO, 6.4, , espresso)
AC_PREREQ(2.64)
AC_CONFIG_MACRO_DIR([m4/])
From 8b0030f94c696f612c6b0924b6d65c6ad321430b Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Thu, 28 Feb 2019 19:36:22 +0100
Subject: [PATCH 03/24] Patch by Oliviero: new "plugin" allows removal of spin
from Environ
---
PW/src/plugin_int_forces.f90 | 12 ++++--------
1 file changed, 4 insertions(+), 8 deletions(-)
diff --git a/PW/src/plugin_int_forces.f90 b/PW/src/plugin_int_forces.f90
index 77a1d0ebf1..c103fcd37a 100644
--- a/PW/src/plugin_int_forces.f90
+++ b/PW/src/plugin_int_forces.f90
@@ -40,17 +40,15 @@ SUBROUTINE external_wg_corr_force( rhor, force )
USE kinds, ONLY : DP
USE cell_base, ONLY : omega
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau, zv
- use lsda_mod, only : nspin
USE gvect, ONLY : ngm, g
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
- !
USE martyna_tuckerman, ONLY : wg_corr_force
USE vlocal, ONLY : strf
!
IMPLICIT NONE
!
- REAL( DP ), INTENT(IN) :: rhor ( dfftp%nnr, nspin )
+ REAL( DP ), INTENT(IN) :: rhor ( dfftp%nnr )
REAL( DP ), INTENT(OUT) :: force (3, nat)
!
! ... Local variables
@@ -58,8 +56,7 @@ SUBROUTINE external_wg_corr_force( rhor, force )
COMPLEX (DP), ALLOCATABLE :: auxg( : ), auxr( : )
!
allocate(auxr(dfftp%nnr))
- auxr = cmplx(rhor(:,1),0.0_dp)
- if ( nspin .eq. 2 ) auxr = auxr + cmplx(rhor(:,2),0.0_dp)
+ auxr = cmplx(rhor,0.0_dp)
call fwfft ("Rho", auxr, dfftp)
!
allocate(auxg(ngm))
@@ -87,20 +84,19 @@ SUBROUTINE external_force_lc( rhor, force )
USE ions_base, ONLY : nat, ityp, tau
USE fft_base, ONLY : dfftp
USE gvect, ONLY : ngm, gstart, ngl, igtongl, g
- use lsda_mod, only : nspin
USE control_flags, ONLY : gamma_only
!
USE vlocal, ONLY : vloc
!
IMPLICIT NONE
!
- REAL( DP ), INTENT(IN) :: rhor ( dfftp%nnr, nspin )
+ REAL( DP ), INTENT(IN) :: rhor ( dfftp%nnr )
REAL( DP ), INTENT(OUT) :: force ( 3, nat )
!
! ... Local variables
!
CALL force_lc( nat, tau, ityp, alat, omega, ngm, ngl, igtongl, &
- g, rhor(:,1), dfftp%nl, gstart, gamma_only, vloc, force )
+ g, rhor, dfftp%nl, gstart, gamma_only, vloc, force )
!
RETURN
!
From 671b0fb40f7eb4b9a1c25fa9f7894c10d4929f9d Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Thu, 28 Feb 2019 20:48:25 +0100
Subject: [PATCH 04/24] Final change for Environ (Oliviero)
---
PW/src/v_of_rho.f90 | 41 ++++++++++++-----------------------------
1 file changed, 12 insertions(+), 29 deletions(-)
diff --git a/PW/src/v_of_rho.f90 b/PW/src/v_of_rho.f90
index 8dbda3d299..9712d9fc04 100644
--- a/PW/src/v_of_rho.f90
+++ b/PW/src/v_of_rho.f90
@@ -1043,56 +1043,39 @@ END SUBROUTINE v_hubbard_nc
SUBROUTINE v_h_of_rho_r( rhor, ehart, charge, v )
!----------------------------------------------------------------------------
!
- ! ... Hartree potential VH(r) from a density in R space n(r)
+ ! ... Hartree potential VH(r) from a density in R space n(r)
!
USE kinds, ONLY : DP
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
- USE lsda_mod, ONLY : nspin
!
IMPLICIT NONE
!
! ... Declares variables
!
- REAL( DP ), INTENT(IN) :: rhor( dfftp%nnr, nspin )
- REAL( DP ), INTENT(INOUT) :: v( dfftp%nnr, nspin )
+ REAL( DP ), INTENT(IN) :: rhor( dfftp%nnr )
+ REAL( DP ), INTENT(INOUT) :: v( dfftp%nnr )
REAL( DP ), INTENT(OUT) :: ehart, charge
!
! ... Local variables
!
- COMPLEX( DP ), ALLOCATABLE :: rhog( : , : )
+ COMPLEX( DP ), ALLOCATABLE :: rhog( : )
COMPLEX( DP ), ALLOCATABLE :: aux( : )
INTEGER :: is
!
! ... bring the (unsymmetrized) rho(r) to G-space (use aux as work array)
!
- ALLOCATE( rhog( dfftp%ngm, nspin ) )
+ ALLOCATE( rhog( dfftp%ngm ) )
ALLOCATE( aux( dfftp%nnr ) )
- DO is = 1, nspin
- aux(:) = CMPLX(rhor( : , is ),0.D0,kind=dp)
- CALL fwfft ('Rho', aux, dfftp)
- rhog(:,is) = aux(dfftp%nl(:))
- END DO
+ aux = CMPLX(rhor,0.D0,kind=dp)
+ CALL fwfft ('Rho', aux, dfftp)
+ rhog(:) = aux(dfftp%nl(:))
DEALLOCATE( aux )
!
- ! ... compute VH(r) from n(G)
+ ! ... compute VH(r) from n(G)
+ !
+ CALL v_h( rhog, ehart, charge, v )
!
- !^^ ... TEMPORARY FIX (newlsda-CPV) ...
- IF ( nspin==2 ) THEN
- rhog(:,1) = rhog(:,1) + rhog(:,2)
- rhog(:,2) = rhog(:,1) - rhog(:,2)*2._dp
- ENDIF
- !^^.......................
- !
- CALL v_h( rhog(:,1), ehart, charge, v )
- !
- !^^ ... TEMPORARY FIX (newlsda) ...
- IF ( nspin==2 ) THEN
- rhog(:,1) = ( rhog(:,1) + rhog(:,2) )*0.5_dp
- rhog(:,2) = rhog(:,1) - rhog(:,2)
- ENDIF
- !^^.......................
- !
DEALLOCATE( rhog )
!
RETURN
@@ -1102,7 +1085,7 @@ END SUBROUTINE v_h_of_rho_r
SUBROUTINE gradv_h_of_rho_r( rho, gradv )
!----------------------------------------------------------------------------
!
- ! ... Gradient of Hartree potential in R space from a total
+ ! ... Gradient of Hartree potential in R space from a total
! (spinless) density in R space n(r)
!
USE kinds, ONLY : DP
From f65046d3a97981cb2ca8ac3cdd741749bde6d229 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Thu, 28 Feb 2019 22:03:22 +0100
Subject: [PATCH 05/24] Check in PWCOND suggested by ALexander Smogunov
---
PWCOND/src/init_cond.f90 | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/PWCOND/src/init_cond.f90 b/PWCOND/src/init_cond.f90
index 68eaba3b62..901e3fff33 100644
--- a/PWCOND/src/init_cond.f90
+++ b/PWCOND/src/init_cond.f90
@@ -43,6 +43,10 @@ subroutine init_cond (nregion, flag)
nry = dffts%nr2
nrztot = dffts%nr3
! if(nrztot/2*2.eq.nrztot) nrztot = nrztot+1
+! check for the 1st Layer to be at Z=0
+ dz1 = MINVAL( abs(tau(3,1:nat)) ) * alat
+ IF (dz1 > 1.d-4) CALL errore ('init_cond ','for numerical reasons &
+ & the 1st Layer of a cell should be aligned with Z=0 plane',1)
zlen = at(3,3)
dz1 = zlen/nrztot
sarea = abs(at(1,1)*at(2,2)-at(2,1)*at(1,2))*alat**2
@@ -292,4 +296,3 @@ subroutine potz_split(vppottot,ztot,vppot,z,nrztot,nrz,nrxy,npol,iz0)
return
end subroutine potz_split
-
From 214b4d479ad351efb44fe663d47d0b6f8e37137d Mon Sep 17 00:00:00 2001
From: Valerio Vitale
Date: Fri, 1 Mar 2019 13:53:06 +0000
Subject: [PATCH 06/24] Bugfix in pw2wannier90
---
PP/src/pw2wannier90.f90 | 9913 ++++++++++++++++++++-------------------
1 file changed, 4957 insertions(+), 4956 deletions(-)
diff --git a/PP/src/pw2wannier90.f90 b/PP/src/pw2wannier90.f90
index 83aa273614..893b88c249 100644
--- a/PP/src/pw2wannier90.f90
+++ b/PP/src/pw2wannier90.f90
@@ -1,4956 +1,4957 @@
-!
-! Copyright (C) 2003-2013 Quantum ESPRESSO and Wannier90 groups
-! This file is distributed under the terms of the
-! GNU General Public License. See the file `License'
-! in the root directory of the present distribution,
-! or http://www.gnu.org/copyleft/gpl.txt .
-!
-! pw2wannier was written by Stefano de Gironcoli
-! with later additions by
-! Jonathan Yates - spinors
-! Arash Mostofi - gamma point and transport things
-! Timo Thonhauser, Graham Lopez, Ivo Souza
-! uHu, uIu terms for orbital magnetisation
-! please send bugs and comments to
-! Jonathan Yates and Arash Mostofi
-! Takashi Koretsune and Florian Thoele -- noncollinear and USPPs
-! Valerio Vitale - Selected columns of density matrix (SCDM)
-!
-!
-! NOTE: old_spinor_proj is still available for compatibility with old
-! nnkp files but should be removed soon.
-!
-!
-module wannier
- USE kinds, only : DP
- !integer, allocatable :: nnb(:) ! #b (ik)
- integer :: nnb ! #b
- integer, allocatable :: kpb(:,:) ! k+b (ik,ib)
- integer, allocatable :: g_kpb(:,:,:) ! G_k+b (ipol,ik,ib)
- integer, allocatable :: ig_(:,:) ! G_k+b (ipol,ik,ib)
- integer, allocatable :: lw(:,:), mw(:,:) ! l and m of wannier (16,n_wannier)
- integer, allocatable :: num_sph(:) ! num. func. in lin. comb., (n_wannier)
- logical, allocatable :: excluded_band(:)
- ! begin change Lopez, Thonhauser, Souza
- integer :: iun_nnkp,iun_mmn,iun_amn,iun_band,iun_spn,iun_plot,iun_parity,&
- nnbx,nexband,iun_uhu,&
- iun_uIu !ivo
- ! end change Lopez, Thonhauser, Souza
- integer :: n_wannier !number of WF
- integer :: n_proj !number of projection
- complex(DP), allocatable :: gf(:,:) ! guding_function(npwx,n_wannier)
- complex(DP), allocatable :: gf_spinor(:,:)
- complex(DP), allocatable :: sgf_spinor(:,:)
- integer :: ispinw, ikstart, ikstop, iknum
- character(LEN=15) :: wan_mode ! running mode
- logical :: logwann, wvfn_formatted, write_unk, write_eig, &
- ! begin change Lopez, Thonhauser, Souza
- write_amn,write_mmn,reduce_unk,write_spn,&
- write_unkg,write_uhu,&
- write_dmn,read_sym, & !YN
- write_uIu, spn_formatted, uHu_formatted, uIu_formatted, & !ivo
- ! end change Lopez, Thonhauser, Souza
- ! vv: Begin SCDM keywords
- scdm_proj
- character(LEN=15) :: scdm_entanglement
- real(DP) :: scdm_mu, scdm_sigma
- ! vv: End SCDM keywords
- ! run check for regular mesh
- logical :: regular_mesh = .true.
- ! input data from nnkp file
- real(DP), allocatable :: center_w(:,:) ! center_w(3,n_wannier)
- integer, allocatable :: spin_eig(:)
- real(DP), allocatable :: spin_qaxis(:,:)
- integer, allocatable :: l_w(:), mr_w(:) ! l and mr of wannier (n_wannier) as from table 3.1,3.2 of spec.
- integer, allocatable :: r_w(:) ! index of radial function (n_wannier) as from table 3.3 of spec.
- real(DP), allocatable :: xaxis(:,:),zaxis(:,:) ! xaxis and zaxis(3,n_wannier)
- real(DP), allocatable :: alpha_w(:) ! alpha_w(n_wannier) ( called zona in wannier spec)
- !
- real(DP), allocatable :: csph(:,:) ! expansion coefficients of gf on QE ylm function (16,n_wannier)
- CHARACTER(len=256) :: seedname = 'wannier' ! prepended to file names in wannier90
- ! For implementation of wannier_lib
- integer :: mp_grid(3) ! dimensions of MP k-point grid
- real(DP) :: rlatt(3,3),glatt(3,3) ! real and recip lattices (Cartesian co-ords, units of Angstrom)
- real(DP), allocatable :: kpt_latt(:,:) ! k-points in crystal co-ords. kpt_latt(3,iknum)
- real(DP), allocatable :: atcart(:,:) ! atom centres in Cartesian co-ords and Angstrom units. atcart(3,nat)
- integer :: num_bands ! number of bands left after exclusions
- character(len=3), allocatable :: atsym(:) ! atomic symbols. atsym(nat)
- integer :: num_nnmax=12
- complex(DP), allocatable :: m_mat(:,:,:,:), a_mat(:,:,:)
- complex(DP), allocatable :: u_mat(:,:,:), u_mat_opt(:,:,:)
- logical, allocatable :: lwindow(:,:)
- real(DP), allocatable :: wann_centers(:,:),wann_spreads(:)
- real(DP) :: spreads(3)
- real(DP), allocatable :: eigval(:,:)
- logical :: old_spinor_proj ! for compatability for nnkp files prior to W90v2.0
- integer,allocatable :: rir(:,:)
- logical,allocatable :: zerophase(:,:)
-end module wannier
-!
-
-
-!------------------------------------------------------------------------
-PROGRAM pw2wannier90
- ! This is the interface to the Wannier90 code: see http://www.wannier.org
- !------------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode, ionode_id
- USE mp_global, ONLY : mp_startup
- USE mp_pools, ONLY : npool
- USE mp, ONLY : mp_bcast
- USE mp_world, ONLY : world_comm
- USE cell_base, ONLY : at, bg
- USE lsda_mod, ONLY : nspin, isk
- USE klist, ONLY : nkstot
- USE io_files, ONLY : prefix, tmp_dir
- USE noncollin_module, ONLY : noncolin
- USE control_flags, ONLY : gamma_only
- USE environment,ONLY : environment_start, environment_end
- USE wannier
- !
- IMPLICIT NONE
- !
- CHARACTER(LEN=256), EXTERNAL :: trimcheck
- !
- INTEGER :: ios
- CHARACTER(len=4) :: spin_component
- CHARACTER(len=256) :: outdir
-
- ! these are in wannier module.....-> integer :: ispinw, ikstart, ikstop, iknum
- NAMELIST / inputpp / outdir, prefix, spin_component, wan_mode, &
- seedname, write_unk, write_amn, write_mmn, write_spn, write_eig,&
- ! begin change Lopez, Thonhauser, Souza
- wvfn_formatted, reduce_unk, write_unkg, write_uhu,&
- write_dmn, read_sym, & !YN:
- write_uIu, spn_formatted, uHu_formatted, uIu_formatted,& !ivo
- ! end change Lopez, Thonhauser, Souza
- regular_mesh,& !gresch
- ! begin change Vitale
- scdm_proj, scdm_entanglement, scdm_mu, scdm_sigma
- ! end change Vitale
- !
- ! initialise environment
- !
-#if defined(__MPI)
- CALL mp_startup ( )
-#endif
- !! not sure if this should be called also in 'library' mode or not !!
- CALL environment_start ( 'PW2WANNIER' )
- !
- CALL start_clock( 'init_pw2wan' )
- !
- ! Read input on i/o node and broadcast to the rest
- !
- ios = 0
- IF(ionode) THEN
- !
- ! Check to see if we are reading from a file
- !
- CALL input_from_file()
- !
- ! set default values for variables in namelist
- !
- CALL get_environment_variable( 'ESPRESSO_TMPDIR', outdir )
- IF ( trim( outdir ) == ' ' ) outdir = './'
- prefix = ' '
- seedname = 'wannier'
- spin_component = 'none'
- wan_mode = 'standalone'
- wvfn_formatted = .false.
- spn_formatted=.false.
- uHu_formatted=.false.
- uIu_formatted=.false.
- write_unk = .false.
- write_amn = .true.
- write_mmn = .true.
- write_spn = .false.
- write_eig = .true.
- ! begin change Lopez, Thonhauser, Souza
- write_uhu = .false.
- write_uIu = .false. !ivo
- ! end change Lopez, Thonhauser, Souza
- reduce_unk= .false.
- write_unkg= .false.
- write_dmn = .false. !YN:
- read_sym = .false. !YN:
- scdm_proj = .false.
- scdm_entanglement = 'isolated'
- scdm_mu = 0.0_dp
- scdm_sigma = 1.0_dp
- !
- ! reading the namelist inputpp
- !
- READ (5, inputpp, iostat=ios)
- !
- ! Check of namelist variables
- !
- tmp_dir = trimcheck(outdir)
- ! back to all nodes
- ENDIF
- !
- CALL mp_bcast(ios,ionode_id, world_comm)
- IF (ios /= 0) CALL errore( 'pw2wannier90', 'reading inputpp namelist', abs(ios))
- !
- ! broadcast input variable to all nodes
- !
- CALL mp_bcast(outdir,ionode_id, world_comm)
- CALL mp_bcast(tmp_dir,ionode_id, world_comm)
- CALL mp_bcast(prefix,ionode_id, world_comm)
- CALL mp_bcast(seedname,ionode_id, world_comm)
- CALL mp_bcast(spin_component,ionode_id, world_comm)
- CALL mp_bcast(wan_mode,ionode_id, world_comm)
- CALL mp_bcast(wvfn_formatted,ionode_id, world_comm)
- CALL mp_bcast(write_unk,ionode_id, world_comm)
- CALL mp_bcast(write_amn,ionode_id, world_comm)
- CALL mp_bcast(write_mmn,ionode_id, world_comm)
- CALL mp_bcast(write_eig,ionode_id, world_comm)
- ! begin change Lopez, Thonhauser, Souza
- CALL mp_bcast(write_uhu,ionode_id, world_comm)
- CALL mp_bcast(write_uIu,ionode_id, world_comm) !ivo
- ! end change Lopez, Thonhauser, Souza
- CALL mp_bcast(write_spn,ionode_id, world_comm)
- CALL mp_bcast(reduce_unk,ionode_id, world_comm)
- CALL mp_bcast(write_unkg,ionode_id, world_comm)
- CALL mp_bcast(write_dmn,ionode_id, world_comm)
- CALL mp_bcast(read_sym,ionode_id, world_comm)
- CALL mp_bcast(scdm_proj,ionode_id, world_comm)
- CALL mp_bcast(scdm_entanglement,ionode_id, world_comm)
- CALL mp_bcast(scdm_mu,ionode_id, world_comm)
- CALL mp_bcast(scdm_sigma,ionode_id, world_comm)
- !
- ! Check: kpoint distribution with pools not implemented
- !
- IF ( npool > 1 ) CALL errore( 'pw2wannier90', 'pools not implemented', npool )
- !
- ! Now allocate space for pwscf variables, read and check them.
- !
- logwann = .true.
- WRITE(stdout,*)
- WRITE(stdout,*) ' Reading nscf_save data'
- CALL read_file
- WRITE(stdout,*)
- !
- IF (noncolin.and.gamma_only) CALL errore('pw2wannier90',&
- 'Non-collinear and gamma_only not implemented',1)
- IF (noncolin.and.scdm_proj) CALL errore('pw2wannier90',&
- 'Non-collinear and SCDM not implemented',1)
- IF (gamma_only.and.scdm_proj) CALL errore('pw2wannier90',&
- 'Gamma_only and SCDM not implemented',1)
- IF (scdm_proj) then
- IF ((trim(scdm_entanglement) /= 'isolated') .AND. &
- (trim(scdm_entanglement) /= 'erfc') .AND. &
- (trim(scdm_entanglement) /= 'gaussian')) then
- call errore('pw2wannier90', &
- 'Can not recognize the choice for scdm_entanglement. ' &
- //'Valid options are: isolated, erfc and gaussian')
- ENDIF
- ENDIF
- IF (scdm_sigma <= 0._dp) &
- call errore('pw2wannier90','Sigma in the SCDM method must be positive.')
- !
- SELECT CASE ( trim( spin_component ) )
- CASE ( 'up' )
- WRITE(stdout,*) ' Spin CASE ( up )'
- ispinw = 1
- ikstart = 1
- ikstop = nkstot/2
- iknum = nkstot/2
- CASE ( 'down' )
- WRITE(stdout,*) ' Spin CASE ( down )'
- ispinw = 2
- ikstart = nkstot/2 + 1
- ikstop = nkstot
- iknum = nkstot/2
- CASE DEFAULT
- IF(noncolin) THEN
- WRITE(stdout,*) ' Spin CASE ( non-collinear )'
- ELSE
- WRITE(stdout,*) ' Spin CASE ( default = unpolarized )'
- ENDIF
- ispinw = 0
- ikstart = 1
- ikstop = nkstot
- iknum = nkstot
- END SELECT
- !
- CALL stop_clock( 'init_pw2wan' )
- !
- WRITE(stdout,*)
- WRITE(stdout,*) ' Wannier mode is: ',wan_mode
- WRITE(stdout,*)
- !
- IF(wan_mode=='standalone') THEN
- !
- WRITE(stdout,*) ' -----------------'
- WRITE(stdout,*) ' *** Reading nnkp '
- WRITE(stdout,*) ' -----------------'
- WRITE(stdout,*)
- CALL read_nnkp
- WRITE(stdout,*) ' Opening pp-files '
- CALL openfil_pp
- CALL ylm_expansion
- WRITE(stdout,*)
- WRITE(stdout,*)
- if(write_dmn)then
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*) ' *** Compute DMN '
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*)
- CALL compute_dmn !YN:
- WRITE(stdout,*)
- end if
- IF(write_amn) THEN
- IF(scdm_proj) THEN
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*) ' *** Compute A with SCDM-k'
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*)
- CALL compute_amn_with_scdm
- ELSE
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*) ' *** Compute A projections'
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*)
- CALL compute_amn
- ENDIF
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*) ' *** A matrix is not computed '
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*)
- ENDIF
- IF(write_mmn) THEN
- WRITE(stdout,*) ' ---------------'
- WRITE(stdout,*) ' *** Compute M '
- WRITE(stdout,*) ' ---------------'
- WRITE(stdout,*)
- CALL compute_mmn
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*) ' *** M matrix is not computed '
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*)
- ENDIF
- if(noncolin) then
- IF(write_spn) THEN
- WRITE(stdout,*) ' ------------------'
- WRITE(stdout,*) ' *** Compute Spin '
- WRITE(stdout,*) ' ------------------'
- WRITE(stdout,*)
- CALL compute_spin
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' --------------------------------'
- WRITE(stdout,*) ' *** Spin matrix is not computed '
- WRITE(stdout,*) ' --------------------------------'
- WRITE(stdout,*)
- ENDIF
- elseif(write_spn) then
- write(stdout,*) ' -----------------------------------'
- write(stdout,*) ' *** Non-collinear calculation is '
- write(stdout,*) ' required for spin '
- write(stdout,*) ' term to be computed '
- write(stdout,*) ' -----------------------------------'
- endif
- IF(write_uHu.or.write_uIu) THEN
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*) ' *** Compute Orb '
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*)
- CALL compute_orb
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------------'
- WRITE(stdout,*) ' *** Orbital terms are not computed '
- WRITE(stdout,*) ' -----------------------------------'
- WRITE(stdout,*)
- ENDIF
- IF(write_eig) THEN
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*) ' *** Write bands '
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*)
- CALL write_band
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*) ' *** Bands are not written '
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*)
- ENDIF
- IF(write_unk) THEN
- WRITE(stdout,*) ' --------------------'
- WRITE(stdout,*) ' *** Write plot info '
- WRITE(stdout,*) ' --------------------'
- WRITE(stdout,*)
- CALL write_plot
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*) ' *** Plot info is not printed '
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*)
- ENDIF
- IF(write_unkg) THEN
- WRITE(stdout,*) ' --------------------'
- WRITE(stdout,*) ' *** Write parity info '
- WRITE(stdout,*) ' --------------------'
- WRITE(stdout,*)
- CALL write_parity
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*) ' *** Parity info is not printed '
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*)
- ENDIF
- WRITE(stdout,*) ' ------------'
- WRITE(stdout,*) ' *** Stop pp '
- WRITE(stdout,*) ' ------------'
- WRITE(stdout,*)
- !
- IF ( ionode ) WRITE( stdout, * )
- CALL print_clock( 'init_pw2wan' )
- if(write_dmn ) CALL print_clock( 'compute_dmn' )!YN:
- IF(write_amn ) CALL print_clock( 'compute_amn' )
- IF(write_mmn ) CALL print_clock( 'compute_mmn' )
- IF(write_unk ) CALL print_clock( 'write_unk' )
- IF(write_unkg ) CALL print_clock( 'write_parity' )
- !! not sure if this should be called also in 'library' mode or not !!
- CALL environment_end ( 'PW2WANNIER' )
- IF ( ionode ) WRITE( stdout, * )
- CALL stop_pp
- !
- ENDIF
- !
- IF(wan_mode=='library') THEN
- !
-! seedname='wannier'
- WRITE(stdout,*) ' Setting up...'
- CALL setup_nnkp
- WRITE(stdout,*)
- WRITE(stdout,*) ' Opening pp-files '
- CALL openfil_pp
- WRITE(stdout,*)
- WRITE(stdout,*) ' Ylm expansion'
- CALL ylm_expansion
- WRITE(stdout,*)
- CALL compute_amn
- CALL compute_mmn
- if(noncolin) then
- IF(write_spn) THEN
- CALL compute_spin
- ENDIF
- ENDIF
- IF(write_uHu.or.write_uIu) THEN
- CALL compute_orb
- ENDIF
- CALL write_band
- IF(write_unk) CALL write_plot
- IF(write_unkg) THEN
- CALL write_parity
- ENDIF
- CALL run_wannier
- CALL lib_dealloc
- CALL stop_pp
- !
- ENDIF
- !
- IF(wan_mode=='wannier2sic') THEN
- !
- CALL read_nnkp
- CALL wan2sic
- !
- ENDIF
- !
- STOP
-END PROGRAM pw2wannier90
-!
-!-----------------------------------------------------------------------
-SUBROUTINE lib_dealloc
- !-----------------------------------------------------------------------
- !
- USE wannier
-
- IMPLICIT NONE
-
- DEALLOCATE(m_mat,u_mat,u_mat_opt,a_mat,eigval)
-
- RETURN
-END SUBROUTINE lib_dealloc
-!
-!-----------------------------------------------------------------------
-SUBROUTINE setup_nnkp
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode, ionode_id
- USE kinds, ONLY : DP
- USE constants, ONLY : eps6, tpi, bohr => BOHR_RADIUS_ANGS
- USE cell_base, ONLY : at, bg, alat
- USE gvect, ONLY : g, gg
- USE ions_base, ONLY : nat, tau, ityp, atm
- USE klist, ONLY : xk
- USE mp, ONLY : mp_bcast, mp_sum
- USE mp_pools, ONLY : intra_pool_comm
- USE mp_world, ONLY : world_comm
- USE wvfct, ONLY : nbnd,npwx
- USE control_flags, ONLY : gamma_only
- USE noncollin_module, ONLY : noncolin
- USE wannier
-
- IMPLICIT NONE
- real(DP) :: g_(3), gg_
- INTEGER :: ik, ib, ig, iw, ia, indexb, TYPE
- INTEGER, ALLOCATABLE :: ig_check(:,:)
- real(DP) :: xnorm, znorm, coseno
- INTEGER :: exclude_bands(nbnd)
-
- ! aam: translations between PW2Wannier90 and Wannier90
- ! pw2wannier90 <==> Wannier90
- ! nbnd num_bands_tot
- ! n_wannier num_wann
- ! num_bands num_bands
- ! nat num_atoms
- ! iknum num_kpts
- ! rlatt transpose(real_lattice)
- ! glatt transpose(recip_lattice)
- ! kpt_latt kpt_latt
- ! nnb nntot
- ! kpb nnlist
- ! g_kpb nncell
- ! mp_grid mp_grid
- ! center_w proj_site
- ! l_w,mr_w,r_w proj_l,proj_m,proj_radial
- ! xaxis,zaxis proj_x,proj_z
- ! alpha_w proj_zona
- ! exclude_bands exclude_bands
- ! atcart atoms_cart
- ! atsym atom_symbols
-
- ALLOCATE( kpt_latt(3,iknum) )
- ALLOCATE( atcart(3,nat), atsym(nat) )
- ALLOCATE( kpb(iknum,num_nnmax), g_kpb(3,iknum,num_nnmax) )
- ALLOCATE( center_w(3,nbnd), alpha_w(nbnd), l_w(nbnd), &
- mr_w(nbnd), r_w(nbnd), zaxis(3,nbnd), xaxis(3,nbnd) )
- ALLOCATE( excluded_band(nbnd) )
-
- ! real lattice (Cartesians, Angstrom)
- rlatt(:,:) = transpose(at(:,:))*alat*bohr
- ! reciprocal lattice (Cartesians, Angstrom)
- glatt(:,:) = transpose(bg(:,:))*tpi/(alat*bohr)
- ! convert Cartesian k-points to crystallographic co-ordinates
- kpt_latt(:,1:iknum)=xk(:,1:iknum)
- CALL cryst_to_cart(iknum,kpt_latt,at,-1)
- ! atom co-ordinates in Cartesian co-ords and Angstrom units
- atcart(:,:) = tau(:,:)*bohr*alat
- ! atom symbols
- DO ia=1,nat
- TYPE=ityp(ia)
- atsym(ia)=atm(TYPE)
- ENDDO
-
- ! MP grid dimensions
- CALL find_mp_grid()
-
- WRITE(stdout,'(" - Number of atoms is (",i3,")")') nat
-
-#if defined(__WANLIB)
- IF (ionode) THEN
- CALL wannier_setup(seedname,mp_grid,iknum,rlatt, & ! input
- glatt,kpt_latt,nbnd,nat,atsym,atcart,gamma_only,noncolin, & ! input
- nnb,kpb,g_kpb,num_bands,n_wannier,center_w, & ! output
- l_w,mr_w,r_w,zaxis,xaxis,alpha_w,exclude_bands) ! output
- ENDIF
-#endif
-
- CALL mp_bcast(nnb,ionode_id, world_comm)
- CALL mp_bcast(kpb,ionode_id, world_comm)
- CALL mp_bcast(g_kpb,ionode_id, world_comm)
- CALL mp_bcast(num_bands,ionode_id, world_comm)
- CALL mp_bcast(n_wannier,ionode_id, world_comm)
- CALL mp_bcast(center_w,ionode_id, world_comm)
- CALL mp_bcast(l_w,ionode_id, world_comm)
- CALL mp_bcast(mr_w,ionode_id, world_comm)
- CALL mp_bcast(r_w,ionode_id, world_comm)
- CALL mp_bcast(zaxis,ionode_id, world_comm)
- CALL mp_bcast(xaxis,ionode_id, world_comm)
- CALL mp_bcast(alpha_w,ionode_id, world_comm)
- CALL mp_bcast(exclude_bands,ionode_id, world_comm)
-
- IF(noncolin) THEN
- n_proj=n_wannier/2
- ELSE
- n_proj=n_wannier
- ENDIF
-
- ALLOCATE( gf(npwx,n_proj), csph(16,n_proj) )
-
- WRITE(stdout,'(" - Number of wannier functions is (",i3,")")') n_wannier
-
- excluded_band(1:nbnd)=.false.
- nexband=0
- band_loop: DO ib=1,nbnd
- indexb=exclude_bands(ib)
- IF (indexb>nbnd .or. indexb<0) THEN
- CALL errore('setup_nnkp',' wrong excluded band index ', 1)
- ELSEIF (indexb==0) THEN
- exit band_loop
- ELSE
- nexband=nexband+1
- excluded_band(indexb)=.true.
- ENDIF
- ENDDO band_loop
-
- IF ( (nbnd-nexband)/=num_bands ) &
- CALL errore('setup_nnkp',' something wrong with num_bands',1)
-
- DO iw=1,n_proj
- xnorm = sqrt(xaxis(1,iw)*xaxis(1,iw) + xaxis(2,iw)*xaxis(2,iw) + &
- xaxis(3,iw)*xaxis(3,iw))
- IF (xnorm < eps6) CALL errore ('setup_nnkp',' |xaxis| < eps ',1)
- znorm = sqrt(zaxis(1,iw)*zaxis(1,iw) + zaxis(2,iw)*zaxis(2,iw) + &
- zaxis(3,iw)*zaxis(3,iw))
- IF (znorm < eps6) CALL errore ('setup_nnkp',' |zaxis| < eps ',1)
- coseno = (xaxis(1,iw)*zaxis(1,iw) + xaxis(2,iw)*zaxis(2,iw) + &
- xaxis(3,iw)*zaxis(3,iw))/xnorm/znorm
- IF (abs(coseno) > eps6) &
- CALL errore('setup_nnkp',' xaxis and zaxis are not orthogonal !',1)
- IF (alpha_w(iw) < eps6) &
- CALL errore('setup_nnkp',' zona value must be positive', 1)
- ! convert wannier center in cartesian coordinates (in unit of alat)
- CALL cryst_to_cart( 1, center_w(:,iw), at, 1 )
- ENDDO
- WRITE(stdout,*) ' - All guiding functions are given '
-
- nnbx=0
- nnb=max(nnbx,nnb)
-
- ALLOCATE( ig_(iknum,nnb), ig_check(iknum,nnb) )
- ALLOCATE( zerophase(iknum,nnb) )
- zerophase = .false.
-
- DO ik=1, iknum
- DO ib = 1, nnb
- IF ( (g_kpb(1,ik,ib).eq.0) .and. &
- (g_kpb(2,ik,ib).eq.0) .and. &
- (g_kpb(3,ik,ib).eq.0) ) zerophase(ik,ib) = .true.
- g_(:) = REAL( g_kpb(:,ik,ib) )
- CALL cryst_to_cart (1, g_, bg, 1)
- gg_ = g_(1)*g_(1) + g_(2)*g_(2) + g_(3)*g_(3)
- ig_(ik,ib) = 0
- ig = 1
- DO WHILE (gg(ig) <= gg_ + eps6)
- IF ( (abs(g(1,ig)-g_(1)) < eps6) .and. &
- (abs(g(2,ig)-g_(2)) < eps6) .and. &
- (abs(g(3,ig)-g_(3)) < eps6) ) ig_(ik,ib) = ig
- ig= ig +1
- ENDDO
- ENDDO
- ENDDO
-
- ig_check(:,:) = ig_(:,:)
- CALL mp_sum( ig_check, intra_pool_comm )
- DO ik=1, iknum
- DO ib = 1, nnb
- IF (ig_check(ik,ib) ==0) &
- CALL errore('setup_nnkp', &
- ' g_kpb vector is not in the list of Gs', 100*ik+ib )
- ENDDO
- ENDDO
- DEALLOCATE (ig_check)
-
- WRITE(stdout,*) ' - All neighbours are found '
- WRITE(stdout,*)
-
- RETURN
-END SUBROUTINE setup_nnkp
- !
- !-----------------------------------------------------------------------
-SUBROUTINE run_wannier
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : ionode, ionode_id
- USE ions_base, ONLY : nat
- USE mp, ONLY : mp_bcast
- USE mp_world, ONLY : world_comm
- USE control_flags, ONLY : gamma_only
- USE wannier
-
- IMPLICIT NONE
-
- ALLOCATE(u_mat(n_wannier,n_wannier,iknum))
- ALLOCATE(u_mat_opt(num_bands,n_wannier,iknum))
- ALLOCATE(lwindow(num_bands,iknum))
- ALLOCATE(wann_centers(3,n_wannier))
- ALLOCATE(wann_spreads(n_wannier))
-
-#if defined(__WANLIB)
- IF (ionode) THEN
- CALL wannier_run(seedname,mp_grid,iknum,rlatt, & ! input
- glatt,kpt_latt,num_bands,n_wannier,nnb,nat, & ! input
- atsym,atcart,gamma_only,m_mat,a_mat,eigval, & ! input
- u_mat,u_mat_opt,lwindow,wann_centers,wann_spreads,spreads) ! output
- ENDIF
-#endif
-
- CALL mp_bcast(u_mat,ionode_id, world_comm)
- CALL mp_bcast(u_mat_opt,ionode_id, world_comm)
- CALL mp_bcast(lwindow,ionode_id, world_comm)
- CALL mp_bcast(wann_centers,ionode_id, world_comm)
- CALL mp_bcast(wann_spreads,ionode_id, world_comm)
- CALL mp_bcast(spreads,ionode_id, world_comm)
-
- RETURN
-END SUBROUTINE run_wannier
-!-----------------------------------------------------------------------
-!
-SUBROUTINE find_mp_grid()
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout
- USE kinds, ONLY: DP
- USE wannier
-
- IMPLICIT NONE
-
- ! <<>>
- INTEGER :: ik,ntemp,ii
- real(DP) :: min_k,temp(3,iknum),mpg1
-
- min_k=minval(kpt_latt(1,:))
- ii=0
- DO ik=1,iknum
- IF (kpt_latt(1,ik)==min_k) THEN
- ii=ii+1
- temp(:,ii)=kpt_latt(:,ik)
- ENDIF
- ENDDO
- ntemp=ii
-
- min_k=minval(temp(2,1:ntemp))
- ii=0
- DO ik=1,ntemp
- IF (temp(2,ik)==min_k) THEN
- ii=ii+1
- ENDIF
- ENDDO
- mp_grid(3)=ii
-
- min_k=minval(temp(3,1:ntemp))
- ii=0
- DO ik=1,ntemp
- IF (temp(3,ik)==min_k) THEN
- ii=ii+1
- ENDIF
- ENDDO
- mp_grid(2)=ii
-
- IF ( (mp_grid(2)==0) .or. (mp_grid(3)==0) ) &
- CALL errore('find_mp_grid',' one or more mp_grid dimensions is zero', 1)
-
- mpg1=iknum/(mp_grid(2)*mp_grid(3))
-
- mp_grid(1) = nint(mpg1)
-
- WRITE(stdout,*)
- WRITE(stdout,'(3(a,i3))') ' MP grid is ',mp_grid(1),' x',mp_grid(2),' x',mp_grid(3)
-
- IF (real(mp_grid(1),kind=DP)/=mpg1) &
- CALL errore('find_mp_grid',' determining mp_grid failed', 1)
-
- RETURN
-END SUBROUTINE find_mp_grid
-!-----------------------------------------------------------------------
-!
-SUBROUTINE read_nnkp
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode, ionode_id
- USE kinds, ONLY: DP
- USE constants, ONLY : eps6, tpi, bohr => BOHR_RADIUS_ANGS
- USE cell_base, ONLY : at, bg, alat
- USE gvect, ONLY : g, gg
- USE klist, ONLY : nkstot, xk
- USE mp, ONLY : mp_bcast, mp_sum
- USE mp_pools, ONLY : intra_pool_comm
- USE mp_world, ONLY : world_comm
- USE wvfct, ONLY : npwx, nbnd
- USE noncollin_module, ONLY : noncolin
- USE wannier
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- real(DP) :: g_(3), gg_
- INTEGER :: ik, ib, ig, ipol, iw, idum, indexb
- INTEGER numk, i, j
- INTEGER, ALLOCATABLE :: ig_check(:,:)
- real(DP) :: xx(3), xnorm, znorm, coseno
- LOGICAL :: have_nnkp,found
- INTEGER :: tmp_auto ! vv: Needed for the selection of projections with SCDM
-
- IF (ionode) THEN ! Read nnkp file on ionode only
-
- INQUIRE(file=trim(seedname)//".nnkp",exist=have_nnkp)
- IF(.not. have_nnkp) THEN
- CALL errore( 'pw2wannier90', 'Could not find the file '&
- &//trim(seedname)//'.nnkp', 1 )
- ENDIF
-
- iun_nnkp = find_free_unit()
- OPEN (unit=iun_nnkp, file=trim(seedname)//".nnkp",form='formatted', status="old")
-
- ENDIF
-
- nnbx=0
-
- ! check the information from *.nnkp with the nscf_save data
- WRITE(stdout,*) ' Checking info from wannier.nnkp file'
- WRITE(stdout,*)
-
- IF (ionode) THEN ! read from ionode only
-
- CALL scan_file_to('real_lattice',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find real_lattice block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- DO j=1,3
- READ(iun_nnkp,*) (rlatt(i,j),i=1,3)
- DO i = 1,3
- rlatt(i,j) = rlatt(i,j)/(alat*bohr)
- ENDDO
- ENDDO
- DO j=1,3
- DO i=1,3
- IF(abs(rlatt(i,j)-at(i,j))>eps6) THEN
- WRITE(stdout,*) ' Something wrong! '
- WRITE(stdout,*) ' rlatt(i,j) =',rlatt(i,j), ' at(i,j)=',at(i,j)
- CALL errore( 'pw2wannier90', 'Direct lattice mismatch', 3*j+i )
- ENDIF
- ENDDO
- ENDDO
- WRITE(stdout,*) ' - Real lattice is ok'
-
- CALL scan_file_to('recip_lattice',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find recip_lattice block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- DO j=1,3
- READ(iun_nnkp,*) (glatt(i,j),i=1,3)
- DO i = 1,3
- glatt(i,j) = (alat*bohr)*glatt(i,j)/tpi
- ENDDO
- ENDDO
- DO j=1,3
- DO i=1,3
- IF(abs(glatt(i,j)-bg(i,j))>eps6) THEN
- WRITE(stdout,*) ' Something wrong! '
- WRITE(stdout,*) ' glatt(i,j)=',glatt(i,j), ' bg(i,j)=',bg(i,j)
- CALL errore( 'pw2wannier90', 'Reciprocal lattice mismatch', 3*j+i )
- ENDIF
- ENDDO
- ENDDO
- WRITE(stdout,*) ' - Reciprocal lattice is ok'
-
- CALL scan_file_to('kpoints',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find kpoints block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- READ(iun_nnkp,*) numk
- IF(numk/=iknum) THEN
- WRITE(stdout,*) ' Something wrong! '
- WRITE(stdout,*) ' numk=',numk, ' iknum=',iknum
- CALL errore( 'pw2wannier90', 'Wrong number of k-points', numk)
- ENDIF
- IF(regular_mesh) THEN
- DO i=1,numk
- READ(iun_nnkp,*) xx(1), xx(2), xx(3)
- CALL cryst_to_cart( 1, xx, bg, 1 )
- IF(abs(xx(1)-xk(1,i))>eps6.or. &
- abs(xx(2)-xk(2,i))>eps6.or. &
- abs(xx(3)-xk(3,i))>eps6) THEN
- WRITE(stdout,*) ' Something wrong! '
- WRITE(stdout,*) ' k-point ',i,' is wrong'
- WRITE(stdout,*) xx(1), xx(2), xx(3)
- WRITE(stdout,*) xk(1,i), xk(2,i), xk(3,i)
- CALL errore( 'pw2wannier90', 'problems with k-points', i )
- ENDIF
- ENDDO
- ENDIF ! regular mesh check
- WRITE(stdout,*) ' - K-points are ok'
-
- ENDIF ! ionode
-
- ! Broadcast
- CALL mp_bcast(rlatt,ionode_id, world_comm)
- CALL mp_bcast(glatt,ionode_id, world_comm)
-
- IF (ionode) THEN ! read from ionode only
- if(noncolin) then
- old_spinor_proj=.false.
- CALL scan_file_to('spinor_projections',found)
- if(.not.found) then
- !try old style projections
- CALL scan_file_to('projections',found)
- if(found) then
- old_spinor_proj=.true.
- else
- CALL errore( 'pw2wannier90', 'Could not find projections block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- end if
- else
- old_spinor_proj=.false.
- CALL scan_file_to('projections',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find projections block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- endif
- READ(iun_nnkp,*) n_proj
- ENDIF
-
- ! Broadcast
- CALL mp_bcast(n_proj,ionode_id, world_comm)
- CALL mp_bcast(old_spinor_proj,ionode_id, world_comm)
-
- IF(old_spinor_proj)THEN
- WRITE(stdout,'(//," ****** begin WARNING ****** ",/)')
- WRITE(stdout,'(" The pw.x calculation was done with non-collinear spin ")')
- WRITE(stdout,'(" but spinor = T was not specified in the wannier90 .win file!")')
- WRITE(stdout,'(" Please set spinor = T and rerun wannier90.x -pp ")')
-! WRITE(stdout,'(/," If you are trying to reuse an old nnkp file, you can remove ")')
-! WRITE(stdout,'(" this check from pw2wannir90.f90 line 870, and recompile. ")')
- WRITE(stdout,'(/," ****** end WARNING ****** ",//)')
-! CALL errore("pw2wannier90","Spinorbit without spinor=T",1)
- ENDIF
-
- ! It is not clear if the next instruction is required or not, it probably depend
- ! on the version of wannier90 that was used to generate the nnkp file:
- IF(old_spinor_proj) THEN
- n_wannier=n_proj*2
- ELSE
- n_wannier=n_proj
- ENDIF
-
- ALLOCATE( center_w(3,n_proj), alpha_w(n_proj), gf(npwx,n_proj), &
- l_w(n_proj), mr_w(n_proj), r_w(n_proj), &
- zaxis(3,n_proj), xaxis(3,n_proj), csph(16,n_proj) )
- if(noncolin.and..not.old_spinor_proj) then
- ALLOCATE( spin_eig(n_proj),spin_qaxis(3,n_proj) )
- endif
-
- ! automatic projections
- IF (ionode) THEN
- CALL scan_file_to('auto_projections',found)
- IF (found) THEN
- IF (scdm_proj) THEN
- IF (n_proj > 0) THEN
- WRITE(stdout,'(//, " ****** begin Error message ******",/)')
- WRITE(stdout,'(/," Found a projection block, an auto_projections block",/)')
- WRITE(stdout,'(/," and scdm_proj = T in the input file. These three options are inconsistent.",/)')
- WRITE(stdout,'(/," Please refer to the Wannier90 User guide for correct use of these flags.",/)')
- WRITE(stdout,'(/, " ****** end Error message ******",//)')
- CALL errore( 'pw2wannier90', 'Inconsistent options for projections.', 1 )
- ELSE
- READ (iun_nnkp, *) n_wannier
- READ (iun_nnkp, *) tmp_auto
- IF (tmp_auto /= 0) CALL errore( 'pw2wannier90', 'Second entry in auto_projections block is not 0. ' // &
- 'See Wannier90 User Guide in the auto_projections section for clarifications.', 1 )
- ENDIF
- ELSE
- ! Fire an error whether or not a projections block is found
- CALL errore( 'pw2wannier90', 'scdm_proj = F but found an auto_projections block in '&
- &//trim(seedname)//'.nnkp', 1 )
- ENDIF
- ELSE
- IF (scdm_proj) THEN
- ! Fire an error whether or not a projections block is found
- CALL errore( 'pw2wannier90', 'scdm_proj = T but cannot find an auto_projections block in '&
- &//trim(seedname)//'.nnkp', 1 )
- ENDIF
- ENDIF
- ENDIF
-
- IF (ionode) THEN ! read from ionode only
- DO iw=1,n_proj
- READ(iun_nnkp,*) (center_w(i,iw), i=1,3), l_w(iw), mr_w(iw), r_w(iw)
- READ(iun_nnkp,*) (zaxis(i,iw),i=1,3),(xaxis(i,iw),i=1,3),alpha_w(iw)
- xnorm = sqrt(xaxis(1,iw)*xaxis(1,iw) + xaxis(2,iw)*xaxis(2,iw) + &
- xaxis(3,iw)*xaxis(3,iw))
- IF (xnorm < eps6) CALL errore ('read_nnkp',' |xaxis| < eps ',1)
- znorm = sqrt(zaxis(1,iw)*zaxis(1,iw) + zaxis(2,iw)*zaxis(2,iw) + &
- zaxis(3,iw)*zaxis(3,iw))
- IF (znorm < eps6) CALL errore ('read_nnkp',' |zaxis| < eps ',1)
- coseno = (xaxis(1,iw)*zaxis(1,iw) + xaxis(2,iw)*zaxis(2,iw) + &
- xaxis(3,iw)*zaxis(3,iw))/xnorm/znorm
- IF (abs(coseno) > eps6) &
- CALL errore('read_nnkp',' xaxis and zaxis are not orthogonal !',1)
- IF (alpha_w(iw) < eps6) &
- CALL errore('read_nnkp',' zona value must be positive', 1)
- ! convert wannier center in cartesian coordinates (in unit of alat)
- CALL cryst_to_cart( 1, center_w(:,iw), at, 1 )
- if(noncolin.and..not.old_spinor_proj) then
- READ(iun_nnkp,*) spin_eig(iw),(spin_qaxis(i,iw),i=1,3)
- xnorm = sqrt(spin_qaxis(1,iw)*spin_qaxis(1,iw) + spin_qaxis(2,iw)*spin_qaxis(2,iw) + &
- spin_qaxis(3,iw)*spin_qaxis(3,iw))
- IF (xnorm < eps6) CALL errore ('read_nnkp',' |xaxis| < eps ',1)
- spin_qaxis(:,iw)=spin_qaxis(:,iw)/xnorm
- endif
- ENDDO
- ENDIF
-
- ! Broadcast
- CALL mp_bcast(n_wannier,ionode_id, world_comm)
- CALL mp_bcast(center_w,ionode_id, world_comm)
- CALL mp_bcast(l_w,ionode_id, world_comm)
- CALL mp_bcast(mr_w,ionode_id, world_comm)
- CALL mp_bcast(r_w,ionode_id, world_comm)
- CALL mp_bcast(zaxis,ionode_id, world_comm)
- CALL mp_bcast(xaxis,ionode_id, world_comm)
- CALL mp_bcast(alpha_w,ionode_id, world_comm)
- if(noncolin.and..not.old_spinor_proj) then
- CALL mp_bcast(spin_eig,ionode_id, world_comm)
- CALL mp_bcast(spin_qaxis,ionode_id, world_comm)
- end if
-
- WRITE(stdout,'(" - Number of wannier functions is ok (",i3,")")') n_wannier
-
- IF (.not. scdm_proj) WRITE(stdout,*) ' - All guiding functions are given '
- !
- WRITE(stdout,*)
- WRITE(stdout,*) 'Projections:'
- DO iw=1,n_proj
- WRITE(stdout,'(3f12.6,3i3,f12.6)') &
- center_w(1:3,iw),l_w(iw),mr_w(iw),r_w(iw),alpha_w(iw)
- ENDDO
-
- IF (ionode) THEN ! read from ionode only
- CALL scan_file_to('nnkpts',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find nnkpts block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- READ (iun_nnkp,*) nnb
- ENDIF
-
- ! Broadcast
- CALL mp_bcast(nnb,ionode_id, world_comm)
- !
- nnbx = max (nnbx, nnb )
- !
- ALLOCATE ( kpb(iknum,nnbx), g_kpb(3,iknum,nnbx),&
- ig_(iknum,nnbx), ig_check(iknum,nnbx) )
- ALLOCATE( zerophase(iknum,nnbx) )
- zerophase = .false.
-
- ! read data about neighbours
- WRITE(stdout,*)
- WRITE(stdout,*) ' Reading data about k-point neighbours '
- WRITE(stdout,*)
-
- IF (ionode) THEN
- DO ik=1, iknum
- DO ib = 1, nnb
- READ(iun_nnkp,*) idum, kpb(ik,ib), (g_kpb(ipol,ik,ib), ipol =1,3)
- ENDDO
- ENDDO
- ENDIF
-
- ! Broadcast
- CALL mp_bcast(kpb,ionode_id, world_comm)
- CALL mp_bcast(g_kpb,ionode_id, world_comm)
-
- DO ik=1, iknum
- DO ib = 1, nnb
- IF ( (g_kpb(1,ik,ib).eq.0) .and. &
- (g_kpb(2,ik,ib).eq.0) .and. &
- (g_kpb(3,ik,ib).eq.0) ) zerophase(ik,ib) = .true.
- g_(:) = REAL( g_kpb(:,ik,ib) )
- CALL cryst_to_cart (1, g_, bg, 1)
- gg_ = g_(1)*g_(1) + g_(2)*g_(2) + g_(3)*g_(3)
- ig_(ik,ib) = 0
- ig = 1
- DO WHILE (gg(ig) <= gg_ + eps6)
- IF ( (abs(g(1,ig)-g_(1)) < eps6) .and. &
- (abs(g(2,ig)-g_(2)) < eps6) .and. &
- (abs(g(3,ig)-g_(3)) < eps6) ) ig_(ik,ib) = ig
- ig= ig +1
- ENDDO
- ENDDO
- ENDDO
- ig_check(:,:) = ig_(:,:)
- CALL mp_sum( ig_check, intra_pool_comm )
- DO ik=1, iknum
- DO ib = 1, nnb
- IF (ig_check(ik,ib) ==0) &
- CALL errore('read_nnkp', &
- ' g_kpb vector is not in the list of Gs', 100*ik+ib )
- ENDDO
- ENDDO
- DEALLOCATE (ig_check)
-
- WRITE(stdout,*) ' All neighbours are found '
- WRITE(stdout,*)
-
- ALLOCATE( excluded_band(nbnd) )
-
- IF (ionode) THEN ! read from ionode only
- CALL scan_file_to('exclude_bands',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find exclude_bands block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- READ (iun_nnkp,*) nexband
- excluded_band(1:nbnd)=.false.
- DO i=1,nexband
- READ(iun_nnkp,*) indexb
- IF (indexb<1 .or. indexb>nbnd) &
- CALL errore('read_nnkp',' wrong excluded band index ', 1)
- excluded_band(indexb)=.true.
- ENDDO
- ENDIF
- num_bands=nbnd-nexband
-
- ! Broadcast
- CALL mp_bcast(nexband,ionode_id, world_comm)
- CALL mp_bcast(excluded_band,ionode_id, world_comm)
- CALL mp_bcast(num_bands,ionode_id, world_comm)
-
- IF (ionode) CLOSE (iun_nnkp) ! ionode only
-
- RETURN
-END SUBROUTINE read_nnkp
-!
-!-----------------------------------------------------------------------
-SUBROUTINE scan_file_to (keyword,found)
- !-----------------------------------------------------------------------
- !
- USE wannier, ONLY :iun_nnkp
- USE io_global, ONLY : stdout
- IMPLICIT NONE
- CHARACTER(len=*), intent(in) :: keyword
- logical, intent(out) :: found
- CHARACTER(len=80) :: line1, line2
-!
-! by uncommenting the following line the file scan restarts every time
-! from the beginning thus making the reading independent on the order
-! of data-blocks
-! rewind (iun_nnkp)
-!
-10 CONTINUE
- READ(iun_nnkp,*,end=20) line1, line2
- IF(line1/='begin') GOTO 10
- IF(line2/=keyword) GOTO 10
- found=.true.
- RETURN
-20 found=.false.
- rewind (iun_nnkp)
-
-END SUBROUTINE scan_file_to
-!
-!-----------------------------------------------------------------------
-SUBROUTINE pw2wan_set_symm (nsym, sr, tvec)
- !-----------------------------------------------------------------------
- !
- ! Uses nkqs and index_sym from module pw2wan, computes rir
- !
- USE symm_base, ONLY : s, ftau, allfrac
- USE fft_base, ONLY : dffts
- USE cell_base, ONLY : at, bg
- USE wannier, ONLY : rir, read_sym
- USE kinds, ONLY : DP
- USE io_global, ONLY : stdout
- !
- IMPLICIT NONE
- !
- INTEGER , intent(in) :: nsym
- REAL(DP) , intent(in) :: sr(3,3,nsym), tvec(3,nsym)
- REAL(DP) :: st(3,3), v(3)
- INTEGER, allocatable :: s_in(:,:,:), ftau_in(:,:)
- !REAL(DP), allocatable:: ftau_in(:,:)
- INTEGER :: nxxs, nr1,nr2,nr3, nr1x,nr2x,nr3x
- INTEGER :: ikq, isym, i,j,k, ri,rj,rk, ir
- LOGICAL :: ispresent(nsym)
- !
- nr1 = dffts%nr1
- nr2 = dffts%nr2
- nr3 = dffts%nr3
- nr1x= dffts%nr1x
- nr2x= dffts%nr2x
- nr3x= dffts%nr3x
- nxxs = nr1x*nr2x*nr3x
- !
- ! sr -> s
- ALLOCATE(s_in(3,3,nsym), ftau_in(3,nsym))
- IF(read_sym ) THEN
- IF(allfrac) THEN
- call errore("pw2wan_set_symm", "use_all_frac = .true. + read_sym = .true. not supported", 1)
- END IF
- DO isym = 1, nsym
- !st = transpose( matmul(transpose(bg), sr(:,:,isym)) )
- st = transpose( matmul(transpose(bg), transpose(sr(:,:,isym))) )
- s_in(:,:,isym) = nint( matmul(transpose(at), st) )
- v = matmul(transpose(bg), tvec(:,isym))
- ftau_in(1,isym) = nint(v(1)*nr1)
- ftau_in(2,isym) = nint(v(2)*nr2)
- ftau_in(3,isym) = nint(v(3)*nr3)
- END DO
- IF( any(s(:,:,1:nsym) /= s_in(:,:,1:nsym)) .or. any(ftau_in(:,1:nsym) /= ftau(:,1:nsym)) ) THEN
- write(stdout,*) " Input symmetry is different from crystal symmetry"
- write(stdout,*)
- END IF
- ELSE
- s_in = s(:,:,1:nsym)
- ftau_in = ftau(:,1:nsym)
- END IF
- !
- IF(.not. allocated(rir)) ALLOCATE(rir(nxxs,nsym))
- rir = 0
- ispresent(1:nsym) = .false.
-
- DO isym = 1, nsym
- IF ( mod(s_in(2, 1, isym) * nr1, nr2) /= 0 .or. &
- mod(s_in(3, 1, isym) * nr1, nr3) /= 0 .or. &
- mod(s_in(1, 2, isym) * nr2, nr1) /= 0 .or. &
- mod(s_in(3, 2, isym) * nr2, nr3) /= 0 .or. &
- mod(s_in(1, 3, isym) * nr3, nr1) /= 0 .or. &
- mod(s_in(2, 3, isym) * nr3, nr2) /= 0 ) THEN
- CALL errore ('pw2waninit',' smooth grid is not compatible with &
- & symmetry: change cutoff',isym)
- ENDIF
- DO ir=1, nxxs
- rir(ir,isym) = ir
- ENDDO
- DO k = 1, nr3
- DO j = 1, nr2
- DO i = 1, nr1
- CALL ruotaijk (s_in(:,:,isym), (/0,0,0/), i,j,k, nr1,nr2,nr3, ri,rj,rk)
- !
- ir = i + ( j-1)*nr1x + ( k-1)*nr1x*nr2x
- rir(ir,isym) = ri + (rj-1)*nr1x + (rk-1)*nr1x*nr2x
- ENDDO
- ENDDO
- ENDDO
- ENDDO
- DEALLOCATE(s_in, ftau_in)
-END SUBROUTINE pw2wan_set_symm
-
-!-----------------------------------------------------------------------
-SUBROUTINE compute_dmn
- !Calculate d_matrix_wann/band for site-symmetry mode given by Rei Sakuma.
- !Contributions for this subroutine:
- ! Yoshiro Nohara (June to July, 2016)
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode, ionode_id
- USE kinds, ONLY: DP
- USE wvfct, ONLY : nbnd, npwx
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc, psic, psic_nc
- USE fft_base, ONLY : dffts, dfftp
- USE fft_interfaces, ONLY : fwfft, invfft
- USE klist, ONLY : nkstot, xk, igk_k, ngk
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE cell_base, ONLY : omega, alat, tpiba, at, bg
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE constants, ONLY : tpi, bohr => BOHR_RADIUS_ANGS
- USE uspp, ONLY : nkb, vkb
- USE uspp_param, ONLY : upf, nh, lmaxq, nhm
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum, mp_bcast
- USE mp_world, ONLY : world_comm
- USE noncollin_module,ONLY : noncolin, npol
- USE gvecw, ONLY : gcutw
- USE wannier
- USE symm_base, ONLY : nsymin=>nsym,srin=>sr,ftin=>ft,invsin=>invs
- USE fft_base, ONLY : dffts
- USE scatter_mod, ONLY : gather_grid, scatter_grid
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
- !
- real(DP), parameter :: p12(3,12)=reshape( &
- (/0d0, 0d0, 1.00000000000000d0, &
- 0.894427190999916d0, 0d0, 0.447213595499958d0, &
- 0.276393202250021d0, 0.850650808352040d0, 0.447213595499958d0, &
- -0.723606797749979d0, 0.525731112119134d0, 0.447213595499958d0, &
- -0.723606797749979d0, -0.525731112119134d0, 0.447213595499958d0, &
- 0.276393202250021d0, -0.850650808352040d0, 0.447213595499958d0, &
- 0.723606797749979d0, 0.525731112119134d0, -0.447213595499958d0, &
- -0.276393202250021d0, 0.850650808352040d0, -0.447213595499958d0, &
- -0.894427190999916d0, 0d0, -0.447213595499958d0, &
- -0.276393202250021d0, -0.850650808352040d0, -0.447213595499958d0,&
- 0.723606797749979d0, -0.525731112119134d0, -0.447213595499958d0,&
- 0d0, 0d0, -1.00000000000000d0/),(/3,12/))
- real(DP), parameter :: p20(3,20)=reshape( &
- (/0.525731112119134d0, 0.381966011250105d0, 0.850650808352040d0, &
- -0.200811415886227d0, 0.618033988749895d0, 0.850650808352040d0, &
- -0.649839392465813d0, 0d0, 0.850650808352040d0, &
- -0.200811415886227d0, -0.618033988749895d0, 0.850650808352040d0, &
- 0.525731112119134d0, -0.381966011250105d0, 0.850650808352040d0, &
- 0.850650808352040d0, 0.618033988749895d0, 0.200811415886227d0, &
- -0.324919696232906d0, 1.00000000000000d0, 0.200811415886227d0, &
- -1.05146222423827d0, 0d0, 0.200811415886227d0, &
- -0.324919696232906d0, -1.00000000000000d0, 0.200811415886227d0, &
- 0.850650808352040d0, -0.618033988749895d0, 0.200811415886227d0, &
- 0.324919696232906d0, 1.00000000000000d0, -0.200811415886227d0, &
- -0.850650808352040d0, 0.618033988749895d0, -0.200811415886227d0, &
- -0.850650808352040d0, -0.618033988749895d0, -0.200811415886227d0, &
- 0.324919696232906d0, -1.00000000000000d0, -0.200811415886227d0, &
- 1.05146222423827d0, 0d0, -0.200811415886227d0, &
- 0.200811415886227d0, 0.618033988749895d0, -0.850650808352040d0, &
- -0.525731112119134d0, 0.381966011250105d0, -0.850650808352040d0, &
- -0.525731112119134d0, -0.381966011250105d0, -0.850650808352040d0, &
- 0.200811415886227d0, -0.618033988749895d0, -0.850650808352040d0, &
- 0.649839392465813d0, 0d0, -0.850650808352040d0/),(/3,20/))
- real(DP), parameter :: pwg(2)=(/2.976190476190479d-2,3.214285714285711d-2/)
- !
- INTEGER :: npw, mmn_tot, ik, ikp, ipol, isym, npwq, i, m, n, ir, jsym
- INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt, nir
- INTEGER :: ikevc, ikpevcq, s, counter, iun_dmn, ig, igp, ip, jp, np, iw, jw
- COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
- becp2(:,:), Mkb(:,:), aux_nc(:,:)
- real(DP), ALLOCATABLE :: rbecp2(:,:),sr(:,:,:)
- COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:), phs(:,:)
- real(DP), ALLOCATABLE :: qg(:), workg(:)
- real(DP), ALLOCATABLE :: ylm(:,:), dxk(:,:), tvec(:,:), dylm(:,:), wws(:,:,:), vps2t(:,:,:), vaxis(:,:,:)
- INTEGER, ALLOCATABLE :: iks2k(:,:),iks2g(:,:),ik2ir(:),ir2ik(:)
- INTEGER, ALLOCATABLE :: iw2ip(:),ip2iw(:),ips2p(:,:),invs(:)
- logical, ALLOCATABLE :: lfound(:)
- COMPLEX(DP) :: mmn, zdotc, phase1
- real(DP) :: arg, g_(3),v1(3),v2(3),v3(3),v4(3),v5(3),err,ermx,dvec(3,32),dwgt(32),dvec2(3,32),dmat(3,3)
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp
- INTEGER :: nn,inn,loop,loop2
- LOGICAL :: nn_found
- INTEGER :: istart,iend
- INTEGER :: ibnd_n, ibnd_m,nsym, nxxs
- COMPLEX(DP), ALLOCATABLE :: psic_all(:), temppsic_all(:)
- LOGICAL :: have_sym
-
- CALL start_clock( 'compute_dmn' )
-
- IF (wan_mode=='standalone') THEN
- iun_dmn = find_free_unit()
- END IF
- dmat=0d0
- dmat(1,1)=1d0
- dmat(2,2)=1d0
- dmat(3,3)=1d0
- if(read_sym)then
- write(stdout,*) ' Reading symmetry from file '//trim(seedname)//'.sym'
- write(stdout,*) ' '
- if(ionode) then
- inquire(file=trim(seedname)//".sym",exist=have_sym)
- if(.not. have_sym) then
- call errore( 'pw2wannier90', 'Could not find the file '&
- &//trim(seedname)//'.sym', 1 )
- endif
- open(unit=iun_dmn, file=trim(seedname)//".sym",form='formatted')
- read(iun_dmn,*) nsym
- end if
- call mp_bcast(nsym,ionode_id, world_comm)
- allocate(invs(nsym),sr(3,3,nsym),tvec(3,nsym))
- invs=-999
- if(ionode) then
- do isym=1,nsym
- read(iun_dmn,*)
- read(iun_dmn,*) sr(:,:,isym), tvec(:,isym)
- end do
- close(iun_dmn)
- end if
- call mp_bcast(sr, ionode_id, world_comm)
- call mp_bcast(tvec, ionode_id, world_comm)
- do isym=1,nsym
- do jsym=1,nsym
- if(invs(jsym).ge.1) cycle
- v1=matmul(matmul(tvec(:,isym),sr(:,:,jsym))+tvec(:,jsym),bg)
- if(sum(abs(matmul(sr(:,:,isym),sr(:,:,jsym))-dmat))+sum(abs(v1-dble(nint(v1)))).lt.1d-3) then
- invs(isym)=jsym
- invs(jsym)=isym
- end if
- end do
- end do
- else
- nsym=nsymin
- allocate(sr(3,3,nsym),invs(nsym),tvec(3,nsym))
- ! original sr corresponds to transpose(s)
- ! so here we use sr = transpose(original sr)
- do isym=1,nsym
- sr(:,:,isym)=transpose(srin(:,:,isym))
- end do
- invs=invsin(1:nsym)
- tvec=matmul(at(:,:),ftin(:,1:nsym))
- if(ionode)then
- open(unit=iun_dmn, file=trim(seedname)//".sym",form='formatted')
- write(iun_dmn,"(i5)") nsym
- do isym=1,nsym
- write(iun_dmn,*)
- write(iun_dmn,"(1p,3e23.15)") sr(:,:,isym), tvec(:,isym)
- end do
- close(iun_dmn)
- end if
- end if
- do isym=1,nsym
- if(invs(isym).le.0.or.invs(isym).ge.nsym+1) then
- call errore("compute_dmn", "out of range in invs", invs(isym))
- end if
- v1=matmul(matmul(tvec(:,isym),sr(:,:,invs(isym)))+tvec(:,invs(isym)),bg)
- if(sum(abs(matmul(sr(:,:,isym),sr(:,:,invs(isym)))-dmat))+sum(abs(v1-dble(nint(v1)))).gt.1d-3) then
- call errore("compute_dmn", "inconsistent invs", 1)
- end if
- end do
-
- CALL pw2wan_set_symm ( nsym, sr, tvec )
-
- any_uspp = any(upf(1:ntyp)%tvanp)
-
- ALLOCATE( phase(dffts%nnr) )
- ALLOCATE( evcq(npol*npwx,nbnd) )
-
- IF(noncolin) CALL errore('compute_dmn','Non-collinear not implemented',1)
- IF (gamma_only) CALL errore('compute_dmn','gamma-only not implemented',1)
- IF (wan_mode=='library') CALL errore('compute_dmn','library mode not implemented',1)
-
- ALLOCATE( aux(npwx) )
-
- allocate(lfound(max(iknum,ngm)))
- if(.not.allocated(iks2k)) allocate(iks2k(iknum,nsym))
- iks2k=-999 !Sym.op.(isym) moves k(iks2k(ik,isym)) to k(ik) + G(iks2g(ik,isym)).
- do isym=1,nsym
- lfound=.false.
- do ik=1,iknum
- v1=xk(:,ik)
- v2=matmul(sr(:,:,isym),v1)
- do ikp=1,iknum
- if(lfound(ikp)) cycle
- v3=xk(:,ikp)
- v4=matmul(v2-v3,at)
- if(sum(abs(nint(v4)-v4)).lt.1d-5) then
- iks2k(ik,isym)=ikp
- lfound(ikp)=.true.
- end if
- if(iks2k(ik,isym).ge.1) exit
- end do
- end do
- end do
- deallocate(lfound)
- !if(count(iks2k.le.0).ne.0) call errore("compute_dmn", "inconsistent in iks2k", count(iks2k.le.0))
- if(.not.allocated(iks2g)) allocate(iks2g(iknum,nsym))
- iks2g=-999 !See above.
- do isym=1,nsym
- do ik=1,iknum
- ikp=iks2k(ik,isym)
- v1=xk(:,ikp)
- v2=matmul(v1,sr(:,:,isym))
- v3=xk(:,ik)
- do ig=1,ngm
- v4=g(:,ig)
- if(sum(abs(v3+v4-v2)).lt.1d-5) iks2g(ik,isym)=ig
- if(iks2g(ik,isym).ge.1) exit
- end do
- end do
- end do
- !if(count(iks2g.le.0).ne.0) call errore("compute_dmn", "inconsistent in iks2g", count(iks2g.le.0))
- !
- if(.not.allocated(ik2ir)) allocate(ik2ir(iknum))
- ik2ir=-999 !Gives irreducible-k points from regular-k points.
- if(.not.allocated(ir2ik)) allocate(ir2ik(iknum))
- ir2ik=-999 !Gives regular-k points from irreducible-k points.
- allocate(lfound(iknum))
- lfound=.false.
- nir=0
- do ik=1,iknum
- if(lfound(ik)) cycle
- lfound(ik)=.true.
- nir=nir+1
- ir2ik(nir)=ik
- ik2ir(ik)=nir
- do isym=1,nsym
- ikp=iks2k(ik,isym)
- if(lfound(ikp)) cycle
- lfound(ikp)=.true.
- ik2ir(ikp)=nir
- end do
- end do
- deallocate(lfound)
- !write(stdout,"(a)") "ik2ir(ir2ik)="
- !write(stdout,"(10i9)") ik2ir(ir2ik(1:nir))
- !write(stdout,"(a)") "ir2ik(ik2ir)="
- !write(stdout,"(10i9)") ir2ik(ik2ir(1:iknum))
-
- allocate(iw2ip(n_wannier),ip2iw(n_wannier))
- np=0 !Conversion table between Wannier and position indexes.
- do iw=1,n_wannier
- v1=center_w(:,iw)
- jp=0
- do ip=1,np
- if(sum(abs(v1-center_w(:,ip2iw(ip)))).lt.1d-2) then
- jp=ip
- exit
- end if
- end do
- if(jp.eq.0) then
- np=np+1
- iw2ip(iw)=np
- ip2iw(np)=iw
- else
- iw2ip(iw)=jp
- end if
- end do
- !write(stdout,"(a,10i9)") "iw2ip(ip2iw)="
- !write(stdout,"(10i9)") iw2ip(ip2iw(1:np))
- !write(stdout,"(a)") "ip2iw(iw2ip)="
- !write(stdout,"(10i9)") ip2iw(iw2ip(1:n_wannier))
- allocate(ips2p(np,nsym),lfound(np))
- ips2p=-999 !See below.
- write(stdout,"(a,i5)") " Number of symmetry operators = ", nsym
- do isym=1,nsym
- write(stdout,"(2x,i5,a)") isym, "-th symmetry operators is"
- write(stdout,"(3f15.7)") sr(:,:,isym), tvec(:,isym) !Writing rotation matrix and translation vector in Cartesian coordinates.
- if(isym.eq.1) then
- dmat=sr(:,:,isym)
- dmat(1,1)=dmat(1,1)-1d0
- dmat(2,2)=dmat(2,2)-1d0
- dmat(3,3)=dmat(3,3)-1d0
- if(sum(abs(dmat))+sum(abs(tvec(:,isym))).gt.1d-5) then
- call errore("compute_dmn", "Error: 1st-symmetry operator is not identical one.", 1)
- end if
- end if
- end do
- do isym=1,nsym
- lfound=.false.
- do ip=1,np
- v1=center_w(:,ip2iw(ip))
- v2=matmul(sr(:,:,isym),(v1+tvec(:,isym)))
- do jp=1,np
- if(lfound(jp)) cycle
- v3=center_w(:,ip2iw(jp))
- v4=matmul(v3-v2,bg)
- if(sum(abs(dble(nint(v4))-v4)).lt.1d-2) then
- lfound(jp)=.true.
- ips2p(ip,isym)=jp
- exit !Sym.op.(isym) moves position(ips2p(ip,isym)) to position(ip) + T, where
- end if !T is given by vps2t(:,ip,isym).
- end do
- if(ips2p(ip,isym).le.0) then
- write(stdout,"(a,3f18.10,a,3f18.10,a)")" Could not find ",v2,"(",matmul(v2,bg),")"
- write(stdout,"(a,3f18.10,a,3f18.10,a)")" coming from ",v1,"(",matmul(v1,bg),")"
- write(stdout,"(a,i5,a )")" of Wannier site",ip,"."
- call errore("compute_dmn", "Error: missing Wannier sites, see the output.", 1)
- end if
- end do
- end do
- allocate(vps2t(3,np,nsym)) !See above.
- do isym=1,nsym
- do ip=1,np
- v1=center_w(:,ip2iw(ip))
- jp=ips2p(ip,isym)
- v2=center_w(:,ip2iw(jp))
- v3=matmul(v2,sr(:,:,isym))-tvec(:,isym)
- vps2t(:,ip,isym)=v3-v1
- end do
- end do
- dvec(:,1:12)=p12
- dvec(:,13:32)=p20
- do ip=1,32
- dvec(:,ip)=dvec(:,ip)/sqrt(sum(dvec(:,ip)**2))
- end do
- dwgt(1:12)=pwg(1)
- dwgt(13:32)=pwg(2)
- !write(stdout,*) sum(dwgt) !Checking the weight sum to be 1.
- allocate(dylm(32,5),vaxis(3,3,n_wannier))
- dylm=0d0
- vaxis=0d0
- do ip=1,5
- CALL ylm_wannier(dylm(1,ip),2,ip,dvec,32)
- end do
- !do ip=1,5
- ! write(stdout,"(5f25.15)") (sum(dylm(:,ip)*dylm(:,jp)*dwgt)*2d0*tpi,jp=1,5)
- !end do !Checking spherical integral.
- allocate(wws(n_wannier,n_wannier,nsym))
- wws=0d0
- do iw=1,n_wannier
- call set_u_matrix (xaxis(:,iw),zaxis(:,iw),vaxis(:,:,iw))
- end do
- do isym=1,nsym
- do iw=1,n_wannier
- ip=iw2ip(iw)
- jp=ips2p(ip,isym)
- CALL ylm_wannier(dylm(1,1),l_w(iw),mr_w(iw),matmul(vaxis(:,:,iw),dvec),32)
- do jw=1,n_wannier
- if(iw2ip(jw).ne.jp) cycle
- do ir=1,32
- dvec2(:,ir)=matmul(sr(:,:,isym),dvec(:,ir))
- end do
- CALL ylm_wannier(dylm(1,2),l_w(jw),mr_w(jw),matmul(vaxis(:,:,jw),dvec2),32)
- wws(jw,iw,isym)=sum(dylm(:,1)*dylm(:,2)*dwgt)*2d0*tpi ! for sym.op.(isym).
- end do
- end do
- end do
- deallocate(dylm,vaxis)
- do isym=1,nsym
- do iw=1,n_wannier
- err=abs((sum(wws(:,iw,isym)**2)+sum(wws(iw,:,isym)**2))*.5d0-1d0)
- if(err.gt.1d-3) then
- write(stdout,"(a,i5,a,i5,a)") "compute_dmn: Symmetry operator (", isym, &
- ") could not transform Wannier function (", iw, ")."
- write(stdout,"(a,f15.7,a )") "compute_dmn: The error is ", err, "."
- call errore("compute_dmn", "Error: missing Wannier functions, see the output.", 1)
- end if
- end do
- end do
-
- IF (wan_mode=='standalone') THEN
- iun_dmn = find_free_unit()
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- IF (ionode) THEN
- OPEN (unit=iun_dmn, file=trim(seedname)//".dmn",form='formatted')
- WRITE (iun_dmn,*) header
- WRITE (iun_dmn,"(4i9)") nbnd-nexband, nsym, nir, iknum
- ENDIF
- ENDIF
-
- IF (ionode) THEN
- WRITE (iun_dmn,*)
- WRITE (iun_dmn,"(10i9)") ik2ir(1:iknum)
- WRITE (iun_dmn,*)
- WRITE (iun_dmn,"(10i9)") ir2ik(1:nir)
- do ir=1,nir
- WRITE (iun_dmn,*)
- WRITE (iun_dmn,"(10i9)") iks2k(ir2ik(ir),:)
- enddo
- ENDIF
- allocate(phs(n_wannier,n_wannier))
- phs=(0d0,0d0)
- WRITE(stdout,'(/)')
- WRITE(stdout,'(a,i8)') ' DMN(d_matrix_wann): nir = ',nir
- DO ir=1,nir
- ik=ir2ik(ir)
- WRITE (stdout,'(i8)',advance='no') ir
- IF( MOD(ir,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- do isym=1,nsym
- do iw=1,n_wannier
- ip=iw2ip(iw)
- jp=ips2p(ip,invs(isym))
- jw=ip2iw(jp)
- v1 = xk(:,iks2k(ik,isym)) - matmul(sr(:,:,isym),xk(:,ik))
- v2 = matmul(v1, sr(:,:,isym))
- phs(iw,iw)=exp(dcmplx(0d0,+sum(vps2t(:,jp,isym)*xk(:,ik))*tpi)) & !Phase of T.k with lattice vectors T of above.
- *exp(dcmplx(0d0,+sum(tvec(:,isym)*v2)*tpi)) !Phase of t.G with translation vector t(isym).
- end do
- IF (ionode) then
- WRITE (iun_dmn,*)
- WRITE (iun_dmn,"(1p,(' (',e18.10,',',e18.10,')'))") matmul(phs,dcmplx(wws(:,:,isym),0d0))
- end if
- end do
- end do
- if(mod(nir,10) /= 0) WRITE(stdout,*)
- WRITE(stdout,*) ' DMN(d_matrix_wann) calculated'
- deallocate(phs)
- !
- ! USPP
- !
- !
- IF(any_uspp) THEN
- CALL init_us_1
- CALL allocate_bec_type ( nkb, nbnd, becp )
- IF (gamma_only) THEN
- call errore("compute_dmn", "gamma-only mode not implemented", 1)
- ELSE
- ALLOCATE ( becp2(nkb,nbnd) )
- ENDIF
- ENDIF
- !
- ! qb is FT of Q(r)
- !
- nbt = nsym*nir!nnb * iknum
- !
- ALLOCATE( qg(nbt) )
- ALLOCATE (dxk(3,nbt))
- !
- ind = 0
- DO ir=1,nir
- ik=ir2ik(ir)
- DO isym=1,nsym!nnb
- ind = ind + 1
- ! ikp = kpb(ik,ib)
- !
- ! g_(:) = REAL( g_kpb(:,ik,ib) )
- ! CALL cryst_to_cart (1, g_, bg, 1)
- dxk(:,ind) = 0d0!xk(:,ikp) +g_(:) - xk(:,ik)
- qg(ind) = dxk(1,ind)*dxk(1,ind)+dxk(2,ind)*dxk(2,ind)+dxk(3,ind)*dxk(3,ind)
- ENDDO
- ! write (stdout,'(i3,12f8.4)') ik, qg((ik-1)*nnb+1:ik*nnb)
- ENDDO
- !
- ! USPP
- !
- IF(any_uspp) THEN
-
- ALLOCATE( ylm(nbt,lmaxq*lmaxq), qgm(nbt) )
- ALLOCATE( qb (nhm, nhm, ntyp, nbt) )
- !
- CALL ylmr2 (lmaxq*lmaxq, nbt, dxk, qg, ylm)
- qg(:) = sqrt(qg(:)) * tpiba
- !
- DO nt = 1, ntyp
- IF (upf(nt)%tvanp ) THEN
- DO ih = 1, nh (nt)
- DO jh = 1, nh (nt)
- CALL qvan2 (nbt, ih, jh, nt, qg, qgm, ylm)
- qb (ih, jh, nt, 1:nbt) = omega * qgm(1:nbt)
- ENDDO
- ENDDO
- ENDIF
- ENDDO
- !
- DEALLOCATE (qg, qgm, ylm )
- !
- ENDIF
-
- WRITE(stdout,'(/)')
- WRITE(stdout,'(a,i8)') ' DMN(d_matrix_band): nir = ',nir
- !
- ALLOCATE( Mkb(nbnd,nbnd) )
- ALLOCATE( workg(npwx) )
- !
- ! Set up variables and stuff needed to rotate wavefunctions
- nxxs = dffts%nr1x *dffts%nr2x *dffts%nr3x
- ALLOCATE(psic_all(nxxs), temppsic_all(nxxs) )
- !
- ind = 0
- DO ir=1,nir
- ik=ir2ik(ir)
- WRITE (stdout,'(i8)',advance='no') ir
- IF( MOD(ir,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- ikevc = ik + ikstart - 1
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
- npw = ngk(ik)
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
- ! below we compute the product of beta functions with |psi>
- CALL calbec (npw, vkb, evc, becp)
- ENDIF
- !
- !
- DO isym=1,nsym
- ind = ind + 1
- ikp = iks2k(ik,isym)
- ! read wfc at k+b
- ikpevcq = ikp + ikstart - 1
- ! if(noncolin) then
- ! call davcio (evcq_nc, 2*nwordwfc, iunwfc, ikpevcq, -1 )
- ! else
- CALL davcio (evcq, 2*nwordwfc, iunwfc, ikpevcq, -1 )
- ! end if
- npwq = ngk(ikp)
- do n=1,nbnd
- do ip=1,npwq !applying translation vector t.
- evcq(ip,n)=evcq(ip,n)*exp(dcmplx(0d0,+sum((matmul(g(:,igk_k(ip,ikp)),sr(:,:,isym))+xk(:,ik))*tvec(:,isym))*tpi))
- end do
- end do
- ! compute the phase
- phase(:) = (0.d0,0.d0)
- ! missing phase G of above is given here and below.
- IF(iks2g(ik,isym) >= 0) phase(dffts%nl(iks2g(ik,isym)))=(1d0,0d0)
- CALL invfft ('Wave', phase, dffts)
- do n=1,nbnd
- if(excluded_band(n)) cycle
- psic(:) = (0.d0, 0.d0)
- psic(dffts%nl(igk_k(1:npwq,ikp))) = evcq(1:npwq,n)
- ! go to real space
- CALL invfft ('Wave', psic, dffts)
-#if defined(__MPI)
- ! gather among all the CPUs
- CALL gather_grid(dffts, psic, temppsic_all)
- ! apply rotation
- !psic_all(1:nxxs) = temppsic_all(rir(1:nxxs,isym))
- psic_all(rir(1:nxxs,isym)) = temppsic_all(1:nxxs)
- ! scatter back a piece to each CPU
- CALL scatter_grid(dffts, psic_all, psic)
-#else
- psic(rir(1:nxxs, isym)) = psic(1:nxxs)
-#endif
- ! apply phase k -> k+G
- psic(1:dffts%nnr) = psic(1:dffts%nnr) * phase(1:dffts%nnr)
- ! go back to G space
- CALL fwfft ('Wave', psic, dffts)
- evcq(1:npw,n) = psic(dffts%nl (igk_k(1:npw,ik) ) )
- end do
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
- ! below we compute the product of beta functions with |psi>
- IF (gamma_only) THEN
- call errore("compute_dmn", "gamma-only mode not implemented", 1)
- ELSE
- CALL calbec ( npw, vkb, evcq, becp2 )
- ENDIF
- ENDIF
- !
- !
- Mkb(:,:) = (0.0d0,0.0d0)
- !
- IF (any_uspp) THEN
- ijkb0 = 0
- DO nt = 1, ntyp
- IF ( upf(nt)%tvanp ) THEN
- DO na = 1, nat
- !
- arg = dot_product( dxk(:,ind), tau(:,na) ) * tpi
- phase1 = cmplx( cos(arg), -sin(arg) ,kind=DP)
- !
- IF ( ityp(na) == nt ) THEN
- DO jh = 1, nh(nt)
- jkb = ijkb0 + jh
- DO ih = 1, nh(nt)
- ikb = ijkb0 + ih
- !
- DO m = 1,nbnd
- IF (excluded_band(m)) CYCLE
- IF (gamma_only) THEN
- call errore("compute_dmn", "gamma-only mode not implemented", 1)
- ELSE
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * qb(ih,jh,nt,ind) * &
- conjg( becp%k(ikb,m) ) * becp2(jkb,n)
- ENDDO
- ENDIF
- ENDDO ! m
- ENDDO !ih
- ENDDO !jh
- ijkb0 = ijkb0 + nh(nt)
- ENDIF !ityp
- ENDDO !nat
- ELSE !tvanp
- DO na = 1, nat
- IF ( ityp(na) == nt ) ijkb0 = ijkb0 + nh(nt)
- ENDDO
- ENDIF !tvanp
- ENDDO !ntyp
- ENDIF ! any_uspp
- !
- !
- ! loops on bands
- !
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE (iun_dmn,*)
- ENDIF
- !
- DO m=1,nbnd
- IF (excluded_band(m)) CYCLE
- !
- !
- ! Mkb(m,n) = Mkb(m,n) + \sum_{ijI} qb_{ij}^I * e^-i(0*tau_I)
- ! < beta_j,k2 | psi_n,k2 >
- !
- IF (gamma_only) THEN
- call errore("compute_dmn", "gamma-only mode not implemented", 1)
- ELSEIF(noncolin) THEN
- call errore("compute_dmn", "Non-collinear not implemented", 1)
- ELSE
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- mmn = zdotc (npw, evc(1,m),1,evcq(1,n),1)
- CALL mp_sum(mmn, intra_pool_comm)
- Mkb(m,n) = mmn + Mkb(m,n)
- ENDDO
- ENDIF
- ENDDO ! m
-
- ibnd_n = 0
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- ibnd_n = ibnd_n + 1
- ibnd_m = 0
- DO m=1,nbnd
- IF (excluded_band(m)) CYCLE
- ibnd_m = ibnd_m + 1
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE (iun_dmn,"(1p,(' (',e18.10,',',e18.10,')'))")dconjg(Mkb(n,m))
- ELSEIF (wan_mode=='library') THEN
- call errore("compute_dmn", "library mode not implemented", 1)
- ELSE
- CALL errore('compute_dmn',' value of wan_mode not recognised',1)
- ENDIF
- ENDDO
- ENDDO
- ENDDO !isym
- ENDDO !ik
-
- if(mod(nir,10) /= 0) WRITE(stdout,*)
- WRITE(stdout,*) ' DMN(d_matrix_band) calculated'
-
- IF (ionode .and. wan_mode=='standalone') CLOSE (iun_dmn)
-
- DEALLOCATE (Mkb, dxk, phase)
- DEALLOCATE(temppsic_all, psic_all)
- DEALLOCATE(aux)
- DEALLOCATE(evcq)
-
- IF(any_uspp) THEN
- DEALLOCATE ( qb)
- CALL deallocate_bec_type (becp)
- IF (gamma_only) THEN
- CALL errore('compute_dmn','gamma-only not implemented',1)
- ELSE
- DEALLOCATE (becp2)
- ENDIF
- ENDIF
- !
- CALL stop_clock( 'compute_dmn' )
-
- RETURN
-END SUBROUTINE compute_dmn
-!
-!-----------------------------------------------------------------------
-SUBROUTINE compute_mmn
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode
- USE kinds, ONLY: DP
- USE wvfct, ONLY : nbnd, npwx
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc, psic, psic_nc
- USE fft_base, ONLY : dffts, dfftp
- USE fft_interfaces, ONLY : fwfft, invfft
- USE klist, ONLY : nkstot, xk, igk_k, ngk
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE cell_base, ONLY : omega, alat, tpiba, at, bg
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE constants, ONLY : tpi
- USE uspp, ONLY : nkb, vkb
- USE uspp_param, ONLY : upf, nh, lmaxq, nhm
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum
- USE noncollin_module,ONLY : noncolin, npol
- USE spin_orb, ONLY : lspinorb
- USE gvecw, ONLY : gcutw
- USE wannier
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
- !
- INTEGER :: npw, mmn_tot, ik, ikp, ipol, ib, npwq, i, m, n
- INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
- INTEGER :: ikevc, ikpevcq, s, counter
- COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
- becp2(:,:), Mkb(:,:), aux_nc(:,:), becp2_nc(:,:,:)
- real(DP), ALLOCATABLE :: rbecp2(:,:)
- COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:), qq_so(:,:,:,:)
- real(DP), ALLOCATABLE :: qg(:), ylm(:,:), dxk(:,:)
- COMPLEX(DP) :: mmn, zdotc, phase1
- real(DP) :: arg, g_(3)
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp
- INTEGER :: nn,inn,loop,loop2
- LOGICAL :: nn_found
- INTEGER :: istart,iend
- INTEGER :: ibnd_n, ibnd_m
-
-
- CALL start_clock( 'compute_mmn' )
-
- any_uspp = any(upf(1:ntyp)%tvanp)
-
- ALLOCATE( phase(dffts%nnr) )
- ALLOCATE( evcq(npol*npwx,nbnd) )
-
- IF(noncolin) THEN
- ALLOCATE( aux_nc(npwx,npol) )
- ELSE
- ALLOCATE( aux(npwx) )
- ENDIF
-
- IF (gamma_only) ALLOCATE(aux2(npwx))
-
- IF (wan_mode=='library') ALLOCATE(m_mat(num_bands,num_bands,nnb,iknum))
-
- IF (wan_mode=='standalone') THEN
- iun_mmn = find_free_unit()
- IF (ionode) OPEN (unit=iun_mmn, file=trim(seedname)//".mmn",form='formatted')
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- IF (ionode) THEN
- WRITE (iun_mmn,*) header
- WRITE (iun_mmn,*) nbnd-nexband, iknum, nnb
- ENDIF
- ENDIF
-
- !
- ! USPP
- !
- !
- IF(any_uspp) THEN
- CALL init_us_1
- CALL allocate_bec_type ( nkb, nbnd, becp )
- IF (gamma_only) THEN
- ALLOCATE ( rbecp2(nkb,nbnd))
- else if (noncolin) then
- ALLOCATE ( becp2_nc(nkb,2,nbnd) )
- ELSE
- ALLOCATE ( becp2(nkb,nbnd) )
- ENDIF
- !
- ! qb is FT of Q(r)
- !
- nbt = nnb * iknum
- !
- ALLOCATE( qg(nbt) )
- ALLOCATE (dxk(3,nbt))
- !
- ind = 0
- DO ik=1,iknum
- DO ib=1,nnb
- ind = ind + 1
- ikp = kpb(ik,ib)
- !
- g_(:) = REAL( g_kpb(:,ik,ib) )
- CALL cryst_to_cart (1, g_, bg, 1)
- dxk(:,ind) = xk(:,ikp) +g_(:) - xk(:,ik)
- qg(ind) = dxk(1,ind)*dxk(1,ind)+dxk(2,ind)*dxk(2,ind)+dxk(3,ind)*dxk(3,ind)
- ENDDO
-! write (stdout,'(i3,12f8.4)') ik, qg((ik-1)*nnb+1:ik*nnb)
- ENDDO
-
- ALLOCATE( ylm(nbt,lmaxq*lmaxq), qgm(nbt) )
- ALLOCATE( qb (nhm, nhm, ntyp, nbt) )
- ALLOCATE( qq_so (nhm, nhm, 4, ntyp) )
- !
- CALL ylmr2 (lmaxq*lmaxq, nbt, dxk, qg, ylm)
- qg(:) = sqrt(qg(:)) * tpiba
- !
- DO nt = 1, ntyp
- IF (upf(nt)%tvanp ) THEN
- DO ih = 1, nh (nt)
- DO jh = 1, nh (nt)
- CALL qvan2 (nbt, ih, jh, nt, qg, qgm, ylm)
- qb (ih, jh, nt, 1:nbt) = omega * qgm(1:nbt)
- ENDDO
- ENDDO
- ENDIF
- ENDDO
- !
- DEALLOCATE (qg, qgm, ylm )
- !
- ENDIF
-
- WRITE(stdout,'(a,i8)') ' MMN: iknum = ',iknum
- !
- ALLOCATE( Mkb(nbnd,nbnd) )
- !
- ind = 0
- DO ik=1,iknum
- WRITE (stdout,'(i8)',advance='no') ik
- IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- ikevc = ik + ikstart - 1
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
- npw = ngk(ik)
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
- ! below we compute the product of beta functions with |psi>
- CALL calbec (npw, vkb, evc, becp)
- ENDIF
- !
- !
- !do ib=1,nnb(ik)
- DO ib=1,nnb
- ind = ind + 1
- ikp = kpb(ik,ib)
-! read wfc at k+b
- ikpevcq = ikp + ikstart - 1
-! if(noncolin) then
-! call davcio (evcq_nc, 2*nwordwfc, iunwfc, ikpevcq, -1 )
-! else
- CALL davcio (evcq, 2*nwordwfc, iunwfc, ikpevcq, -1 )
-! end if
-! compute the phase
- IF (.not.zerophase(ik,ib)) THEN
- phase(:) = (0.d0,0.d0)
- IF ( ig_(ik,ib)>0) phase( dffts%nl(ig_(ik,ib)) ) = (1.d0,0.d0)
- CALL invfft ('Wave', phase, dffts)
- ENDIF
- !
- ! USPP
- !
- npwq = ngk(ikp)
- IF(any_uspp) THEN
- CALL init_us_2 (npwq, igk_k(1,ikp), xk(1,ikp), vkb)
- ! below we compute the product of beta functions with |psi>
- IF (gamma_only) THEN
- CALL calbec ( npwq, vkb, evcq, rbecp2 )
- else if (noncolin) then
- CALL calbec ( npwq, vkb, evcq, becp2_nc )
-
- if (lspinorb) then
- qq_so = (0.0d0, 0.0d0)
- call transform_qq_so(qb(:,:,:,ind), qq_so)
- endif
-
- ELSE
- CALL calbec ( npwq, vkb, evcq, becp2 )
- ENDIF
- ENDIF
- !
- !
- Mkb(:,:) = (0.0d0,0.0d0)
- !
- IF (any_uspp) THEN
- ijkb0 = 0
- DO nt = 1, ntyp
- IF ( upf(nt)%tvanp ) THEN
- DO na = 1, nat
- !
- arg = dot_product( dxk(:,ind), tau(:,na) ) * tpi
- phase1 = cmplx( cos(arg), -sin(arg) ,kind=DP)
- !
- IF ( ityp(na) == nt ) THEN
- DO jh = 1, nh(nt)
- jkb = ijkb0 + jh
- DO ih = 1, nh(nt)
- ikb = ijkb0 + ih
- !
- DO m = 1,nbnd
- IF (excluded_band(m)) CYCLE
- IF (gamma_only) THEN
- DO n=1,m ! Mkb(m,n) is symmetric in m and n for gamma_only case
- IF (excluded_band(n)) CYCLE
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * qb(ih,jh,nt,ind) * &
- becp%r(ikb,m) * rbecp2(jkb,n)
- ENDDO
- else if (noncolin) then
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- if (lspinorb) then
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * ( &
- qq_so(ih,jh,1,nt) * conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 1, n) &
- + qq_so(ih,jh,2,nt) * conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 2, n) &
- + qq_so(ih,jh,3,nt) * conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 1, n) &
- + qq_so(ih,jh,4,nt) * conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 2, n) &
- )
- else
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * qb(ih,jh,nt,ind) * &
- (conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 1, n) &
- + conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 2, n) )
- endif
- ENDDO
- ELSE
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * qb(ih,jh,nt,ind) * &
- conjg( becp%k(ikb,m) ) * becp2(jkb,n)
- ENDDO
- ENDIF
- ENDDO ! m
- ENDDO !ih
- ENDDO !jh
- ijkb0 = ijkb0 + nh(nt)
- ENDIF !ityp
- ENDDO !nat
- ELSE !tvanp
- DO na = 1, nat
- IF ( ityp(na) == nt ) ijkb0 = ijkb0 + nh(nt)
- ENDDO
- ENDIF !tvanp
- ENDDO !ntyp
- ENDIF ! any_uspp
- !
- !
-! loops on bands
- !
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE (iun_mmn,'(7i5)') ik, ikp, (g_kpb(ipol,ik,ib), ipol=1,3)
- ENDIF
- !
- DO m=1,nbnd
- IF (excluded_band(m)) CYCLE
- !
- IF(noncolin) THEN
- psic_nc(:,:) = (0.d0, 0.d0)
- DO ipol=1,2!npol
- istart=(ipol-1)*npwx+1
- iend=istart+npw-1
- psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol ) = evc(istart:iend, m)
- IF (.not.zerophase(ik,ib)) THEN
- CALL invfft ('Wave', psic_nc(:,ipol), dffts)
- psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * &
- phase(1:dffts%nnr)
- CALL fwfft ('Wave', psic_nc(:,ipol), dffts)
- ENDIF
- aux_nc(1:npwq,ipol) = psic_nc(dffts%nl (igk_k(1:npwq,ikp)),ipol )
- ENDDO
- ELSE
- psic(:) = (0.d0, 0.d0)
- psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw, m)
- IF(gamma_only) psic(dffts%nlm(igk_k(1:npw,ik) ) ) = conjg(evc (1:npw, m))
- IF (.not.zerophase(ik,ib)) THEN
- CALL invfft ('Wave', psic, dffts)
- psic(1:dffts%nnr) = psic(1:dffts%nnr) * phase(1:dffts%nnr)
- CALL fwfft ('Wave', psic, dffts)
- ENDIF
- aux(1:npwq) = psic(dffts%nl (igk_k(1:npwq,ikp) ) )
- ENDIF
- IF(gamma_only) THEN
- IF (gstart==2) psic(dffts%nlm(1)) = (0.d0,0.d0)
- aux2(1:npwq) = conjg(psic(dffts%nlm(igk_k(1:npwq,ikp) ) ) )
- ENDIF
- !
- ! Mkb(m,n) = Mkb(m,n) + \sum_{ijI} qb_{ij}^I * e^-i(b*tau_I)
- ! < beta_j,k2 | psi_n,k2 >
- !
- IF (gamma_only) THEN
- DO n=1,m ! Mkb(m,n) is symmetric in m and n for gamma_only case
- IF (excluded_band(n)) CYCLE
- mmn = zdotc (npwq, aux,1,evcq(1,n),1) &
- + conjg(zdotc(npwq,aux2,1,evcq(1,n),1))
- CALL mp_sum(mmn, intra_pool_comm)
- Mkb(m,n) = mmn + Mkb(m,n)
- IF (m/=n) Mkb(n,m) = Mkb(m,n) ! fill other half of matrix by symmetry
- ENDDO
- ELSEIF(noncolin) THEN
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- mmn=(0.d0, 0.d0)
-! do ipol=1,2
-! mmn = mmn+zdotc (npwq, aux_nc(1,ipol),1,evcq_nc(1,ipol,n),1)
- mmn = mmn + zdotc (npwq, aux_nc(1,1),1,evcq(1,n),1) &
- + zdotc (npwq, aux_nc(1,2),1,evcq(npwx+1,n),1)
-! end do
- CALL mp_sum(mmn, intra_pool_comm)
- Mkb(m,n) = mmn + Mkb(m,n)
- ENDDO
- ELSE
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- mmn = zdotc (npwq, aux,1,evcq(1,n),1)
- CALL mp_sum(mmn, intra_pool_comm)
- Mkb(m,n) = mmn + Mkb(m,n)
- ENDDO
- ENDIF
- ENDDO ! m
-
- ibnd_n = 0
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- ibnd_n = ibnd_n + 1
- ibnd_m = 0
- DO m=1,nbnd
- IF (excluded_band(m)) CYCLE
- ibnd_m = ibnd_m + 1
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE (iun_mmn,'(2f18.12)') Mkb(m,n)
- ELSEIF (wan_mode=='library') THEN
- m_mat(ibnd_m,ibnd_n,ib,ik)=Mkb(m,n)
- ELSE
- CALL errore('compute_mmn',' value of wan_mode not recognised',1)
- ENDIF
- ENDDO
- ENDDO
-
- ENDDO !ib
- ENDDO !ik
-
- IF (ionode .and. wan_mode=='standalone') CLOSE (iun_mmn)
-
- IF (gamma_only) DEALLOCATE(aux2)
- DEALLOCATE (Mkb, phase)
- IF (any_uspp) DEALLOCATE (dxk)
- IF(noncolin) THEN
- DEALLOCATE(aux_nc)
- ELSE
- DEALLOCATE(aux)
- ENDIF
- DEALLOCATE(evcq)
-
- IF(any_uspp) THEN
- DEALLOCATE ( qb)
- DEALLOCATE (qq_so)
- CALL deallocate_bec_type (becp)
- IF (gamma_only) THEN
- DEALLOCATE (rbecp2)
- else if (noncolin) then
- deallocate (becp2_nc)
- ELSE
- DEALLOCATE (becp2)
- ENDIF
- ENDIF
-!
- WRITE(stdout,'(/)')
- WRITE(stdout,*) ' MMN calculated'
-
- CALL stop_clock( 'compute_mmn' )
-
- RETURN
-END SUBROUTINE compute_mmn
-
-!-----------------------------------------------------------------------
-SUBROUTINE compute_spin
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode
- USE kinds, ONLY: DP
- USE wvfct, ONLY : nbnd, npwx
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc, psic, psic_nc
- USE fft_base, ONLY : dffts, dfftp
- USE fft_interfaces, ONLY : fwfft, invfft
- USE klist, ONLY : nkstot, xk, ngk, igk_k
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE cell_base, ONLY : alat, at, bg
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE constants, ONLY : tpi
- USE uspp, ONLY : nkb, vkb
- USE uspp_param, ONLY : upf, nh, lmaxq
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum
- USE noncollin_module,ONLY : noncolin, npol
- USE gvecw, ONLY : gcutw
- USE wannier
- ! begin change Lopez, Thonhauser, Souza
- USE mp, ONLY : mp_barrier
- USE scf, ONLY : vrs, vltot, v, kedtau
- USE gvecs, ONLY : doublegrid
- USE lsda_mod, ONLY : nspin
- USE constants, ONLY : rytoev
-
- USE uspp_param, ONLY : upf, nh, nhm
- USE uspp, ONLY: qq_nt, nhtol,nhtoj, indv
- USE spin_orb, ONLY : fcoef
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
- !
- INTEGER :: npw, mmn_tot, ik, ikp, ipol, ib, i, m, n
- INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
- INTEGER :: ikevc, ikpevcq, s, counter
- COMPLEX(DP) :: mmn, zdotc, phase1
- real(DP) :: arg, g_(3)
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp
- INTEGER :: nn,inn,loop,loop2
- LOGICAL :: nn_found
- INTEGER :: istart,iend
- COMPLEX(DP) :: sigma_x,sigma_y,sigma_z,cdum1,cdum2
- complex(DP), allocatable :: spn(:,:), spn_aug(:,:)
-
- integer :: np, is1, is2, kh, kkb
- complex(dp) :: sigma_x_aug, sigma_y_aug, sigma_z_aug
- COMPLEX(DP), ALLOCATABLE :: be_n(:,:), be_m(:,:)
-
-
- any_uspp = any(upf(1:ntyp)%tvanp)
-
- if (any_uspp) then
- CALL init_us_1
- CALL allocate_bec_type ( nkb, nbnd, becp )
- ALLOCATE(be_n(nhm,2))
- ALLOCATE(be_m(nhm,2))
- endif
-
-
- if (write_spn) allocate(spn(3,(num_bands*(num_bands+1))/2))
- if (write_spn) allocate(spn_aug(3,(num_bands*(num_bands+1))/2))
- spn_aug = (0.0d0, 0.0d0)
-!ivo
-! not sure this is really needed
- if((write_spn.or.write_uhu.or.write_uIu).and.wan_mode=='library')&
- call errore('pw2wannier90',&
- 'write_spn, write_uhu, and write_uIu not meant to work library mode',1)
-!endivo
-
- IF(write_spn.and.noncolin) THEN
- IF (ionode) then
- iun_spn = find_free_unit()
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- if(spn_formatted) then
- OPEN (unit=iun_spn, file=trim(seedname)//".spn",form='formatted')
- WRITE (iun_spn,*) header !ivo
- WRITE (iun_spn,*) nbnd-nexband,iknum
- else
- OPEN (unit=iun_spn, file=trim(seedname)//".spn",form='unformatted')
- WRITE (iun_spn) header !ivo
- WRITE (iun_spn) nbnd-nexband,iknum
- endif
- ENDIF
- ENDIF
- !
- WRITE(stdout,'(a,i8)') ' iknum = ',iknum
-
- ind = 0
- DO ik=1,iknum
- WRITE (stdout,'(i8)') ik
- ikevc = ik + ikstart - 1
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
- npw = ngk(ik)
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
- ! below we compute the product of beta functions with |psi>
- CALL calbec (npw, vkb, evc, becp)
- ENDIF
-
-
- IF(write_spn.and.noncolin) THEN
- counter=0
- DO m=1,nbnd
- if(excluded_band(m)) cycle !ivo
- DO n=1,m
- if(excluded_band(n)) cycle !ivo
- cdum1=zdotc(npw,evc(1,n),1,evc(npwx+1,m),1)
- call mp_sum(cdum1,intra_pool_comm)
- cdum2=zdotc(npw,evc(npwx+1,n),1,evc(1,m),1)
- call mp_sum(cdum2,intra_pool_comm)
- sigma_x=cdum1+cdum2
- sigma_y=cmplx_i*(cdum2-cdum1)
- sigma_z=zdotc(npw,evc(1,n),1,evc(1,m),1)&
- -zdotc(npw,evc(npwx+1,n),1,evc(npwx+1,m),1)
- call mp_sum(sigma_z,intra_pool_comm)
- counter=counter+1
- spn(1,counter)=sigma_x
- spn(2,counter)=sigma_y
- spn(3,counter)=sigma_z
-
- if (any_uspp) then
- sigma_x_aug = (0.0d0, 0.0d0)
- sigma_y_aug = (0.0d0, 0.0d0)
- sigma_z_aug = (0.0d0, 0.0d0)
- ijkb0 = 0
-
- DO np = 1, ntyp
- IF ( upf(np)%tvanp ) THEN
- DO na = 1, nat
- IF (ityp(na)==np) THEN
- be_m = 0.d0
- be_n = 0.d0
- DO ih = 1, nh(np)
- ikb = ijkb0 + ih
- IF (upf(np)%has_so) THEN
- DO kh = 1, nh(np)
- IF ((nhtol(kh,np)==nhtol(ih,np)).and. &
- (nhtoj(kh,np)==nhtoj(ih,np)).and. &
- (indv(kh,np)==indv(ih,np))) THEN
- kkb=ijkb0 + kh
- DO is1=1,2
- DO is2=1,2
- be_n(ih,is1)=be_n(ih,is1)+ &
- fcoef(ih,kh,is1,is2,np)* &
- becp%nc(kkb,is2,n)
-
- be_m(ih,is1)=be_m(ih,is1)+ &
- fcoef(ih,kh,is1,is2,np)* &
- becp%nc(kkb,is2,m)
- ENDDO
- ENDDO
- ENDIF
- ENDDO
- ELSE
- DO is1=1,2
- be_n(ih, is1) = becp%nc(ikb, is1, n)
- be_m(ih, is1) = becp%nc(ikb, is1, m)
- ENDDO
- ENDIF
- ENDDO
- DO ih = 1, nh(np)
- DO jh = 1, nh(np)
- sigma_x_aug = sigma_x_aug &
- + qq_nt(ih,jh,np) * ( be_m(jh,2)*conjg(be_n(ih,1))+ be_m(jh,1)*conjg(be_n(ih,2)) )
-
- sigma_y_aug = sigma_y_aug &
- + qq_nt(ih,jh,np) * ( &
- be_m(jh,1) * conjg(be_n(ih,2)) &
- - be_m(jh,2) * conjg(be_n(ih,1)) &
- ) * (0.0d0, 1.0d0)
-
- sigma_z_aug = sigma_z_aug &
- + qq_nt(ih,jh,np) * ( be_m(jh,1)*conjg(be_n(ih,1)) - be_m(jh,2)*conjg(be_n(ih,2)) )
- ENDDO
- ENDDO
- ijkb0 = ijkb0 + nh(np)
- ENDIF
- ENDDO
- ELSE
- DO na = 1, nat
- IF ( ityp(na) == np ) ijkb0 = ijkb0 + nh(np)
- ENDDO
- ENDIF
- ENDDO
- spn_aug(1, counter) = sigma_x_aug
- spn_aug(2, counter) = sigma_y_aug
- spn_aug(3, counter) = sigma_z_aug
- endif
- ENDDO
- ENDDO
- if(ionode) then ! root node for i/o
- if(spn_formatted) then ! slow formatted way
- counter=0
- do m=1,num_bands
- do n=1,m
- counter=counter+1
- do s=1,3
- write(iun_spn,'(2es26.16)') spn(s,counter) + spn_aug(s,counter)
- enddo
- enddo
- enddo
- else ! fast unformatted way
- write(iun_spn) ((spn(s,m) + spn_aug(s,m),s=1,3),m=1,((num_bands*(num_bands+1))/2))
- endif
- endif ! end of root activity
-
-
- ENDIF
-
- end DO
-
- IF (ionode .and. write_spn .and. noncolin) CLOSE (iun_spn)
-
- if(write_spn.and.noncolin) deallocate(spn, spn_aug)
- if (any_uspp) then
- deallocate(be_n, be_m)
- call deallocate_bec_type(becp)
- endif
-
- WRITE(stdout,*)
- WRITE(stdout,*) ' SPIN calculated'
-
- RETURN
-END SUBROUTINE compute_spin
-
-!-----------------------------------------------------------------------
-SUBROUTINE compute_orb
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode
- USE kinds, ONLY: DP
- USE wvfct, ONLY : nbnd, npwx, current_k
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc, psic, psic_nc
- USE fft_base, ONLY : dffts, dfftp
- USE fft_interfaces, ONLY : fwfft, invfft
- USE klist, ONLY : nkstot, xk, ngk, igk_k
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE cell_base, ONLY : tpiba2, alat, at, bg
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE constants, ONLY : tpi
- USE uspp, ONLY : nkb, vkb
- USE uspp_param, ONLY : upf, nh, lmaxq
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum
- USE noncollin_module,ONLY : noncolin, npol
- USE gvecw, ONLY : gcutw
- USE wannier
- ! begin change Lopez, Thonhauser, Souza
- USE mp, ONLY : mp_barrier
- USE scf, ONLY : vrs, vltot, v, kedtau
- USE gvecs, ONLY : doublegrid
- USE lsda_mod, ONLY : nspin
- USE constants, ONLY : rytoev
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
- !
- INTEGER :: mmn_tot, ik, ikp, ipol, ib, npw, i, m, n
- INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
- INTEGER :: ikevc, ikpevcq, s, counter
- COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
- becp2(:,:), Mkb(:,:), aux_nc(:,:)
- real(DP), ALLOCATABLE :: rbecp2(:,:)
- COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:)
- real(DP), ALLOCATABLE :: qg(:), ylm(:,:), workg(:)
- COMPLEX(DP) :: mmn, zdotc, phase1
- real(DP) :: arg, g_(3)
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp
- INTEGER :: nn,inn,loop,loop2
- LOGICAL :: nn_found
- INTEGER :: istart,iend
- ! begin change Lopez, Thonhauser, Souza
- COMPLEX(DP) :: sigma_x,sigma_y,sigma_z,cdum1,cdum2
- integer :: npw_b1, npw_b2, i_b1, i_b2, ikp_b1, ikp_b2
- integer, allocatable :: igk_b1(:), igk_b2(:)
- complex(DP), allocatable :: evc_b1(:,:),evc_b2(:,:),evc_aux(:,:),H_evc(:,:)
- complex(DP), allocatable :: uHu(:,:),uIu(:,:),spn(:,:)
- ! end change Lopez, Thonhauser, Souza
-
- any_uspp = any(upf(1:ntyp)%tvanp)
-
- IF(any_uspp .and. noncolin) CALL errore('pw2wannier90',&
- 'NCLS calculation not implimented with USP',1)
-
- ALLOCATE( phase(dffts%nnr) )
- ALLOCATE( evcq(npol*npwx,nbnd) )
-
- IF(noncolin) THEN
- ALLOCATE( aux_nc(npwx,npol) )
- ELSE
- ALLOCATE( aux(npwx) )
- ENDIF
-
- IF (gamma_only) ALLOCATE(aux2(npwx))
-
- IF (wan_mode=='library') ALLOCATE(m_mat(num_bands,num_bands,nnb,iknum))
-
- if (write_uHu) allocate(uhu(num_bands,num_bands))
- if (write_uIu) allocate(uIu(num_bands,num_bands))
-
-
-!ivo
-! not sure this is really needed
- if((write_uhu.or.write_uIu).and.wan_mode=='library')&
- call errore('pw2wannier90',&
- 'write_uhu, and write_uIu not meant to work library mode',1)
-!endivo
-
-
- !
- !
- ! begin change Lopez, Thonhauser, Souza
- !
- !====================================================================
- !
- ! The following code was inserted by Timo Thonhauser, Ivo Souza, and
- ! Graham Lopez in order to calculate the matrix elements
- ! necessary for the Wannier interpolation
- ! of the orbital magnetization
- !
- !====================================================================
- !
- !
- !
- if(write_uHu.or.write_uIu) then !ivo
- !
- if(gamma_only) call errore('pw2wannier90',&
- 'write_uHu and write_uIu not yet implemented for gamma_only case',1) !ivo
- if(any_uspp) call errore('pw2wannier90',&
- 'write_uHu and write_uIu not yet implemented with USP',1) !ivo
- !
- !
- allocate(igk_b1(npwx),igk_b2(npwx),evc_b1(npol*npwx,nbnd),&
- evc_b2(npol*npwx,nbnd),&
- evc_aux(npol*npwx,nbnd))
- !
- if(write_uHu) then
- allocate(H_evc(npol*npwx,nbnd))
- write(stdout,*)
- write(stdout,*) ' -----------------'
- write(stdout,*) ' *** Compute uHu '
- write(stdout,*) ' -----------------'
- write(stdout,*)
- iun_uhu = find_free_unit()
- if (ionode) then
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- if(uHu_formatted) then
- open (unit=iun_uhu, file=TRIM(seedname)//".uHu",form='FORMATTED')
- write (iun_uhu,*) header
- write (iun_uhu,*) nbnd, iknum, nnb
- else
- open (unit=iun_uhu, file=TRIM(seedname)//".uHu",form='UNFORMATTED')
- write (iun_uhu) header
- write (iun_uhu) nbnd, iknum, nnb
- endif
- endif
- endif
- if(write_uIu) then
- write(stdout,*)
- write(stdout,*) ' -----------------'
- write(stdout,*) ' *** Compute uIu '
- write(stdout,*) ' -----------------'
- write(stdout,*)
- iun_uIu = find_free_unit()
- if (ionode) then
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- if(uIu_formatted) then
- open (unit=iun_uIu, file=TRIM(seedname)//".uIu",form='FORMATTED')
- write (iun_uIu,*) header
- write (iun_uIu,*) nbnd, iknum, nnb
- else
- open (unit=iun_uIu, file=TRIM(seedname)//".uIu",form='UNFORMATTED')
- write (iun_uIu) header
- write (iun_uIu) nbnd, iknum, nnb
- endif
- endif
- endif
-
- CALL set_vrs(vrs,vltot,v%of_r,kedtau,v%kin_r,dfftp%nnr,nspin,doublegrid)
- call allocate_bec_type ( nkb, nbnd, becp )
- ALLOCATE( workg(npwx) )
-
- write(stdout,'(a,i8)') ' iknum = ',iknum
- do ik = 1, iknum ! loop over k points
- !
- write (stdout,'(i8)') ik
- !
- npw = ngk(ik)
- ! sort the wfc at k and set up stuff for h_psi
- current_k=ik
- CALL init_us_2(npw,igk_k(1,ik),xk(1,ik),vkb)
- !
- ! compute " H | u_n,k+b2 > "
- !
- do i_b2 = 1, nnb ! nnb = # of nearest neighbors
- !
- ! read wfc at k+b2
- ikp_b2 = kpb(ik,i_b2) ! for kpoint 'ik', index of neighbor 'i_b2'
- !
-! call davcio (evc_b2, 2*nwordwfc, iunwfc, ikp_b2, -1 ) !ivo
- call davcio (evc_b2, 2*nwordwfc, iunwfc, ikp_b2+ikstart-1, -1 ) !ivo
-! call gk_sort (xk(1,ikp_b2), ngm, g, gcutw, npw_b2, igk_b2, workg)
-! ivo; igkq -> igk_k(:,ikp_b2), npw_b2 -> ngk(ikp_b2), replaced by PG
- npw_b2=ngk(ikp_b2)
- !
- ! compute the phase
- phase(:) = ( 0.0D0, 0.0D0 )
- if (ig_(ik,i_b2)>0) phase( dffts%nl(ig_(ik,i_b2)) ) = ( 1.0D0, 0.0D0 )
- call invfft('Wave', phase, dffts)
- !
- ! loop on bands
- evc_aux = ( 0.0D0, 0.0D0 )
- do n = 1, nbnd
- !ivo replaced dummy m --> n everywhere on this do loop,
- ! for consistency w/ band indices in comments
- if (excluded_band(n)) cycle
- if(noncolin) then
- psic_nc = ( 0.0D0, 0.0D0 ) !ivo
- do ipol = 1, 2
-! psic_nc = ( 0.0D0, 0.0D0 ) !ivo
- istart=(ipol-1)*npwx+1
- iend=istart+npw_b2-1 !ivo npw_b1 --> npw_b2
- psic_nc(dffts%nl (igk_k(1:npw_b2,ikp_b2) ),ipol ) = &
- evc_b2(istart:iend, n)
- ! ivo igk_b1, npw_b1 --> igk_b2, npw_b2
- ! multiply by phase in real space - '1' unless neighbor is in a bordering BZ
- call invfft ('Wave', psic_nc(:,ipol), dffts)
- psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * conjg(phase(1:dffts%nnr))
- call fwfft ('Wave', psic_nc(:,ipol), dffts)
- ! save the result
- iend=istart+npw-1
- evc_aux(istart:iend,n) = psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol )
- end do
- else ! this is modeled after the pre-existing code at 1162
- psic = ( 0.0D0, 0.0D0 )
- ! Graham, changed npw --> npw_b2 on RHS. Do you agree?!
- psic(dffts%nl (igk_k(1:npw_b2,ikp_b2) ) ) = evc_b2(1:npw_b2, n)
- call invfft ('Wave', psic, dffts)
- psic(1:dffts%nnr) = psic(1:dffts%nnr) * conjg(phase(1:dffts%nnr))
- call fwfft ('Wave', psic, dffts)
- evc_aux(1:npw,n) = psic(dffts%nl (igk_k(1:npw,ik) ) )
- end if
- end do !n
-
- if(write_uHu) then !ivo
- !
- ! calculate the kinetic energy at ik, used in h_psi
- !
- CALL g2_kin (ik)
- !
- CALL h_psi(npwx, npw, nbnd, evc_aux, H_evc)
- !
- endif
- !
- ! compute " < u_m,k+b1 | "
- !
- do i_b1 = 1, nnb
- !
- ! read wfc at k+b1 !ivo replaced k+b2 --> k+b1
- ikp_b1 = kpb(ik,i_b1)
-! call davcio (evc_b1, 2*nwordwfc, iunwfc, ikp_b1, -1 ) !ivo
- call davcio (evc_b1, 2*nwordwfc, iunwfc, ikp_b1+ikstart-1, -1 ) !ivo
-
-! call gk_sort (xk(1,ikp_b1), ngm, g, gcutw, npw_b2, igk_b2, workg) !ivo
- call gk_sort (xk(1,ikp_b1), ngm, g, gcutw, npw_b1, igk_b1, workg) !ivo
- !
- ! compute the phase
- phase(:) = ( 0.0D0, 0.0D0 )
- if (ig_(ik,i_b1)>0) phase( dffts%nl(ig_(ik,i_b1)) ) = ( 1.0D0, 0.0D0 )
- !call cft3s (phase, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
- call invfft('Wave', phase, dffts)
- !
- ! loop on bands
- do m = 1, nbnd
- if (excluded_band(m)) cycle
- if(noncolin) then
- aux_nc = ( 0.0D0, 0.0D0 )
- psic_nc = ( 0.0D0, 0.0D0 ) !ivo
- do ipol = 1, 2
-! psic_nc = ( 0.0D0, 0.0D0 ) !ivo
- istart=(ipol-1)*npwx+1
- iend=istart+npw_b1-1 !ivo npw_b2 --> npw_b1
- psic_nc(dffts%nl (igk_b1(1:npw_b1) ),ipol ) = evc_b1(istart:iend, m) !ivo igk_b2,npw_b2 --> igk_b1,npw_b1
- ! multiply by phase in real space - '1' unless neighbor is in a different BZ
- call invfft ('Wave', psic_nc(:,ipol), dffts)
- !psic_nc(1:nrxxs,ipol) = psic_nc(1:nrxxs,ipol) * conjg(phase(1:nrxxs))
- psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * conjg(phase(1:dffts%nnr))
- call fwfft ('Wave', psic_nc(:,ipol), dffts)
- ! save the result
- aux_nc(1:npw,ipol) = psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol )
- end do
- else ! this is modeled after the pre-existing code at 1162
- aux = ( 0.0D0 )
- psic = ( 0.0D0, 0.0D0 )
- ! Graham, changed npw --> npw_b1 on RHS. Do you agree?!
- psic(dffts%nl (igk_b1(1:npw_b1) ) ) = evc_b1(1:npw_b1, m) !ivo igk_b2 --> igk_b1
- call invfft ('Wave', psic, dffts)
- !psic(1:nrxxs) = psic(1:nrxxs) * conjg(phase(1:nrxxs))
- psic(1:dffts%nnr) = psic(1:dffts%nnr) * conjg(phase(1:dffts%nnr))
- call fwfft ('Wave', psic, dffts)
- aux(1:npw) = psic(dffts%nl (igk_k(1:npw,ik) ) )
- end if
-
- !
- !
- if(write_uHu) then !ivo
- do n = 1, nbnd ! loop over bands of already computed ket
- if (excluded_band(n)) cycle
- if(noncolin) then
- mmn = zdotc (npw, aux_nc(1,1),1,H_evc(1,n),1) + &
- zdotc (npw, aux_nc(1,2),1,H_evc(1+npwx,n),1)
- else
- mmn = zdotc (npw, aux,1,H_evc(1,n),1)
- end if
- mmn = mmn * rytoev ! because wannier90 works in eV
- call mp_sum(mmn, intra_pool_comm)
-! if (ionode) write (iun_uhu) mmn
- uHu(n,m)=mmn
- !
- end do !n
- endif
- if(write_uIu) then !ivo
- do n = 1, nbnd ! loop over bands of already computed ket
- if (excluded_band(n)) cycle
- if(noncolin) then
- mmn = zdotc (npw, aux_nc(1,1),1,evc_aux(1,n),1) + &
- zdotc (npw, aux_nc(1,2),1,evc_aux(1+npwx,n),1)
- else
- mmn = zdotc (npw, aux,1,evc_aux(1,n),1)
- end if
- call mp_sum(mmn, intra_pool_comm)
-! if (ionode) write (iun_uIu) mmn
- uIu(n,m)=mmn
- !
- end do !n
- endif
- !
- end do ! m = 1, nbnd
- if (ionode) then ! write the files out to disk
- if(write_uhu) then
- if(uHu_formatted) then ! slow bulky way for transferable files
- do n=1,num_bands
- do m=1,num_bands
- write(iun_uHu,'(2ES20.10)') uHu(m,n)
- enddo
- enddo
- else ! the fast way
- write(iun_uHu) ((uHu(n,m),n=1,num_bands),m=1,num_bands)
- endif
- endif
- if(write_uiu) then
- if(uIu_formatted) then ! slow bulky way for transferable files
- do n=1,num_bands
- do m=1,num_bands
- write(iun_uIu,'(2ES20.10)') uIu(m,n)
- enddo
- enddo
- else ! the fast way
- write(iun_uIu) ((uIu(n,m),n=1,num_bands),m=1,num_bands)
- endif
- endif
- endif ! end of io
- end do ! i_b1
- end do ! i_b2
- end do ! ik
- DEALLOCATE (workg)
- !
- deallocate(igk_b1,igk_b2,evc_b1,evc_b2,evc_aux)
- if(write_uHu) then
- deallocate(H_evc)
- deallocate(uHu)
- end if
- if(write_uIu) deallocate(uIu)
- if (ionode.and.write_uHu) close (iun_uhu) !ivo
- if (ionode.and.write_uIu) close (iun_uIu) !ivo
- !
- else
- if(.not.write_uHu) then
- write(stdout,*)
- write(stdout,*) ' -------------------------------'
- write(stdout,*) ' *** uHu matrix is not computed '
- write(stdout,*) ' -------------------------------'
- write(stdout,*)
- endif
- if(.not.write_uIu) then
- write(stdout,*)
- write(stdout,*) ' -------------------------------'
- write(stdout,*) ' *** uIu matrix is not computed '
- write(stdout,*) ' -------------------------------'
- write(stdout,*)
- endif
- end if
- !
- !
- !
- !
- !
- !
- !====================================================================
- !
- ! END_m_orbit
- !
- !====================================================================
- !
- ! end change Lopez, Thonhauser, Souza
- !
- !
- !
-
- IF (gamma_only) DEALLOCATE(aux2)
- DEALLOCATE (phase)
- IF(noncolin) THEN
- DEALLOCATE(aux_nc)
- ELSE
- DEALLOCATE(aux)
- ENDIF
- DEALLOCATE(evcq)
- if(write_spn.and.noncolin) deallocate(spn)
-
- IF(any_uspp) THEN
- DEALLOCATE ( qb)
- CALL deallocate_bec_type (becp)
- IF (gamma_only) THEN
- DEALLOCATE (rbecp2)
- ELSE
- DEALLOCATE (becp2)
- ENDIF
- ENDIF
-!
- WRITE(stdout,*)
- WRITE(stdout,*) ' uHu calculated'
-
- RETURN
-END SUBROUTINE compute_orb
-!
-!-----------------------------------------------------------------------
-SUBROUTINE compute_amn
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode
- USE kinds, ONLY : DP
- USE klist, ONLY : nkstot, xk, ngk, igk_k
- USE wvfct, ONLY : nbnd, npwx
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE uspp, ONLY : nkb, vkb
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE wannier
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE uspp_param, ONLY : upf
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum
- USE noncollin_module,ONLY : noncolin, npol
- USE gvecw, ONLY : gcutw
- USE constants, ONLY : eps6
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- COMPLEX(DP) :: amn, zdotc,amn_tmp,fac(2)
- real(DP):: ddot
- COMPLEX(DP), ALLOCATABLE :: sgf(:,:)
- INTEGER :: ik, npw, ibnd, ibnd1, iw,i, ikevc, nt, ipol
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp, opnd, exst,spin_z_pos, spin_z_neg
- INTEGER :: istart
-
- !nocolin: we have half as many projections g(r) defined as wannier
- ! functions. We project onto (1,0) (ie up spin) and then onto
- ! (0,1) to obtain num_wann projections. jry
-
-
- !call read_gf_definition.....> this is done at the beging
-
- CALL start_clock( 'compute_amn' )
-
- any_uspp =any (upf(1:ntyp)%tvanp)
-
- IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum))
-
- IF (wan_mode=='standalone') THEN
- iun_amn = find_free_unit()
- IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted')
- ENDIF
-
- WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum
- !
- IF (wan_mode=='standalone') THEN
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- IF (ionode) THEN
- WRITE (iun_amn,*) header
- WRITE (iun_amn,*) nbnd-nexband, iknum, n_wannier
- !WRITE (iun_amn,*) nbnd-nexband, iknum, n_proj
- ENDIF
- ENDIF
- !
- ALLOCATE( sgf(npwx,n_proj))
- ALLOCATE( gf_spinor(2*npwx,n_proj))
- ALLOCATE( sgf_spinor(2*npwx,n_proj))
- !
- IF (any_uspp) THEN
- CALL allocate_bec_type ( nkb, n_wannier, becp)
- CALL init_us_1
- ENDIF
- !
-
- DO ik=1,iknum
- WRITE (stdout,'(i8)',advance='no') ik
- IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- ikevc = ik + ikstart - 1
-! if(noncolin) then
-! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 )
-! else
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
-! end if
- npw = ngk(ik)
- CALL generate_guiding_functions(ik) ! they are called gf(npw,n_proj)
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- if(noncolin) then
- sgf_spinor = (0.d0,0.d0)
- call orient_gf_spinor(npw)
- endif
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
- ! below we compute the product of beta functions with trial func.
- IF (gamma_only) THEN
- CALL calbec ( npw, vkb, gf, becp, n_proj )
- ELSE if (noncolin) then
- CALL calbec ( npw, vkb, gf_spinor, becp, n_proj )
- else
- CALL calbec ( npw, vkb, gf, becp, n_proj )
- ENDIF
- ! and we use it for the product S|trial_func>
- if (noncolin) then
- CALL s_psi (npwx, npw, n_proj, gf_spinor, sgf_spinor)
- else
- CALL s_psi (npwx, npw, n_proj, gf, sgf)
- endif
-
- ELSE
- !if (noncolin) then
- ! sgf_spinor(:,:) = gf_spinor
- !else
- sgf(:,:) = gf(:,:)
- !endif
- ENDIF
- !
- noncolin_case : &
- IF(noncolin) THEN
- old_spinor_proj_case : &
- IF(old_spinor_proj) THEN
- ! we do the projection as g(r)*a(r) and g(r)*b(r)
- DO ipol=1,npol
- istart = (ipol-1)*npwx + 1
- DO iw = 1,n_proj
- ibnd1 = 0
- DO ibnd = 1,nbnd
- IF (excluded_band(ibnd)) CYCLE
- amn=(0.0_dp,0.0_dp)
- ! amn = zdotc(npw,evc_nc(1,ipol,ibnd),1,sgf(1,iw),1)
- if (any_uspp) then
- amn = zdotc(npw, evc(0,ibnd), 1, sgf_spinor(1, iw + (ipol-1)*n_proj), 1)
- amn = amn + zdotc(npw, evc(npwx+1,ibnd), 1, sgf_spinor(npwx+1, iw + (ipol-1)*n_proj), 1)
- else
- amn = zdotc(npw,evc(istart,ibnd),1,sgf(1,iw),1)
- endif
- CALL mp_sum(amn, intra_pool_comm)
- ibnd1=ibnd1+1
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') ibnd1, iw+n_proj*(ipol-1), ik, amn
- ELSEIF (wan_mode=='library') THEN
- a_mat(ibnd1,iw+n_proj*(ipol-1),ik) = amn
- ELSE
- CALL errore('compute_amn',' value of wan_mode not recognised',1)
- ENDIF
- ENDDO
- ENDDO
- ENDDO
- ELSE old_spinor_proj_case
- DO iw = 1,n_proj
- spin_z_pos=.false.;spin_z_neg=.false.
- ! detect if spin quantisation axis is along z
- if((abs(spin_qaxis(1,iw)-0.0d0) nsp, tau
- USE uspp_param, ONLY : upf
-
- IMPLICIT NONE
-
- INTEGER, EXTERNAL :: find_free_unit
- COMPLEX(DP), ALLOCATABLE :: phase(:), nowfc1(:,:), nowfc(:,:), psi_gamma(:,:), &
- qr_tau(:), cwork(:), cwork2(:), Umat(:,:), VTmat(:,:), Amat(:,:) ! vv: complex arrays for the SVD factorization
- REAL(DP), ALLOCATABLE :: focc(:), rwork(:), rwork2(:), singval(:), rpos(:,:), cpos(:,:) ! vv: Real array for the QR factorization and SVD
- INTEGER, ALLOCATABLE :: piv(:) ! vv: Pivot array in the QR factorization
- COMPLEX(DP) :: tmp_cwork(2)
- REAL(DP):: ddot, sumk, norm_psi, f_gamma
- INTEGER :: ik, npw, ibnd, iw, ikevc, nrtot, ipt, info, lcwork, locibnd, &
- jpt,kpt,lpt, ib, istart, gamma_idx, minmn, minmn2, maxmn2, numbands, nbtot
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp, found_gamma
-
-#if defined(__MPI)
- INTEGER :: nxxs
- COMPLEX(DP),ALLOCATABLE :: psic_all(:)
- nxxs = dffts%nr1x * dffts%nr2x * dffts%nr3x
- ALLOCATE(psic_all(nxxs) )
-#endif
-
- ! vv: Write info about SCDM in output
- IF (TRIM(scdm_entanglement) == 'isolated') THEN
- WRITE(stdout,'(1x,a,a/)') 'Case : ',trim(scdm_entanglement)
- ELSEIF (TRIM(scdm_entanglement) == 'erfc' .OR. &
- TRIM(scdm_entanglement) == 'gaussian') THEN
- WRITE(stdout,'(1x,a,a)') 'Case : ',trim(scdm_entanglement)
- WRITE(stdout,'(1x,a,f10.3,a/,1x,a,f10.3,a/)') 'mu = ', scdm_mu, ' eV', 'sigma =', scdm_sigma, ' eV'
- ENDIF
-
- CALL start_clock( 'compute_amn' )
-
- any_uspp =any (upf(1:ntyp)%tvanp)
-
- ! vv: Error for using SCDM with non-collinear spin calculations
- IF (noncolin) THEN
- call errore('pw2wannier90','The SCDM method is not compatible with non-collinear spin yet.',1)
- ENDIF
-
- ! vv: Error for using SCDM with Ultrasoft pseudopotentials
- !IF (any_uspp) THEN
- ! call errore('pw2wannier90','The SCDM method does not work with Ultrasoft pseudopotential yet.',1)
- !ENDIF
-
- ! vv: Error for using SCDM with gamma_only
- IF (gamma_only) THEN
- call errore('pw2wannier90','The SCDM method does not work with gamma_only calculations.',1)
- ENDIF
- ! vv: Allocate all the variables for the SCDM method:
- ! 1)For the QR decomposition
- ! 2)For the unk's on the real grid
- ! 3)For the SVD
- IF(TRIM(scdm_entanglement) == 'isolated') THEN
- numbands=n_wannier
- nbtot=n_wannier + nexband
- ELSE
- numbands=nbnd-nexband
- nbtot=nbnd
- ENDIF
- nrtot = dffts%nr1*dffts%nr2*dffts%nr3
- info = 0
- minmn = MIN(numbands,nrtot)
- ALLOCATE(qr_tau(2*minmn))
- ALLOCATE(piv(nrtot))
- piv(:) = 0
- ALLOCATE(rwork(2*nrtot))
- rwork(:) = 0.0_DP
-
- ALLOCATE(kpt_latt(3,iknum))
- ALLOCATE(nowfc1(n_wannier,numbands))
- ALLOCATE(nowfc(n_wannier,numbands))
- ALLOCATE(psi_gamma(nrtot,numbands))
- ALLOCATE(focc(numbands))
- minmn2 = MIN(numbands,n_wannier)
- maxmn2 = MAX(numbands,n_wannier)
- ALLOCATE(rwork2(5*minmn2))
-
- ALLOCATE(rpos(nrtot,3))
- ALLOCATE(cpos(n_wannier,3))
- ALLOCATE(phase(n_wannier))
- ALLOCATE(singval(n_wannier))
- ALLOCATE(Umat(numbands,n_wannier))
- ALLOCATE(VTmat(n_wannier,n_wannier))
- ALLOCATE(Amat(numbands,n_wannier))
-
- IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum))
-
- IF (wan_mode=='standalone') THEN
- iun_amn = find_free_unit()
- IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted')
- ENDIF
-
- WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum
- !
- IF (wan_mode=='standalone') THEN
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime//' with SCDM '
- IF (ionode) THEN
- WRITE (iun_amn,*) header
- WRITE (iun_amn,'(3i8,xxx,2f10.6)') numbands, iknum, n_wannier, scdm_mu, scdm_sigma
- ENDIF
- ENDIF
-
- !vv: Find Gamma-point index in the list of k-vectors
- ik = 0
- gamma_idx = 1
- sumk = -1.0_DP
- found_gamma = .false.
- kpt_latt(:,1:iknum)=xk(:,1:iknum)
- CALL cryst_to_cart(iknum,kpt_latt,at,-1)
- DO WHILE(sumk/=0.0_DP .and. ik < iknum)
- ik = ik + 1
- sumk = ABS(kpt_latt(1,ik)**2 + kpt_latt(2,ik)**2 + kpt_latt(3,ik)**2)
- IF (sumk==0.0_DP) THEN
- found_gamma = .true.
- gamma_idx = ik
- ENDIF
- END DO
- IF (.not. found_gamma) call errore('compute_amn','No Gamma point found.',1)
-
- f_gamma = 0.0_DP
- ik = gamma_idx
- locibnd = 0
- DO ibnd=1,nbtot
- IF(excluded_band(ibnd)) CYCLE
- locibnd = locibnd + 1
- ! check locibnd <= numbands
- IF (locibnd > numbands) call errore('compute_amn','Something wrong with the number of bands. Check exclude_bands.')
- IF(TRIM(scdm_entanglement) == 'isolated') THEN
- f_gamma = 1.0_DP
- ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN
- f_gamma = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma)
- ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN
- f_gamma = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2))
- ELSE
- call errore('compute_amn','scdm_entanglement value not recognized.',1)
- END IF
- CALL davcio (evc, 2*nwordwfc, iunwfc, ik, -1 )
- npw = ngk(ik)
- ! vv: Compute unk's on a real grid (the fft grid)
- psic(:) = (0.D0,0.D0)
- psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd)
- CALL invfft ('Wave', psic, dffts)
-#if defined(__MPI)
- CALL gather_grid(dffts,psic,psic_all)
- ! vv: Gamma only
- ! vv: Build Psi_k = Unk * focc
- norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP))
- psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi
- psi_gamma(1:nrtot,locibnd) = psic_all(1:nrtot)
- psi_gamma(1:nrtot,locibnd) = psi_gamma(1:nrtot,locibnd) * f_gamma
-#else
- norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP))
- psic(1:nrtot) = psic(1:nrtot)/ norm_psi
- psi_gamma(1:nrtot,locibnd) = psic(1:nrtot)
- psi_gamma(1:nrtot,locibnd) = psi_gamma(1:nrtot,locibnd) * f_gamma
-#endif
- ENDDO
-
- ! vv: Perform QR factorization with pivoting on Psi_Gamma
- ! vv: Preliminary call to define optimal values for lwork and cwork size
- CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,tmp_cwork,-1,rwork,info)
- IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
- lcwork = AINT(REAL(tmp_cwork(1)))
- tmp_cwork(:) = (0.0_DP,0.0_DP)
- piv(:) = 0
- rwork(:) = 0.0_DP
- ALLOCATE(cwork(lcwork))
- cwork(:) = (0.0_DP,0.0_DP)
-#if defined(__MPI)
- IF(ionode) THEN
- CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info)
- IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
- ENDIF
- CALL mp_bcast(piv,ionode_id,world_comm)
-#else
- ! vv: Perform QR factorization with pivoting on Psi_Gamma
- CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info)
- IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
-#endif
- DEALLOCATE(cwork)
- tmp_cwork(:) = (0.0_DP,0.0_DP)
-
- ! vv: Compute the points
- lpt = 0
- rpos(:,:) = 0.0_DP
- cpos(:,:) = 0.0_DP
- DO kpt = 0,dffts%nr3-1
- DO jpt = 0,dffts%nr2-1
- DO ipt = 0,dffts%nr1-1
- lpt = lpt + 1
- rpos(lpt,1) = REAL(ipt)/dffts%nr1
- rpos(lpt,2) = REAL(jpt)/dffts%nr2
- rpos(lpt,3) = REAL(kpt)/dffts%nr3
- ENDDO
- ENDDO
- ENDDO
- DO iw=1,n_wannier
- cpos(iw,:) = rpos(piv(iw),:)
- cpos(iw,:) = cpos(iw,:) - ANINT(cpos(iw,:))
- ENDDO
-
- DO ik=1,iknum
- WRITE (stdout,'(i8)',advance='no') ik
- IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- ikevc = ik + ikstart - 1
-! if(noncolin) then
-! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 )
-! else
-! end if
-
- ! vv: SCDM method for generating the Amn matrix
- phase(:) = (0.0_DP,0.0_DP)
- nowfc1(:,:) = (0.0_DP,0.0_DP)
- nowfc(:,:) = (0.0_DP,0.0_DP)
- Umat(:,:) = (0.0_DP,0.0_DP)
- VTmat(:,:) = (0.0_DP,0.0_DP)
- Amat(:,:) = (0.0_DP,0.0_DP)
- singval(:) = 0.0_DP
- rwork2(:) = 0.0_DP
- locibnd = 0
- ! vv: Generate the occupation numbers matrix according to scdm_entanglement
- DO ibnd=1,nbtot
- IF (excluded_band(ibnd)) CYCLE
- locibnd = locibnd + 1
- ! vv: Define the occupation numbers matrix according to scdm_entanglement
- IF(TRIM(scdm_entanglement) == 'isolated') THEN
- focc(locibnd) = 1.0_DP
- ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN
- focc(locibnd) = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma)
- ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN
- focc(locibnd) = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2))
- ELSE
- call errore('compute_amn','scdm_entanglement value not recognized.',1)
- END IF
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
- npw = ngk(ik)
- psic(:) = (0.D0,0.D0)
- psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd)
- CALL invfft ('Wave', psic, dffts)
-#if defined(__MPI)
- CALL gather_grid(dffts,psic,psic_all)
- norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP))
- psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi
- DO iw = 1,n_wannier
- phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
- &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),&
- &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
- &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)))
- nowfc(iw,locibnd) = phase(iw)*psic_all(piv(iw))*focc(locibnd)
- ENDDO
-#else
- norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP))
- psic(1:nrtot) = psic(1:nrtot)/ norm_psi
- DO iw = 1,n_wannier
- phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
- &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),&
- &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
- &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)))
- nowfc(iw,locibnd) = phase(iw)*psic(piv(iw))*focc(locibnd)
-
- ENDDO
-#endif
- ENDDO
-
- CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
- &singval,Umat,numbands,VTmat,n_wannier,tmp_cwork,-1,rwork2,info)
- lcwork = AINT(REAL(tmp_cwork(1)))
- tmp_cwork(:) = (0.0_DP,0.0_DP)
- ALLOCATE(cwork(lcwork))
-#if defined(__MPI)
- IF(ionode) THEN
- ! vv: SVD to generate orthogonal projections
- CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
- &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info)
- IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1)
- ENDIF
- CALL mp_bcast(Umat,ionode_id,world_comm)
- CALL mp_bcast(VTmat,ionode_id,world_comm)
-#else
- ! vv: SVD to generate orthogonal projections
- CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
- &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info)
- IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1)
-#endif
- DEALLOCATE(cwork)
-
- Amat = MATMUL(Umat,VTmat)
- DO iw = 1,n_wannier
- locibnd = 0
- DO ibnd = 1,nbtot
- IF (excluded_band(ibnd)) CYCLE
- locibnd = locibnd + 1
- IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') locibnd, iw, ik, REAL(Amat(locibnd,iw)), AIMAG(Amat(locibnd,iw))
- ENDDO
- ENDDO
- ENDDO ! k-points
-
- ! vv: Deallocate all the variables for the SCDM method
- DEALLOCATE(kpt_latt)
- DEALLOCATE(psi_gamma)
- DEALLOCATE(nowfc)
- DEALLOCATE(nowfc1)
- DEALLOCATE(focc)
- DEALLOCATE(piv)
- DEALLOCATE(qr_tau)
- DEALLOCATE(rwork)
- DEALLOCATE(rwork2)
- DEALLOCATE(rpos)
- DEALLOCATE(cpos)
- DEALLOCATE(Umat)
- DEALLOCATE(VTmat)
- DEALLOCATE(Amat)
- DEALLOCATE(singval)
-
-#if defined(__MPI)
- DEALLOCATE( psic_all )
-#endif
-
- IF (ionode .and. wan_mode=='standalone') CLOSE (iun_amn)
- WRITE(stdout,'(/)')
- WRITE(stdout,*) ' AMN calculated'
- CALL stop_clock( 'compute_amn' )
-
- RETURN
-END SUBROUTINE compute_amn_with_scdm
-
-subroutine orient_gf_spinor(npw)
- use constants, only: eps6
- use noncollin_module, only: npol
- use wvfct, ONLY : npwx
- use wannier
-
- implicit none
-
- integer :: npw, iw, ipol, istart, iw_spinor
- logical :: spin_z_pos, spin_z_neg
- complex(dp) :: fac(2)
-
-
- gf_spinor = (0.0d0, 0.0d0)
- if (old_spinor_proj) then
- iw_spinor = 1
- DO ipol=1,npol
- istart = (ipol-1)*npwx + 1
- DO iw = 1,n_proj
- ! generate 2*nproj spinor functions, one for each spin channel
- gf_spinor(istart:istart+npw-1, iw_spinor) = gf(1:npw, iw)
- iw_spinor = iw_spinor + 1
- enddo
- enddo
- else
- DO iw = 1,n_proj
- spin_z_pos=.false.;spin_z_neg=.false.
- ! detect if spin quantisation axis is along z
- if((abs(spin_qaxis(1,iw)-0.0d0).unkg file
- !
- iun_parity = find_free_unit()
- IF (ionode) THEN
- OPEN (unit=iun_parity, file=trim(seedname)//".unkg",form='formatted')
- WRITE(stdout,*)"Finding the 32 unkg's per band required for parity signature."
- ENDIF
- !
- ! g_abc(:,ipw) are the coordinates of the ipw-th G vector in b1, b2, b3 basis,
- ! we compute them from g(:,ipw) by multiplying : transpose(at) with g(:,ipw)
- !
- ALLOCATE(g_abc(3,npw))
- DO igv=1,npw
- g_abc(:,igk_k(igv,kgamma))=matmul(transpose(at),g(:,igk_k(igv,kgamma)))
- ENDDO
- !
- ! Count and identify the G vectors we will be extracting for each
- ! cpu.
- !
- ig_idx=0
- num_G = 0
- DO igv=1,npw
- ! 0-th Order
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! 1
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- ! 1st Order
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- ! 2nd Order
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! yz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! yz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! z^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- ! 3rd Order
- IF ( (abs(g_abc(1,igv) - 3.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^3
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2y
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2y
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! x^2z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! x^2z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xyz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xyz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xyz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xyz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! xz^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 2.d0 <= eps6) ) THEN ! xz^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 3.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y^3
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! y^2z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! y^2z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! yz^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and.&
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 2.d0 <= eps6) ) THEN ! yz^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 3.d0 <= eps6) ) THEN ! z^3
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- ENDDO
- !
- ! Sum laterally across cpus num_G, so it contains
- ! the number of g_vectors on each node, and known to all cpus
- !
- CALL mp_sum(num_G, intra_pool_comm)
-
- IF (ionode) WRITE(iun_parity,*) sum(num_G)
- IF (sum(num_G) /= 32) CALL errore('write_parity', 'incorrect number of g-vectors extracted',1)
- IF (ionode) THEN
- WRITE(stdout,*)' ...done'
- WRITE(stdout,*)'G-vector splitting:'
- DO i=1,nproc
- WRITE(stdout,*)' cpu: ',i-1,' number g-vectors: ',num_G(i)
- ENDDO
- WRITE(stdout,*)' Collecting g-vectors and writing to file'
- ENDIF
-
- !
- ! Define needed intermediate arrays
- !
- ALLOCATE(evc_sub(32,nbnd,nproc))
- ALLOCATE(evc_sub_gathered(32,nbnd))
- ALLOCATE(g_abc_pre_gather(3,32,nproc))
- !
- ! Initialise
- !
- evc_sub=(0.d0,0.d0)
- evc_sub_1D=(0.d0,0.d0)
- evc_sub_gathered=(0.d0,0.d0)
- g_abc_pre_gather=0
- g_abc_1D=0
- g_abc_gathered=0
- !
- ! Compute displacements needed for filling evc_sub
- !
- displ(1)=1
- IF (nproc > 1) THEN
- DO i=2,nproc
- displ(i)=displ(i-1)+num_G(i-1)
- ENDDO
- ENDIF
- !
- ! Fill evc_sub with required fourier component from each cpu dependent evc
- !
- DO i=1,num_G(mpime+1)
- evc_sub(i+displ(mpime+1)-1,:,mpime+1)=evc(ig_idx(i),:)
- ENDDO
- !
- ! g_abc_pre_gather(:,ipw,icpu) are the coordinates of the ipw-th G vector in b1, b2, b3 basis
- ! on icpu and stored sequencially, ready for a lateral mp_sum
- !
- DO igv=1,num_G(mpime+1)
- g_abc_pre_gather(:,igv+displ(mpime+1)-1,mpime+1) = &
- matmul(transpose(at),g(:,ig_idx(igk_k(igv,kgamma))))
- ENDDO
- !
- ! Gather evc_sub and g_abc_pre_gather into common arrays to each cpu
- !
- DO ibnd=1,nbnd
- evc_sub_1D=evc_sub(:,ibnd,mpime+1)
- CALL mp_sum(evc_sub_1D, intra_pool_comm)
- evc_sub_gathered(:,ibnd)=evc_sub_1D
- ENDDO
- !
- DO i=1,3
- g_abc_1D=g_abc_pre_gather(i,:,mpime+1)
- CALL mp_sum(g_abc_1D, intra_pool_comm)
- g_abc_gathered(i,:)=g_abc_1D
- ENDDO
- !
- ! Write to file
- !
- DO ibnd=1,nbnd
- DO igv=1,32
- IF (ionode) WRITE(iun_parity,'(5i5,2f12.7)') ibnd, igv, nint(g_abc_gathered(1,igv)),&
- nint(g_abc_gathered(2,igv)),&
- nint(g_abc_gathered(3,igv)),&
- real(evc_sub_gathered(igv,ibnd)),&
- aimag(evc_sub_gathered(igv,ibnd))
- ENDDO
- ENDDO
- WRITE(stdout,*)' ...done'
- !
- IF (ionode) CLOSE(unit=iun_parity)
- !
- DEALLOCATE(evc_sub)
- DEALLOCATE(evc_sub_gathered)
- DEALLOCATE(g_abc_pre_gather)
-
- CALL stop_clock( 'write_parity' )
-
-END SUBROUTINE write_parity
-
-
-SUBROUTINE wan2sic
-
- USE io_global, ONLY : stdout
- USE kinds, ONLY : DP
- USE io_files, ONLY : iunwfc, nwordwfc, nwordwann
- USE gvect, ONLY : g, ngm
- USE wavefunctions, ONLY : evc, psic
- USE wvfct, ONLY : nbnd, npwx
- USE gvecw, ONLY : gcutw
- USE klist, ONLY : nkstot, xk, wk, ngk
- USE wannier
-
- IMPLICIT NONE
-
- INTEGER :: i, j, nn, ik, ibnd, iw, ikevc, npw
- COMPLEX(DP), ALLOCATABLE :: orbital(:,:), u_matrix(:,:,:)
- INTEGER :: iunatsicwfc = 31 ! unit for sic wfc
-
- OPEN (20, file = trim(seedname)//".dat" , form = 'formatted', status = 'unknown')
- WRITE(stdout,*) ' wannier plot '
-
- ALLOCATE ( u_matrix( n_wannier, n_wannier, nkstot) )
- ALLOCATE ( orbital( npwx, n_wannier) )
-
- !
- DO i = 1, n_wannier
- DO j = 1, n_wannier
- DO ik = 1, nkstot
- READ (20, * ) u_matrix(i,j,ik)
- !do nn = 1, nnb(ik)
- DO nn = 1, nnb
- READ (20, * ) ! m_matrix (i,j,nkp,nn)
- ENDDO
- ENDDO !nkp
- ENDDO !j
- ENDDO !i
- !
- DO ik=1,iknum
- ikevc = ik + ikstart - 1
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1)
- npw = ngk(ik)
- WRITE(stdout,*) 'npw ',npw
- DO iw=1,n_wannier
- DO j=1,npw
- orbital(j,iw) = (0.0d0,0.0d0)
- DO ibnd=1,n_wannier
- orbital(j,iw) = orbital(j,iw) + u_matrix(iw,ibnd,ik)*evc(j,ibnd)
- WRITE(stdout,*) j, iw, ibnd, ik, orbital(j,iw), &
- u_matrix(iw,ibnd,ik), evc(j,ibnd)
- ENDDO !ibnd
- ENDDO !j
- ENDDO !wannier
- CALL davcio (orbital, 2*nwordwann, iunatsicwfc, ikevc, +1)
- ENDDO ! k-points
-
- DEALLOCATE ( u_matrix)
- WRITE(stdout,*) ' dealloc u '
- DEALLOCATE ( orbital)
- WRITE(stdout,*) ' dealloc orbital '
- !
-END SUBROUTINE wan2sic
-
-SUBROUTINE ylm_expansion
- USE io_global, ONLY : stdout
- USE kinds, ONLY : DP
- USE random_numbers, ONLY : randy
- USE matrix_inversion
- USE wannier
- IMPLICIT NONE
- ! local variables
- INTEGER, PARAMETER :: lmax2=16
- INTEGER :: lm, i, ir, iw, m
- real(DP), ALLOCATABLE :: r(:,:), rr(:), rp(:,:), ylm_w(:), ylm(:,:), mly(:,:)
- real(DP) :: u(3,3)
-
- ALLOCATE (r(3,lmax2), rp(3,lmax2), rr(lmax2), ylm_w(lmax2))
- ALLOCATE (ylm(lmax2,lmax2), mly(lmax2,lmax2) )
-
- ! generate a set of nr=lmax2 random vectors
- DO ir=1,lmax2
- DO i=1,3
- r(i,ir) = randy() -0.5d0
- ENDDO
- ENDDO
- rr(:) = r(1,:)*r(1,:) + r(2,:)*r(2,:) + r(3,:)*r(3,:)
- !- compute ylm(ir,lm)
- CALL ylmr2(lmax2, lmax2, r, rr, ylm)
- !- store the inverse of ylm(ir,lm) in mly(lm,ir)
- CALL invmat(lmax2, ylm, mly)
- !- check that r points are independent
- CALL check_inverse(lmax2, ylm, mly)
-
- DO iw=1, n_proj
-
- !- define the u matrix that rotate the reference frame
- CALL set_u_matrix (xaxis(:,iw),zaxis(:,iw),u)
- !- find rotated r-vectors
- rp(:,:) = matmul ( u(:,:) , r(:,:) )
- !- set ylm funtion according to wannier90 (l,mr) indexing in the rotaterd points
- CALL ylm_wannier(ylm_w,l_w(iw),mr_w(iw),rp,lmax2)
-
- csph(:,iw) = matmul (mly(:,:), ylm_w(:))
-
-! write (stdout,*)
-! write (stdout,'(2i4,2(2x,3f6.3))') l_w(iw), mr_w(iw), xaxis(:,iw), zaxis(:,iw)
-! write (stdout,'(16i6)') (lm, lm=1,lmax2)
-! write (stdout,'(16f6.3)') (csph(lm,iw), lm=1,lmax2)
-
- ENDDO
- DEALLOCATE (r, rp, rr, ylm_w, ylm, mly )
-
- RETURN
-END SUBROUTINE ylm_expansion
-
-SUBROUTINE check_inverse(lmax2, ylm, mly)
- USE kinds, ONLY : DP
- USE constants, ONLY : eps8
- IMPLICIT NONE
- ! I/O variables
- INTEGER :: lmax2
- real(DP) :: ylm(lmax2,lmax2), mly(lmax2,lmax2)
- ! local variables
- real(DP), ALLOCATABLE :: uno(:,:)
- real(DP) :: capel
- INTEGER :: lm
- !
- ALLOCATE (uno(lmax2,lmax2) )
- uno = matmul(mly, ylm)
- capel = 0.d0
- DO lm = 1, lmax2
- uno(lm,lm) = uno(lm,lm) - 1.d0
- ENDDO
- capel = capel + sum ( abs(uno(1:lmax2,1:lmax2) ) )
-! write (stdout,*) "capel = ", capel
- IF (capel > eps8) CALL errore('ylm_expansion', &
- ' inversion failed: r(*,1:nr) are not all independent !!',1)
- DEALLOCATE (uno)
- RETURN
-END SUBROUTINE check_inverse
-
-SUBROUTINE set_u_matrix(x,z,u)
- USE kinds, ONLY : DP
- USE constants, ONLY : eps6
- IMPLICIT NONE
- ! I/O variables
- real(DP) :: x(3),z(3),u(3,3)
- ! local variables
- real(DP) :: xx, zz, y(3), coseno
-
- xx = sqrt(x(1)*x(1) + x(2)*x(2) + x(3)*x(3))
- IF (xx < eps6) CALL errore ('set_u_matrix',' |xaxis| < eps ',1)
-! x(:) = x(:)/xx
- zz = sqrt(z(1)*z(1) + z(2)*z(2) + z(3)*z(3))
- IF (zz < eps6) CALL errore ('set_u_matrix',' |zaxis| < eps ',1)
-! z(:) = z(:)/zz
-
- coseno = (x(1)*z(1) + x(2)*z(2) + x(3)*z(3))/xx/zz
- IF (abs(coseno) > eps6) CALL errore('set_u_matrix',' xaxis and zaxis are not orthogonal !',1)
-
- y(1) = (z(2)*x(3) - x(2)*z(3))/xx/zz
- y(2) = (z(3)*x(1) - x(3)*z(1))/xx/zz
- y(3) = (z(1)*x(2) - x(1)*z(2))/xx/zz
-
- u(1,:) = x(:)/xx
- u(2,:) = y(:)
- u(3,:) = z(:)/zz
-
-! write (stdout,'(3f10.7)') u(:,:)
-
- RETURN
-
-END SUBROUTINE set_u_matrix
-
-SUBROUTINE ylm_wannier(ylm,l,mr,r,nr)
-!
-! this routine returns in ylm(r) the values at the nr points r(1:3,1:nr)
-! of the spherical harmonic identified by indices (l,mr)
-! in table 3.1 of the wannierf90 specification.
-!
-! No reference to the particular ylm ordering internal to Quantum ESPRESSO
-! is assumed.
-!
-! If ordering in wannier90 code is changed or extended this should be the
-! only place to be modified accordingly
-!
- USE kinds, ONLY : DP
- USE constants, ONLY : pi, fpi, eps8
- IMPLICIT NONE
-! I/O variables
-!
- INTEGER :: l, mr, nr
- real(DP) :: ylm(nr), r(3,nr)
-!
-! local variables
-!
- real(DP), EXTERNAL :: s, p_z,px,py, dz2, dxz, dyz, dx2my2, dxy
- real(DP), EXTERNAL :: fz3, fxz2, fyz2, fzx2my2, fxyz, fxx2m3y2, fy3x2my2
- real(DP) :: rr, cost, phi
- INTEGER :: ir
- real(DP) :: bs2, bs3, bs6, bs12
- bs2 = 1.d0/sqrt(2.d0)
- bs3=1.d0/sqrt(3.d0)
- bs6 = 1.d0/sqrt(6.d0)
- bs12 = 1.d0/sqrt(12.d0)
-!
- IF (l > 3 .or. l < -5 ) CALL errore('ylm_wannier',' l out of range ', 1)
- IF (l>=0) THEN
- IF (mr < 1 .or. mr > 2*l+1) CALL errore('ylm_wannier','mr out of range' ,1)
- ELSE
- IF (mr < 1 .or. mr > abs(l)+1 ) CALL errore('ylm_wannier','mr out of range',1)
- ENDIF
-
- DO ir=1, nr
- rr = sqrt( r(1,ir)*r(1,ir) + r(2,ir)*r(2,ir) + r(3,ir)*r(3,ir) )
- IF (rr < eps8) CALL errore('ylm_wannier',' rr too small ',1)
-
- cost = r(3,ir) / rr
- !
- ! beware the arc tan, it is defined modulo pi
- !
- IF (r(1,ir) > eps8) THEN
- phi = atan( r(2,ir)/r(1,ir) )
- ELSEIF (r(1,ir) < -eps8 ) THEN
- phi = atan( r(2,ir)/r(1,ir) ) + pi
- ELSE
- phi = sign( pi/2.d0,r(2,ir) )
- ENDIF
-
-
- IF (l==0) THEN ! s orbital
- ylm(ir) = s(cost,phi)
- ENDIF
- IF (l==1) THEN ! p orbitals
- IF (mr==1) ylm(ir) = p_z(cost,phi)
- IF (mr==2) ylm(ir) = px(cost,phi)
- IF (mr==3) ylm(ir) = py(cost,phi)
- ENDIF
- IF (l==2) THEN ! d orbitals
- IF (mr==1) ylm(ir) = dz2(cost,phi)
- IF (mr==2) ylm(ir) = dxz(cost,phi)
- IF (mr==3) ylm(ir) = dyz(cost,phi)
- IF (mr==4) ylm(ir) = dx2my2(cost,phi)
- IF (mr==5) ylm(ir) = dxy(cost,phi)
- ENDIF
- IF (l==3) THEN ! f orbitals
- IF (mr==1) ylm(ir) = fz3(cost,phi)
- IF (mr==2) ylm(ir) = fxz2(cost,phi)
- IF (mr==3) ylm(ir) = fyz2(cost,phi)
- IF (mr==4) ylm(ir) = fzx2my2(cost,phi)
- IF (mr==5) ylm(ir) = fxyz(cost,phi)
- IF (mr==6) ylm(ir) = fxx2m3y2(cost,phi)
- IF (mr==7) ylm(ir) = fy3x2my2(cost,phi)
- ENDIF
- IF (l==-1) THEN ! sp hybrids
- IF (mr==1) ylm(ir) = bs2 * ( s(cost,phi) + px(cost,phi) )
- IF (mr==2) ylm(ir) = bs2 * ( s(cost,phi) - px(cost,phi) )
- ENDIF
- IF (l==-2) THEN ! sp2 hybrids
- IF (mr==1) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)+bs2*py(cost,phi)
- IF (mr==2) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)-bs2*py(cost,phi)
- IF (mr==3) ylm(ir) = bs3*s(cost,phi) +2.d0*bs6*px(cost,phi)
- ENDIF
- IF (l==-3) THEN ! sp3 hybrids
- IF (mr==1) ylm(ir) = 0.5d0*(s(cost,phi)+px(cost,phi)+py(cost,phi)+p_z(cost,phi))
- IF (mr==2) ylm(ir) = 0.5d0*(s(cost,phi)+px(cost,phi)-py(cost,phi)-p_z(cost,phi))
- IF (mr==3) ylm(ir) = 0.5d0*(s(cost,phi)-px(cost,phi)+py(cost,phi)-p_z(cost,phi))
- IF (mr==4) ylm(ir) = 0.5d0*(s(cost,phi)-px(cost,phi)-py(cost,phi)+p_z(cost,phi))
- ENDIF
- IF (l==-4) THEN ! sp3d hybrids
- IF (mr==1) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)+bs2*py(cost,phi)
- IF (mr==2) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)-bs2*py(cost,phi)
- IF (mr==3) ylm(ir) = bs3*s(cost,phi) +2.d0*bs6*px(cost,phi)
- IF (mr==4) ylm(ir) = bs2*p_z(cost,phi)+bs2*dz2(cost,phi)
- IF (mr==5) ylm(ir) =-bs2*p_z(cost,phi)+bs2*dz2(cost,phi)
- ENDIF
- IF (l==-5) THEN ! sp3d2 hybrids
- IF (mr==1) ylm(ir) = bs6*s(cost,phi)-bs2*px(cost,phi)-bs12*dz2(cost,phi)+.5d0*dx2my2(cost,phi)
- IF (mr==2) ylm(ir) = bs6*s(cost,phi)+bs2*px(cost,phi)-bs12*dz2(cost,phi)+.5d0*dx2my2(cost,phi)
- IF (mr==3) ylm(ir) = bs6*s(cost,phi)-bs2*py(cost,phi)-bs12*dz2(cost,phi)-.5d0*dx2my2(cost,phi)
- IF (mr==4) ylm(ir) = bs6*s(cost,phi)+bs2*py(cost,phi)-bs12*dz2(cost,phi)-.5d0*dx2my2(cost,phi)
- IF (mr==5) ylm(ir) = bs6*s(cost,phi)-bs2*p_z(cost,phi)+bs3*dz2(cost,phi)
- IF (mr==6) ylm(ir) = bs6*s(cost,phi)+bs2*p_z(cost,phi)+bs3*dz2(cost,phi)
- ENDIF
-
- ENDDO
-
- RETURN
-
-END SUBROUTINE ylm_wannier
-
-!======== l = 0 =====================================================================
-FUNCTION s(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) :: s, cost,phi
- s = 1.d0/ sqrt(fpi)
- RETURN
-END FUNCTION s
-!======== l = 1 =====================================================================
-FUNCTION p_z(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::p_z, cost,phi
- p_z = sqrt(3.d0/fpi) * cost
- RETURN
-END FUNCTION p_z
-FUNCTION px(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::px, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- px = sqrt(3.d0/fpi) * sint * cos(phi)
- RETURN
-END FUNCTION px
-FUNCTION py(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::py, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- py = sqrt(3.d0/fpi) * sint * sin(phi)
- RETURN
-END FUNCTION py
-!======== l = 2 =====================================================================
-FUNCTION dz2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dz2, cost, phi
- dz2 = sqrt(1.25d0/fpi) * (3.d0* cost*cost-1.d0)
- RETURN
-END FUNCTION dz2
-FUNCTION dxz(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dxz, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- dxz = sqrt(15.d0/fpi) * sint*cost * cos(phi)
- RETURN
-END FUNCTION dxz
-FUNCTION dyz(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dyz, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- dyz = sqrt(15.d0/fpi) * sint*cost * sin(phi)
- RETURN
-END FUNCTION dyz
-FUNCTION dx2my2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dx2my2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- dx2my2 = sqrt(3.75d0/fpi) * sint*sint * cos(2.d0*phi)
- RETURN
-END FUNCTION dx2my2
-FUNCTION dxy(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dxy, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- dxy = sqrt(3.75d0/fpi) * sint*sint * sin(2.d0*phi)
- RETURN
-END FUNCTION dxy
-!======== l = 3 =====================================================================
-FUNCTION fz3(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fz3, cost, phi
- fz3 = 0.25d0*sqrt(7.d0/pi) * ( 5.d0 * cost * cost - 3.d0 ) * cost
- RETURN
-END FUNCTION fz3
-FUNCTION fxz2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fxz2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fxz2 = 0.25d0*sqrt(10.5d0/pi) * ( 5.d0 * cost * cost - 1.d0 ) * sint * cos(phi)
- RETURN
-END FUNCTION fxz2
-FUNCTION fyz2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fyz2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fyz2 = 0.25d0*sqrt(10.5d0/pi) * ( 5.d0 * cost * cost - 1.d0 ) * sint * sin(phi)
- RETURN
-END FUNCTION fyz2
-FUNCTION fzx2my2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fzx2my2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fzx2my2 = 0.25d0*sqrt(105d0/pi) * sint * sint * cost * cos(2.d0*phi)
- RETURN
-END FUNCTION fzx2my2
-FUNCTION fxyz(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fxyz, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fxyz = 0.25d0*sqrt(105d0/pi) * sint * sint * cost * sin(2.d0*phi)
- RETURN
-END FUNCTION fxyz
-FUNCTION fxx2m3y2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fxx2m3y2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fxx2m3y2 = 0.25d0*sqrt(17.5d0/pi) * sint * sint * sint * cos(3.d0*phi)
- RETURN
-END FUNCTION fxx2m3y2
-FUNCTION fy3x2my2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fy3x2my2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fy3x2my2 = 0.25d0*sqrt(17.5d0/pi) * sint * sint * sint * sin(3.d0*phi)
- RETURN
-END FUNCTION fy3x2my2
-!
-!
-!-----------------------------------------------------------------------
-SUBROUTINE radialpart(ng, q, alfa, rvalue, lmax, radial)
- !-----------------------------------------------------------------------
- !
- ! This routine computes a table with the radial Fourier transform
- ! of the radial functions.
- !
- USE kinds, ONLY : dp
- USE constants, ONLY : fpi
- USE cell_base, ONLY : omega
- !
- IMPLICIT NONE
- ! I/O
- INTEGER :: ng, rvalue, lmax
- real(DP) :: q(ng), alfa, radial(ng,0:lmax)
- ! local variables
- real(DP), PARAMETER :: xmin=-6.d0, dx=0.025d0, rmax=10.d0
-
- real(DP) :: rad_int, pref, x
- INTEGER :: l, lp1, ir, ig, mesh_r
- real(DP), ALLOCATABLE :: bes(:), func_r(:), r(:), rij(:), aux(:)
-
- mesh_r = nint ( ( log ( rmax ) - xmin ) / dx + 1 )
- ALLOCATE ( bes(mesh_r), func_r(mesh_r), r(mesh_r), rij(mesh_r) )
- ALLOCATE ( aux(mesh_r))
- !
- ! compute the radial mesh
- !
- DO ir = 1, mesh_r
- x = xmin + dble (ir - 1) * dx
- r (ir) = exp (x) / alfa
- rij (ir) = dx * r (ir)
- ENDDO
- !
- IF (rvalue==1) func_r(:) = 2.d0 * alfa**(3.d0/2.d0) * exp(-alfa*r(:))
- IF (rvalue==2) func_r(:) = 1.d0/sqrt(8.d0) * alfa**(3.d0/2.d0) * &
- (2.0d0 - alfa*r(:)) * exp(-alfa*r(:)*0.5d0)
- IF (rvalue==3) func_r(:) = sqrt(4.d0/27.d0) * alfa**(3.0d0/2.0d0) * &
- (1.d0 - 2.0d0/3.0d0*alfa*r(:) + 2.d0*(alfa*r(:))**2/27.d0) * &
- exp(-alfa*r(:)/3.0d0)
- pref = fpi/sqrt(omega)
- !
- DO l = 0, lmax
- DO ig=1,ng
- CALL sph_bes (mesh_r, r(1), q(ig), l, bes)
- aux(:) = bes(:) * func_r(:) * r(:) * r(:)
- ! second r factor added upo suggestion by YY Liang
- CALL simpson (mesh_r, aux, rij, rad_int)
- radial(ig,l) = rad_int * pref
- ENDDO
- ENDDO
-
- DEALLOCATE (bes, func_r, r, rij, aux )
- RETURN
-END SUBROUTINE radialpart
-
-
+!
+! Copyright (C) 2003-2013 Quantum ESPRESSO and Wannier90 groups
+! This file is distributed under the terms of the
+! GNU General Public License. See the file `License'
+! in the root directory of the present distribution,
+! or http://www.gnu.org/copyleft/gpl.txt .
+!
+! pw2wannier was written by Stefano de Gironcoli
+! with later additions by
+! Jonathan Yates - spinors
+! Arash Mostofi - gamma point and transport things
+! Timo Thonhauser, Graham Lopez, Ivo Souza
+! uHu, uIu terms for orbital magnetisation
+! please send bugs and comments to
+! Jonathan Yates and Arash Mostofi
+! Takashi Koretsune and Florian Thoele -- noncollinear and USPPs
+! Valerio Vitale - Selected columns of density matrix (SCDM)
+!
+!
+! NOTE: old_spinor_proj is still available for compatibility with old
+! nnkp files but should be removed soon.
+!
+!
+module wannier
+ USE kinds, only : DP
+ !integer, allocatable :: nnb(:) ! #b (ik)
+ integer :: nnb ! #b
+ integer, allocatable :: kpb(:,:) ! k+b (ik,ib)
+ integer, allocatable :: g_kpb(:,:,:) ! G_k+b (ipol,ik,ib)
+ integer, allocatable :: ig_(:,:) ! G_k+b (ipol,ik,ib)
+ integer, allocatable :: lw(:,:), mw(:,:) ! l and m of wannier (16,n_wannier)
+ integer, allocatable :: num_sph(:) ! num. func. in lin. comb., (n_wannier)
+ logical, allocatable :: excluded_band(:)
+ ! begin change Lopez, Thonhauser, Souza
+ integer :: iun_nnkp,iun_mmn,iun_amn,iun_band,iun_spn,iun_plot,iun_parity,&
+ nnbx,nexband,iun_uhu,&
+ iun_uIu !ivo
+ ! end change Lopez, Thonhauser, Souza
+ integer :: n_wannier !number of WF
+ integer :: n_proj !number of projection
+ complex(DP), allocatable :: gf(:,:) ! guding_function(npwx,n_wannier)
+ complex(DP), allocatable :: gf_spinor(:,:)
+ complex(DP), allocatable :: sgf_spinor(:,:)
+ integer :: ispinw, ikstart, ikstop, iknum
+ character(LEN=15) :: wan_mode ! running mode
+ logical :: logwann, wvfn_formatted, write_unk, write_eig, &
+ ! begin change Lopez, Thonhauser, Souza
+ write_amn,write_mmn,reduce_unk,write_spn,&
+ write_unkg,write_uhu,&
+ write_dmn,read_sym, & !YN
+ write_uIu, spn_formatted, uHu_formatted, uIu_formatted, & !ivo
+ ! end change Lopez, Thonhauser, Souza
+ ! vv: Begin SCDM keywords
+ scdm_proj
+ character(LEN=15) :: scdm_entanglement
+ real(DP) :: scdm_mu, scdm_sigma
+ ! vv: End SCDM keywords
+ ! run check for regular mesh
+ logical :: regular_mesh = .true.
+ ! input data from nnkp file
+ real(DP), allocatable :: center_w(:,:) ! center_w(3,n_wannier)
+ integer, allocatable :: spin_eig(:)
+ real(DP), allocatable :: spin_qaxis(:,:)
+ integer, allocatable :: l_w(:), mr_w(:) ! l and mr of wannier (n_wannier) as from table 3.1,3.2 of spec.
+ integer, allocatable :: r_w(:) ! index of radial function (n_wannier) as from table 3.3 of spec.
+ real(DP), allocatable :: xaxis(:,:),zaxis(:,:) ! xaxis and zaxis(3,n_wannier)
+ real(DP), allocatable :: alpha_w(:) ! alpha_w(n_wannier) ( called zona in wannier spec)
+ !
+ real(DP), allocatable :: csph(:,:) ! expansion coefficients of gf on QE ylm function (16,n_wannier)
+ CHARACTER(len=256) :: seedname = 'wannier' ! prepended to file names in wannier90
+ ! For implementation of wannier_lib
+ integer :: mp_grid(3) ! dimensions of MP k-point grid
+ real(DP) :: rlatt(3,3),glatt(3,3) ! real and recip lattices (Cartesian co-ords, units of Angstrom)
+ real(DP), allocatable :: kpt_latt(:,:) ! k-points in crystal co-ords. kpt_latt(3,iknum)
+ real(DP), allocatable :: atcart(:,:) ! atom centres in Cartesian co-ords and Angstrom units. atcart(3,nat)
+ integer :: num_bands ! number of bands left after exclusions
+ character(len=3), allocatable :: atsym(:) ! atomic symbols. atsym(nat)
+ integer :: num_nnmax=12
+ complex(DP), allocatable :: m_mat(:,:,:,:), a_mat(:,:,:)
+ complex(DP), allocatable :: u_mat(:,:,:), u_mat_opt(:,:,:)
+ logical, allocatable :: lwindow(:,:)
+ real(DP), allocatable :: wann_centers(:,:),wann_spreads(:)
+ real(DP) :: spreads(3)
+ real(DP), allocatable :: eigval(:,:)
+ logical :: old_spinor_proj ! for compatability for nnkp files prior to W90v2.0
+ integer,allocatable :: rir(:,:)
+ logical,allocatable :: zerophase(:,:)
+end module wannier
+!
+
+
+!------------------------------------------------------------------------
+PROGRAM pw2wannier90
+ ! This is the interface to the Wannier90 code: see http://www.wannier.org
+ !------------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode, ionode_id
+ USE mp_global, ONLY : mp_startup
+ USE mp_pools, ONLY : npool
+ USE mp, ONLY : mp_bcast
+ USE mp_world, ONLY : world_comm
+ USE cell_base, ONLY : at, bg
+ USE lsda_mod, ONLY : nspin, isk
+ USE klist, ONLY : nkstot
+ USE io_files, ONLY : prefix, tmp_dir
+ USE noncollin_module, ONLY : noncolin
+ USE control_flags, ONLY : gamma_only
+ USE environment,ONLY : environment_start, environment_end
+ USE wannier
+ !
+ IMPLICIT NONE
+ !
+ CHARACTER(LEN=256), EXTERNAL :: trimcheck
+ !
+ INTEGER :: ios
+ CHARACTER(len=4) :: spin_component
+ CHARACTER(len=256) :: outdir
+
+ ! these are in wannier module.....-> integer :: ispinw, ikstart, ikstop, iknum
+ NAMELIST / inputpp / outdir, prefix, spin_component, wan_mode, &
+ seedname, write_unk, write_amn, write_mmn, write_spn, write_eig,&
+ ! begin change Lopez, Thonhauser, Souza
+ wvfn_formatted, reduce_unk, write_unkg, write_uhu,&
+ write_dmn, read_sym, & !YN:
+ write_uIu, spn_formatted, uHu_formatted, uIu_formatted,& !ivo
+ ! end change Lopez, Thonhauser, Souza
+ regular_mesh,& !gresch
+ ! begin change Vitale
+ scdm_proj, scdm_entanglement, scdm_mu, scdm_sigma
+ ! end change Vitale
+ !
+ ! initialise environment
+ !
+#if defined(__MPI)
+ CALL mp_startup ( )
+#endif
+ !! not sure if this should be called also in 'library' mode or not !!
+ CALL environment_start ( 'PW2WANNIER' )
+ !
+ CALL start_clock( 'init_pw2wan' )
+ !
+ ! Read input on i/o node and broadcast to the rest
+ !
+ ios = 0
+ IF(ionode) THEN
+ !
+ ! Check to see if we are reading from a file
+ !
+ CALL input_from_file()
+ !
+ ! set default values for variables in namelist
+ !
+ CALL get_environment_variable( 'ESPRESSO_TMPDIR', outdir )
+ IF ( trim( outdir ) == ' ' ) outdir = './'
+ prefix = ' '
+ seedname = 'wannier'
+ spin_component = 'none'
+ wan_mode = 'standalone'
+ wvfn_formatted = .false.
+ spn_formatted=.false.
+ uHu_formatted=.false.
+ uIu_formatted=.false.
+ write_unk = .false.
+ write_amn = .true.
+ write_mmn = .true.
+ write_spn = .false.
+ write_eig = .true.
+ ! begin change Lopez, Thonhauser, Souza
+ write_uhu = .false.
+ write_uIu = .false. !ivo
+ ! end change Lopez, Thonhauser, Souza
+ reduce_unk= .false.
+ write_unkg= .false.
+ write_dmn = .false. !YN:
+ read_sym = .false. !YN:
+ scdm_proj = .false.
+ scdm_entanglement = 'isolated'
+ scdm_mu = 0.0_dp
+ scdm_sigma = 1.0_dp
+ !
+ ! reading the namelist inputpp
+ !
+ READ (5, inputpp, iostat=ios)
+ !
+ ! Check of namelist variables
+ !
+ tmp_dir = trimcheck(outdir)
+ ! back to all nodes
+ ENDIF
+ !
+ CALL mp_bcast(ios,ionode_id, world_comm)
+ IF (ios /= 0) CALL errore( 'pw2wannier90', 'reading inputpp namelist', abs(ios))
+ !
+ ! broadcast input variable to all nodes
+ !
+ CALL mp_bcast(outdir,ionode_id, world_comm)
+ CALL mp_bcast(tmp_dir,ionode_id, world_comm)
+ CALL mp_bcast(prefix,ionode_id, world_comm)
+ CALL mp_bcast(seedname,ionode_id, world_comm)
+ CALL mp_bcast(spin_component,ionode_id, world_comm)
+ CALL mp_bcast(wan_mode,ionode_id, world_comm)
+ CALL mp_bcast(wvfn_formatted,ionode_id, world_comm)
+ CALL mp_bcast(write_unk,ionode_id, world_comm)
+ CALL mp_bcast(write_amn,ionode_id, world_comm)
+ CALL mp_bcast(write_mmn,ionode_id, world_comm)
+ CALL mp_bcast(write_eig,ionode_id, world_comm)
+ ! begin change Lopez, Thonhauser, Souza
+ CALL mp_bcast(write_uhu,ionode_id, world_comm)
+ CALL mp_bcast(write_uIu,ionode_id, world_comm) !ivo
+ ! end change Lopez, Thonhauser, Souza
+ CALL mp_bcast(write_spn,ionode_id, world_comm)
+ CALL mp_bcast(reduce_unk,ionode_id, world_comm)
+ CALL mp_bcast(write_unkg,ionode_id, world_comm)
+ CALL mp_bcast(write_dmn,ionode_id, world_comm)
+ CALL mp_bcast(read_sym,ionode_id, world_comm)
+ CALL mp_bcast(scdm_proj,ionode_id, world_comm)
+ CALL mp_bcast(scdm_entanglement,ionode_id, world_comm)
+ CALL mp_bcast(scdm_mu,ionode_id, world_comm)
+ CALL mp_bcast(scdm_sigma,ionode_id, world_comm)
+ !
+ ! Check: kpoint distribution with pools not implemented
+ !
+ IF ( npool > 1 ) CALL errore( 'pw2wannier90', 'pools not implemented', npool )
+ !
+ ! Now allocate space for pwscf variables, read and check them.
+ !
+ logwann = .true.
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Reading nscf_save data'
+ CALL read_file
+ WRITE(stdout,*)
+ !
+ IF (noncolin.and.gamma_only) CALL errore('pw2wannier90',&
+ 'Non-collinear and gamma_only not implemented',1)
+ IF (noncolin.and.scdm_proj) CALL errore('pw2wannier90',&
+ 'Non-collinear and SCDM not implemented',1)
+ IF (gamma_only.and.scdm_proj) CALL errore('pw2wannier90',&
+ 'Gamma_only and SCDM not implemented',1)
+ IF (scdm_proj) then
+ IF ((trim(scdm_entanglement) /= 'isolated') .AND. &
+ (trim(scdm_entanglement) /= 'erfc') .AND. &
+ (trim(scdm_entanglement) /= 'gaussian')) then
+ call errore('pw2wannier90', &
+ 'Can not recognize the choice for scdm_entanglement. ' &
+ //'Valid options are: isolated, erfc and gaussian')
+ ENDIF
+ ENDIF
+ IF (scdm_sigma <= 0._dp) &
+ call errore('pw2wannier90','Sigma in the SCDM method must be positive.')
+ !
+ SELECT CASE ( trim( spin_component ) )
+ CASE ( 'up' )
+ WRITE(stdout,*) ' Spin CASE ( up )'
+ ispinw = 1
+ ikstart = 1
+ ikstop = nkstot/2
+ iknum = nkstot/2
+ CASE ( 'down' )
+ WRITE(stdout,*) ' Spin CASE ( down )'
+ ispinw = 2
+ ikstart = nkstot/2 + 1
+ ikstop = nkstot
+ iknum = nkstot/2
+ CASE DEFAULT
+ IF(noncolin) THEN
+ WRITE(stdout,*) ' Spin CASE ( non-collinear )'
+ ELSE
+ WRITE(stdout,*) ' Spin CASE ( default = unpolarized )'
+ ENDIF
+ ispinw = 0
+ ikstart = 1
+ ikstop = nkstot
+ iknum = nkstot
+ END SELECT
+ !
+ CALL stop_clock( 'init_pw2wan' )
+ !
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Wannier mode is: ',wan_mode
+ WRITE(stdout,*)
+ !
+ IF(wan_mode=='standalone') THEN
+ !
+ WRITE(stdout,*) ' -----------------'
+ WRITE(stdout,*) ' *** Reading nnkp '
+ WRITE(stdout,*) ' -----------------'
+ WRITE(stdout,*)
+ CALL read_nnkp
+ WRITE(stdout,*) ' Opening pp-files '
+ CALL openfil_pp
+ CALL ylm_expansion
+ WRITE(stdout,*)
+ WRITE(stdout,*)
+ if(write_dmn)then
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*) ' *** Compute DMN '
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*)
+ CALL compute_dmn !YN:
+ WRITE(stdout,*)
+ end if
+ IF(write_amn) THEN
+ IF(scdm_proj) THEN
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*) ' *** Compute A with SCDM-k'
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*)
+ CALL compute_amn_with_scdm
+ ELSE
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*) ' *** Compute A projections'
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*)
+ CALL compute_amn
+ ENDIF
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*) ' *** A matrix is not computed '
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ IF(write_mmn) THEN
+ WRITE(stdout,*) ' ---------------'
+ WRITE(stdout,*) ' *** Compute M '
+ WRITE(stdout,*) ' ---------------'
+ WRITE(stdout,*)
+ CALL compute_mmn
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*) ' *** M matrix is not computed '
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ if(noncolin) then
+ IF(write_spn) THEN
+ WRITE(stdout,*) ' ------------------'
+ WRITE(stdout,*) ' *** Compute Spin '
+ WRITE(stdout,*) ' ------------------'
+ WRITE(stdout,*)
+ CALL compute_spin
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' --------------------------------'
+ WRITE(stdout,*) ' *** Spin matrix is not computed '
+ WRITE(stdout,*) ' --------------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ elseif(write_spn) then
+ write(stdout,*) ' -----------------------------------'
+ write(stdout,*) ' *** Non-collinear calculation is '
+ write(stdout,*) ' required for spin '
+ write(stdout,*) ' term to be computed '
+ write(stdout,*) ' -----------------------------------'
+ endif
+ IF(write_uHu.or.write_uIu) THEN
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*) ' *** Compute Orb '
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*)
+ CALL compute_orb
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------------'
+ WRITE(stdout,*) ' *** Orbital terms are not computed '
+ WRITE(stdout,*) ' -----------------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ IF(write_eig) THEN
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*) ' *** Write bands '
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*)
+ CALL write_band
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*) ' *** Bands are not written '
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ IF(write_unk) THEN
+ WRITE(stdout,*) ' --------------------'
+ WRITE(stdout,*) ' *** Write plot info '
+ WRITE(stdout,*) ' --------------------'
+ WRITE(stdout,*)
+ CALL write_plot
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*) ' *** Plot info is not printed '
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ IF(write_unkg) THEN
+ WRITE(stdout,*) ' --------------------'
+ WRITE(stdout,*) ' *** Write parity info '
+ WRITE(stdout,*) ' --------------------'
+ WRITE(stdout,*)
+ CALL write_parity
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*) ' *** Parity info is not printed '
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ WRITE(stdout,*) ' ------------'
+ WRITE(stdout,*) ' *** Stop pp '
+ WRITE(stdout,*) ' ------------'
+ WRITE(stdout,*)
+ !
+ IF ( ionode ) WRITE( stdout, * )
+ CALL print_clock( 'init_pw2wan' )
+ if(write_dmn ) CALL print_clock( 'compute_dmn' )!YN:
+ IF(write_amn ) CALL print_clock( 'compute_amn' )
+ IF(write_mmn ) CALL print_clock( 'compute_mmn' )
+ IF(write_unk ) CALL print_clock( 'write_unk' )
+ IF(write_unkg ) CALL print_clock( 'write_parity' )
+ !! not sure if this should be called also in 'library' mode or not !!
+ CALL environment_end ( 'PW2WANNIER' )
+ IF ( ionode ) WRITE( stdout, * )
+ CALL stop_pp
+ !
+ ENDIF
+ !
+ IF(wan_mode=='library') THEN
+ !
+! seedname='wannier'
+ WRITE(stdout,*) ' Setting up...'
+ CALL setup_nnkp
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Opening pp-files '
+ CALL openfil_pp
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Ylm expansion'
+ CALL ylm_expansion
+ WRITE(stdout,*)
+ CALL compute_amn
+ CALL compute_mmn
+ if(noncolin) then
+ IF(write_spn) THEN
+ CALL compute_spin
+ ENDIF
+ ENDIF
+ IF(write_uHu.or.write_uIu) THEN
+ CALL compute_orb
+ ENDIF
+ CALL write_band
+ IF(write_unk) CALL write_plot
+ IF(write_unkg) THEN
+ CALL write_parity
+ ENDIF
+ CALL run_wannier
+ CALL lib_dealloc
+ CALL stop_pp
+ !
+ ENDIF
+ !
+ IF(wan_mode=='wannier2sic') THEN
+ !
+ CALL read_nnkp
+ CALL wan2sic
+ !
+ ENDIF
+ !
+ STOP
+END PROGRAM pw2wannier90
+!
+!-----------------------------------------------------------------------
+SUBROUTINE lib_dealloc
+ !-----------------------------------------------------------------------
+ !
+ USE wannier
+
+ IMPLICIT NONE
+
+ DEALLOCATE(m_mat,u_mat,u_mat_opt,a_mat,eigval)
+
+ RETURN
+END SUBROUTINE lib_dealloc
+!
+!-----------------------------------------------------------------------
+SUBROUTINE setup_nnkp
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode, ionode_id
+ USE kinds, ONLY : DP
+ USE constants, ONLY : eps6, tpi, bohr => BOHR_RADIUS_ANGS
+ USE cell_base, ONLY : at, bg, alat
+ USE gvect, ONLY : g, gg
+ USE ions_base, ONLY : nat, tau, ityp, atm
+ USE klist, ONLY : xk
+ USE mp, ONLY : mp_bcast, mp_sum
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp_world, ONLY : world_comm
+ USE wvfct, ONLY : nbnd,npwx
+ USE control_flags, ONLY : gamma_only
+ USE noncollin_module, ONLY : noncolin
+ USE wannier
+
+ IMPLICIT NONE
+ real(DP) :: g_(3), gg_
+ INTEGER :: ik, ib, ig, iw, ia, indexb, TYPE
+ INTEGER, ALLOCATABLE :: ig_check(:,:)
+ real(DP) :: xnorm, znorm, coseno
+ INTEGER :: exclude_bands(nbnd)
+
+ ! aam: translations between PW2Wannier90 and Wannier90
+ ! pw2wannier90 <==> Wannier90
+ ! nbnd num_bands_tot
+ ! n_wannier num_wann
+ ! num_bands num_bands
+ ! nat num_atoms
+ ! iknum num_kpts
+ ! rlatt transpose(real_lattice)
+ ! glatt transpose(recip_lattice)
+ ! kpt_latt kpt_latt
+ ! nnb nntot
+ ! kpb nnlist
+ ! g_kpb nncell
+ ! mp_grid mp_grid
+ ! center_w proj_site
+ ! l_w,mr_w,r_w proj_l,proj_m,proj_radial
+ ! xaxis,zaxis proj_x,proj_z
+ ! alpha_w proj_zona
+ ! exclude_bands exclude_bands
+ ! atcart atoms_cart
+ ! atsym atom_symbols
+
+ ALLOCATE( kpt_latt(3,iknum) )
+ ALLOCATE( atcart(3,nat), atsym(nat) )
+ ALLOCATE( kpb(iknum,num_nnmax), g_kpb(3,iknum,num_nnmax) )
+ ALLOCATE( center_w(3,nbnd), alpha_w(nbnd), l_w(nbnd), &
+ mr_w(nbnd), r_w(nbnd), zaxis(3,nbnd), xaxis(3,nbnd) )
+ ALLOCATE( excluded_band(nbnd) )
+
+ ! real lattice (Cartesians, Angstrom)
+ rlatt(:,:) = transpose(at(:,:))*alat*bohr
+ ! reciprocal lattice (Cartesians, Angstrom)
+ glatt(:,:) = transpose(bg(:,:))*tpi/(alat*bohr)
+ ! convert Cartesian k-points to crystallographic co-ordinates
+ kpt_latt(:,1:iknum)=xk(:,1:iknum)
+ CALL cryst_to_cart(iknum,kpt_latt,at,-1)
+ ! atom co-ordinates in Cartesian co-ords and Angstrom units
+ atcart(:,:) = tau(:,:)*bohr*alat
+ ! atom symbols
+ DO ia=1,nat
+ TYPE=ityp(ia)
+ atsym(ia)=atm(TYPE)
+ ENDDO
+
+ ! MP grid dimensions
+ CALL find_mp_grid()
+
+ WRITE(stdout,'(" - Number of atoms is (",i3,")")') nat
+
+#if defined(__WANLIB)
+ IF (ionode) THEN
+ CALL wannier_setup(seedname,mp_grid,iknum,rlatt, & ! input
+ glatt,kpt_latt,nbnd,nat,atsym,atcart,gamma_only,noncolin, & ! input
+ nnb,kpb,g_kpb,num_bands,n_wannier,center_w, & ! output
+ l_w,mr_w,r_w,zaxis,xaxis,alpha_w,exclude_bands) ! output
+ ENDIF
+#endif
+
+ CALL mp_bcast(nnb,ionode_id, world_comm)
+ CALL mp_bcast(kpb,ionode_id, world_comm)
+ CALL mp_bcast(g_kpb,ionode_id, world_comm)
+ CALL mp_bcast(num_bands,ionode_id, world_comm)
+ CALL mp_bcast(n_wannier,ionode_id, world_comm)
+ CALL mp_bcast(center_w,ionode_id, world_comm)
+ CALL mp_bcast(l_w,ionode_id, world_comm)
+ CALL mp_bcast(mr_w,ionode_id, world_comm)
+ CALL mp_bcast(r_w,ionode_id, world_comm)
+ CALL mp_bcast(zaxis,ionode_id, world_comm)
+ CALL mp_bcast(xaxis,ionode_id, world_comm)
+ CALL mp_bcast(alpha_w,ionode_id, world_comm)
+ CALL mp_bcast(exclude_bands,ionode_id, world_comm)
+
+ IF(noncolin) THEN
+ n_proj=n_wannier/2
+ ELSE
+ n_proj=n_wannier
+ ENDIF
+
+ ALLOCATE( gf(npwx,n_proj), csph(16,n_proj) )
+
+ WRITE(stdout,'(" - Number of wannier functions is (",i3,")")') n_wannier
+
+ excluded_band(1:nbnd)=.false.
+ nexband=0
+ band_loop: DO ib=1,nbnd
+ indexb=exclude_bands(ib)
+ IF (indexb>nbnd .or. indexb<0) THEN
+ CALL errore('setup_nnkp',' wrong excluded band index ', 1)
+ ELSEIF (indexb==0) THEN
+ exit band_loop
+ ELSE
+ nexband=nexband+1
+ excluded_band(indexb)=.true.
+ ENDIF
+ ENDDO band_loop
+
+ IF ( (nbnd-nexband)/=num_bands ) &
+ CALL errore('setup_nnkp',' something wrong with num_bands',1)
+
+ DO iw=1,n_proj
+ xnorm = sqrt(xaxis(1,iw)*xaxis(1,iw) + xaxis(2,iw)*xaxis(2,iw) + &
+ xaxis(3,iw)*xaxis(3,iw))
+ IF (xnorm < eps6) CALL errore ('setup_nnkp',' |xaxis| < eps ',1)
+ znorm = sqrt(zaxis(1,iw)*zaxis(1,iw) + zaxis(2,iw)*zaxis(2,iw) + &
+ zaxis(3,iw)*zaxis(3,iw))
+ IF (znorm < eps6) CALL errore ('setup_nnkp',' |zaxis| < eps ',1)
+ coseno = (xaxis(1,iw)*zaxis(1,iw) + xaxis(2,iw)*zaxis(2,iw) + &
+ xaxis(3,iw)*zaxis(3,iw))/xnorm/znorm
+ IF (abs(coseno) > eps6) &
+ CALL errore('setup_nnkp',' xaxis and zaxis are not orthogonal !',1)
+ IF (alpha_w(iw) < eps6) &
+ CALL errore('setup_nnkp',' zona value must be positive', 1)
+ ! convert wannier center in cartesian coordinates (in unit of alat)
+ CALL cryst_to_cart( 1, center_w(:,iw), at, 1 )
+ ENDDO
+ WRITE(stdout,*) ' - All guiding functions are given '
+
+ nnbx=0
+ nnb=max(nnbx,nnb)
+
+ ALLOCATE( ig_(iknum,nnb), ig_check(iknum,nnb) )
+ ALLOCATE( zerophase(iknum,nnb) )
+ zerophase = .false.
+
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ IF ( (g_kpb(1,ik,ib).eq.0) .and. &
+ (g_kpb(2,ik,ib).eq.0) .and. &
+ (g_kpb(3,ik,ib).eq.0) ) zerophase(ik,ib) = .true.
+ g_(:) = REAL( g_kpb(:,ik,ib) )
+ CALL cryst_to_cart (1, g_, bg, 1)
+ gg_ = g_(1)*g_(1) + g_(2)*g_(2) + g_(3)*g_(3)
+ ig_(ik,ib) = 0
+ ig = 1
+ DO WHILE (gg(ig) <= gg_ + eps6)
+ IF ( (abs(g(1,ig)-g_(1)) < eps6) .and. &
+ (abs(g(2,ig)-g_(2)) < eps6) .and. &
+ (abs(g(3,ig)-g_(3)) < eps6) ) ig_(ik,ib) = ig
+ ig= ig +1
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ig_check(:,:) = ig_(:,:)
+ CALL mp_sum( ig_check, intra_pool_comm )
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ IF (ig_check(ik,ib) ==0) &
+ CALL errore('setup_nnkp', &
+ ' g_kpb vector is not in the list of Gs', 100*ik+ib )
+ ENDDO
+ ENDDO
+ DEALLOCATE (ig_check)
+
+ WRITE(stdout,*) ' - All neighbours are found '
+ WRITE(stdout,*)
+
+ RETURN
+END SUBROUTINE setup_nnkp
+ !
+ !-----------------------------------------------------------------------
+SUBROUTINE run_wannier
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : ionode, ionode_id
+ USE ions_base, ONLY : nat
+ USE mp, ONLY : mp_bcast
+ USE mp_world, ONLY : world_comm
+ USE control_flags, ONLY : gamma_only
+ USE wannier
+
+ IMPLICIT NONE
+
+ ALLOCATE(u_mat(n_wannier,n_wannier,iknum))
+ ALLOCATE(u_mat_opt(num_bands,n_wannier,iknum))
+ ALLOCATE(lwindow(num_bands,iknum))
+ ALLOCATE(wann_centers(3,n_wannier))
+ ALLOCATE(wann_spreads(n_wannier))
+
+#if defined(__WANLIB)
+ IF (ionode) THEN
+ CALL wannier_run(seedname,mp_grid,iknum,rlatt, & ! input
+ glatt,kpt_latt,num_bands,n_wannier,nnb,nat, & ! input
+ atsym,atcart,gamma_only,m_mat,a_mat,eigval, & ! input
+ u_mat,u_mat_opt,lwindow,wann_centers,wann_spreads,spreads) ! output
+ ENDIF
+#endif
+
+ CALL mp_bcast(u_mat,ionode_id, world_comm)
+ CALL mp_bcast(u_mat_opt,ionode_id, world_comm)
+ CALL mp_bcast(lwindow,ionode_id, world_comm)
+ CALL mp_bcast(wann_centers,ionode_id, world_comm)
+ CALL mp_bcast(wann_spreads,ionode_id, world_comm)
+ CALL mp_bcast(spreads,ionode_id, world_comm)
+
+ RETURN
+END SUBROUTINE run_wannier
+!-----------------------------------------------------------------------
+!
+SUBROUTINE find_mp_grid()
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout
+ USE kinds, ONLY: DP
+ USE wannier
+
+ IMPLICIT NONE
+
+ ! <<>>
+ INTEGER :: ik,ntemp,ii
+ real(DP) :: min_k,temp(3,iknum),mpg1
+
+ min_k=minval(kpt_latt(1,:))
+ ii=0
+ DO ik=1,iknum
+ IF (kpt_latt(1,ik)==min_k) THEN
+ ii=ii+1
+ temp(:,ii)=kpt_latt(:,ik)
+ ENDIF
+ ENDDO
+ ntemp=ii
+
+ min_k=minval(temp(2,1:ntemp))
+ ii=0
+ DO ik=1,ntemp
+ IF (temp(2,ik)==min_k) THEN
+ ii=ii+1
+ ENDIF
+ ENDDO
+ mp_grid(3)=ii
+
+ min_k=minval(temp(3,1:ntemp))
+ ii=0
+ DO ik=1,ntemp
+ IF (temp(3,ik)==min_k) THEN
+ ii=ii+1
+ ENDIF
+ ENDDO
+ mp_grid(2)=ii
+
+ IF ( (mp_grid(2)==0) .or. (mp_grid(3)==0) ) &
+ CALL errore('find_mp_grid',' one or more mp_grid dimensions is zero', 1)
+
+ mpg1=iknum/(mp_grid(2)*mp_grid(3))
+
+ mp_grid(1) = nint(mpg1)
+
+ WRITE(stdout,*)
+ WRITE(stdout,'(3(a,i3))') ' MP grid is ',mp_grid(1),' x',mp_grid(2),' x',mp_grid(3)
+
+ IF (real(mp_grid(1),kind=DP)/=mpg1) &
+ CALL errore('find_mp_grid',' determining mp_grid failed', 1)
+
+ RETURN
+END SUBROUTINE find_mp_grid
+!-----------------------------------------------------------------------
+!
+SUBROUTINE read_nnkp
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode, ionode_id
+ USE kinds, ONLY: DP
+ USE constants, ONLY : eps6, tpi, bohr => BOHR_RADIUS_ANGS
+ USE cell_base, ONLY : at, bg, alat
+ USE gvect, ONLY : g, gg
+ USE klist, ONLY : nkstot, xk
+ USE mp, ONLY : mp_bcast, mp_sum
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp_world, ONLY : world_comm
+ USE wvfct, ONLY : npwx, nbnd
+ USE noncollin_module, ONLY : noncolin
+ USE wannier
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ real(DP) :: g_(3), gg_
+ INTEGER :: ik, ib, ig, ipol, iw, idum, indexb
+ INTEGER numk, i, j
+ INTEGER, ALLOCATABLE :: ig_check(:,:)
+ real(DP) :: xx(3), xnorm, znorm, coseno
+ LOGICAL :: have_nnkp,found
+ INTEGER :: tmp_auto ! vv: Needed for the selection of projections with SCDM
+
+ IF (ionode) THEN ! Read nnkp file on ionode only
+
+ INQUIRE(file=trim(seedname)//".nnkp",exist=have_nnkp)
+ IF(.not. have_nnkp) THEN
+ CALL errore( 'pw2wannier90', 'Could not find the file '&
+ &//trim(seedname)//'.nnkp', 1 )
+ ENDIF
+
+ iun_nnkp = find_free_unit()
+ OPEN (unit=iun_nnkp, file=trim(seedname)//".nnkp",form='formatted', status="old")
+
+ ENDIF
+
+ nnbx=0
+
+ ! check the information from *.nnkp with the nscf_save data
+ WRITE(stdout,*) ' Checking info from wannier.nnkp file'
+ WRITE(stdout,*)
+
+ IF (ionode) THEN ! read from ionode only
+
+ CALL scan_file_to('real_lattice',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find real_lattice block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ DO j=1,3
+ READ(iun_nnkp,*) (rlatt(i,j),i=1,3)
+ DO i = 1,3
+ rlatt(i,j) = rlatt(i,j)/(alat*bohr)
+ ENDDO
+ ENDDO
+ DO j=1,3
+ DO i=1,3
+ IF(abs(rlatt(i,j)-at(i,j))>eps6) THEN
+ WRITE(stdout,*) ' Something wrong! '
+ WRITE(stdout,*) ' rlatt(i,j) =',rlatt(i,j), ' at(i,j)=',at(i,j)
+ CALL errore( 'pw2wannier90', 'Direct lattice mismatch', 3*j+i )
+ ENDIF
+ ENDDO
+ ENDDO
+ WRITE(stdout,*) ' - Real lattice is ok'
+
+ CALL scan_file_to('recip_lattice',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find recip_lattice block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ DO j=1,3
+ READ(iun_nnkp,*) (glatt(i,j),i=1,3)
+ DO i = 1,3
+ glatt(i,j) = (alat*bohr)*glatt(i,j)/tpi
+ ENDDO
+ ENDDO
+ DO j=1,3
+ DO i=1,3
+ IF(abs(glatt(i,j)-bg(i,j))>eps6) THEN
+ WRITE(stdout,*) ' Something wrong! '
+ WRITE(stdout,*) ' glatt(i,j)=',glatt(i,j), ' bg(i,j)=',bg(i,j)
+ CALL errore( 'pw2wannier90', 'Reciprocal lattice mismatch', 3*j+i )
+ ENDIF
+ ENDDO
+ ENDDO
+ WRITE(stdout,*) ' - Reciprocal lattice is ok'
+
+ CALL scan_file_to('kpoints',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find kpoints block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ READ(iun_nnkp,*) numk
+ IF(numk/=iknum) THEN
+ WRITE(stdout,*) ' Something wrong! '
+ WRITE(stdout,*) ' numk=',numk, ' iknum=',iknum
+ CALL errore( 'pw2wannier90', 'Wrong number of k-points', numk)
+ ENDIF
+ IF(regular_mesh) THEN
+ DO i=1,numk
+ READ(iun_nnkp,*) xx(1), xx(2), xx(3)
+ CALL cryst_to_cart( 1, xx, bg, 1 )
+ IF(abs(xx(1)-xk(1,i))>eps6.or. &
+ abs(xx(2)-xk(2,i))>eps6.or. &
+ abs(xx(3)-xk(3,i))>eps6) THEN
+ WRITE(stdout,*) ' Something wrong! '
+ WRITE(stdout,*) ' k-point ',i,' is wrong'
+ WRITE(stdout,*) xx(1), xx(2), xx(3)
+ WRITE(stdout,*) xk(1,i), xk(2,i), xk(3,i)
+ CALL errore( 'pw2wannier90', 'problems with k-points', i )
+ ENDIF
+ ENDDO
+ ENDIF ! regular mesh check
+ WRITE(stdout,*) ' - K-points are ok'
+
+ ENDIF ! ionode
+
+ ! Broadcast
+ CALL mp_bcast(rlatt,ionode_id, world_comm)
+ CALL mp_bcast(glatt,ionode_id, world_comm)
+
+ IF (ionode) THEN ! read from ionode only
+ if(noncolin) then
+ old_spinor_proj=.false.
+ CALL scan_file_to('spinor_projections',found)
+ if(.not.found) then
+ !try old style projections
+ CALL scan_file_to('projections',found)
+ if(found) then
+ old_spinor_proj=.true.
+ else
+ CALL errore( 'pw2wannier90', 'Could not find projections block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ end if
+ else
+ old_spinor_proj=.false.
+ CALL scan_file_to('projections',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find projections block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ endif
+ READ(iun_nnkp,*) n_proj
+ ENDIF
+
+ ! Broadcast
+ CALL mp_bcast(n_proj,ionode_id, world_comm)
+ CALL mp_bcast(old_spinor_proj,ionode_id, world_comm)
+
+ IF(old_spinor_proj)THEN
+ WRITE(stdout,'(//," ****** begin WARNING ****** ",/)')
+ WRITE(stdout,'(" The pw.x calculation was done with non-collinear spin ")')
+ WRITE(stdout,'(" but spinor = T was not specified in the wannier90 .win file!")')
+ WRITE(stdout,'(" Please set spinor = T and rerun wannier90.x -pp ")')
+! WRITE(stdout,'(/," If you are trying to reuse an old nnkp file, you can remove ")')
+! WRITE(stdout,'(" this check from pw2wannir90.f90 line 870, and recompile. ")')
+ WRITE(stdout,'(/," ****** end WARNING ****** ",//)')
+! CALL errore("pw2wannier90","Spinorbit without spinor=T",1)
+ ENDIF
+
+ ! It is not clear if the next instruction is required or not, it probably depend
+ ! on the version of wannier90 that was used to generate the nnkp file:
+ IF(old_spinor_proj) THEN
+ n_wannier=n_proj*2
+ ELSE
+ n_wannier=n_proj
+ ENDIF
+
+ ALLOCATE( center_w(3,n_proj), alpha_w(n_proj), gf(npwx,n_proj), &
+ l_w(n_proj), mr_w(n_proj), r_w(n_proj), &
+ zaxis(3,n_proj), xaxis(3,n_proj), csph(16,n_proj) )
+ if(noncolin.and..not.old_spinor_proj) then
+ ALLOCATE( spin_eig(n_proj),spin_qaxis(3,n_proj) )
+ endif
+
+ IF (ionode) THEN ! read from ionode only
+ DO iw=1,n_proj
+ READ(iun_nnkp,*) (center_w(i,iw), i=1,3), l_w(iw), mr_w(iw), r_w(iw)
+ READ(iun_nnkp,*) (zaxis(i,iw),i=1,3),(xaxis(i,iw),i=1,3),alpha_w(iw)
+ xnorm = sqrt(xaxis(1,iw)*xaxis(1,iw) + xaxis(2,iw)*xaxis(2,iw) + &
+ xaxis(3,iw)*xaxis(3,iw))
+ IF (xnorm < eps6) CALL errore ('read_nnkp',' |xaxis| < eps ',1)
+ znorm = sqrt(zaxis(1,iw)*zaxis(1,iw) + zaxis(2,iw)*zaxis(2,iw) + &
+ zaxis(3,iw)*zaxis(3,iw))
+ IF (znorm < eps6) CALL errore ('read_nnkp',' |zaxis| < eps ',1)
+ coseno = (xaxis(1,iw)*zaxis(1,iw) + xaxis(2,iw)*zaxis(2,iw) + &
+ xaxis(3,iw)*zaxis(3,iw))/xnorm/znorm
+ IF (abs(coseno) > eps6) &
+ CALL errore('read_nnkp',' xaxis and zaxis are not orthogonal !',1)
+ IF (alpha_w(iw) < eps6) &
+ CALL errore('read_nnkp',' zona value must be positive', 1)
+ ! convert wannier center in cartesian coordinates (in unit of alat)
+ CALL cryst_to_cart( 1, center_w(:,iw), at, 1 )
+ if(noncolin.and..not.old_spinor_proj) then
+ READ(iun_nnkp,*) spin_eig(iw),(spin_qaxis(i,iw),i=1,3)
+ xnorm = sqrt(spin_qaxis(1,iw)*spin_qaxis(1,iw) + spin_qaxis(2,iw)*spin_qaxis(2,iw) + &
+ spin_qaxis(3,iw)*spin_qaxis(3,iw))
+ IF (xnorm < eps6) CALL errore ('read_nnkp',' |xaxis| < eps ',1)
+ spin_qaxis(:,iw)=spin_qaxis(:,iw)/xnorm
+ endif
+ ENDDO
+ ENDIF
+
+ ! automatic projections
+ IF (ionode) THEN
+ CALL scan_file_to('auto_projections',found)
+ IF (found) THEN
+ READ (iun_nnkp, *) n_wannier
+ READ (iun_nnkp, *) tmp_auto
+
+ IF (scdm_proj) THEN
+ IF (n_proj > 0) THEN
+ WRITE(stdout,'(//, " ****** begin Error message ******",/)')
+ WRITE(stdout,'(/," Found a projection block, an auto_projections block",/)')
+ WRITE(stdout,'(/," and scdm_proj = T in the input file. These three options are inconsistent.",/)')
+ WRITE(stdout,'(/," Please refer to the Wannier90 User guide for correct use of these flags.",/)')
+ WRITE(stdout,'(/, " ****** end Error message ******",//)')
+ CALL errore( 'pw2wannier90', 'Inconsistent options for projections.', 1 )
+ ELSE
+ IF (tmp_auto /= 0) CALL errore( 'pw2wannier90', 'Second entry in auto_projections block is not 0. ' // &
+ 'See Wannier90 User Guide in the auto_projections section for clarifications.', 1 )
+ ENDIF
+ ELSE
+ ! Fire an error whether or not a projections block is found
+ CALL errore( 'pw2wannier90', 'scdm_proj = F but found an auto_projections block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ ENDIF
+ ELSE
+ IF (scdm_proj) THEN
+ ! Fire an error whether or not a projections block is found
+ CALL errore( 'pw2wannier90', 'scdm_proj = T but cannot find an auto_projections block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ ENDIF
+ ENDIF
+ ENDIF
+
+ ! Broadcast
+ CALL mp_bcast(n_wannier,ionode_id, world_comm)
+ CALL mp_bcast(center_w,ionode_id, world_comm)
+ CALL mp_bcast(l_w,ionode_id, world_comm)
+ CALL mp_bcast(mr_w,ionode_id, world_comm)
+ CALL mp_bcast(r_w,ionode_id, world_comm)
+ CALL mp_bcast(zaxis,ionode_id, world_comm)
+ CALL mp_bcast(xaxis,ionode_id, world_comm)
+ CALL mp_bcast(alpha_w,ionode_id, world_comm)
+ if(noncolin.and..not.old_spinor_proj) then
+ CALL mp_bcast(spin_eig,ionode_id, world_comm)
+ CALL mp_bcast(spin_qaxis,ionode_id, world_comm)
+ end if
+
+ WRITE(stdout,'(" - Number of wannier functions is ok (",i3,")")') n_wannier
+
+ IF (.not. scdm_proj) WRITE(stdout,*) ' - All guiding functions are given '
+ !
+ WRITE(stdout,*)
+ WRITE(stdout,*) 'Projections:'
+ DO iw=1,n_proj
+ WRITE(stdout,'(3f12.6,3i3,f12.6)') &
+ center_w(1:3,iw),l_w(iw),mr_w(iw),r_w(iw),alpha_w(iw)
+ ENDDO
+
+ IF (ionode) THEN ! read from ionode only
+ CALL scan_file_to('nnkpts',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find nnkpts block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ READ (iun_nnkp,*) nnb
+ ENDIF
+
+ ! Broadcast
+ CALL mp_bcast(nnb,ionode_id, world_comm)
+ !
+ nnbx = max (nnbx, nnb )
+ !
+ ALLOCATE ( kpb(iknum,nnbx), g_kpb(3,iknum,nnbx),&
+ ig_(iknum,nnbx), ig_check(iknum,nnbx) )
+ ALLOCATE( zerophase(iknum,nnbx) )
+ zerophase = .false.
+
+ ! read data about neighbours
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Reading data about k-point neighbours '
+ WRITE(stdout,*)
+
+ IF (ionode) THEN
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ READ(iun_nnkp,*) idum, kpb(ik,ib), (g_kpb(ipol,ik,ib), ipol =1,3)
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ! Broadcast
+ CALL mp_bcast(kpb,ionode_id, world_comm)
+ CALL mp_bcast(g_kpb,ionode_id, world_comm)
+
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ IF ( (g_kpb(1,ik,ib).eq.0) .and. &
+ (g_kpb(2,ik,ib).eq.0) .and. &
+ (g_kpb(3,ik,ib).eq.0) ) zerophase(ik,ib) = .true.
+ g_(:) = REAL( g_kpb(:,ik,ib) )
+ CALL cryst_to_cart (1, g_, bg, 1)
+ gg_ = g_(1)*g_(1) + g_(2)*g_(2) + g_(3)*g_(3)
+ ig_(ik,ib) = 0
+ ig = 1
+ DO WHILE (gg(ig) <= gg_ + eps6)
+ IF ( (abs(g(1,ig)-g_(1)) < eps6) .and. &
+ (abs(g(2,ig)-g_(2)) < eps6) .and. &
+ (abs(g(3,ig)-g_(3)) < eps6) ) ig_(ik,ib) = ig
+ ig= ig +1
+ ENDDO
+ ENDDO
+ ENDDO
+ ig_check(:,:) = ig_(:,:)
+ CALL mp_sum( ig_check, intra_pool_comm )
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ IF (ig_check(ik,ib) ==0) &
+ CALL errore('read_nnkp', &
+ ' g_kpb vector is not in the list of Gs', 100*ik+ib )
+ ENDDO
+ ENDDO
+ DEALLOCATE (ig_check)
+
+ WRITE(stdout,*) ' All neighbours are found '
+ WRITE(stdout,*)
+
+ ALLOCATE( excluded_band(nbnd) )
+
+ IF (ionode) THEN ! read from ionode only
+ CALL scan_file_to('exclude_bands',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find exclude_bands block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ READ (iun_nnkp,*) nexband
+ excluded_band(1:nbnd)=.false.
+ DO i=1,nexband
+ READ(iun_nnkp,*) indexb
+ IF (indexb<1 .or. indexb>nbnd) &
+ CALL errore('read_nnkp',' wrong excluded band index ', 1)
+ excluded_band(indexb)=.true.
+ ENDDO
+ ENDIF
+ num_bands=nbnd-nexband
+
+ ! Broadcast
+ CALL mp_bcast(nexband,ionode_id, world_comm)
+ CALL mp_bcast(excluded_band,ionode_id, world_comm)
+ CALL mp_bcast(num_bands,ionode_id, world_comm)
+
+ IF (ionode) CLOSE (iun_nnkp) ! ionode only
+
+ RETURN
+END SUBROUTINE read_nnkp
+!
+!-----------------------------------------------------------------------
+SUBROUTINE scan_file_to (keyword,found)
+ !-----------------------------------------------------------------------
+ !
+ USE wannier, ONLY :iun_nnkp
+ USE io_global, ONLY : stdout
+ IMPLICIT NONE
+ CHARACTER(len=*), intent(in) :: keyword
+ logical, intent(out) :: found
+ CHARACTER(len=80) :: line1, line2
+!
+! by uncommenting the following line the file scan restarts every time
+! from the beginning thus making the reading independent on the order
+! of data-blocks
+! rewind (iun_nnkp)
+!
+10 CONTINUE
+ READ(iun_nnkp,*,end=20) line1, line2
+ IF(line1/='begin') GOTO 10
+ IF(line2/=keyword) GOTO 10
+ found=.true.
+ RETURN
+20 found=.false.
+ rewind (iun_nnkp)
+
+END SUBROUTINE scan_file_to
+!
+!-----------------------------------------------------------------------
+SUBROUTINE pw2wan_set_symm (nsym, sr, tvec)
+ !-----------------------------------------------------------------------
+ !
+ ! Uses nkqs and index_sym from module pw2wan, computes rir
+ !
+ USE symm_base, ONLY : s, ftau, allfrac
+ USE fft_base, ONLY : dffts
+ USE cell_base, ONLY : at, bg
+ USE wannier, ONLY : rir, read_sym
+ USE kinds, ONLY : DP
+ USE io_global, ONLY : stdout
+ !
+ IMPLICIT NONE
+ !
+ INTEGER , intent(in) :: nsym
+ REAL(DP) , intent(in) :: sr(3,3,nsym), tvec(3,nsym)
+ REAL(DP) :: st(3,3), v(3)
+ INTEGER, allocatable :: s_in(:,:,:), ftau_in(:,:)
+ !REAL(DP), allocatable:: ftau_in(:,:)
+ INTEGER :: nxxs, nr1,nr2,nr3, nr1x,nr2x,nr3x
+ INTEGER :: ikq, isym, i,j,k, ri,rj,rk, ir
+ LOGICAL :: ispresent(nsym)
+ !
+ nr1 = dffts%nr1
+ nr2 = dffts%nr2
+ nr3 = dffts%nr3
+ nr1x= dffts%nr1x
+ nr2x= dffts%nr2x
+ nr3x= dffts%nr3x
+ nxxs = nr1x*nr2x*nr3x
+ !
+ ! sr -> s
+ ALLOCATE(s_in(3,3,nsym), ftau_in(3,nsym))
+ IF(read_sym ) THEN
+ IF(allfrac) THEN
+ call errore("pw2wan_set_symm", "use_all_frac = .true. + read_sym = .true. not supported", 1)
+ END IF
+ DO isym = 1, nsym
+ !st = transpose( matmul(transpose(bg), sr(:,:,isym)) )
+ st = transpose( matmul(transpose(bg), transpose(sr(:,:,isym))) )
+ s_in(:,:,isym) = nint( matmul(transpose(at), st) )
+ v = matmul(transpose(bg), tvec(:,isym))
+ ftau_in(1,isym) = nint(v(1)*nr1)
+ ftau_in(2,isym) = nint(v(2)*nr2)
+ ftau_in(3,isym) = nint(v(3)*nr3)
+ END DO
+ IF( any(s(:,:,1:nsym) /= s_in(:,:,1:nsym)) .or. any(ftau_in(:,1:nsym) /= ftau(:,1:nsym)) ) THEN
+ write(stdout,*) " Input symmetry is different from crystal symmetry"
+ write(stdout,*)
+ END IF
+ ELSE
+ s_in = s(:,:,1:nsym)
+ ftau_in = ftau(:,1:nsym)
+ END IF
+ !
+ IF(.not. allocated(rir)) ALLOCATE(rir(nxxs,nsym))
+ rir = 0
+ ispresent(1:nsym) = .false.
+
+ DO isym = 1, nsym
+ IF ( mod(s_in(2, 1, isym) * nr1, nr2) /= 0 .or. &
+ mod(s_in(3, 1, isym) * nr1, nr3) /= 0 .or. &
+ mod(s_in(1, 2, isym) * nr2, nr1) /= 0 .or. &
+ mod(s_in(3, 2, isym) * nr2, nr3) /= 0 .or. &
+ mod(s_in(1, 3, isym) * nr3, nr1) /= 0 .or. &
+ mod(s_in(2, 3, isym) * nr3, nr2) /= 0 ) THEN
+ CALL errore ('pw2waninit',' smooth grid is not compatible with &
+ & symmetry: change cutoff',isym)
+ ENDIF
+ DO ir=1, nxxs
+ rir(ir,isym) = ir
+ ENDDO
+ DO k = 1, nr3
+ DO j = 1, nr2
+ DO i = 1, nr1
+ CALL ruotaijk (s_in(:,:,isym), (/0,0,0/), i,j,k, nr1,nr2,nr3, ri,rj,rk)
+ !
+ ir = i + ( j-1)*nr1x + ( k-1)*nr1x*nr2x
+ rir(ir,isym) = ri + (rj-1)*nr1x + (rk-1)*nr1x*nr2x
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ DEALLOCATE(s_in, ftau_in)
+END SUBROUTINE pw2wan_set_symm
+
+!-----------------------------------------------------------------------
+SUBROUTINE compute_dmn
+ !Calculate d_matrix_wann/band for site-symmetry mode given by Rei Sakuma.
+ !Contributions for this subroutine:
+ ! Yoshiro Nohara (June to July, 2016)
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode, ionode_id
+ USE kinds, ONLY: DP
+ USE wvfct, ONLY : nbnd, npwx
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc, psic, psic_nc
+ USE fft_base, ONLY : dffts, dfftp
+ USE fft_interfaces, ONLY : fwfft, invfft
+ USE klist, ONLY : nkstot, xk, igk_k, ngk
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE cell_base, ONLY : omega, alat, tpiba, at, bg
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE constants, ONLY : tpi, bohr => BOHR_RADIUS_ANGS
+ USE uspp, ONLY : nkb, vkb
+ USE uspp_param, ONLY : upf, nh, lmaxq, nhm
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum, mp_bcast
+ USE mp_world, ONLY : world_comm
+ USE noncollin_module,ONLY : noncolin, npol
+ USE gvecw, ONLY : gcutw
+ USE wannier
+ USE symm_base, ONLY : nsymin=>nsym,srin=>sr,ftin=>ft,invsin=>invs
+ USE fft_base, ONLY : dffts
+ USE scatter_mod, ONLY : gather_grid, scatter_grid
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
+ !
+ real(DP), parameter :: p12(3,12)=reshape( &
+ (/0d0, 0d0, 1.00000000000000d0, &
+ 0.894427190999916d0, 0d0, 0.447213595499958d0, &
+ 0.276393202250021d0, 0.850650808352040d0, 0.447213595499958d0, &
+ -0.723606797749979d0, 0.525731112119134d0, 0.447213595499958d0, &
+ -0.723606797749979d0, -0.525731112119134d0, 0.447213595499958d0, &
+ 0.276393202250021d0, -0.850650808352040d0, 0.447213595499958d0, &
+ 0.723606797749979d0, 0.525731112119134d0, -0.447213595499958d0, &
+ -0.276393202250021d0, 0.850650808352040d0, -0.447213595499958d0, &
+ -0.894427190999916d0, 0d0, -0.447213595499958d0, &
+ -0.276393202250021d0, -0.850650808352040d0, -0.447213595499958d0,&
+ 0.723606797749979d0, -0.525731112119134d0, -0.447213595499958d0,&
+ 0d0, 0d0, -1.00000000000000d0/),(/3,12/))
+ real(DP), parameter :: p20(3,20)=reshape( &
+ (/0.525731112119134d0, 0.381966011250105d0, 0.850650808352040d0, &
+ -0.200811415886227d0, 0.618033988749895d0, 0.850650808352040d0, &
+ -0.649839392465813d0, 0d0, 0.850650808352040d0, &
+ -0.200811415886227d0, -0.618033988749895d0, 0.850650808352040d0, &
+ 0.525731112119134d0, -0.381966011250105d0, 0.850650808352040d0, &
+ 0.850650808352040d0, 0.618033988749895d0, 0.200811415886227d0, &
+ -0.324919696232906d0, 1.00000000000000d0, 0.200811415886227d0, &
+ -1.05146222423827d0, 0d0, 0.200811415886227d0, &
+ -0.324919696232906d0, -1.00000000000000d0, 0.200811415886227d0, &
+ 0.850650808352040d0, -0.618033988749895d0, 0.200811415886227d0, &
+ 0.324919696232906d0, 1.00000000000000d0, -0.200811415886227d0, &
+ -0.850650808352040d0, 0.618033988749895d0, -0.200811415886227d0, &
+ -0.850650808352040d0, -0.618033988749895d0, -0.200811415886227d0, &
+ 0.324919696232906d0, -1.00000000000000d0, -0.200811415886227d0, &
+ 1.05146222423827d0, 0d0, -0.200811415886227d0, &
+ 0.200811415886227d0, 0.618033988749895d0, -0.850650808352040d0, &
+ -0.525731112119134d0, 0.381966011250105d0, -0.850650808352040d0, &
+ -0.525731112119134d0, -0.381966011250105d0, -0.850650808352040d0, &
+ 0.200811415886227d0, -0.618033988749895d0, -0.850650808352040d0, &
+ 0.649839392465813d0, 0d0, -0.850650808352040d0/),(/3,20/))
+ real(DP), parameter :: pwg(2)=(/2.976190476190479d-2,3.214285714285711d-2/)
+ !
+ INTEGER :: npw, mmn_tot, ik, ikp, ipol, isym, npwq, i, m, n, ir, jsym
+ INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt, nir
+ INTEGER :: ikevc, ikpevcq, s, counter, iun_dmn, ig, igp, ip, jp, np, iw, jw
+ COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
+ becp2(:,:), Mkb(:,:), aux_nc(:,:)
+ real(DP), ALLOCATABLE :: rbecp2(:,:),sr(:,:,:)
+ COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:), phs(:,:)
+ real(DP), ALLOCATABLE :: qg(:), workg(:)
+ real(DP), ALLOCATABLE :: ylm(:,:), dxk(:,:), tvec(:,:), dylm(:,:), wws(:,:,:), vps2t(:,:,:), vaxis(:,:,:)
+ INTEGER, ALLOCATABLE :: iks2k(:,:),iks2g(:,:),ik2ir(:),ir2ik(:)
+ INTEGER, ALLOCATABLE :: iw2ip(:),ip2iw(:),ips2p(:,:),invs(:)
+ logical, ALLOCATABLE :: lfound(:)
+ COMPLEX(DP) :: mmn, zdotc, phase1
+ real(DP) :: arg, g_(3),v1(3),v2(3),v3(3),v4(3),v5(3),err,ermx,dvec(3,32),dwgt(32),dvec2(3,32),dmat(3,3)
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp
+ INTEGER :: nn,inn,loop,loop2
+ LOGICAL :: nn_found
+ INTEGER :: istart,iend
+ INTEGER :: ibnd_n, ibnd_m,nsym, nxxs
+ COMPLEX(DP), ALLOCATABLE :: psic_all(:), temppsic_all(:)
+ LOGICAL :: have_sym
+
+ CALL start_clock( 'compute_dmn' )
+
+ IF (wan_mode=='standalone') THEN
+ iun_dmn = find_free_unit()
+ END IF
+ dmat=0d0
+ dmat(1,1)=1d0
+ dmat(2,2)=1d0
+ dmat(3,3)=1d0
+ if(read_sym)then
+ write(stdout,*) ' Reading symmetry from file '//trim(seedname)//'.sym'
+ write(stdout,*) ' '
+ if(ionode) then
+ inquire(file=trim(seedname)//".sym",exist=have_sym)
+ if(.not. have_sym) then
+ call errore( 'pw2wannier90', 'Could not find the file '&
+ &//trim(seedname)//'.sym', 1 )
+ endif
+ open(unit=iun_dmn, file=trim(seedname)//".sym",form='formatted')
+ read(iun_dmn,*) nsym
+ end if
+ call mp_bcast(nsym,ionode_id, world_comm)
+ allocate(invs(nsym),sr(3,3,nsym),tvec(3,nsym))
+ invs=-999
+ if(ionode) then
+ do isym=1,nsym
+ read(iun_dmn,*)
+ read(iun_dmn,*) sr(:,:,isym), tvec(:,isym)
+ end do
+ close(iun_dmn)
+ end if
+ call mp_bcast(sr, ionode_id, world_comm)
+ call mp_bcast(tvec, ionode_id, world_comm)
+ do isym=1,nsym
+ do jsym=1,nsym
+ if(invs(jsym).ge.1) cycle
+ v1=matmul(matmul(tvec(:,isym),sr(:,:,jsym))+tvec(:,jsym),bg)
+ if(sum(abs(matmul(sr(:,:,isym),sr(:,:,jsym))-dmat))+sum(abs(v1-dble(nint(v1)))).lt.1d-3) then
+ invs(isym)=jsym
+ invs(jsym)=isym
+ end if
+ end do
+ end do
+ else
+ nsym=nsymin
+ allocate(sr(3,3,nsym),invs(nsym),tvec(3,nsym))
+ ! original sr corresponds to transpose(s)
+ ! so here we use sr = transpose(original sr)
+ do isym=1,nsym
+ sr(:,:,isym)=transpose(srin(:,:,isym))
+ end do
+ invs=invsin(1:nsym)
+ tvec=matmul(at(:,:),ftin(:,1:nsym))
+ if(ionode)then
+ open(unit=iun_dmn, file=trim(seedname)//".sym",form='formatted')
+ write(iun_dmn,"(i5)") nsym
+ do isym=1,nsym
+ write(iun_dmn,*)
+ write(iun_dmn,"(1p,3e23.15)") sr(:,:,isym), tvec(:,isym)
+ end do
+ close(iun_dmn)
+ end if
+ end if
+ do isym=1,nsym
+ if(invs(isym).le.0.or.invs(isym).ge.nsym+1) then
+ call errore("compute_dmn", "out of range in invs", invs(isym))
+ end if
+ v1=matmul(matmul(tvec(:,isym),sr(:,:,invs(isym)))+tvec(:,invs(isym)),bg)
+ if(sum(abs(matmul(sr(:,:,isym),sr(:,:,invs(isym)))-dmat))+sum(abs(v1-dble(nint(v1)))).gt.1d-3) then
+ call errore("compute_dmn", "inconsistent invs", 1)
+ end if
+ end do
+
+ CALL pw2wan_set_symm ( nsym, sr, tvec )
+
+ any_uspp = any(upf(1:ntyp)%tvanp)
+
+ ALLOCATE( phase(dffts%nnr) )
+ ALLOCATE( evcq(npol*npwx,nbnd) )
+
+ IF(noncolin) CALL errore('compute_dmn','Non-collinear not implemented',1)
+ IF (gamma_only) CALL errore('compute_dmn','gamma-only not implemented',1)
+ IF (wan_mode=='library') CALL errore('compute_dmn','library mode not implemented',1)
+
+ ALLOCATE( aux(npwx) )
+
+ allocate(lfound(max(iknum,ngm)))
+ if(.not.allocated(iks2k)) allocate(iks2k(iknum,nsym))
+ iks2k=-999 !Sym.op.(isym) moves k(iks2k(ik,isym)) to k(ik) + G(iks2g(ik,isym)).
+ do isym=1,nsym
+ lfound=.false.
+ do ik=1,iknum
+ v1=xk(:,ik)
+ v2=matmul(sr(:,:,isym),v1)
+ do ikp=1,iknum
+ if(lfound(ikp)) cycle
+ v3=xk(:,ikp)
+ v4=matmul(v2-v3,at)
+ if(sum(abs(nint(v4)-v4)).lt.1d-5) then
+ iks2k(ik,isym)=ikp
+ lfound(ikp)=.true.
+ end if
+ if(iks2k(ik,isym).ge.1) exit
+ end do
+ end do
+ end do
+ deallocate(lfound)
+ !if(count(iks2k.le.0).ne.0) call errore("compute_dmn", "inconsistent in iks2k", count(iks2k.le.0))
+ if(.not.allocated(iks2g)) allocate(iks2g(iknum,nsym))
+ iks2g=-999 !See above.
+ do isym=1,nsym
+ do ik=1,iknum
+ ikp=iks2k(ik,isym)
+ v1=xk(:,ikp)
+ v2=matmul(v1,sr(:,:,isym))
+ v3=xk(:,ik)
+ do ig=1,ngm
+ v4=g(:,ig)
+ if(sum(abs(v3+v4-v2)).lt.1d-5) iks2g(ik,isym)=ig
+ if(iks2g(ik,isym).ge.1) exit
+ end do
+ end do
+ end do
+ !if(count(iks2g.le.0).ne.0) call errore("compute_dmn", "inconsistent in iks2g", count(iks2g.le.0))
+ !
+ if(.not.allocated(ik2ir)) allocate(ik2ir(iknum))
+ ik2ir=-999 !Gives irreducible-k points from regular-k points.
+ if(.not.allocated(ir2ik)) allocate(ir2ik(iknum))
+ ir2ik=-999 !Gives regular-k points from irreducible-k points.
+ allocate(lfound(iknum))
+ lfound=.false.
+ nir=0
+ do ik=1,iknum
+ if(lfound(ik)) cycle
+ lfound(ik)=.true.
+ nir=nir+1
+ ir2ik(nir)=ik
+ ik2ir(ik)=nir
+ do isym=1,nsym
+ ikp=iks2k(ik,isym)
+ if(lfound(ikp)) cycle
+ lfound(ikp)=.true.
+ ik2ir(ikp)=nir
+ end do
+ end do
+ deallocate(lfound)
+ !write(stdout,"(a)") "ik2ir(ir2ik)="
+ !write(stdout,"(10i9)") ik2ir(ir2ik(1:nir))
+ !write(stdout,"(a)") "ir2ik(ik2ir)="
+ !write(stdout,"(10i9)") ir2ik(ik2ir(1:iknum))
+
+ allocate(iw2ip(n_wannier),ip2iw(n_wannier))
+ np=0 !Conversion table between Wannier and position indexes.
+ do iw=1,n_wannier
+ v1=center_w(:,iw)
+ jp=0
+ do ip=1,np
+ if(sum(abs(v1-center_w(:,ip2iw(ip)))).lt.1d-2) then
+ jp=ip
+ exit
+ end if
+ end do
+ if(jp.eq.0) then
+ np=np+1
+ iw2ip(iw)=np
+ ip2iw(np)=iw
+ else
+ iw2ip(iw)=jp
+ end if
+ end do
+ !write(stdout,"(a,10i9)") "iw2ip(ip2iw)="
+ !write(stdout,"(10i9)") iw2ip(ip2iw(1:np))
+ !write(stdout,"(a)") "ip2iw(iw2ip)="
+ !write(stdout,"(10i9)") ip2iw(iw2ip(1:n_wannier))
+ allocate(ips2p(np,nsym),lfound(np))
+ ips2p=-999 !See below.
+ write(stdout,"(a,i5)") " Number of symmetry operators = ", nsym
+ do isym=1,nsym
+ write(stdout,"(2x,i5,a)") isym, "-th symmetry operators is"
+ write(stdout,"(3f15.7)") sr(:,:,isym), tvec(:,isym) !Writing rotation matrix and translation vector in Cartesian coordinates.
+ if(isym.eq.1) then
+ dmat=sr(:,:,isym)
+ dmat(1,1)=dmat(1,1)-1d0
+ dmat(2,2)=dmat(2,2)-1d0
+ dmat(3,3)=dmat(3,3)-1d0
+ if(sum(abs(dmat))+sum(abs(tvec(:,isym))).gt.1d-5) then
+ call errore("compute_dmn", "Error: 1st-symmetry operator is not identical one.", 1)
+ end if
+ end if
+ end do
+ do isym=1,nsym
+ lfound=.false.
+ do ip=1,np
+ v1=center_w(:,ip2iw(ip))
+ v2=matmul(sr(:,:,isym),(v1+tvec(:,isym)))
+ do jp=1,np
+ if(lfound(jp)) cycle
+ v3=center_w(:,ip2iw(jp))
+ v4=matmul(v3-v2,bg)
+ if(sum(abs(dble(nint(v4))-v4)).lt.1d-2) then
+ lfound(jp)=.true.
+ ips2p(ip,isym)=jp
+ exit !Sym.op.(isym) moves position(ips2p(ip,isym)) to position(ip) + T, where
+ end if !T is given by vps2t(:,ip,isym).
+ end do
+ if(ips2p(ip,isym).le.0) then
+ write(stdout,"(a,3f18.10,a,3f18.10,a)")" Could not find ",v2,"(",matmul(v2,bg),")"
+ write(stdout,"(a,3f18.10,a,3f18.10,a)")" coming from ",v1,"(",matmul(v1,bg),")"
+ write(stdout,"(a,i5,a )")" of Wannier site",ip,"."
+ call errore("compute_dmn", "Error: missing Wannier sites, see the output.", 1)
+ end if
+ end do
+ end do
+ allocate(vps2t(3,np,nsym)) !See above.
+ do isym=1,nsym
+ do ip=1,np
+ v1=center_w(:,ip2iw(ip))
+ jp=ips2p(ip,isym)
+ v2=center_w(:,ip2iw(jp))
+ v3=matmul(v2,sr(:,:,isym))-tvec(:,isym)
+ vps2t(:,ip,isym)=v3-v1
+ end do
+ end do
+ dvec(:,1:12)=p12
+ dvec(:,13:32)=p20
+ do ip=1,32
+ dvec(:,ip)=dvec(:,ip)/sqrt(sum(dvec(:,ip)**2))
+ end do
+ dwgt(1:12)=pwg(1)
+ dwgt(13:32)=pwg(2)
+ !write(stdout,*) sum(dwgt) !Checking the weight sum to be 1.
+ allocate(dylm(32,5),vaxis(3,3,n_wannier))
+ dylm=0d0
+ vaxis=0d0
+ do ip=1,5
+ CALL ylm_wannier(dylm(1,ip),2,ip,dvec,32)
+ end do
+ !do ip=1,5
+ ! write(stdout,"(5f25.15)") (sum(dylm(:,ip)*dylm(:,jp)*dwgt)*2d0*tpi,jp=1,5)
+ !end do !Checking spherical integral.
+ allocate(wws(n_wannier,n_wannier,nsym))
+ wws=0d0
+ do iw=1,n_wannier
+ call set_u_matrix (xaxis(:,iw),zaxis(:,iw),vaxis(:,:,iw))
+ end do
+ do isym=1,nsym
+ do iw=1,n_wannier
+ ip=iw2ip(iw)
+ jp=ips2p(ip,isym)
+ CALL ylm_wannier(dylm(1,1),l_w(iw),mr_w(iw),matmul(vaxis(:,:,iw),dvec),32)
+ do jw=1,n_wannier
+ if(iw2ip(jw).ne.jp) cycle
+ do ir=1,32
+ dvec2(:,ir)=matmul(sr(:,:,isym),dvec(:,ir))
+ end do
+ CALL ylm_wannier(dylm(1,2),l_w(jw),mr_w(jw),matmul(vaxis(:,:,jw),dvec2),32)
+ wws(jw,iw,isym)=sum(dylm(:,1)*dylm(:,2)*dwgt)*2d0*tpi ! for sym.op.(isym).
+ end do
+ end do
+ end do
+ deallocate(dylm,vaxis)
+ do isym=1,nsym
+ do iw=1,n_wannier
+ err=abs((sum(wws(:,iw,isym)**2)+sum(wws(iw,:,isym)**2))*.5d0-1d0)
+ if(err.gt.1d-3) then
+ write(stdout,"(a,i5,a,i5,a)") "compute_dmn: Symmetry operator (", isym, &
+ ") could not transform Wannier function (", iw, ")."
+ write(stdout,"(a,f15.7,a )") "compute_dmn: The error is ", err, "."
+ call errore("compute_dmn", "Error: missing Wannier functions, see the output.", 1)
+ end if
+ end do
+ end do
+
+ IF (wan_mode=='standalone') THEN
+ iun_dmn = find_free_unit()
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ IF (ionode) THEN
+ OPEN (unit=iun_dmn, file=trim(seedname)//".dmn",form='formatted')
+ WRITE (iun_dmn,*) header
+ WRITE (iun_dmn,"(4i9)") nbnd-nexband, nsym, nir, iknum
+ ENDIF
+ ENDIF
+
+ IF (ionode) THEN
+ WRITE (iun_dmn,*)
+ WRITE (iun_dmn,"(10i9)") ik2ir(1:iknum)
+ WRITE (iun_dmn,*)
+ WRITE (iun_dmn,"(10i9)") ir2ik(1:nir)
+ do ir=1,nir
+ WRITE (iun_dmn,*)
+ WRITE (iun_dmn,"(10i9)") iks2k(ir2ik(ir),:)
+ enddo
+ ENDIF
+ allocate(phs(n_wannier,n_wannier))
+ phs=(0d0,0d0)
+ WRITE(stdout,'(/)')
+ WRITE(stdout,'(a,i8)') ' DMN(d_matrix_wann): nir = ',nir
+ DO ir=1,nir
+ ik=ir2ik(ir)
+ WRITE (stdout,'(i8)',advance='no') ir
+ IF( MOD(ir,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ do isym=1,nsym
+ do iw=1,n_wannier
+ ip=iw2ip(iw)
+ jp=ips2p(ip,invs(isym))
+ jw=ip2iw(jp)
+ v1 = xk(:,iks2k(ik,isym)) - matmul(sr(:,:,isym),xk(:,ik))
+ v2 = matmul(v1, sr(:,:,isym))
+ phs(iw,iw)=exp(dcmplx(0d0,+sum(vps2t(:,jp,isym)*xk(:,ik))*tpi)) & !Phase of T.k with lattice vectors T of above.
+ *exp(dcmplx(0d0,+sum(tvec(:,isym)*v2)*tpi)) !Phase of t.G with translation vector t(isym).
+ end do
+ IF (ionode) then
+ WRITE (iun_dmn,*)
+ WRITE (iun_dmn,"(1p,(' (',e18.10,',',e18.10,')'))") matmul(phs,dcmplx(wws(:,:,isym),0d0))
+ end if
+ end do
+ end do
+ if(mod(nir,10) /= 0) WRITE(stdout,*)
+ WRITE(stdout,*) ' DMN(d_matrix_wann) calculated'
+ deallocate(phs)
+ !
+ ! USPP
+ !
+ !
+ IF(any_uspp) THEN
+ CALL init_us_1
+ CALL allocate_bec_type ( nkb, nbnd, becp )
+ IF (gamma_only) THEN
+ call errore("compute_dmn", "gamma-only mode not implemented", 1)
+ ELSE
+ ALLOCATE ( becp2(nkb,nbnd) )
+ ENDIF
+ ENDIF
+ !
+ ! qb is FT of Q(r)
+ !
+ nbt = nsym*nir!nnb * iknum
+ !
+ ALLOCATE( qg(nbt) )
+ ALLOCATE (dxk(3,nbt))
+ !
+ ind = 0
+ DO ir=1,nir
+ ik=ir2ik(ir)
+ DO isym=1,nsym!nnb
+ ind = ind + 1
+ ! ikp = kpb(ik,ib)
+ !
+ ! g_(:) = REAL( g_kpb(:,ik,ib) )
+ ! CALL cryst_to_cart (1, g_, bg, 1)
+ dxk(:,ind) = 0d0!xk(:,ikp) +g_(:) - xk(:,ik)
+ qg(ind) = dxk(1,ind)*dxk(1,ind)+dxk(2,ind)*dxk(2,ind)+dxk(3,ind)*dxk(3,ind)
+ ENDDO
+ ! write (stdout,'(i3,12f8.4)') ik, qg((ik-1)*nnb+1:ik*nnb)
+ ENDDO
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+
+ ALLOCATE( ylm(nbt,lmaxq*lmaxq), qgm(nbt) )
+ ALLOCATE( qb (nhm, nhm, ntyp, nbt) )
+ !
+ CALL ylmr2 (lmaxq*lmaxq, nbt, dxk, qg, ylm)
+ qg(:) = sqrt(qg(:)) * tpiba
+ !
+ DO nt = 1, ntyp
+ IF (upf(nt)%tvanp ) THEN
+ DO ih = 1, nh (nt)
+ DO jh = 1, nh (nt)
+ CALL qvan2 (nbt, ih, jh, nt, qg, qgm, ylm)
+ qb (ih, jh, nt, 1:nbt) = omega * qgm(1:nbt)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDDO
+ !
+ DEALLOCATE (qg, qgm, ylm )
+ !
+ ENDIF
+
+ WRITE(stdout,'(/)')
+ WRITE(stdout,'(a,i8)') ' DMN(d_matrix_band): nir = ',nir
+ !
+ ALLOCATE( Mkb(nbnd,nbnd) )
+ ALLOCATE( workg(npwx) )
+ !
+ ! Set up variables and stuff needed to rotate wavefunctions
+ nxxs = dffts%nr1x *dffts%nr2x *dffts%nr3x
+ ALLOCATE(psic_all(nxxs), temppsic_all(nxxs) )
+ !
+ ind = 0
+ DO ir=1,nir
+ ik=ir2ik(ir)
+ WRITE (stdout,'(i8)',advance='no') ir
+ IF( MOD(ir,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ ikevc = ik + ikstart - 1
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+ npw = ngk(ik)
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
+ ! below we compute the product of beta functions with |psi>
+ CALL calbec (npw, vkb, evc, becp)
+ ENDIF
+ !
+ !
+ DO isym=1,nsym
+ ind = ind + 1
+ ikp = iks2k(ik,isym)
+ ! read wfc at k+b
+ ikpevcq = ikp + ikstart - 1
+ ! if(noncolin) then
+ ! call davcio (evcq_nc, 2*nwordwfc, iunwfc, ikpevcq, -1 )
+ ! else
+ CALL davcio (evcq, 2*nwordwfc, iunwfc, ikpevcq, -1 )
+ ! end if
+ npwq = ngk(ikp)
+ do n=1,nbnd
+ do ip=1,npwq !applying translation vector t.
+ evcq(ip,n)=evcq(ip,n)*exp(dcmplx(0d0,+sum((matmul(g(:,igk_k(ip,ikp)),sr(:,:,isym))+xk(:,ik))*tvec(:,isym))*tpi))
+ end do
+ end do
+ ! compute the phase
+ phase(:) = (0.d0,0.d0)
+ ! missing phase G of above is given here and below.
+ IF(iks2g(ik,isym) >= 0) phase(dffts%nl(iks2g(ik,isym)))=(1d0,0d0)
+ CALL invfft ('Wave', phase, dffts)
+ do n=1,nbnd
+ if(excluded_band(n)) cycle
+ psic(:) = (0.d0, 0.d0)
+ psic(dffts%nl(igk_k(1:npwq,ikp))) = evcq(1:npwq,n)
+ ! go to real space
+ CALL invfft ('Wave', psic, dffts)
+#if defined(__MPI)
+ ! gather among all the CPUs
+ CALL gather_grid(dffts, psic, temppsic_all)
+ ! apply rotation
+ !psic_all(1:nxxs) = temppsic_all(rir(1:nxxs,isym))
+ psic_all(rir(1:nxxs,isym)) = temppsic_all(1:nxxs)
+ ! scatter back a piece to each CPU
+ CALL scatter_grid(dffts, psic_all, psic)
+#else
+ psic(rir(1:nxxs, isym)) = psic(1:nxxs)
+#endif
+ ! apply phase k -> k+G
+ psic(1:dffts%nnr) = psic(1:dffts%nnr) * phase(1:dffts%nnr)
+ ! go back to G space
+ CALL fwfft ('Wave', psic, dffts)
+ evcq(1:npw,n) = psic(dffts%nl (igk_k(1:npw,ik) ) )
+ end do
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
+ ! below we compute the product of beta functions with |psi>
+ IF (gamma_only) THEN
+ call errore("compute_dmn", "gamma-only mode not implemented", 1)
+ ELSE
+ CALL calbec ( npw, vkb, evcq, becp2 )
+ ENDIF
+ ENDIF
+ !
+ !
+ Mkb(:,:) = (0.0d0,0.0d0)
+ !
+ IF (any_uspp) THEN
+ ijkb0 = 0
+ DO nt = 1, ntyp
+ IF ( upf(nt)%tvanp ) THEN
+ DO na = 1, nat
+ !
+ arg = dot_product( dxk(:,ind), tau(:,na) ) * tpi
+ phase1 = cmplx( cos(arg), -sin(arg) ,kind=DP)
+ !
+ IF ( ityp(na) == nt ) THEN
+ DO jh = 1, nh(nt)
+ jkb = ijkb0 + jh
+ DO ih = 1, nh(nt)
+ ikb = ijkb0 + ih
+ !
+ DO m = 1,nbnd
+ IF (excluded_band(m)) CYCLE
+ IF (gamma_only) THEN
+ call errore("compute_dmn", "gamma-only mode not implemented", 1)
+ ELSE
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * qb(ih,jh,nt,ind) * &
+ conjg( becp%k(ikb,m) ) * becp2(jkb,n)
+ ENDDO
+ ENDIF
+ ENDDO ! m
+ ENDDO !ih
+ ENDDO !jh
+ ijkb0 = ijkb0 + nh(nt)
+ ENDIF !ityp
+ ENDDO !nat
+ ELSE !tvanp
+ DO na = 1, nat
+ IF ( ityp(na) == nt ) ijkb0 = ijkb0 + nh(nt)
+ ENDDO
+ ENDIF !tvanp
+ ENDDO !ntyp
+ ENDIF ! any_uspp
+ !
+ !
+ ! loops on bands
+ !
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE (iun_dmn,*)
+ ENDIF
+ !
+ DO m=1,nbnd
+ IF (excluded_band(m)) CYCLE
+ !
+ !
+ ! Mkb(m,n) = Mkb(m,n) + \sum_{ijI} qb_{ij}^I * e^-i(0*tau_I)
+ ! < beta_j,k2 | psi_n,k2 >
+ !
+ IF (gamma_only) THEN
+ call errore("compute_dmn", "gamma-only mode not implemented", 1)
+ ELSEIF(noncolin) THEN
+ call errore("compute_dmn", "Non-collinear not implemented", 1)
+ ELSE
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ mmn = zdotc (npw, evc(1,m),1,evcq(1,n),1)
+ CALL mp_sum(mmn, intra_pool_comm)
+ Mkb(m,n) = mmn + Mkb(m,n)
+ ENDDO
+ ENDIF
+ ENDDO ! m
+
+ ibnd_n = 0
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ ibnd_n = ibnd_n + 1
+ ibnd_m = 0
+ DO m=1,nbnd
+ IF (excluded_band(m)) CYCLE
+ ibnd_m = ibnd_m + 1
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE (iun_dmn,"(1p,(' (',e18.10,',',e18.10,')'))")dconjg(Mkb(n,m))
+ ELSEIF (wan_mode=='library') THEN
+ call errore("compute_dmn", "library mode not implemented", 1)
+ ELSE
+ CALL errore('compute_dmn',' value of wan_mode not recognised',1)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO !isym
+ ENDDO !ik
+
+ if(mod(nir,10) /= 0) WRITE(stdout,*)
+ WRITE(stdout,*) ' DMN(d_matrix_band) calculated'
+
+ IF (ionode .and. wan_mode=='standalone') CLOSE (iun_dmn)
+
+ DEALLOCATE (Mkb, dxk, phase)
+ DEALLOCATE(temppsic_all, psic_all)
+ DEALLOCATE(aux)
+ DEALLOCATE(evcq)
+
+ IF(any_uspp) THEN
+ DEALLOCATE ( qb)
+ CALL deallocate_bec_type (becp)
+ IF (gamma_only) THEN
+ CALL errore('compute_dmn','gamma-only not implemented',1)
+ ELSE
+ DEALLOCATE (becp2)
+ ENDIF
+ ENDIF
+ !
+ CALL stop_clock( 'compute_dmn' )
+
+ RETURN
+END SUBROUTINE compute_dmn
+!
+!-----------------------------------------------------------------------
+SUBROUTINE compute_mmn
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode
+ USE kinds, ONLY: DP
+ USE wvfct, ONLY : nbnd, npwx
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc, psic, psic_nc
+ USE fft_base, ONLY : dffts, dfftp
+ USE fft_interfaces, ONLY : fwfft, invfft
+ USE klist, ONLY : nkstot, xk, igk_k, ngk
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE cell_base, ONLY : omega, alat, tpiba, at, bg
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE constants, ONLY : tpi
+ USE uspp, ONLY : nkb, vkb
+ USE uspp_param, ONLY : upf, nh, lmaxq, nhm
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum
+ USE noncollin_module,ONLY : noncolin, npol
+ USE spin_orb, ONLY : lspinorb
+ USE gvecw, ONLY : gcutw
+ USE wannier
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
+ !
+ INTEGER :: npw, mmn_tot, ik, ikp, ipol, ib, npwq, i, m, n
+ INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
+ INTEGER :: ikevc, ikpevcq, s, counter
+ COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
+ becp2(:,:), Mkb(:,:), aux_nc(:,:), becp2_nc(:,:,:)
+ real(DP), ALLOCATABLE :: rbecp2(:,:)
+ COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:), qq_so(:,:,:,:)
+ real(DP), ALLOCATABLE :: qg(:), ylm(:,:), dxk(:,:)
+ COMPLEX(DP) :: mmn, zdotc, phase1
+ real(DP) :: arg, g_(3)
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp
+ INTEGER :: nn,inn,loop,loop2
+ LOGICAL :: nn_found
+ INTEGER :: istart,iend
+ INTEGER :: ibnd_n, ibnd_m
+
+
+ CALL start_clock( 'compute_mmn' )
+
+ any_uspp = any(upf(1:ntyp)%tvanp)
+
+ ALLOCATE( phase(dffts%nnr) )
+ ALLOCATE( evcq(npol*npwx,nbnd) )
+
+ IF(noncolin) THEN
+ ALLOCATE( aux_nc(npwx,npol) )
+ ELSE
+ ALLOCATE( aux(npwx) )
+ ENDIF
+
+ IF (gamma_only) ALLOCATE(aux2(npwx))
+
+ IF (wan_mode=='library') ALLOCATE(m_mat(num_bands,num_bands,nnb,iknum))
+
+ IF (wan_mode=='standalone') THEN
+ iun_mmn = find_free_unit()
+ IF (ionode) OPEN (unit=iun_mmn, file=trim(seedname)//".mmn",form='formatted')
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ IF (ionode) THEN
+ WRITE (iun_mmn,*) header
+ WRITE (iun_mmn,*) nbnd-nexband, iknum, nnb
+ ENDIF
+ ENDIF
+
+ !
+ ! USPP
+ !
+ !
+ IF(any_uspp) THEN
+ CALL init_us_1
+ CALL allocate_bec_type ( nkb, nbnd, becp )
+ IF (gamma_only) THEN
+ ALLOCATE ( rbecp2(nkb,nbnd))
+ else if (noncolin) then
+ ALLOCATE ( becp2_nc(nkb,2,nbnd) )
+ ELSE
+ ALLOCATE ( becp2(nkb,nbnd) )
+ ENDIF
+ !
+ ! qb is FT of Q(r)
+ !
+ nbt = nnb * iknum
+ !
+ ALLOCATE( qg(nbt) )
+ ALLOCATE (dxk(3,nbt))
+ !
+ ind = 0
+ DO ik=1,iknum
+ DO ib=1,nnb
+ ind = ind + 1
+ ikp = kpb(ik,ib)
+ !
+ g_(:) = REAL( g_kpb(:,ik,ib) )
+ CALL cryst_to_cart (1, g_, bg, 1)
+ dxk(:,ind) = xk(:,ikp) +g_(:) - xk(:,ik)
+ qg(ind) = dxk(1,ind)*dxk(1,ind)+dxk(2,ind)*dxk(2,ind)+dxk(3,ind)*dxk(3,ind)
+ ENDDO
+! write (stdout,'(i3,12f8.4)') ik, qg((ik-1)*nnb+1:ik*nnb)
+ ENDDO
+
+ ALLOCATE( ylm(nbt,lmaxq*lmaxq), qgm(nbt) )
+ ALLOCATE( qb (nhm, nhm, ntyp, nbt) )
+ ALLOCATE( qq_so (nhm, nhm, 4, ntyp) )
+ !
+ CALL ylmr2 (lmaxq*lmaxq, nbt, dxk, qg, ylm)
+ qg(:) = sqrt(qg(:)) * tpiba
+ !
+ DO nt = 1, ntyp
+ IF (upf(nt)%tvanp ) THEN
+ DO ih = 1, nh (nt)
+ DO jh = 1, nh (nt)
+ CALL qvan2 (nbt, ih, jh, nt, qg, qgm, ylm)
+ qb (ih, jh, nt, 1:nbt) = omega * qgm(1:nbt)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDDO
+ !
+ DEALLOCATE (qg, qgm, ylm )
+ !
+ ENDIF
+
+ WRITE(stdout,'(a,i8)') ' MMN: iknum = ',iknum
+ !
+ ALLOCATE( Mkb(nbnd,nbnd) )
+ !
+ ind = 0
+ DO ik=1,iknum
+ WRITE (stdout,'(i8)',advance='no') ik
+ IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ ikevc = ik + ikstart - 1
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+ npw = ngk(ik)
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
+ ! below we compute the product of beta functions with |psi>
+ CALL calbec (npw, vkb, evc, becp)
+ ENDIF
+ !
+ !
+ !do ib=1,nnb(ik)
+ DO ib=1,nnb
+ ind = ind + 1
+ ikp = kpb(ik,ib)
+! read wfc at k+b
+ ikpevcq = ikp + ikstart - 1
+! if(noncolin) then
+! call davcio (evcq_nc, 2*nwordwfc, iunwfc, ikpevcq, -1 )
+! else
+ CALL davcio (evcq, 2*nwordwfc, iunwfc, ikpevcq, -1 )
+! end if
+! compute the phase
+ IF (.not.zerophase(ik,ib)) THEN
+ phase(:) = (0.d0,0.d0)
+ IF ( ig_(ik,ib)>0) phase( dffts%nl(ig_(ik,ib)) ) = (1.d0,0.d0)
+ CALL invfft ('Wave', phase, dffts)
+ ENDIF
+ !
+ ! USPP
+ !
+ npwq = ngk(ikp)
+ IF(any_uspp) THEN
+ CALL init_us_2 (npwq, igk_k(1,ikp), xk(1,ikp), vkb)
+ ! below we compute the product of beta functions with |psi>
+ IF (gamma_only) THEN
+ CALL calbec ( npwq, vkb, evcq, rbecp2 )
+ else if (noncolin) then
+ CALL calbec ( npwq, vkb, evcq, becp2_nc )
+
+ if (lspinorb) then
+ qq_so = (0.0d0, 0.0d0)
+ call transform_qq_so(qb(:,:,:,ind), qq_so)
+ endif
+
+ ELSE
+ CALL calbec ( npwq, vkb, evcq, becp2 )
+ ENDIF
+ ENDIF
+ !
+ !
+ Mkb(:,:) = (0.0d0,0.0d0)
+ !
+ IF (any_uspp) THEN
+ ijkb0 = 0
+ DO nt = 1, ntyp
+ IF ( upf(nt)%tvanp ) THEN
+ DO na = 1, nat
+ !
+ arg = dot_product( dxk(:,ind), tau(:,na) ) * tpi
+ phase1 = cmplx( cos(arg), -sin(arg) ,kind=DP)
+ !
+ IF ( ityp(na) == nt ) THEN
+ DO jh = 1, nh(nt)
+ jkb = ijkb0 + jh
+ DO ih = 1, nh(nt)
+ ikb = ijkb0 + ih
+ !
+ DO m = 1,nbnd
+ IF (excluded_band(m)) CYCLE
+ IF (gamma_only) THEN
+ DO n=1,m ! Mkb(m,n) is symmetric in m and n for gamma_only case
+ IF (excluded_band(n)) CYCLE
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * qb(ih,jh,nt,ind) * &
+ becp%r(ikb,m) * rbecp2(jkb,n)
+ ENDDO
+ else if (noncolin) then
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ if (lspinorb) then
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * ( &
+ qq_so(ih,jh,1,nt) * conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 1, n) &
+ + qq_so(ih,jh,2,nt) * conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 2, n) &
+ + qq_so(ih,jh,3,nt) * conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 1, n) &
+ + qq_so(ih,jh,4,nt) * conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 2, n) &
+ )
+ else
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * qb(ih,jh,nt,ind) * &
+ (conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 1, n) &
+ + conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 2, n) )
+ endif
+ ENDDO
+ ELSE
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * qb(ih,jh,nt,ind) * &
+ conjg( becp%k(ikb,m) ) * becp2(jkb,n)
+ ENDDO
+ ENDIF
+ ENDDO ! m
+ ENDDO !ih
+ ENDDO !jh
+ ijkb0 = ijkb0 + nh(nt)
+ ENDIF !ityp
+ ENDDO !nat
+ ELSE !tvanp
+ DO na = 1, nat
+ IF ( ityp(na) == nt ) ijkb0 = ijkb0 + nh(nt)
+ ENDDO
+ ENDIF !tvanp
+ ENDDO !ntyp
+ ENDIF ! any_uspp
+ !
+ !
+! loops on bands
+ !
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE (iun_mmn,'(7i5)') ik, ikp, (g_kpb(ipol,ik,ib), ipol=1,3)
+ ENDIF
+ !
+ DO m=1,nbnd
+ IF (excluded_band(m)) CYCLE
+ !
+ IF(noncolin) THEN
+ psic_nc(:,:) = (0.d0, 0.d0)
+ DO ipol=1,2!npol
+ istart=(ipol-1)*npwx+1
+ iend=istart+npw-1
+ psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol ) = evc(istart:iend, m)
+ IF (.not.zerophase(ik,ib)) THEN
+ CALL invfft ('Wave', psic_nc(:,ipol), dffts)
+ psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * &
+ phase(1:dffts%nnr)
+ CALL fwfft ('Wave', psic_nc(:,ipol), dffts)
+ ENDIF
+ aux_nc(1:npwq,ipol) = psic_nc(dffts%nl (igk_k(1:npwq,ikp)),ipol )
+ ENDDO
+ ELSE
+ psic(:) = (0.d0, 0.d0)
+ psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw, m)
+ IF(gamma_only) psic(dffts%nlm(igk_k(1:npw,ik) ) ) = conjg(evc (1:npw, m))
+ IF (.not.zerophase(ik,ib)) THEN
+ CALL invfft ('Wave', psic, dffts)
+ psic(1:dffts%nnr) = psic(1:dffts%nnr) * phase(1:dffts%nnr)
+ CALL fwfft ('Wave', psic, dffts)
+ ENDIF
+ aux(1:npwq) = psic(dffts%nl (igk_k(1:npwq,ikp) ) )
+ ENDIF
+ IF(gamma_only) THEN
+ IF (gstart==2) psic(dffts%nlm(1)) = (0.d0,0.d0)
+ aux2(1:npwq) = conjg(psic(dffts%nlm(igk_k(1:npwq,ikp) ) ) )
+ ENDIF
+ !
+ ! Mkb(m,n) = Mkb(m,n) + \sum_{ijI} qb_{ij}^I * e^-i(b*tau_I)
+ ! < beta_j,k2 | psi_n,k2 >
+ !
+ IF (gamma_only) THEN
+ DO n=1,m ! Mkb(m,n) is symmetric in m and n for gamma_only case
+ IF (excluded_band(n)) CYCLE
+ mmn = zdotc (npwq, aux,1,evcq(1,n),1) &
+ + conjg(zdotc(npwq,aux2,1,evcq(1,n),1))
+ CALL mp_sum(mmn, intra_pool_comm)
+ Mkb(m,n) = mmn + Mkb(m,n)
+ IF (m/=n) Mkb(n,m) = Mkb(m,n) ! fill other half of matrix by symmetry
+ ENDDO
+ ELSEIF(noncolin) THEN
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ mmn=(0.d0, 0.d0)
+! do ipol=1,2
+! mmn = mmn+zdotc (npwq, aux_nc(1,ipol),1,evcq_nc(1,ipol,n),1)
+ mmn = mmn + zdotc (npwq, aux_nc(1,1),1,evcq(1,n),1) &
+ + zdotc (npwq, aux_nc(1,2),1,evcq(npwx+1,n),1)
+! end do
+ CALL mp_sum(mmn, intra_pool_comm)
+ Mkb(m,n) = mmn + Mkb(m,n)
+ ENDDO
+ ELSE
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ mmn = zdotc (npwq, aux,1,evcq(1,n),1)
+ CALL mp_sum(mmn, intra_pool_comm)
+ Mkb(m,n) = mmn + Mkb(m,n)
+ ENDDO
+ ENDIF
+ ENDDO ! m
+
+ ibnd_n = 0
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ ibnd_n = ibnd_n + 1
+ ibnd_m = 0
+ DO m=1,nbnd
+ IF (excluded_band(m)) CYCLE
+ ibnd_m = ibnd_m + 1
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE (iun_mmn,'(2f18.12)') Mkb(m,n)
+ ELSEIF (wan_mode=='library') THEN
+ m_mat(ibnd_m,ibnd_n,ib,ik)=Mkb(m,n)
+ ELSE
+ CALL errore('compute_mmn',' value of wan_mode not recognised',1)
+ ENDIF
+ ENDDO
+ ENDDO
+
+ ENDDO !ib
+ ENDDO !ik
+
+ IF (ionode .and. wan_mode=='standalone') CLOSE (iun_mmn)
+
+ IF (gamma_only) DEALLOCATE(aux2)
+ DEALLOCATE (Mkb, phase)
+ IF (any_uspp) DEALLOCATE (dxk)
+ IF(noncolin) THEN
+ DEALLOCATE(aux_nc)
+ ELSE
+ DEALLOCATE(aux)
+ ENDIF
+ DEALLOCATE(evcq)
+
+ IF(any_uspp) THEN
+ DEALLOCATE ( qb)
+ DEALLOCATE (qq_so)
+ CALL deallocate_bec_type (becp)
+ IF (gamma_only) THEN
+ DEALLOCATE (rbecp2)
+ else if (noncolin) then
+ deallocate (becp2_nc)
+ ELSE
+ DEALLOCATE (becp2)
+ ENDIF
+ ENDIF
+!
+ WRITE(stdout,'(/)')
+ WRITE(stdout,*) ' MMN calculated'
+
+ CALL stop_clock( 'compute_mmn' )
+
+ RETURN
+END SUBROUTINE compute_mmn
+
+!-----------------------------------------------------------------------
+SUBROUTINE compute_spin
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode
+ USE kinds, ONLY: DP
+ USE wvfct, ONLY : nbnd, npwx
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc, psic, psic_nc
+ USE fft_base, ONLY : dffts, dfftp
+ USE fft_interfaces, ONLY : fwfft, invfft
+ USE klist, ONLY : nkstot, xk, ngk, igk_k
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE cell_base, ONLY : alat, at, bg
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE constants, ONLY : tpi
+ USE uspp, ONLY : nkb, vkb
+ USE uspp_param, ONLY : upf, nh, lmaxq
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum
+ USE noncollin_module,ONLY : noncolin, npol
+ USE gvecw, ONLY : gcutw
+ USE wannier
+ ! begin change Lopez, Thonhauser, Souza
+ USE mp, ONLY : mp_barrier
+ USE scf, ONLY : vrs, vltot, v, kedtau
+ USE gvecs, ONLY : doublegrid
+ USE lsda_mod, ONLY : nspin
+ USE constants, ONLY : rytoev
+
+ USE uspp_param, ONLY : upf, nh, nhm
+ USE uspp, ONLY: qq_nt, nhtol,nhtoj, indv
+ USE spin_orb, ONLY : fcoef
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
+ !
+ INTEGER :: npw, mmn_tot, ik, ikp, ipol, ib, i, m, n
+ INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
+ INTEGER :: ikevc, ikpevcq, s, counter
+ COMPLEX(DP) :: mmn, zdotc, phase1
+ real(DP) :: arg, g_(3)
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp
+ INTEGER :: nn,inn,loop,loop2
+ LOGICAL :: nn_found
+ INTEGER :: istart,iend
+ COMPLEX(DP) :: sigma_x,sigma_y,sigma_z,cdum1,cdum2
+ complex(DP), allocatable :: spn(:,:), spn_aug(:,:)
+
+ integer :: np, is1, is2, kh, kkb
+ complex(dp) :: sigma_x_aug, sigma_y_aug, sigma_z_aug
+ COMPLEX(DP), ALLOCATABLE :: be_n(:,:), be_m(:,:)
+
+
+ any_uspp = any(upf(1:ntyp)%tvanp)
+
+ if (any_uspp) then
+ CALL init_us_1
+ CALL allocate_bec_type ( nkb, nbnd, becp )
+ ALLOCATE(be_n(nhm,2))
+ ALLOCATE(be_m(nhm,2))
+ endif
+
+
+ if (write_spn) allocate(spn(3,(num_bands*(num_bands+1))/2))
+ if (write_spn) allocate(spn_aug(3,(num_bands*(num_bands+1))/2))
+ spn_aug = (0.0d0, 0.0d0)
+!ivo
+! not sure this is really needed
+ if((write_spn.or.write_uhu.or.write_uIu).and.wan_mode=='library')&
+ call errore('pw2wannier90',&
+ 'write_spn, write_uhu, and write_uIu not meant to work library mode',1)
+!endivo
+
+ IF(write_spn.and.noncolin) THEN
+ IF (ionode) then
+ iun_spn = find_free_unit()
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ if(spn_formatted) then
+ OPEN (unit=iun_spn, file=trim(seedname)//".spn",form='formatted')
+ WRITE (iun_spn,*) header !ivo
+ WRITE (iun_spn,*) nbnd-nexband,iknum
+ else
+ OPEN (unit=iun_spn, file=trim(seedname)//".spn",form='unformatted')
+ WRITE (iun_spn) header !ivo
+ WRITE (iun_spn) nbnd-nexband,iknum
+ endif
+ ENDIF
+ ENDIF
+ !
+ WRITE(stdout,'(a,i8)') ' iknum = ',iknum
+
+ ind = 0
+ DO ik=1,iknum
+ WRITE (stdout,'(i8)') ik
+ ikevc = ik + ikstart - 1
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+ npw = ngk(ik)
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
+ ! below we compute the product of beta functions with |psi>
+ CALL calbec (npw, vkb, evc, becp)
+ ENDIF
+
+
+ IF(write_spn.and.noncolin) THEN
+ counter=0
+ DO m=1,nbnd
+ if(excluded_band(m)) cycle !ivo
+ DO n=1,m
+ if(excluded_band(n)) cycle !ivo
+ cdum1=zdotc(npw,evc(1,n),1,evc(npwx+1,m),1)
+ call mp_sum(cdum1,intra_pool_comm)
+ cdum2=zdotc(npw,evc(npwx+1,n),1,evc(1,m),1)
+ call mp_sum(cdum2,intra_pool_comm)
+ sigma_x=cdum1+cdum2
+ sigma_y=cmplx_i*(cdum2-cdum1)
+ sigma_z=zdotc(npw,evc(1,n),1,evc(1,m),1)&
+ -zdotc(npw,evc(npwx+1,n),1,evc(npwx+1,m),1)
+ call mp_sum(sigma_z,intra_pool_comm)
+ counter=counter+1
+ spn(1,counter)=sigma_x
+ spn(2,counter)=sigma_y
+ spn(3,counter)=sigma_z
+
+ if (any_uspp) then
+ sigma_x_aug = (0.0d0, 0.0d0)
+ sigma_y_aug = (0.0d0, 0.0d0)
+ sigma_z_aug = (0.0d0, 0.0d0)
+ ijkb0 = 0
+
+ DO np = 1, ntyp
+ IF ( upf(np)%tvanp ) THEN
+ DO na = 1, nat
+ IF (ityp(na)==np) THEN
+ be_m = 0.d0
+ be_n = 0.d0
+ DO ih = 1, nh(np)
+ ikb = ijkb0 + ih
+ IF (upf(np)%has_so) THEN
+ DO kh = 1, nh(np)
+ IF ((nhtol(kh,np)==nhtol(ih,np)).and. &
+ (nhtoj(kh,np)==nhtoj(ih,np)).and. &
+ (indv(kh,np)==indv(ih,np))) THEN
+ kkb=ijkb0 + kh
+ DO is1=1,2
+ DO is2=1,2
+ be_n(ih,is1)=be_n(ih,is1)+ &
+ fcoef(ih,kh,is1,is2,np)* &
+ becp%nc(kkb,is2,n)
+
+ be_m(ih,is1)=be_m(ih,is1)+ &
+ fcoef(ih,kh,is1,is2,np)* &
+ becp%nc(kkb,is2,m)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDDO
+ ELSE
+ DO is1=1,2
+ be_n(ih, is1) = becp%nc(ikb, is1, n)
+ be_m(ih, is1) = becp%nc(ikb, is1, m)
+ ENDDO
+ ENDIF
+ ENDDO
+ DO ih = 1, nh(np)
+ DO jh = 1, nh(np)
+ sigma_x_aug = sigma_x_aug &
+ + qq_nt(ih,jh,np) * ( be_m(jh,2)*conjg(be_n(ih,1))+ be_m(jh,1)*conjg(be_n(ih,2)) )
+
+ sigma_y_aug = sigma_y_aug &
+ + qq_nt(ih,jh,np) * ( &
+ be_m(jh,1) * conjg(be_n(ih,2)) &
+ - be_m(jh,2) * conjg(be_n(ih,1)) &
+ ) * (0.0d0, 1.0d0)
+
+ sigma_z_aug = sigma_z_aug &
+ + qq_nt(ih,jh,np) * ( be_m(jh,1)*conjg(be_n(ih,1)) - be_m(jh,2)*conjg(be_n(ih,2)) )
+ ENDDO
+ ENDDO
+ ijkb0 = ijkb0 + nh(np)
+ ENDIF
+ ENDDO
+ ELSE
+ DO na = 1, nat
+ IF ( ityp(na) == np ) ijkb0 = ijkb0 + nh(np)
+ ENDDO
+ ENDIF
+ ENDDO
+ spn_aug(1, counter) = sigma_x_aug
+ spn_aug(2, counter) = sigma_y_aug
+ spn_aug(3, counter) = sigma_z_aug
+ endif
+ ENDDO
+ ENDDO
+ if(ionode) then ! root node for i/o
+ if(spn_formatted) then ! slow formatted way
+ counter=0
+ do m=1,num_bands
+ do n=1,m
+ counter=counter+1
+ do s=1,3
+ write(iun_spn,'(2es26.16)') spn(s,counter) + spn_aug(s,counter)
+ enddo
+ enddo
+ enddo
+ else ! fast unformatted way
+ write(iun_spn) ((spn(s,m) + spn_aug(s,m),s=1,3),m=1,((num_bands*(num_bands+1))/2))
+ endif
+ endif ! end of root activity
+
+
+ ENDIF
+
+ end DO
+
+ IF (ionode .and. write_spn .and. noncolin) CLOSE (iun_spn)
+
+ if(write_spn.and.noncolin) deallocate(spn, spn_aug)
+ if (any_uspp) then
+ deallocate(be_n, be_m)
+ call deallocate_bec_type(becp)
+ endif
+
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' SPIN calculated'
+
+ RETURN
+END SUBROUTINE compute_spin
+
+!-----------------------------------------------------------------------
+SUBROUTINE compute_orb
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode
+ USE kinds, ONLY: DP
+ USE wvfct, ONLY : nbnd, npwx, current_k
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc, psic, psic_nc
+ USE fft_base, ONLY : dffts, dfftp
+ USE fft_interfaces, ONLY : fwfft, invfft
+ USE klist, ONLY : nkstot, xk, ngk, igk_k
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE cell_base, ONLY : tpiba2, alat, at, bg
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE constants, ONLY : tpi
+ USE uspp, ONLY : nkb, vkb
+ USE uspp_param, ONLY : upf, nh, lmaxq
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum
+ USE noncollin_module,ONLY : noncolin, npol
+ USE gvecw, ONLY : gcutw
+ USE wannier
+ ! begin change Lopez, Thonhauser, Souza
+ USE mp, ONLY : mp_barrier
+ USE scf, ONLY : vrs, vltot, v, kedtau
+ USE gvecs, ONLY : doublegrid
+ USE lsda_mod, ONLY : nspin
+ USE constants, ONLY : rytoev
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
+ !
+ INTEGER :: mmn_tot, ik, ikp, ipol, ib, npw, i, m, n
+ INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
+ INTEGER :: ikevc, ikpevcq, s, counter
+ COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
+ becp2(:,:), Mkb(:,:), aux_nc(:,:)
+ real(DP), ALLOCATABLE :: rbecp2(:,:)
+ COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:)
+ real(DP), ALLOCATABLE :: qg(:), ylm(:,:), workg(:)
+ COMPLEX(DP) :: mmn, zdotc, phase1
+ real(DP) :: arg, g_(3)
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp
+ INTEGER :: nn,inn,loop,loop2
+ LOGICAL :: nn_found
+ INTEGER :: istart,iend
+ ! begin change Lopez, Thonhauser, Souza
+ COMPLEX(DP) :: sigma_x,sigma_y,sigma_z,cdum1,cdum2
+ integer :: npw_b1, npw_b2, i_b1, i_b2, ikp_b1, ikp_b2
+ integer, allocatable :: igk_b1(:), igk_b2(:)
+ complex(DP), allocatable :: evc_b1(:,:),evc_b2(:,:),evc_aux(:,:),H_evc(:,:)
+ complex(DP), allocatable :: uHu(:,:),uIu(:,:),spn(:,:)
+ ! end change Lopez, Thonhauser, Souza
+
+ any_uspp = any(upf(1:ntyp)%tvanp)
+
+ IF(any_uspp .and. noncolin) CALL errore('pw2wannier90',&
+ 'NCLS calculation not implimented with USP',1)
+
+ ALLOCATE( phase(dffts%nnr) )
+ ALLOCATE( evcq(npol*npwx,nbnd) )
+
+ IF(noncolin) THEN
+ ALLOCATE( aux_nc(npwx,npol) )
+ ELSE
+ ALLOCATE( aux(npwx) )
+ ENDIF
+
+ IF (gamma_only) ALLOCATE(aux2(npwx))
+
+ IF (wan_mode=='library') ALLOCATE(m_mat(num_bands,num_bands,nnb,iknum))
+
+ if (write_uHu) allocate(uhu(num_bands,num_bands))
+ if (write_uIu) allocate(uIu(num_bands,num_bands))
+
+
+!ivo
+! not sure this is really needed
+ if((write_uhu.or.write_uIu).and.wan_mode=='library')&
+ call errore('pw2wannier90',&
+ 'write_uhu, and write_uIu not meant to work library mode',1)
+!endivo
+
+
+ !
+ !
+ ! begin change Lopez, Thonhauser, Souza
+ !
+ !====================================================================
+ !
+ ! The following code was inserted by Timo Thonhauser, Ivo Souza, and
+ ! Graham Lopez in order to calculate the matrix elements
+ ! necessary for the Wannier interpolation
+ ! of the orbital magnetization
+ !
+ !====================================================================
+ !
+ !
+ !
+ if(write_uHu.or.write_uIu) then !ivo
+ !
+ if(gamma_only) call errore('pw2wannier90',&
+ 'write_uHu and write_uIu not yet implemented for gamma_only case',1) !ivo
+ if(any_uspp) call errore('pw2wannier90',&
+ 'write_uHu and write_uIu not yet implemented with USP',1) !ivo
+ !
+ !
+ allocate(igk_b1(npwx),igk_b2(npwx),evc_b1(npol*npwx,nbnd),&
+ evc_b2(npol*npwx,nbnd),&
+ evc_aux(npol*npwx,nbnd))
+ !
+ if(write_uHu) then
+ allocate(H_evc(npol*npwx,nbnd))
+ write(stdout,*)
+ write(stdout,*) ' -----------------'
+ write(stdout,*) ' *** Compute uHu '
+ write(stdout,*) ' -----------------'
+ write(stdout,*)
+ iun_uhu = find_free_unit()
+ if (ionode) then
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ if(uHu_formatted) then
+ open (unit=iun_uhu, file=TRIM(seedname)//".uHu",form='FORMATTED')
+ write (iun_uhu,*) header
+ write (iun_uhu,*) nbnd, iknum, nnb
+ else
+ open (unit=iun_uhu, file=TRIM(seedname)//".uHu",form='UNFORMATTED')
+ write (iun_uhu) header
+ write (iun_uhu) nbnd, iknum, nnb
+ endif
+ endif
+ endif
+ if(write_uIu) then
+ write(stdout,*)
+ write(stdout,*) ' -----------------'
+ write(stdout,*) ' *** Compute uIu '
+ write(stdout,*) ' -----------------'
+ write(stdout,*)
+ iun_uIu = find_free_unit()
+ if (ionode) then
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ if(uIu_formatted) then
+ open (unit=iun_uIu, file=TRIM(seedname)//".uIu",form='FORMATTED')
+ write (iun_uIu,*) header
+ write (iun_uIu,*) nbnd, iknum, nnb
+ else
+ open (unit=iun_uIu, file=TRIM(seedname)//".uIu",form='UNFORMATTED')
+ write (iun_uIu) header
+ write (iun_uIu) nbnd, iknum, nnb
+ endif
+ endif
+ endif
+
+ CALL set_vrs(vrs,vltot,v%of_r,kedtau,v%kin_r,dfftp%nnr,nspin,doublegrid)
+ call allocate_bec_type ( nkb, nbnd, becp )
+ ALLOCATE( workg(npwx) )
+
+ write(stdout,'(a,i8)') ' iknum = ',iknum
+ do ik = 1, iknum ! loop over k points
+ !
+ write (stdout,'(i8)') ik
+ !
+ npw = ngk(ik)
+ ! sort the wfc at k and set up stuff for h_psi
+ current_k=ik
+ CALL init_us_2(npw,igk_k(1,ik),xk(1,ik),vkb)
+ !
+ ! compute " H | u_n,k+b2 > "
+ !
+ do i_b2 = 1, nnb ! nnb = # of nearest neighbors
+ !
+ ! read wfc at k+b2
+ ikp_b2 = kpb(ik,i_b2) ! for kpoint 'ik', index of neighbor 'i_b2'
+ !
+! call davcio (evc_b2, 2*nwordwfc, iunwfc, ikp_b2, -1 ) !ivo
+ call davcio (evc_b2, 2*nwordwfc, iunwfc, ikp_b2+ikstart-1, -1 ) !ivo
+! call gk_sort (xk(1,ikp_b2), ngm, g, gcutw, npw_b2, igk_b2, workg)
+! ivo; igkq -> igk_k(:,ikp_b2), npw_b2 -> ngk(ikp_b2), replaced by PG
+ npw_b2=ngk(ikp_b2)
+ !
+ ! compute the phase
+ phase(:) = ( 0.0D0, 0.0D0 )
+ if (ig_(ik,i_b2)>0) phase( dffts%nl(ig_(ik,i_b2)) ) = ( 1.0D0, 0.0D0 )
+ call invfft('Wave', phase, dffts)
+ !
+ ! loop on bands
+ evc_aux = ( 0.0D0, 0.0D0 )
+ do n = 1, nbnd
+ !ivo replaced dummy m --> n everywhere on this do loop,
+ ! for consistency w/ band indices in comments
+ if (excluded_band(n)) cycle
+ if(noncolin) then
+ psic_nc = ( 0.0D0, 0.0D0 ) !ivo
+ do ipol = 1, 2
+! psic_nc = ( 0.0D0, 0.0D0 ) !ivo
+ istart=(ipol-1)*npwx+1
+ iend=istart+npw_b2-1 !ivo npw_b1 --> npw_b2
+ psic_nc(dffts%nl (igk_k(1:npw_b2,ikp_b2) ),ipol ) = &
+ evc_b2(istart:iend, n)
+ ! ivo igk_b1, npw_b1 --> igk_b2, npw_b2
+ ! multiply by phase in real space - '1' unless neighbor is in a bordering BZ
+ call invfft ('Wave', psic_nc(:,ipol), dffts)
+ psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * conjg(phase(1:dffts%nnr))
+ call fwfft ('Wave', psic_nc(:,ipol), dffts)
+ ! save the result
+ iend=istart+npw-1
+ evc_aux(istart:iend,n) = psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol )
+ end do
+ else ! this is modeled after the pre-existing code at 1162
+ psic = ( 0.0D0, 0.0D0 )
+ ! Graham, changed npw --> npw_b2 on RHS. Do you agree?!
+ psic(dffts%nl (igk_k(1:npw_b2,ikp_b2) ) ) = evc_b2(1:npw_b2, n)
+ call invfft ('Wave', psic, dffts)
+ psic(1:dffts%nnr) = psic(1:dffts%nnr) * conjg(phase(1:dffts%nnr))
+ call fwfft ('Wave', psic, dffts)
+ evc_aux(1:npw,n) = psic(dffts%nl (igk_k(1:npw,ik) ) )
+ end if
+ end do !n
+
+ if(write_uHu) then !ivo
+ !
+ ! calculate the kinetic energy at ik, used in h_psi
+ !
+ CALL g2_kin (ik)
+ !
+ CALL h_psi(npwx, npw, nbnd, evc_aux, H_evc)
+ !
+ endif
+ !
+ ! compute " < u_m,k+b1 | "
+ !
+ do i_b1 = 1, nnb
+ !
+ ! read wfc at k+b1 !ivo replaced k+b2 --> k+b1
+ ikp_b1 = kpb(ik,i_b1)
+! call davcio (evc_b1, 2*nwordwfc, iunwfc, ikp_b1, -1 ) !ivo
+ call davcio (evc_b1, 2*nwordwfc, iunwfc, ikp_b1+ikstart-1, -1 ) !ivo
+
+! call gk_sort (xk(1,ikp_b1), ngm, g, gcutw, npw_b2, igk_b2, workg) !ivo
+ call gk_sort (xk(1,ikp_b1), ngm, g, gcutw, npw_b1, igk_b1, workg) !ivo
+ !
+ ! compute the phase
+ phase(:) = ( 0.0D0, 0.0D0 )
+ if (ig_(ik,i_b1)>0) phase( dffts%nl(ig_(ik,i_b1)) ) = ( 1.0D0, 0.0D0 )
+ !call cft3s (phase, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
+ call invfft('Wave', phase, dffts)
+ !
+ ! loop on bands
+ do m = 1, nbnd
+ if (excluded_band(m)) cycle
+ if(noncolin) then
+ aux_nc = ( 0.0D0, 0.0D0 )
+ psic_nc = ( 0.0D0, 0.0D0 ) !ivo
+ do ipol = 1, 2
+! psic_nc = ( 0.0D0, 0.0D0 ) !ivo
+ istart=(ipol-1)*npwx+1
+ iend=istart+npw_b1-1 !ivo npw_b2 --> npw_b1
+ psic_nc(dffts%nl (igk_b1(1:npw_b1) ),ipol ) = evc_b1(istart:iend, m) !ivo igk_b2,npw_b2 --> igk_b1,npw_b1
+ ! multiply by phase in real space - '1' unless neighbor is in a different BZ
+ call invfft ('Wave', psic_nc(:,ipol), dffts)
+ !psic_nc(1:nrxxs,ipol) = psic_nc(1:nrxxs,ipol) * conjg(phase(1:nrxxs))
+ psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * conjg(phase(1:dffts%nnr))
+ call fwfft ('Wave', psic_nc(:,ipol), dffts)
+ ! save the result
+ aux_nc(1:npw,ipol) = psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol )
+ end do
+ else ! this is modeled after the pre-existing code at 1162
+ aux = ( 0.0D0 )
+ psic = ( 0.0D0, 0.0D0 )
+ ! Graham, changed npw --> npw_b1 on RHS. Do you agree?!
+ psic(dffts%nl (igk_b1(1:npw_b1) ) ) = evc_b1(1:npw_b1, m) !ivo igk_b2 --> igk_b1
+ call invfft ('Wave', psic, dffts)
+ !psic(1:nrxxs) = psic(1:nrxxs) * conjg(phase(1:nrxxs))
+ psic(1:dffts%nnr) = psic(1:dffts%nnr) * conjg(phase(1:dffts%nnr))
+ call fwfft ('Wave', psic, dffts)
+ aux(1:npw) = psic(dffts%nl (igk_k(1:npw,ik) ) )
+ end if
+
+ !
+ !
+ if(write_uHu) then !ivo
+ do n = 1, nbnd ! loop over bands of already computed ket
+ if (excluded_band(n)) cycle
+ if(noncolin) then
+ mmn = zdotc (npw, aux_nc(1,1),1,H_evc(1,n),1) + &
+ zdotc (npw, aux_nc(1,2),1,H_evc(1+npwx,n),1)
+ else
+ mmn = zdotc (npw, aux,1,H_evc(1,n),1)
+ end if
+ mmn = mmn * rytoev ! because wannier90 works in eV
+ call mp_sum(mmn, intra_pool_comm)
+! if (ionode) write (iun_uhu) mmn
+ uHu(n,m)=mmn
+ !
+ end do !n
+ endif
+ if(write_uIu) then !ivo
+ do n = 1, nbnd ! loop over bands of already computed ket
+ if (excluded_band(n)) cycle
+ if(noncolin) then
+ mmn = zdotc (npw, aux_nc(1,1),1,evc_aux(1,n),1) + &
+ zdotc (npw, aux_nc(1,2),1,evc_aux(1+npwx,n),1)
+ else
+ mmn = zdotc (npw, aux,1,evc_aux(1,n),1)
+ end if
+ call mp_sum(mmn, intra_pool_comm)
+! if (ionode) write (iun_uIu) mmn
+ uIu(n,m)=mmn
+ !
+ end do !n
+ endif
+ !
+ end do ! m = 1, nbnd
+ if (ionode) then ! write the files out to disk
+ if(write_uhu) then
+ if(uHu_formatted) then ! slow bulky way for transferable files
+ do n=1,num_bands
+ do m=1,num_bands
+ write(iun_uHu,'(2ES20.10)') uHu(m,n)
+ enddo
+ enddo
+ else ! the fast way
+ write(iun_uHu) ((uHu(n,m),n=1,num_bands),m=1,num_bands)
+ endif
+ endif
+ if(write_uiu) then
+ if(uIu_formatted) then ! slow bulky way for transferable files
+ do n=1,num_bands
+ do m=1,num_bands
+ write(iun_uIu,'(2ES20.10)') uIu(m,n)
+ enddo
+ enddo
+ else ! the fast way
+ write(iun_uIu) ((uIu(n,m),n=1,num_bands),m=1,num_bands)
+ endif
+ endif
+ endif ! end of io
+ end do ! i_b1
+ end do ! i_b2
+ end do ! ik
+ DEALLOCATE (workg)
+ !
+ deallocate(igk_b1,igk_b2,evc_b1,evc_b2,evc_aux)
+ if(write_uHu) then
+ deallocate(H_evc)
+ deallocate(uHu)
+ end if
+ if(write_uIu) deallocate(uIu)
+ if (ionode.and.write_uHu) close (iun_uhu) !ivo
+ if (ionode.and.write_uIu) close (iun_uIu) !ivo
+ !
+ else
+ if(.not.write_uHu) then
+ write(stdout,*)
+ write(stdout,*) ' -------------------------------'
+ write(stdout,*) ' *** uHu matrix is not computed '
+ write(stdout,*) ' -------------------------------'
+ write(stdout,*)
+ endif
+ if(.not.write_uIu) then
+ write(stdout,*)
+ write(stdout,*) ' -------------------------------'
+ write(stdout,*) ' *** uIu matrix is not computed '
+ write(stdout,*) ' -------------------------------'
+ write(stdout,*)
+ endif
+ end if
+ !
+ !
+ !
+ !
+ !
+ !
+ !====================================================================
+ !
+ ! END_m_orbit
+ !
+ !====================================================================
+ !
+ ! end change Lopez, Thonhauser, Souza
+ !
+ !
+ !
+
+ IF (gamma_only) DEALLOCATE(aux2)
+ DEALLOCATE (phase)
+ IF(noncolin) THEN
+ DEALLOCATE(aux_nc)
+ ELSE
+ DEALLOCATE(aux)
+ ENDIF
+ DEALLOCATE(evcq)
+ if(write_spn.and.noncolin) deallocate(spn)
+
+ IF(any_uspp) THEN
+ DEALLOCATE ( qb)
+ CALL deallocate_bec_type (becp)
+ IF (gamma_only) THEN
+ DEALLOCATE (rbecp2)
+ ELSE
+ DEALLOCATE (becp2)
+ ENDIF
+ ENDIF
+!
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' uHu calculated'
+
+ RETURN
+END SUBROUTINE compute_orb
+!
+!-----------------------------------------------------------------------
+SUBROUTINE compute_amn
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode
+ USE kinds, ONLY : DP
+ USE klist, ONLY : nkstot, xk, ngk, igk_k
+ USE wvfct, ONLY : nbnd, npwx
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE uspp, ONLY : nkb, vkb
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE wannier
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE uspp_param, ONLY : upf
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum
+ USE noncollin_module,ONLY : noncolin, npol
+ USE gvecw, ONLY : gcutw
+ USE constants, ONLY : eps6
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ COMPLEX(DP) :: amn, zdotc,amn_tmp,fac(2)
+ real(DP):: ddot
+ COMPLEX(DP), ALLOCATABLE :: sgf(:,:)
+ INTEGER :: ik, npw, ibnd, ibnd1, iw,i, ikevc, nt, ipol
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp, opnd, exst,spin_z_pos, spin_z_neg
+ INTEGER :: istart
+
+ !nocolin: we have half as many projections g(r) defined as wannier
+ ! functions. We project onto (1,0) (ie up spin) and then onto
+ ! (0,1) to obtain num_wann projections. jry
+
+
+ !call read_gf_definition.....> this is done at the beging
+
+ CALL start_clock( 'compute_amn' )
+
+ any_uspp =any (upf(1:ntyp)%tvanp)
+
+ IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum))
+
+ IF (wan_mode=='standalone') THEN
+ iun_amn = find_free_unit()
+ IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted')
+ ENDIF
+
+ WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum
+ !
+ IF (wan_mode=='standalone') THEN
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ IF (ionode) THEN
+ WRITE (iun_amn,*) header
+ WRITE (iun_amn,*) nbnd-nexband, iknum, n_wannier
+ !WRITE (iun_amn,*) nbnd-nexband, iknum, n_proj
+ ENDIF
+ ENDIF
+ !
+ ALLOCATE( sgf(npwx,n_proj))
+ ALLOCATE( gf_spinor(2*npwx,n_proj))
+ ALLOCATE( sgf_spinor(2*npwx,n_proj))
+ !
+ IF (any_uspp) THEN
+ CALL allocate_bec_type ( nkb, n_wannier, becp)
+ CALL init_us_1
+ ENDIF
+ !
+
+ DO ik=1,iknum
+ WRITE (stdout,'(i8)',advance='no') ik
+ IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ ikevc = ik + ikstart - 1
+! if(noncolin) then
+! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 )
+! else
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+! end if
+ npw = ngk(ik)
+ CALL generate_guiding_functions(ik) ! they are called gf(npw,n_proj)
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ if(noncolin) then
+ sgf_spinor = (0.d0,0.d0)
+ call orient_gf_spinor(npw)
+ endif
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
+ ! below we compute the product of beta functions with trial func.
+ IF (gamma_only) THEN
+ CALL calbec ( npw, vkb, gf, becp, n_proj )
+ ELSE if (noncolin) then
+ CALL calbec ( npw, vkb, gf_spinor, becp, n_proj )
+ else
+ CALL calbec ( npw, vkb, gf, becp, n_proj )
+ ENDIF
+ ! and we use it for the product S|trial_func>
+ if (noncolin) then
+ CALL s_psi (npwx, npw, n_proj, gf_spinor, sgf_spinor)
+ else
+ CALL s_psi (npwx, npw, n_proj, gf, sgf)
+ endif
+
+ ELSE
+ !if (noncolin) then
+ ! sgf_spinor(:,:) = gf_spinor
+ !else
+ sgf(:,:) = gf(:,:)
+ !endif
+ ENDIF
+ !
+ noncolin_case : &
+ IF(noncolin) THEN
+ old_spinor_proj_case : &
+ IF(old_spinor_proj) THEN
+ ! we do the projection as g(r)*a(r) and g(r)*b(r)
+ DO ipol=1,npol
+ istart = (ipol-1)*npwx + 1
+ DO iw = 1,n_proj
+ ibnd1 = 0
+ DO ibnd = 1,nbnd
+ IF (excluded_band(ibnd)) CYCLE
+ amn=(0.0_dp,0.0_dp)
+ ! amn = zdotc(npw,evc_nc(1,ipol,ibnd),1,sgf(1,iw),1)
+ if (any_uspp) then
+ amn = zdotc(npw, evc(0,ibnd), 1, sgf_spinor(1, iw + (ipol-1)*n_proj), 1)
+ amn = amn + zdotc(npw, evc(npwx+1,ibnd), 1, sgf_spinor(npwx+1, iw + (ipol-1)*n_proj), 1)
+ else
+ amn = zdotc(npw,evc(istart,ibnd),1,sgf(1,iw),1)
+ endif
+ CALL mp_sum(amn, intra_pool_comm)
+ ibnd1=ibnd1+1
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') ibnd1, iw+n_proj*(ipol-1), ik, amn
+ ELSEIF (wan_mode=='library') THEN
+ a_mat(ibnd1,iw+n_proj*(ipol-1),ik) = amn
+ ELSE
+ CALL errore('compute_amn',' value of wan_mode not recognised',1)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE old_spinor_proj_case
+ DO iw = 1,n_proj
+ spin_z_pos=.false.;spin_z_neg=.false.
+ ! detect if spin quantisation axis is along z
+ if((abs(spin_qaxis(1,iw)-0.0d0) nsp, tau
+ USE uspp_param, ONLY : upf
+
+ IMPLICIT NONE
+
+ INTEGER, EXTERNAL :: find_free_unit
+ COMPLEX(DP), ALLOCATABLE :: phase(:), nowfc1(:,:), nowfc(:,:), psi_gamma(:,:), &
+ qr_tau(:), cwork(:), cwork2(:), Umat(:,:), VTmat(:,:), Amat(:,:) ! vv: complex arrays for the SVD factorization
+ REAL(DP), ALLOCATABLE :: focc(:), rwork(:), rwork2(:), singval(:), rpos(:,:), cpos(:,:) ! vv: Real array for the QR factorization and SVD
+ INTEGER, ALLOCATABLE :: piv(:) ! vv: Pivot array in the QR factorization
+ COMPLEX(DP) :: tmp_cwork(2)
+ REAL(DP):: ddot, sumk, norm_psi, f_gamma
+ INTEGER :: ik, npw, ibnd, iw, ikevc, nrtot, ipt, info, lcwork, locibnd, &
+ jpt,kpt,lpt, ib, istart, gamma_idx, minmn, minmn2, maxmn2, numbands, nbtot
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp, found_gamma
+
+#if defined(__MPI)
+ INTEGER :: nxxs
+ COMPLEX(DP),ALLOCATABLE :: psic_all(:)
+ nxxs = dffts%nr1x * dffts%nr2x * dffts%nr3x
+ ALLOCATE(psic_all(nxxs) )
+#endif
+
+ ! vv: Write info about SCDM in output
+ IF (TRIM(scdm_entanglement) == 'isolated') THEN
+ WRITE(stdout,'(1x,a,a/)') 'Case : ',trim(scdm_entanglement)
+ ELSEIF (TRIM(scdm_entanglement) == 'erfc' .OR. &
+ TRIM(scdm_entanglement) == 'gaussian') THEN
+ WRITE(stdout,'(1x,a,a)') 'Case : ',trim(scdm_entanglement)
+ WRITE(stdout,'(1x,a,f10.3,a/,1x,a,f10.3,a/)') 'mu = ', scdm_mu, ' eV', 'sigma =', scdm_sigma, ' eV'
+ ENDIF
+
+ CALL start_clock( 'compute_amn' )
+
+ any_uspp =any (upf(1:ntyp)%tvanp)
+
+ ! vv: Error for using SCDM with non-collinear spin calculations
+ IF (noncolin) THEN
+ call errore('pw2wannier90','The SCDM method is not compatible with non-collinear spin yet.',1)
+ ENDIF
+
+ ! vv: Error for using SCDM with Ultrasoft pseudopotentials
+ !IF (any_uspp) THEN
+ ! call errore('pw2wannier90','The SCDM method does not work with Ultrasoft pseudopotential yet.',1)
+ !ENDIF
+
+ ! vv: Error for using SCDM with gamma_only
+ IF (gamma_only) THEN
+ call errore('pw2wannier90','The SCDM method does not work with gamma_only calculations.',1)
+ ENDIF
+ ! vv: Allocate all the variables for the SCDM method:
+ ! 1)For the QR decomposition
+ ! 2)For the unk's on the real grid
+ ! 3)For the SVD
+ IF(TRIM(scdm_entanglement) == 'isolated') THEN
+ numbands=n_wannier
+ nbtot=n_wannier + nexband
+ ELSE
+ numbands=nbnd-nexband
+ nbtot=nbnd
+ ENDIF
+ nrtot = dffts%nr1*dffts%nr2*dffts%nr3
+ info = 0
+ minmn = MIN(numbands,nrtot)
+ ALLOCATE(qr_tau(2*minmn))
+ ALLOCATE(piv(nrtot))
+ piv(:) = 0
+ ALLOCATE(rwork(2*nrtot))
+ rwork(:) = 0.0_DP
+
+ ALLOCATE(kpt_latt(3,iknum))
+ ALLOCATE(nowfc1(n_wannier,numbands))
+ ALLOCATE(nowfc(n_wannier,numbands))
+ ALLOCATE(psi_gamma(nrtot,numbands))
+ ALLOCATE(focc(numbands))
+ minmn2 = MIN(numbands,n_wannier)
+ maxmn2 = MAX(numbands,n_wannier)
+ ALLOCATE(rwork2(5*minmn2))
+
+ ALLOCATE(rpos(nrtot,3))
+ ALLOCATE(cpos(n_wannier,3))
+ ALLOCATE(phase(n_wannier))
+ ALLOCATE(singval(n_wannier))
+ ALLOCATE(Umat(numbands,n_wannier))
+ ALLOCATE(VTmat(n_wannier,n_wannier))
+ ALLOCATE(Amat(numbands,n_wannier))
+
+ IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum))
+
+ IF (wan_mode=='standalone') THEN
+ iun_amn = find_free_unit()
+ IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted')
+ ENDIF
+
+ WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum
+ !
+ IF (wan_mode=='standalone') THEN
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime//' with SCDM '
+ IF (ionode) THEN
+ WRITE (iun_amn,*) header
+ WRITE (iun_amn,'(3i8,xxx,2f10.6)') numbands, iknum, n_wannier, scdm_mu, scdm_sigma
+ ENDIF
+ ENDIF
+
+ !vv: Find Gamma-point index in the list of k-vectors
+ ik = 0
+ gamma_idx = 1
+ sumk = -1.0_DP
+ found_gamma = .false.
+ kpt_latt(:,1:iknum)=xk(:,1:iknum)
+ CALL cryst_to_cart(iknum,kpt_latt,at,-1)
+ DO WHILE(sumk/=0.0_DP .and. ik < iknum)
+ ik = ik + 1
+ sumk = ABS(kpt_latt(1,ik)**2 + kpt_latt(2,ik)**2 + kpt_latt(3,ik)**2)
+ IF (sumk==0.0_DP) THEN
+ found_gamma = .true.
+ gamma_idx = ik
+ ENDIF
+ END DO
+ IF (.not. found_gamma) call errore('compute_amn','No Gamma point found.',1)
+
+ f_gamma = 0.0_DP
+ ik = gamma_idx
+ locibnd = 0
+ DO ibnd=1,nbtot
+ IF(excluded_band(ibnd)) CYCLE
+ locibnd = locibnd + 1
+ ! check locibnd <= numbands
+ IF (locibnd > numbands) call errore('compute_amn','Something wrong with the number of bands. Check exclude_bands.')
+ IF(TRIM(scdm_entanglement) == 'isolated') THEN
+ f_gamma = 1.0_DP
+ ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN
+ f_gamma = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma)
+ ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN
+ f_gamma = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2))
+ ELSE
+ call errore('compute_amn','scdm_entanglement value not recognized.',1)
+ END IF
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ik, -1 )
+ npw = ngk(ik)
+ ! vv: Compute unk's on a real grid (the fft grid)
+ psic(:) = (0.D0,0.D0)
+ psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd)
+ CALL invfft ('Wave', psic, dffts)
+#if defined(__MPI)
+ CALL gather_grid(dffts,psic,psic_all)
+ ! vv: Gamma only
+ ! vv: Build Psi_k = Unk * focc
+ norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP))
+ psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi
+ psi_gamma(1:nrtot,locibnd) = psic_all(1:nrtot)
+ psi_gamma(1:nrtot,locibnd) = psi_gamma(1:nrtot,locibnd) * f_gamma
+#else
+ norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP))
+ psic(1:nrtot) = psic(1:nrtot)/ norm_psi
+ psi_gamma(1:nrtot,locibnd) = psic(1:nrtot)
+ psi_gamma(1:nrtot,locibnd) = psi_gamma(1:nrtot,locibnd) * f_gamma
+#endif
+ ENDDO
+
+ ! vv: Perform QR factorization with pivoting on Psi_Gamma
+ ! vv: Preliminary call to define optimal values for lwork and cwork size
+ CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,tmp_cwork,-1,rwork,info)
+ IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
+ lcwork = AINT(REAL(tmp_cwork(1)))
+ tmp_cwork(:) = (0.0_DP,0.0_DP)
+ piv(:) = 0
+ rwork(:) = 0.0_DP
+ ALLOCATE(cwork(lcwork))
+ cwork(:) = (0.0_DP,0.0_DP)
+#if defined(__MPI)
+ IF(ionode) THEN
+ CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info)
+ IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
+ ENDIF
+ CALL mp_bcast(piv,ionode_id,world_comm)
+#else
+ ! vv: Perform QR factorization with pivoting on Psi_Gamma
+ CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info)
+ IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
+#endif
+ DEALLOCATE(cwork)
+ tmp_cwork(:) = (0.0_DP,0.0_DP)
+
+ ! vv: Compute the points
+ lpt = 0
+ rpos(:,:) = 0.0_DP
+ cpos(:,:) = 0.0_DP
+ DO kpt = 0,dffts%nr3-1
+ DO jpt = 0,dffts%nr2-1
+ DO ipt = 0,dffts%nr1-1
+ lpt = lpt + 1
+ rpos(lpt,1) = REAL(ipt)/dffts%nr1
+ rpos(lpt,2) = REAL(jpt)/dffts%nr2
+ rpos(lpt,3) = REAL(kpt)/dffts%nr3
+ ENDDO
+ ENDDO
+ ENDDO
+ DO iw=1,n_wannier
+ cpos(iw,:) = rpos(piv(iw),:)
+ cpos(iw,:) = cpos(iw,:) - ANINT(cpos(iw,:))
+ ENDDO
+
+ DO ik=1,iknum
+ WRITE (stdout,'(i8)',advance='no') ik
+ IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ ikevc = ik + ikstart - 1
+! if(noncolin) then
+! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 )
+! else
+! end if
+
+ ! vv: SCDM method for generating the Amn matrix
+ phase(:) = (0.0_DP,0.0_DP)
+ nowfc1(:,:) = (0.0_DP,0.0_DP)
+ nowfc(:,:) = (0.0_DP,0.0_DP)
+ Umat(:,:) = (0.0_DP,0.0_DP)
+ VTmat(:,:) = (0.0_DP,0.0_DP)
+ Amat(:,:) = (0.0_DP,0.0_DP)
+ singval(:) = 0.0_DP
+ rwork2(:) = 0.0_DP
+ locibnd = 0
+ ! vv: Generate the occupation numbers matrix according to scdm_entanglement
+ DO ibnd=1,nbtot
+ IF (excluded_band(ibnd)) CYCLE
+ locibnd = locibnd + 1
+ ! vv: Define the occupation numbers matrix according to scdm_entanglement
+ IF(TRIM(scdm_entanglement) == 'isolated') THEN
+ focc(locibnd) = 1.0_DP
+ ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN
+ focc(locibnd) = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma)
+ ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN
+ focc(locibnd) = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2))
+ ELSE
+ call errore('compute_amn','scdm_entanglement value not recognized.',1)
+ END IF
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+ npw = ngk(ik)
+ psic(:) = (0.D0,0.D0)
+ psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd)
+ CALL invfft ('Wave', psic, dffts)
+#if defined(__MPI)
+ CALL gather_grid(dffts,psic,psic_all)
+ norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP))
+ psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi
+ DO iw = 1,n_wannier
+ phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
+ &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),&
+ &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
+ &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)))
+ nowfc(iw,locibnd) = phase(iw)*psic_all(piv(iw))*focc(locibnd)
+ ENDDO
+#else
+ norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP))
+ psic(1:nrtot) = psic(1:nrtot)/ norm_psi
+ DO iw = 1,n_wannier
+ phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
+ &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),&
+ &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
+ &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)))
+ nowfc(iw,locibnd) = phase(iw)*psic(piv(iw))*focc(locibnd)
+
+ ENDDO
+#endif
+ ENDDO
+
+ CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
+ &singval,Umat,numbands,VTmat,n_wannier,tmp_cwork,-1,rwork2,info)
+ lcwork = AINT(REAL(tmp_cwork(1)))
+ tmp_cwork(:) = (0.0_DP,0.0_DP)
+ ALLOCATE(cwork(lcwork))
+#if defined(__MPI)
+ IF(ionode) THEN
+ ! vv: SVD to generate orthogonal projections
+ CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
+ &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info)
+ IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1)
+ ENDIF
+ CALL mp_bcast(Umat,ionode_id,world_comm)
+ CALL mp_bcast(VTmat,ionode_id,world_comm)
+#else
+ ! vv: SVD to generate orthogonal projections
+ CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
+ &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info)
+ IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1)
+#endif
+ DEALLOCATE(cwork)
+
+ Amat = MATMUL(Umat,VTmat)
+ DO iw = 1,n_wannier
+ locibnd = 0
+ DO ibnd = 1,nbtot
+ IF (excluded_band(ibnd)) CYCLE
+ locibnd = locibnd + 1
+ IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') locibnd, iw, ik, REAL(Amat(locibnd,iw)), AIMAG(Amat(locibnd,iw))
+ ENDDO
+ ENDDO
+ ENDDO ! k-points
+
+ ! vv: Deallocate all the variables for the SCDM method
+ DEALLOCATE(kpt_latt)
+ DEALLOCATE(psi_gamma)
+ DEALLOCATE(nowfc)
+ DEALLOCATE(nowfc1)
+ DEALLOCATE(focc)
+ DEALLOCATE(piv)
+ DEALLOCATE(qr_tau)
+ DEALLOCATE(rwork)
+ DEALLOCATE(rwork2)
+ DEALLOCATE(rpos)
+ DEALLOCATE(cpos)
+ DEALLOCATE(Umat)
+ DEALLOCATE(VTmat)
+ DEALLOCATE(Amat)
+ DEALLOCATE(singval)
+
+#if defined(__MPI)
+ DEALLOCATE( psic_all )
+#endif
+
+ IF (ionode .and. wan_mode=='standalone') CLOSE (iun_amn)
+ WRITE(stdout,'(/)')
+ WRITE(stdout,*) ' AMN calculated'
+ CALL stop_clock( 'compute_amn' )
+
+ RETURN
+END SUBROUTINE compute_amn_with_scdm
+
+subroutine orient_gf_spinor(npw)
+ use constants, only: eps6
+ use noncollin_module, only: npol
+ use wvfct, ONLY : npwx
+ use wannier
+
+ implicit none
+
+ integer :: npw, iw, ipol, istart, iw_spinor
+ logical :: spin_z_pos, spin_z_neg
+ complex(dp) :: fac(2)
+
+
+ gf_spinor = (0.0d0, 0.0d0)
+ if (old_spinor_proj) then
+ iw_spinor = 1
+ DO ipol=1,npol
+ istart = (ipol-1)*npwx + 1
+ DO iw = 1,n_proj
+ ! generate 2*nproj spinor functions, one for each spin channel
+ gf_spinor(istart:istart+npw-1, iw_spinor) = gf(1:npw, iw)
+ iw_spinor = iw_spinor + 1
+ enddo
+ enddo
+ else
+ DO iw = 1,n_proj
+ spin_z_pos=.false.;spin_z_neg=.false.
+ ! detect if spin quantisation axis is along z
+ if((abs(spin_qaxis(1,iw)-0.0d0).unkg file
+ !
+ iun_parity = find_free_unit()
+ IF (ionode) THEN
+ OPEN (unit=iun_parity, file=trim(seedname)//".unkg",form='formatted')
+ WRITE(stdout,*)"Finding the 32 unkg's per band required for parity signature."
+ ENDIF
+ !
+ ! g_abc(:,ipw) are the coordinates of the ipw-th G vector in b1, b2, b3 basis,
+ ! we compute them from g(:,ipw) by multiplying : transpose(at) with g(:,ipw)
+ !
+ ALLOCATE(g_abc(3,npw))
+ DO igv=1,npw
+ g_abc(:,igk_k(igv,kgamma))=matmul(transpose(at),g(:,igk_k(igv,kgamma)))
+ ENDDO
+ !
+ ! Count and identify the G vectors we will be extracting for each
+ ! cpu.
+ !
+ ig_idx=0
+ num_G = 0
+ DO igv=1,npw
+ ! 0-th Order
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! 1
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ ! 1st Order
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ ! 2nd Order
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! yz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! yz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! z^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ ! 3rd Order
+ IF ( (abs(g_abc(1,igv) - 3.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^3
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2y
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2y
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! x^2z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! x^2z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xyz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xyz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xyz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xyz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! xz^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 2.d0 <= eps6) ) THEN ! xz^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 3.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y^3
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! y^2z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! y^2z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! yz^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and.&
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 2.d0 <= eps6) ) THEN ! yz^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 3.d0 <= eps6) ) THEN ! z^3
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ ENDDO
+ !
+ ! Sum laterally across cpus num_G, so it contains
+ ! the number of g_vectors on each node, and known to all cpus
+ !
+ CALL mp_sum(num_G, intra_pool_comm)
+
+ IF (ionode) WRITE(iun_parity,*) sum(num_G)
+ IF (sum(num_G) /= 32) CALL errore('write_parity', 'incorrect number of g-vectors extracted',1)
+ IF (ionode) THEN
+ WRITE(stdout,*)' ...done'
+ WRITE(stdout,*)'G-vector splitting:'
+ DO i=1,nproc
+ WRITE(stdout,*)' cpu: ',i-1,' number g-vectors: ',num_G(i)
+ ENDDO
+ WRITE(stdout,*)' Collecting g-vectors and writing to file'
+ ENDIF
+
+ !
+ ! Define needed intermediate arrays
+ !
+ ALLOCATE(evc_sub(32,nbnd,nproc))
+ ALLOCATE(evc_sub_gathered(32,nbnd))
+ ALLOCATE(g_abc_pre_gather(3,32,nproc))
+ !
+ ! Initialise
+ !
+ evc_sub=(0.d0,0.d0)
+ evc_sub_1D=(0.d0,0.d0)
+ evc_sub_gathered=(0.d0,0.d0)
+ g_abc_pre_gather=0
+ g_abc_1D=0
+ g_abc_gathered=0
+ !
+ ! Compute displacements needed for filling evc_sub
+ !
+ displ(1)=1
+ IF (nproc > 1) THEN
+ DO i=2,nproc
+ displ(i)=displ(i-1)+num_G(i-1)
+ ENDDO
+ ENDIF
+ !
+ ! Fill evc_sub with required fourier component from each cpu dependent evc
+ !
+ DO i=1,num_G(mpime+1)
+ evc_sub(i+displ(mpime+1)-1,:,mpime+1)=evc(ig_idx(i),:)
+ ENDDO
+ !
+ ! g_abc_pre_gather(:,ipw,icpu) are the coordinates of the ipw-th G vector in b1, b2, b3 basis
+ ! on icpu and stored sequencially, ready for a lateral mp_sum
+ !
+ DO igv=1,num_G(mpime+1)
+ g_abc_pre_gather(:,igv+displ(mpime+1)-1,mpime+1) = &
+ matmul(transpose(at),g(:,ig_idx(igk_k(igv,kgamma))))
+ ENDDO
+ !
+ ! Gather evc_sub and g_abc_pre_gather into common arrays to each cpu
+ !
+ DO ibnd=1,nbnd
+ evc_sub_1D=evc_sub(:,ibnd,mpime+1)
+ CALL mp_sum(evc_sub_1D, intra_pool_comm)
+ evc_sub_gathered(:,ibnd)=evc_sub_1D
+ ENDDO
+ !
+ DO i=1,3
+ g_abc_1D=g_abc_pre_gather(i,:,mpime+1)
+ CALL mp_sum(g_abc_1D, intra_pool_comm)
+ g_abc_gathered(i,:)=g_abc_1D
+ ENDDO
+ !
+ ! Write to file
+ !
+ DO ibnd=1,nbnd
+ DO igv=1,32
+ IF (ionode) WRITE(iun_parity,'(5i5,2f12.7)') ibnd, igv, nint(g_abc_gathered(1,igv)),&
+ nint(g_abc_gathered(2,igv)),&
+ nint(g_abc_gathered(3,igv)),&
+ real(evc_sub_gathered(igv,ibnd)),&
+ aimag(evc_sub_gathered(igv,ibnd))
+ ENDDO
+ ENDDO
+ WRITE(stdout,*)' ...done'
+ !
+ IF (ionode) CLOSE(unit=iun_parity)
+ !
+ DEALLOCATE(evc_sub)
+ DEALLOCATE(evc_sub_gathered)
+ DEALLOCATE(g_abc_pre_gather)
+
+ CALL stop_clock( 'write_parity' )
+
+END SUBROUTINE write_parity
+
+
+SUBROUTINE wan2sic
+
+ USE io_global, ONLY : stdout
+ USE kinds, ONLY : DP
+ USE io_files, ONLY : iunwfc, nwordwfc, nwordwann
+ USE gvect, ONLY : g, ngm
+ USE wavefunctions, ONLY : evc, psic
+ USE wvfct, ONLY : nbnd, npwx
+ USE gvecw, ONLY : gcutw
+ USE klist, ONLY : nkstot, xk, wk, ngk
+ USE wannier
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, nn, ik, ibnd, iw, ikevc, npw
+ COMPLEX(DP), ALLOCATABLE :: orbital(:,:), u_matrix(:,:,:)
+ INTEGER :: iunatsicwfc = 31 ! unit for sic wfc
+
+ OPEN (20, file = trim(seedname)//".dat" , form = 'formatted', status = 'unknown')
+ WRITE(stdout,*) ' wannier plot '
+
+ ALLOCATE ( u_matrix( n_wannier, n_wannier, nkstot) )
+ ALLOCATE ( orbital( npwx, n_wannier) )
+
+ !
+ DO i = 1, n_wannier
+ DO j = 1, n_wannier
+ DO ik = 1, nkstot
+ READ (20, * ) u_matrix(i,j,ik)
+ !do nn = 1, nnb(ik)
+ DO nn = 1, nnb
+ READ (20, * ) ! m_matrix (i,j,nkp,nn)
+ ENDDO
+ ENDDO !nkp
+ ENDDO !j
+ ENDDO !i
+ !
+ DO ik=1,iknum
+ ikevc = ik + ikstart - 1
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1)
+ npw = ngk(ik)
+ WRITE(stdout,*) 'npw ',npw
+ DO iw=1,n_wannier
+ DO j=1,npw
+ orbital(j,iw) = (0.0d0,0.0d0)
+ DO ibnd=1,n_wannier
+ orbital(j,iw) = orbital(j,iw) + u_matrix(iw,ibnd,ik)*evc(j,ibnd)
+ WRITE(stdout,*) j, iw, ibnd, ik, orbital(j,iw), &
+ u_matrix(iw,ibnd,ik), evc(j,ibnd)
+ ENDDO !ibnd
+ ENDDO !j
+ ENDDO !wannier
+ CALL davcio (orbital, 2*nwordwann, iunatsicwfc, ikevc, +1)
+ ENDDO ! k-points
+
+ DEALLOCATE ( u_matrix)
+ WRITE(stdout,*) ' dealloc u '
+ DEALLOCATE ( orbital)
+ WRITE(stdout,*) ' dealloc orbital '
+ !
+END SUBROUTINE wan2sic
+
+SUBROUTINE ylm_expansion
+ USE io_global, ONLY : stdout
+ USE kinds, ONLY : DP
+ USE random_numbers, ONLY : randy
+ USE matrix_inversion
+ USE wannier
+ IMPLICIT NONE
+ ! local variables
+ INTEGER, PARAMETER :: lmax2=16
+ INTEGER :: lm, i, ir, iw, m
+ real(DP), ALLOCATABLE :: r(:,:), rr(:), rp(:,:), ylm_w(:), ylm(:,:), mly(:,:)
+ real(DP) :: u(3,3)
+
+ ALLOCATE (r(3,lmax2), rp(3,lmax2), rr(lmax2), ylm_w(lmax2))
+ ALLOCATE (ylm(lmax2,lmax2), mly(lmax2,lmax2) )
+
+ ! generate a set of nr=lmax2 random vectors
+ DO ir=1,lmax2
+ DO i=1,3
+ r(i,ir) = randy() -0.5d0
+ ENDDO
+ ENDDO
+ rr(:) = r(1,:)*r(1,:) + r(2,:)*r(2,:) + r(3,:)*r(3,:)
+ !- compute ylm(ir,lm)
+ CALL ylmr2(lmax2, lmax2, r, rr, ylm)
+ !- store the inverse of ylm(ir,lm) in mly(lm,ir)
+ CALL invmat(lmax2, ylm, mly)
+ !- check that r points are independent
+ CALL check_inverse(lmax2, ylm, mly)
+
+ DO iw=1, n_proj
+
+ !- define the u matrix that rotate the reference frame
+ CALL set_u_matrix (xaxis(:,iw),zaxis(:,iw),u)
+ !- find rotated r-vectors
+ rp(:,:) = matmul ( u(:,:) , r(:,:) )
+ !- set ylm funtion according to wannier90 (l,mr) indexing in the rotaterd points
+ CALL ylm_wannier(ylm_w,l_w(iw),mr_w(iw),rp,lmax2)
+
+ csph(:,iw) = matmul (mly(:,:), ylm_w(:))
+
+! write (stdout,*)
+! write (stdout,'(2i4,2(2x,3f6.3))') l_w(iw), mr_w(iw), xaxis(:,iw), zaxis(:,iw)
+! write (stdout,'(16i6)') (lm, lm=1,lmax2)
+! write (stdout,'(16f6.3)') (csph(lm,iw), lm=1,lmax2)
+
+ ENDDO
+ DEALLOCATE (r, rp, rr, ylm_w, ylm, mly )
+
+ RETURN
+END SUBROUTINE ylm_expansion
+
+SUBROUTINE check_inverse(lmax2, ylm, mly)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : eps8
+ IMPLICIT NONE
+ ! I/O variables
+ INTEGER :: lmax2
+ real(DP) :: ylm(lmax2,lmax2), mly(lmax2,lmax2)
+ ! local variables
+ real(DP), ALLOCATABLE :: uno(:,:)
+ real(DP) :: capel
+ INTEGER :: lm
+ !
+ ALLOCATE (uno(lmax2,lmax2) )
+ uno = matmul(mly, ylm)
+ capel = 0.d0
+ DO lm = 1, lmax2
+ uno(lm,lm) = uno(lm,lm) - 1.d0
+ ENDDO
+ capel = capel + sum ( abs(uno(1:lmax2,1:lmax2) ) )
+! write (stdout,*) "capel = ", capel
+ IF (capel > eps8) CALL errore('ylm_expansion', &
+ ' inversion failed: r(*,1:nr) are not all independent !!',1)
+ DEALLOCATE (uno)
+ RETURN
+END SUBROUTINE check_inverse
+
+SUBROUTINE set_u_matrix(x,z,u)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : eps6
+ IMPLICIT NONE
+ ! I/O variables
+ real(DP) :: x(3),z(3),u(3,3)
+ ! local variables
+ real(DP) :: xx, zz, y(3), coseno
+
+ xx = sqrt(x(1)*x(1) + x(2)*x(2) + x(3)*x(3))
+ IF (xx < eps6) CALL errore ('set_u_matrix',' |xaxis| < eps ',1)
+! x(:) = x(:)/xx
+ zz = sqrt(z(1)*z(1) + z(2)*z(2) + z(3)*z(3))
+ IF (zz < eps6) CALL errore ('set_u_matrix',' |zaxis| < eps ',1)
+! z(:) = z(:)/zz
+
+ coseno = (x(1)*z(1) + x(2)*z(2) + x(3)*z(3))/xx/zz
+ IF (abs(coseno) > eps6) CALL errore('set_u_matrix',' xaxis and zaxis are not orthogonal !',1)
+
+ y(1) = (z(2)*x(3) - x(2)*z(3))/xx/zz
+ y(2) = (z(3)*x(1) - x(3)*z(1))/xx/zz
+ y(3) = (z(1)*x(2) - x(1)*z(2))/xx/zz
+
+ u(1,:) = x(:)/xx
+ u(2,:) = y(:)
+ u(3,:) = z(:)/zz
+
+! write (stdout,'(3f10.7)') u(:,:)
+
+ RETURN
+
+END SUBROUTINE set_u_matrix
+
+SUBROUTINE ylm_wannier(ylm,l,mr,r,nr)
+!
+! this routine returns in ylm(r) the values at the nr points r(1:3,1:nr)
+! of the spherical harmonic identified by indices (l,mr)
+! in table 3.1 of the wannierf90 specification.
+!
+! No reference to the particular ylm ordering internal to Quantum ESPRESSO
+! is assumed.
+!
+! If ordering in wannier90 code is changed or extended this should be the
+! only place to be modified accordingly
+!
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi, fpi, eps8
+ IMPLICIT NONE
+! I/O variables
+!
+ INTEGER :: l, mr, nr
+ real(DP) :: ylm(nr), r(3,nr)
+!
+! local variables
+!
+ real(DP), EXTERNAL :: s, p_z,px,py, dz2, dxz, dyz, dx2my2, dxy
+ real(DP), EXTERNAL :: fz3, fxz2, fyz2, fzx2my2, fxyz, fxx2m3y2, fy3x2my2
+ real(DP) :: rr, cost, phi
+ INTEGER :: ir
+ real(DP) :: bs2, bs3, bs6, bs12
+ bs2 = 1.d0/sqrt(2.d0)
+ bs3=1.d0/sqrt(3.d0)
+ bs6 = 1.d0/sqrt(6.d0)
+ bs12 = 1.d0/sqrt(12.d0)
+!
+ IF (l > 3 .or. l < -5 ) CALL errore('ylm_wannier',' l out of range ', 1)
+ IF (l>=0) THEN
+ IF (mr < 1 .or. mr > 2*l+1) CALL errore('ylm_wannier','mr out of range' ,1)
+ ELSE
+ IF (mr < 1 .or. mr > abs(l)+1 ) CALL errore('ylm_wannier','mr out of range',1)
+ ENDIF
+
+ DO ir=1, nr
+ rr = sqrt( r(1,ir)*r(1,ir) + r(2,ir)*r(2,ir) + r(3,ir)*r(3,ir) )
+ IF (rr < eps8) CALL errore('ylm_wannier',' rr too small ',1)
+
+ cost = r(3,ir) / rr
+ !
+ ! beware the arc tan, it is defined modulo pi
+ !
+ IF (r(1,ir) > eps8) THEN
+ phi = atan( r(2,ir)/r(1,ir) )
+ ELSEIF (r(1,ir) < -eps8 ) THEN
+ phi = atan( r(2,ir)/r(1,ir) ) + pi
+ ELSE
+ phi = sign( pi/2.d0,r(2,ir) )
+ ENDIF
+
+
+ IF (l==0) THEN ! s orbital
+ ylm(ir) = s(cost,phi)
+ ENDIF
+ IF (l==1) THEN ! p orbitals
+ IF (mr==1) ylm(ir) = p_z(cost,phi)
+ IF (mr==2) ylm(ir) = px(cost,phi)
+ IF (mr==3) ylm(ir) = py(cost,phi)
+ ENDIF
+ IF (l==2) THEN ! d orbitals
+ IF (mr==1) ylm(ir) = dz2(cost,phi)
+ IF (mr==2) ylm(ir) = dxz(cost,phi)
+ IF (mr==3) ylm(ir) = dyz(cost,phi)
+ IF (mr==4) ylm(ir) = dx2my2(cost,phi)
+ IF (mr==5) ylm(ir) = dxy(cost,phi)
+ ENDIF
+ IF (l==3) THEN ! f orbitals
+ IF (mr==1) ylm(ir) = fz3(cost,phi)
+ IF (mr==2) ylm(ir) = fxz2(cost,phi)
+ IF (mr==3) ylm(ir) = fyz2(cost,phi)
+ IF (mr==4) ylm(ir) = fzx2my2(cost,phi)
+ IF (mr==5) ylm(ir) = fxyz(cost,phi)
+ IF (mr==6) ylm(ir) = fxx2m3y2(cost,phi)
+ IF (mr==7) ylm(ir) = fy3x2my2(cost,phi)
+ ENDIF
+ IF (l==-1) THEN ! sp hybrids
+ IF (mr==1) ylm(ir) = bs2 * ( s(cost,phi) + px(cost,phi) )
+ IF (mr==2) ylm(ir) = bs2 * ( s(cost,phi) - px(cost,phi) )
+ ENDIF
+ IF (l==-2) THEN ! sp2 hybrids
+ IF (mr==1) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)+bs2*py(cost,phi)
+ IF (mr==2) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)-bs2*py(cost,phi)
+ IF (mr==3) ylm(ir) = bs3*s(cost,phi) +2.d0*bs6*px(cost,phi)
+ ENDIF
+ IF (l==-3) THEN ! sp3 hybrids
+ IF (mr==1) ylm(ir) = 0.5d0*(s(cost,phi)+px(cost,phi)+py(cost,phi)+p_z(cost,phi))
+ IF (mr==2) ylm(ir) = 0.5d0*(s(cost,phi)+px(cost,phi)-py(cost,phi)-p_z(cost,phi))
+ IF (mr==3) ylm(ir) = 0.5d0*(s(cost,phi)-px(cost,phi)+py(cost,phi)-p_z(cost,phi))
+ IF (mr==4) ylm(ir) = 0.5d0*(s(cost,phi)-px(cost,phi)-py(cost,phi)+p_z(cost,phi))
+ ENDIF
+ IF (l==-4) THEN ! sp3d hybrids
+ IF (mr==1) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)+bs2*py(cost,phi)
+ IF (mr==2) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)-bs2*py(cost,phi)
+ IF (mr==3) ylm(ir) = bs3*s(cost,phi) +2.d0*bs6*px(cost,phi)
+ IF (mr==4) ylm(ir) = bs2*p_z(cost,phi)+bs2*dz2(cost,phi)
+ IF (mr==5) ylm(ir) =-bs2*p_z(cost,phi)+bs2*dz2(cost,phi)
+ ENDIF
+ IF (l==-5) THEN ! sp3d2 hybrids
+ IF (mr==1) ylm(ir) = bs6*s(cost,phi)-bs2*px(cost,phi)-bs12*dz2(cost,phi)+.5d0*dx2my2(cost,phi)
+ IF (mr==2) ylm(ir) = bs6*s(cost,phi)+bs2*px(cost,phi)-bs12*dz2(cost,phi)+.5d0*dx2my2(cost,phi)
+ IF (mr==3) ylm(ir) = bs6*s(cost,phi)-bs2*py(cost,phi)-bs12*dz2(cost,phi)-.5d0*dx2my2(cost,phi)
+ IF (mr==4) ylm(ir) = bs6*s(cost,phi)+bs2*py(cost,phi)-bs12*dz2(cost,phi)-.5d0*dx2my2(cost,phi)
+ IF (mr==5) ylm(ir) = bs6*s(cost,phi)-bs2*p_z(cost,phi)+bs3*dz2(cost,phi)
+ IF (mr==6) ylm(ir) = bs6*s(cost,phi)+bs2*p_z(cost,phi)+bs3*dz2(cost,phi)
+ ENDIF
+
+ ENDDO
+
+ RETURN
+
+END SUBROUTINE ylm_wannier
+
+!======== l = 0 =====================================================================
+FUNCTION s(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) :: s, cost,phi
+ s = 1.d0/ sqrt(fpi)
+ RETURN
+END FUNCTION s
+!======== l = 1 =====================================================================
+FUNCTION p_z(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::p_z, cost,phi
+ p_z = sqrt(3.d0/fpi) * cost
+ RETURN
+END FUNCTION p_z
+FUNCTION px(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::px, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ px = sqrt(3.d0/fpi) * sint * cos(phi)
+ RETURN
+END FUNCTION px
+FUNCTION py(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::py, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ py = sqrt(3.d0/fpi) * sint * sin(phi)
+ RETURN
+END FUNCTION py
+!======== l = 2 =====================================================================
+FUNCTION dz2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dz2, cost, phi
+ dz2 = sqrt(1.25d0/fpi) * (3.d0* cost*cost-1.d0)
+ RETURN
+END FUNCTION dz2
+FUNCTION dxz(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dxz, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ dxz = sqrt(15.d0/fpi) * sint*cost * cos(phi)
+ RETURN
+END FUNCTION dxz
+FUNCTION dyz(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dyz, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ dyz = sqrt(15.d0/fpi) * sint*cost * sin(phi)
+ RETURN
+END FUNCTION dyz
+FUNCTION dx2my2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dx2my2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ dx2my2 = sqrt(3.75d0/fpi) * sint*sint * cos(2.d0*phi)
+ RETURN
+END FUNCTION dx2my2
+FUNCTION dxy(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dxy, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ dxy = sqrt(3.75d0/fpi) * sint*sint * sin(2.d0*phi)
+ RETURN
+END FUNCTION dxy
+!======== l = 3 =====================================================================
+FUNCTION fz3(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fz3, cost, phi
+ fz3 = 0.25d0*sqrt(7.d0/pi) * ( 5.d0 * cost * cost - 3.d0 ) * cost
+ RETURN
+END FUNCTION fz3
+FUNCTION fxz2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fxz2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fxz2 = 0.25d0*sqrt(10.5d0/pi) * ( 5.d0 * cost * cost - 1.d0 ) * sint * cos(phi)
+ RETURN
+END FUNCTION fxz2
+FUNCTION fyz2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fyz2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fyz2 = 0.25d0*sqrt(10.5d0/pi) * ( 5.d0 * cost * cost - 1.d0 ) * sint * sin(phi)
+ RETURN
+END FUNCTION fyz2
+FUNCTION fzx2my2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fzx2my2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fzx2my2 = 0.25d0*sqrt(105d0/pi) * sint * sint * cost * cos(2.d0*phi)
+ RETURN
+END FUNCTION fzx2my2
+FUNCTION fxyz(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fxyz, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fxyz = 0.25d0*sqrt(105d0/pi) * sint * sint * cost * sin(2.d0*phi)
+ RETURN
+END FUNCTION fxyz
+FUNCTION fxx2m3y2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fxx2m3y2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fxx2m3y2 = 0.25d0*sqrt(17.5d0/pi) * sint * sint * sint * cos(3.d0*phi)
+ RETURN
+END FUNCTION fxx2m3y2
+FUNCTION fy3x2my2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fy3x2my2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fy3x2my2 = 0.25d0*sqrt(17.5d0/pi) * sint * sint * sint * sin(3.d0*phi)
+ RETURN
+END FUNCTION fy3x2my2
+!
+!
+!-----------------------------------------------------------------------
+SUBROUTINE radialpart(ng, q, alfa, rvalue, lmax, radial)
+ !-----------------------------------------------------------------------
+ !
+ ! This routine computes a table with the radial Fourier transform
+ ! of the radial functions.
+ !
+ USE kinds, ONLY : dp
+ USE constants, ONLY : fpi
+ USE cell_base, ONLY : omega
+ !
+ IMPLICIT NONE
+ ! I/O
+ INTEGER :: ng, rvalue, lmax
+ real(DP) :: q(ng), alfa, radial(ng,0:lmax)
+ ! local variables
+ real(DP), PARAMETER :: xmin=-6.d0, dx=0.025d0, rmax=10.d0
+
+ real(DP) :: rad_int, pref, x
+ INTEGER :: l, lp1, ir, ig, mesh_r
+ real(DP), ALLOCATABLE :: bes(:), func_r(:), r(:), rij(:), aux(:)
+
+ mesh_r = nint ( ( log ( rmax ) - xmin ) / dx + 1 )
+ ALLOCATE ( bes(mesh_r), func_r(mesh_r), r(mesh_r), rij(mesh_r) )
+ ALLOCATE ( aux(mesh_r))
+ !
+ ! compute the radial mesh
+ !
+ DO ir = 1, mesh_r
+ x = xmin + dble (ir - 1) * dx
+ r (ir) = exp (x) / alfa
+ rij (ir) = dx * r (ir)
+ ENDDO
+ !
+ IF (rvalue==1) func_r(:) = 2.d0 * alfa**(3.d0/2.d0) * exp(-alfa*r(:))
+ IF (rvalue==2) func_r(:) = 1.d0/sqrt(8.d0) * alfa**(3.d0/2.d0) * &
+ (2.0d0 - alfa*r(:)) * exp(-alfa*r(:)*0.5d0)
+ IF (rvalue==3) func_r(:) = sqrt(4.d0/27.d0) * alfa**(3.0d0/2.0d0) * &
+ (1.d0 - 2.0d0/3.0d0*alfa*r(:) + 2.d0*(alfa*r(:))**2/27.d0) * &
+ exp(-alfa*r(:)/3.0d0)
+ pref = fpi/sqrt(omega)
+ !
+ DO l = 0, lmax
+ DO ig=1,ng
+ CALL sph_bes (mesh_r, r(1), q(ig), l, bes)
+ aux(:) = bes(:) * func_r(:) * r(:) * r(:)
+ ! second r factor added upo suggestion by YY Liang
+ CALL simpson (mesh_r, aux, rij, rad_int)
+ radial(ig,l) = rad_int * pref
+ ENDDO
+ ENDDO
+
+ DEALLOCATE (bes, func_r, r, rij, aux )
+ RETURN
+END SUBROUTINE radialpart
+
+
From 657abdd3cfbf73a38a2b62150d472dab1987185b Mon Sep 17 00:00:00 2001
From: Valerio Vitale
Date: Fri, 1 Mar 2019 14:58:58 +0000
Subject: [PATCH 07/24] Removed CR/LF from pw2wannier90.f90
---
PP/src/pw2wannier90.f90 | 9912 +++++++++++++++++++--------------------
1 file changed, 4955 insertions(+), 4957 deletions(-)
diff --git a/PP/src/pw2wannier90.f90 b/PP/src/pw2wannier90.f90
index 893b88c249..d9e2c870ef 100644
--- a/PP/src/pw2wannier90.f90
+++ b/PP/src/pw2wannier90.f90
@@ -1,4957 +1,4955 @@
-!
-! Copyright (C) 2003-2013 Quantum ESPRESSO and Wannier90 groups
-! This file is distributed under the terms of the
-! GNU General Public License. See the file `License'
-! in the root directory of the present distribution,
-! or http://www.gnu.org/copyleft/gpl.txt .
-!
-! pw2wannier was written by Stefano de Gironcoli
-! with later additions by
-! Jonathan Yates - spinors
-! Arash Mostofi - gamma point and transport things
-! Timo Thonhauser, Graham Lopez, Ivo Souza
-! uHu, uIu terms for orbital magnetisation
-! please send bugs and comments to
-! Jonathan Yates and Arash Mostofi
-! Takashi Koretsune and Florian Thoele -- noncollinear and USPPs
-! Valerio Vitale - Selected columns of density matrix (SCDM)
-!
-!
-! NOTE: old_spinor_proj is still available for compatibility with old
-! nnkp files but should be removed soon.
-!
-!
-module wannier
- USE kinds, only : DP
- !integer, allocatable :: nnb(:) ! #b (ik)
- integer :: nnb ! #b
- integer, allocatable :: kpb(:,:) ! k+b (ik,ib)
- integer, allocatable :: g_kpb(:,:,:) ! G_k+b (ipol,ik,ib)
- integer, allocatable :: ig_(:,:) ! G_k+b (ipol,ik,ib)
- integer, allocatable :: lw(:,:), mw(:,:) ! l and m of wannier (16,n_wannier)
- integer, allocatable :: num_sph(:) ! num. func. in lin. comb., (n_wannier)
- logical, allocatable :: excluded_band(:)
- ! begin change Lopez, Thonhauser, Souza
- integer :: iun_nnkp,iun_mmn,iun_amn,iun_band,iun_spn,iun_plot,iun_parity,&
- nnbx,nexband,iun_uhu,&
- iun_uIu !ivo
- ! end change Lopez, Thonhauser, Souza
- integer :: n_wannier !number of WF
- integer :: n_proj !number of projection
- complex(DP), allocatable :: gf(:,:) ! guding_function(npwx,n_wannier)
- complex(DP), allocatable :: gf_spinor(:,:)
- complex(DP), allocatable :: sgf_spinor(:,:)
- integer :: ispinw, ikstart, ikstop, iknum
- character(LEN=15) :: wan_mode ! running mode
- logical :: logwann, wvfn_formatted, write_unk, write_eig, &
- ! begin change Lopez, Thonhauser, Souza
- write_amn,write_mmn,reduce_unk,write_spn,&
- write_unkg,write_uhu,&
- write_dmn,read_sym, & !YN
- write_uIu, spn_formatted, uHu_formatted, uIu_formatted, & !ivo
- ! end change Lopez, Thonhauser, Souza
- ! vv: Begin SCDM keywords
- scdm_proj
- character(LEN=15) :: scdm_entanglement
- real(DP) :: scdm_mu, scdm_sigma
- ! vv: End SCDM keywords
- ! run check for regular mesh
- logical :: regular_mesh = .true.
- ! input data from nnkp file
- real(DP), allocatable :: center_w(:,:) ! center_w(3,n_wannier)
- integer, allocatable :: spin_eig(:)
- real(DP), allocatable :: spin_qaxis(:,:)
- integer, allocatable :: l_w(:), mr_w(:) ! l and mr of wannier (n_wannier) as from table 3.1,3.2 of spec.
- integer, allocatable :: r_w(:) ! index of radial function (n_wannier) as from table 3.3 of spec.
- real(DP), allocatable :: xaxis(:,:),zaxis(:,:) ! xaxis and zaxis(3,n_wannier)
- real(DP), allocatable :: alpha_w(:) ! alpha_w(n_wannier) ( called zona in wannier spec)
- !
- real(DP), allocatable :: csph(:,:) ! expansion coefficients of gf on QE ylm function (16,n_wannier)
- CHARACTER(len=256) :: seedname = 'wannier' ! prepended to file names in wannier90
- ! For implementation of wannier_lib
- integer :: mp_grid(3) ! dimensions of MP k-point grid
- real(DP) :: rlatt(3,3),glatt(3,3) ! real and recip lattices (Cartesian co-ords, units of Angstrom)
- real(DP), allocatable :: kpt_latt(:,:) ! k-points in crystal co-ords. kpt_latt(3,iknum)
- real(DP), allocatable :: atcart(:,:) ! atom centres in Cartesian co-ords and Angstrom units. atcart(3,nat)
- integer :: num_bands ! number of bands left after exclusions
- character(len=3), allocatable :: atsym(:) ! atomic symbols. atsym(nat)
- integer :: num_nnmax=12
- complex(DP), allocatable :: m_mat(:,:,:,:), a_mat(:,:,:)
- complex(DP), allocatable :: u_mat(:,:,:), u_mat_opt(:,:,:)
- logical, allocatable :: lwindow(:,:)
- real(DP), allocatable :: wann_centers(:,:),wann_spreads(:)
- real(DP) :: spreads(3)
- real(DP), allocatable :: eigval(:,:)
- logical :: old_spinor_proj ! for compatability for nnkp files prior to W90v2.0
- integer,allocatable :: rir(:,:)
- logical,allocatable :: zerophase(:,:)
-end module wannier
-!
-
-
-!------------------------------------------------------------------------
-PROGRAM pw2wannier90
- ! This is the interface to the Wannier90 code: see http://www.wannier.org
- !------------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode, ionode_id
- USE mp_global, ONLY : mp_startup
- USE mp_pools, ONLY : npool
- USE mp, ONLY : mp_bcast
- USE mp_world, ONLY : world_comm
- USE cell_base, ONLY : at, bg
- USE lsda_mod, ONLY : nspin, isk
- USE klist, ONLY : nkstot
- USE io_files, ONLY : prefix, tmp_dir
- USE noncollin_module, ONLY : noncolin
- USE control_flags, ONLY : gamma_only
- USE environment,ONLY : environment_start, environment_end
- USE wannier
- !
- IMPLICIT NONE
- !
- CHARACTER(LEN=256), EXTERNAL :: trimcheck
- !
- INTEGER :: ios
- CHARACTER(len=4) :: spin_component
- CHARACTER(len=256) :: outdir
-
- ! these are in wannier module.....-> integer :: ispinw, ikstart, ikstop, iknum
- NAMELIST / inputpp / outdir, prefix, spin_component, wan_mode, &
- seedname, write_unk, write_amn, write_mmn, write_spn, write_eig,&
- ! begin change Lopez, Thonhauser, Souza
- wvfn_formatted, reduce_unk, write_unkg, write_uhu,&
- write_dmn, read_sym, & !YN:
- write_uIu, spn_formatted, uHu_formatted, uIu_formatted,& !ivo
- ! end change Lopez, Thonhauser, Souza
- regular_mesh,& !gresch
- ! begin change Vitale
- scdm_proj, scdm_entanglement, scdm_mu, scdm_sigma
- ! end change Vitale
- !
- ! initialise environment
- !
-#if defined(__MPI)
- CALL mp_startup ( )
-#endif
- !! not sure if this should be called also in 'library' mode or not !!
- CALL environment_start ( 'PW2WANNIER' )
- !
- CALL start_clock( 'init_pw2wan' )
- !
- ! Read input on i/o node and broadcast to the rest
- !
- ios = 0
- IF(ionode) THEN
- !
- ! Check to see if we are reading from a file
- !
- CALL input_from_file()
- !
- ! set default values for variables in namelist
- !
- CALL get_environment_variable( 'ESPRESSO_TMPDIR', outdir )
- IF ( trim( outdir ) == ' ' ) outdir = './'
- prefix = ' '
- seedname = 'wannier'
- spin_component = 'none'
- wan_mode = 'standalone'
- wvfn_formatted = .false.
- spn_formatted=.false.
- uHu_formatted=.false.
- uIu_formatted=.false.
- write_unk = .false.
- write_amn = .true.
- write_mmn = .true.
- write_spn = .false.
- write_eig = .true.
- ! begin change Lopez, Thonhauser, Souza
- write_uhu = .false.
- write_uIu = .false. !ivo
- ! end change Lopez, Thonhauser, Souza
- reduce_unk= .false.
- write_unkg= .false.
- write_dmn = .false. !YN:
- read_sym = .false. !YN:
- scdm_proj = .false.
- scdm_entanglement = 'isolated'
- scdm_mu = 0.0_dp
- scdm_sigma = 1.0_dp
- !
- ! reading the namelist inputpp
- !
- READ (5, inputpp, iostat=ios)
- !
- ! Check of namelist variables
- !
- tmp_dir = trimcheck(outdir)
- ! back to all nodes
- ENDIF
- !
- CALL mp_bcast(ios,ionode_id, world_comm)
- IF (ios /= 0) CALL errore( 'pw2wannier90', 'reading inputpp namelist', abs(ios))
- !
- ! broadcast input variable to all nodes
- !
- CALL mp_bcast(outdir,ionode_id, world_comm)
- CALL mp_bcast(tmp_dir,ionode_id, world_comm)
- CALL mp_bcast(prefix,ionode_id, world_comm)
- CALL mp_bcast(seedname,ionode_id, world_comm)
- CALL mp_bcast(spin_component,ionode_id, world_comm)
- CALL mp_bcast(wan_mode,ionode_id, world_comm)
- CALL mp_bcast(wvfn_formatted,ionode_id, world_comm)
- CALL mp_bcast(write_unk,ionode_id, world_comm)
- CALL mp_bcast(write_amn,ionode_id, world_comm)
- CALL mp_bcast(write_mmn,ionode_id, world_comm)
- CALL mp_bcast(write_eig,ionode_id, world_comm)
- ! begin change Lopez, Thonhauser, Souza
- CALL mp_bcast(write_uhu,ionode_id, world_comm)
- CALL mp_bcast(write_uIu,ionode_id, world_comm) !ivo
- ! end change Lopez, Thonhauser, Souza
- CALL mp_bcast(write_spn,ionode_id, world_comm)
- CALL mp_bcast(reduce_unk,ionode_id, world_comm)
- CALL mp_bcast(write_unkg,ionode_id, world_comm)
- CALL mp_bcast(write_dmn,ionode_id, world_comm)
- CALL mp_bcast(read_sym,ionode_id, world_comm)
- CALL mp_bcast(scdm_proj,ionode_id, world_comm)
- CALL mp_bcast(scdm_entanglement,ionode_id, world_comm)
- CALL mp_bcast(scdm_mu,ionode_id, world_comm)
- CALL mp_bcast(scdm_sigma,ionode_id, world_comm)
- !
- ! Check: kpoint distribution with pools not implemented
- !
- IF ( npool > 1 ) CALL errore( 'pw2wannier90', 'pools not implemented', npool )
- !
- ! Now allocate space for pwscf variables, read and check them.
- !
- logwann = .true.
- WRITE(stdout,*)
- WRITE(stdout,*) ' Reading nscf_save data'
- CALL read_file
- WRITE(stdout,*)
- !
- IF (noncolin.and.gamma_only) CALL errore('pw2wannier90',&
- 'Non-collinear and gamma_only not implemented',1)
- IF (noncolin.and.scdm_proj) CALL errore('pw2wannier90',&
- 'Non-collinear and SCDM not implemented',1)
- IF (gamma_only.and.scdm_proj) CALL errore('pw2wannier90',&
- 'Gamma_only and SCDM not implemented',1)
- IF (scdm_proj) then
- IF ((trim(scdm_entanglement) /= 'isolated') .AND. &
- (trim(scdm_entanglement) /= 'erfc') .AND. &
- (trim(scdm_entanglement) /= 'gaussian')) then
- call errore('pw2wannier90', &
- 'Can not recognize the choice for scdm_entanglement. ' &
- //'Valid options are: isolated, erfc and gaussian')
- ENDIF
- ENDIF
- IF (scdm_sigma <= 0._dp) &
- call errore('pw2wannier90','Sigma in the SCDM method must be positive.')
- !
- SELECT CASE ( trim( spin_component ) )
- CASE ( 'up' )
- WRITE(stdout,*) ' Spin CASE ( up )'
- ispinw = 1
- ikstart = 1
- ikstop = nkstot/2
- iknum = nkstot/2
- CASE ( 'down' )
- WRITE(stdout,*) ' Spin CASE ( down )'
- ispinw = 2
- ikstart = nkstot/2 + 1
- ikstop = nkstot
- iknum = nkstot/2
- CASE DEFAULT
- IF(noncolin) THEN
- WRITE(stdout,*) ' Spin CASE ( non-collinear )'
- ELSE
- WRITE(stdout,*) ' Spin CASE ( default = unpolarized )'
- ENDIF
- ispinw = 0
- ikstart = 1
- ikstop = nkstot
- iknum = nkstot
- END SELECT
- !
- CALL stop_clock( 'init_pw2wan' )
- !
- WRITE(stdout,*)
- WRITE(stdout,*) ' Wannier mode is: ',wan_mode
- WRITE(stdout,*)
- !
- IF(wan_mode=='standalone') THEN
- !
- WRITE(stdout,*) ' -----------------'
- WRITE(stdout,*) ' *** Reading nnkp '
- WRITE(stdout,*) ' -----------------'
- WRITE(stdout,*)
- CALL read_nnkp
- WRITE(stdout,*) ' Opening pp-files '
- CALL openfil_pp
- CALL ylm_expansion
- WRITE(stdout,*)
- WRITE(stdout,*)
- if(write_dmn)then
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*) ' *** Compute DMN '
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*)
- CALL compute_dmn !YN:
- WRITE(stdout,*)
- end if
- IF(write_amn) THEN
- IF(scdm_proj) THEN
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*) ' *** Compute A with SCDM-k'
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*)
- CALL compute_amn_with_scdm
- ELSE
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*) ' *** Compute A projections'
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*)
- CALL compute_amn
- ENDIF
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*) ' *** A matrix is not computed '
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*)
- ENDIF
- IF(write_mmn) THEN
- WRITE(stdout,*) ' ---------------'
- WRITE(stdout,*) ' *** Compute M '
- WRITE(stdout,*) ' ---------------'
- WRITE(stdout,*)
- CALL compute_mmn
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*) ' *** M matrix is not computed '
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*)
- ENDIF
- if(noncolin) then
- IF(write_spn) THEN
- WRITE(stdout,*) ' ------------------'
- WRITE(stdout,*) ' *** Compute Spin '
- WRITE(stdout,*) ' ------------------'
- WRITE(stdout,*)
- CALL compute_spin
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' --------------------------------'
- WRITE(stdout,*) ' *** Spin matrix is not computed '
- WRITE(stdout,*) ' --------------------------------'
- WRITE(stdout,*)
- ENDIF
- elseif(write_spn) then
- write(stdout,*) ' -----------------------------------'
- write(stdout,*) ' *** Non-collinear calculation is '
- write(stdout,*) ' required for spin '
- write(stdout,*) ' term to be computed '
- write(stdout,*) ' -----------------------------------'
- endif
- IF(write_uHu.or.write_uIu) THEN
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*) ' *** Compute Orb '
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*)
- CALL compute_orb
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------------'
- WRITE(stdout,*) ' *** Orbital terms are not computed '
- WRITE(stdout,*) ' -----------------------------------'
- WRITE(stdout,*)
- ENDIF
- IF(write_eig) THEN
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*) ' *** Write bands '
- WRITE(stdout,*) ' ----------------'
- WRITE(stdout,*)
- CALL write_band
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*) ' *** Bands are not written '
- WRITE(stdout,*) ' --------------------------'
- WRITE(stdout,*)
- ENDIF
- IF(write_unk) THEN
- WRITE(stdout,*) ' --------------------'
- WRITE(stdout,*) ' *** Write plot info '
- WRITE(stdout,*) ' --------------------'
- WRITE(stdout,*)
- CALL write_plot
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*) ' *** Plot info is not printed '
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*)
- ENDIF
- IF(write_unkg) THEN
- WRITE(stdout,*) ' --------------------'
- WRITE(stdout,*) ' *** Write parity info '
- WRITE(stdout,*) ' --------------------'
- WRITE(stdout,*)
- CALL write_parity
- WRITE(stdout,*)
- ELSE
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*) ' *** Parity info is not printed '
- WRITE(stdout,*) ' -----------------------------'
- WRITE(stdout,*)
- ENDIF
- WRITE(stdout,*) ' ------------'
- WRITE(stdout,*) ' *** Stop pp '
- WRITE(stdout,*) ' ------------'
- WRITE(stdout,*)
- !
- IF ( ionode ) WRITE( stdout, * )
- CALL print_clock( 'init_pw2wan' )
- if(write_dmn ) CALL print_clock( 'compute_dmn' )!YN:
- IF(write_amn ) CALL print_clock( 'compute_amn' )
- IF(write_mmn ) CALL print_clock( 'compute_mmn' )
- IF(write_unk ) CALL print_clock( 'write_unk' )
- IF(write_unkg ) CALL print_clock( 'write_parity' )
- !! not sure if this should be called also in 'library' mode or not !!
- CALL environment_end ( 'PW2WANNIER' )
- IF ( ionode ) WRITE( stdout, * )
- CALL stop_pp
- !
- ENDIF
- !
- IF(wan_mode=='library') THEN
- !
-! seedname='wannier'
- WRITE(stdout,*) ' Setting up...'
- CALL setup_nnkp
- WRITE(stdout,*)
- WRITE(stdout,*) ' Opening pp-files '
- CALL openfil_pp
- WRITE(stdout,*)
- WRITE(stdout,*) ' Ylm expansion'
- CALL ylm_expansion
- WRITE(stdout,*)
- CALL compute_amn
- CALL compute_mmn
- if(noncolin) then
- IF(write_spn) THEN
- CALL compute_spin
- ENDIF
- ENDIF
- IF(write_uHu.or.write_uIu) THEN
- CALL compute_orb
- ENDIF
- CALL write_band
- IF(write_unk) CALL write_plot
- IF(write_unkg) THEN
- CALL write_parity
- ENDIF
- CALL run_wannier
- CALL lib_dealloc
- CALL stop_pp
- !
- ENDIF
- !
- IF(wan_mode=='wannier2sic') THEN
- !
- CALL read_nnkp
- CALL wan2sic
- !
- ENDIF
- !
- STOP
-END PROGRAM pw2wannier90
-!
-!-----------------------------------------------------------------------
-SUBROUTINE lib_dealloc
- !-----------------------------------------------------------------------
- !
- USE wannier
-
- IMPLICIT NONE
-
- DEALLOCATE(m_mat,u_mat,u_mat_opt,a_mat,eigval)
-
- RETURN
-END SUBROUTINE lib_dealloc
-!
-!-----------------------------------------------------------------------
-SUBROUTINE setup_nnkp
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode, ionode_id
- USE kinds, ONLY : DP
- USE constants, ONLY : eps6, tpi, bohr => BOHR_RADIUS_ANGS
- USE cell_base, ONLY : at, bg, alat
- USE gvect, ONLY : g, gg
- USE ions_base, ONLY : nat, tau, ityp, atm
- USE klist, ONLY : xk
- USE mp, ONLY : mp_bcast, mp_sum
- USE mp_pools, ONLY : intra_pool_comm
- USE mp_world, ONLY : world_comm
- USE wvfct, ONLY : nbnd,npwx
- USE control_flags, ONLY : gamma_only
- USE noncollin_module, ONLY : noncolin
- USE wannier
-
- IMPLICIT NONE
- real(DP) :: g_(3), gg_
- INTEGER :: ik, ib, ig, iw, ia, indexb, TYPE
- INTEGER, ALLOCATABLE :: ig_check(:,:)
- real(DP) :: xnorm, znorm, coseno
- INTEGER :: exclude_bands(nbnd)
-
- ! aam: translations between PW2Wannier90 and Wannier90
- ! pw2wannier90 <==> Wannier90
- ! nbnd num_bands_tot
- ! n_wannier num_wann
- ! num_bands num_bands
- ! nat num_atoms
- ! iknum num_kpts
- ! rlatt transpose(real_lattice)
- ! glatt transpose(recip_lattice)
- ! kpt_latt kpt_latt
- ! nnb nntot
- ! kpb nnlist
- ! g_kpb nncell
- ! mp_grid mp_grid
- ! center_w proj_site
- ! l_w,mr_w,r_w proj_l,proj_m,proj_radial
- ! xaxis,zaxis proj_x,proj_z
- ! alpha_w proj_zona
- ! exclude_bands exclude_bands
- ! atcart atoms_cart
- ! atsym atom_symbols
-
- ALLOCATE( kpt_latt(3,iknum) )
- ALLOCATE( atcart(3,nat), atsym(nat) )
- ALLOCATE( kpb(iknum,num_nnmax), g_kpb(3,iknum,num_nnmax) )
- ALLOCATE( center_w(3,nbnd), alpha_w(nbnd), l_w(nbnd), &
- mr_w(nbnd), r_w(nbnd), zaxis(3,nbnd), xaxis(3,nbnd) )
- ALLOCATE( excluded_band(nbnd) )
-
- ! real lattice (Cartesians, Angstrom)
- rlatt(:,:) = transpose(at(:,:))*alat*bohr
- ! reciprocal lattice (Cartesians, Angstrom)
- glatt(:,:) = transpose(bg(:,:))*tpi/(alat*bohr)
- ! convert Cartesian k-points to crystallographic co-ordinates
- kpt_latt(:,1:iknum)=xk(:,1:iknum)
- CALL cryst_to_cart(iknum,kpt_latt,at,-1)
- ! atom co-ordinates in Cartesian co-ords and Angstrom units
- atcart(:,:) = tau(:,:)*bohr*alat
- ! atom symbols
- DO ia=1,nat
- TYPE=ityp(ia)
- atsym(ia)=atm(TYPE)
- ENDDO
-
- ! MP grid dimensions
- CALL find_mp_grid()
-
- WRITE(stdout,'(" - Number of atoms is (",i3,")")') nat
-
-#if defined(__WANLIB)
- IF (ionode) THEN
- CALL wannier_setup(seedname,mp_grid,iknum,rlatt, & ! input
- glatt,kpt_latt,nbnd,nat,atsym,atcart,gamma_only,noncolin, & ! input
- nnb,kpb,g_kpb,num_bands,n_wannier,center_w, & ! output
- l_w,mr_w,r_w,zaxis,xaxis,alpha_w,exclude_bands) ! output
- ENDIF
-#endif
-
- CALL mp_bcast(nnb,ionode_id, world_comm)
- CALL mp_bcast(kpb,ionode_id, world_comm)
- CALL mp_bcast(g_kpb,ionode_id, world_comm)
- CALL mp_bcast(num_bands,ionode_id, world_comm)
- CALL mp_bcast(n_wannier,ionode_id, world_comm)
- CALL mp_bcast(center_w,ionode_id, world_comm)
- CALL mp_bcast(l_w,ionode_id, world_comm)
- CALL mp_bcast(mr_w,ionode_id, world_comm)
- CALL mp_bcast(r_w,ionode_id, world_comm)
- CALL mp_bcast(zaxis,ionode_id, world_comm)
- CALL mp_bcast(xaxis,ionode_id, world_comm)
- CALL mp_bcast(alpha_w,ionode_id, world_comm)
- CALL mp_bcast(exclude_bands,ionode_id, world_comm)
-
- IF(noncolin) THEN
- n_proj=n_wannier/2
- ELSE
- n_proj=n_wannier
- ENDIF
-
- ALLOCATE( gf(npwx,n_proj), csph(16,n_proj) )
-
- WRITE(stdout,'(" - Number of wannier functions is (",i3,")")') n_wannier
-
- excluded_band(1:nbnd)=.false.
- nexband=0
- band_loop: DO ib=1,nbnd
- indexb=exclude_bands(ib)
- IF (indexb>nbnd .or. indexb<0) THEN
- CALL errore('setup_nnkp',' wrong excluded band index ', 1)
- ELSEIF (indexb==0) THEN
- exit band_loop
- ELSE
- nexband=nexband+1
- excluded_band(indexb)=.true.
- ENDIF
- ENDDO band_loop
-
- IF ( (nbnd-nexband)/=num_bands ) &
- CALL errore('setup_nnkp',' something wrong with num_bands',1)
-
- DO iw=1,n_proj
- xnorm = sqrt(xaxis(1,iw)*xaxis(1,iw) + xaxis(2,iw)*xaxis(2,iw) + &
- xaxis(3,iw)*xaxis(3,iw))
- IF (xnorm < eps6) CALL errore ('setup_nnkp',' |xaxis| < eps ',1)
- znorm = sqrt(zaxis(1,iw)*zaxis(1,iw) + zaxis(2,iw)*zaxis(2,iw) + &
- zaxis(3,iw)*zaxis(3,iw))
- IF (znorm < eps6) CALL errore ('setup_nnkp',' |zaxis| < eps ',1)
- coseno = (xaxis(1,iw)*zaxis(1,iw) + xaxis(2,iw)*zaxis(2,iw) + &
- xaxis(3,iw)*zaxis(3,iw))/xnorm/znorm
- IF (abs(coseno) > eps6) &
- CALL errore('setup_nnkp',' xaxis and zaxis are not orthogonal !',1)
- IF (alpha_w(iw) < eps6) &
- CALL errore('setup_nnkp',' zona value must be positive', 1)
- ! convert wannier center in cartesian coordinates (in unit of alat)
- CALL cryst_to_cart( 1, center_w(:,iw), at, 1 )
- ENDDO
- WRITE(stdout,*) ' - All guiding functions are given '
-
- nnbx=0
- nnb=max(nnbx,nnb)
-
- ALLOCATE( ig_(iknum,nnb), ig_check(iknum,nnb) )
- ALLOCATE( zerophase(iknum,nnb) )
- zerophase = .false.
-
- DO ik=1, iknum
- DO ib = 1, nnb
- IF ( (g_kpb(1,ik,ib).eq.0) .and. &
- (g_kpb(2,ik,ib).eq.0) .and. &
- (g_kpb(3,ik,ib).eq.0) ) zerophase(ik,ib) = .true.
- g_(:) = REAL( g_kpb(:,ik,ib) )
- CALL cryst_to_cart (1, g_, bg, 1)
- gg_ = g_(1)*g_(1) + g_(2)*g_(2) + g_(3)*g_(3)
- ig_(ik,ib) = 0
- ig = 1
- DO WHILE (gg(ig) <= gg_ + eps6)
- IF ( (abs(g(1,ig)-g_(1)) < eps6) .and. &
- (abs(g(2,ig)-g_(2)) < eps6) .and. &
- (abs(g(3,ig)-g_(3)) < eps6) ) ig_(ik,ib) = ig
- ig= ig +1
- ENDDO
- ENDDO
- ENDDO
-
- ig_check(:,:) = ig_(:,:)
- CALL mp_sum( ig_check, intra_pool_comm )
- DO ik=1, iknum
- DO ib = 1, nnb
- IF (ig_check(ik,ib) ==0) &
- CALL errore('setup_nnkp', &
- ' g_kpb vector is not in the list of Gs', 100*ik+ib )
- ENDDO
- ENDDO
- DEALLOCATE (ig_check)
-
- WRITE(stdout,*) ' - All neighbours are found '
- WRITE(stdout,*)
-
- RETURN
-END SUBROUTINE setup_nnkp
- !
- !-----------------------------------------------------------------------
-SUBROUTINE run_wannier
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : ionode, ionode_id
- USE ions_base, ONLY : nat
- USE mp, ONLY : mp_bcast
- USE mp_world, ONLY : world_comm
- USE control_flags, ONLY : gamma_only
- USE wannier
-
- IMPLICIT NONE
-
- ALLOCATE(u_mat(n_wannier,n_wannier,iknum))
- ALLOCATE(u_mat_opt(num_bands,n_wannier,iknum))
- ALLOCATE(lwindow(num_bands,iknum))
- ALLOCATE(wann_centers(3,n_wannier))
- ALLOCATE(wann_spreads(n_wannier))
-
-#if defined(__WANLIB)
- IF (ionode) THEN
- CALL wannier_run(seedname,mp_grid,iknum,rlatt, & ! input
- glatt,kpt_latt,num_bands,n_wannier,nnb,nat, & ! input
- atsym,atcart,gamma_only,m_mat,a_mat,eigval, & ! input
- u_mat,u_mat_opt,lwindow,wann_centers,wann_spreads,spreads) ! output
- ENDIF
-#endif
-
- CALL mp_bcast(u_mat,ionode_id, world_comm)
- CALL mp_bcast(u_mat_opt,ionode_id, world_comm)
- CALL mp_bcast(lwindow,ionode_id, world_comm)
- CALL mp_bcast(wann_centers,ionode_id, world_comm)
- CALL mp_bcast(wann_spreads,ionode_id, world_comm)
- CALL mp_bcast(spreads,ionode_id, world_comm)
-
- RETURN
-END SUBROUTINE run_wannier
-!-----------------------------------------------------------------------
-!
-SUBROUTINE find_mp_grid()
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout
- USE kinds, ONLY: DP
- USE wannier
-
- IMPLICIT NONE
-
- ! <<>>
- INTEGER :: ik,ntemp,ii
- real(DP) :: min_k,temp(3,iknum),mpg1
-
- min_k=minval(kpt_latt(1,:))
- ii=0
- DO ik=1,iknum
- IF (kpt_latt(1,ik)==min_k) THEN
- ii=ii+1
- temp(:,ii)=kpt_latt(:,ik)
- ENDIF
- ENDDO
- ntemp=ii
-
- min_k=minval(temp(2,1:ntemp))
- ii=0
- DO ik=1,ntemp
- IF (temp(2,ik)==min_k) THEN
- ii=ii+1
- ENDIF
- ENDDO
- mp_grid(3)=ii
-
- min_k=minval(temp(3,1:ntemp))
- ii=0
- DO ik=1,ntemp
- IF (temp(3,ik)==min_k) THEN
- ii=ii+1
- ENDIF
- ENDDO
- mp_grid(2)=ii
-
- IF ( (mp_grid(2)==0) .or. (mp_grid(3)==0) ) &
- CALL errore('find_mp_grid',' one or more mp_grid dimensions is zero', 1)
-
- mpg1=iknum/(mp_grid(2)*mp_grid(3))
-
- mp_grid(1) = nint(mpg1)
-
- WRITE(stdout,*)
- WRITE(stdout,'(3(a,i3))') ' MP grid is ',mp_grid(1),' x',mp_grid(2),' x',mp_grid(3)
-
- IF (real(mp_grid(1),kind=DP)/=mpg1) &
- CALL errore('find_mp_grid',' determining mp_grid failed', 1)
-
- RETURN
-END SUBROUTINE find_mp_grid
-!-----------------------------------------------------------------------
-!
-SUBROUTINE read_nnkp
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode, ionode_id
- USE kinds, ONLY: DP
- USE constants, ONLY : eps6, tpi, bohr => BOHR_RADIUS_ANGS
- USE cell_base, ONLY : at, bg, alat
- USE gvect, ONLY : g, gg
- USE klist, ONLY : nkstot, xk
- USE mp, ONLY : mp_bcast, mp_sum
- USE mp_pools, ONLY : intra_pool_comm
- USE mp_world, ONLY : world_comm
- USE wvfct, ONLY : npwx, nbnd
- USE noncollin_module, ONLY : noncolin
- USE wannier
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- real(DP) :: g_(3), gg_
- INTEGER :: ik, ib, ig, ipol, iw, idum, indexb
- INTEGER numk, i, j
- INTEGER, ALLOCATABLE :: ig_check(:,:)
- real(DP) :: xx(3), xnorm, znorm, coseno
- LOGICAL :: have_nnkp,found
- INTEGER :: tmp_auto ! vv: Needed for the selection of projections with SCDM
-
- IF (ionode) THEN ! Read nnkp file on ionode only
-
- INQUIRE(file=trim(seedname)//".nnkp",exist=have_nnkp)
- IF(.not. have_nnkp) THEN
- CALL errore( 'pw2wannier90', 'Could not find the file '&
- &//trim(seedname)//'.nnkp', 1 )
- ENDIF
-
- iun_nnkp = find_free_unit()
- OPEN (unit=iun_nnkp, file=trim(seedname)//".nnkp",form='formatted', status="old")
-
- ENDIF
-
- nnbx=0
-
- ! check the information from *.nnkp with the nscf_save data
- WRITE(stdout,*) ' Checking info from wannier.nnkp file'
- WRITE(stdout,*)
-
- IF (ionode) THEN ! read from ionode only
-
- CALL scan_file_to('real_lattice',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find real_lattice block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- DO j=1,3
- READ(iun_nnkp,*) (rlatt(i,j),i=1,3)
- DO i = 1,3
- rlatt(i,j) = rlatt(i,j)/(alat*bohr)
- ENDDO
- ENDDO
- DO j=1,3
- DO i=1,3
- IF(abs(rlatt(i,j)-at(i,j))>eps6) THEN
- WRITE(stdout,*) ' Something wrong! '
- WRITE(stdout,*) ' rlatt(i,j) =',rlatt(i,j), ' at(i,j)=',at(i,j)
- CALL errore( 'pw2wannier90', 'Direct lattice mismatch', 3*j+i )
- ENDIF
- ENDDO
- ENDDO
- WRITE(stdout,*) ' - Real lattice is ok'
-
- CALL scan_file_to('recip_lattice',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find recip_lattice block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- DO j=1,3
- READ(iun_nnkp,*) (glatt(i,j),i=1,3)
- DO i = 1,3
- glatt(i,j) = (alat*bohr)*glatt(i,j)/tpi
- ENDDO
- ENDDO
- DO j=1,3
- DO i=1,3
- IF(abs(glatt(i,j)-bg(i,j))>eps6) THEN
- WRITE(stdout,*) ' Something wrong! '
- WRITE(stdout,*) ' glatt(i,j)=',glatt(i,j), ' bg(i,j)=',bg(i,j)
- CALL errore( 'pw2wannier90', 'Reciprocal lattice mismatch', 3*j+i )
- ENDIF
- ENDDO
- ENDDO
- WRITE(stdout,*) ' - Reciprocal lattice is ok'
-
- CALL scan_file_to('kpoints',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find kpoints block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- READ(iun_nnkp,*) numk
- IF(numk/=iknum) THEN
- WRITE(stdout,*) ' Something wrong! '
- WRITE(stdout,*) ' numk=',numk, ' iknum=',iknum
- CALL errore( 'pw2wannier90', 'Wrong number of k-points', numk)
- ENDIF
- IF(regular_mesh) THEN
- DO i=1,numk
- READ(iun_nnkp,*) xx(1), xx(2), xx(3)
- CALL cryst_to_cart( 1, xx, bg, 1 )
- IF(abs(xx(1)-xk(1,i))>eps6.or. &
- abs(xx(2)-xk(2,i))>eps6.or. &
- abs(xx(3)-xk(3,i))>eps6) THEN
- WRITE(stdout,*) ' Something wrong! '
- WRITE(stdout,*) ' k-point ',i,' is wrong'
- WRITE(stdout,*) xx(1), xx(2), xx(3)
- WRITE(stdout,*) xk(1,i), xk(2,i), xk(3,i)
- CALL errore( 'pw2wannier90', 'problems with k-points', i )
- ENDIF
- ENDDO
- ENDIF ! regular mesh check
- WRITE(stdout,*) ' - K-points are ok'
-
- ENDIF ! ionode
-
- ! Broadcast
- CALL mp_bcast(rlatt,ionode_id, world_comm)
- CALL mp_bcast(glatt,ionode_id, world_comm)
-
- IF (ionode) THEN ! read from ionode only
- if(noncolin) then
- old_spinor_proj=.false.
- CALL scan_file_to('spinor_projections',found)
- if(.not.found) then
- !try old style projections
- CALL scan_file_to('projections',found)
- if(found) then
- old_spinor_proj=.true.
- else
- CALL errore( 'pw2wannier90', 'Could not find projections block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- end if
- else
- old_spinor_proj=.false.
- CALL scan_file_to('projections',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find projections block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- endif
- READ(iun_nnkp,*) n_proj
- ENDIF
-
- ! Broadcast
- CALL mp_bcast(n_proj,ionode_id, world_comm)
- CALL mp_bcast(old_spinor_proj,ionode_id, world_comm)
-
- IF(old_spinor_proj)THEN
- WRITE(stdout,'(//," ****** begin WARNING ****** ",/)')
- WRITE(stdout,'(" The pw.x calculation was done with non-collinear spin ")')
- WRITE(stdout,'(" but spinor = T was not specified in the wannier90 .win file!")')
- WRITE(stdout,'(" Please set spinor = T and rerun wannier90.x -pp ")')
-! WRITE(stdout,'(/," If you are trying to reuse an old nnkp file, you can remove ")')
-! WRITE(stdout,'(" this check from pw2wannir90.f90 line 870, and recompile. ")')
- WRITE(stdout,'(/," ****** end WARNING ****** ",//)')
-! CALL errore("pw2wannier90","Spinorbit without spinor=T",1)
- ENDIF
-
- ! It is not clear if the next instruction is required or not, it probably depend
- ! on the version of wannier90 that was used to generate the nnkp file:
- IF(old_spinor_proj) THEN
- n_wannier=n_proj*2
- ELSE
- n_wannier=n_proj
- ENDIF
-
- ALLOCATE( center_w(3,n_proj), alpha_w(n_proj), gf(npwx,n_proj), &
- l_w(n_proj), mr_w(n_proj), r_w(n_proj), &
- zaxis(3,n_proj), xaxis(3,n_proj), csph(16,n_proj) )
- if(noncolin.and..not.old_spinor_proj) then
- ALLOCATE( spin_eig(n_proj),spin_qaxis(3,n_proj) )
- endif
-
- IF (ionode) THEN ! read from ionode only
- DO iw=1,n_proj
- READ(iun_nnkp,*) (center_w(i,iw), i=1,3), l_w(iw), mr_w(iw), r_w(iw)
- READ(iun_nnkp,*) (zaxis(i,iw),i=1,3),(xaxis(i,iw),i=1,3),alpha_w(iw)
- xnorm = sqrt(xaxis(1,iw)*xaxis(1,iw) + xaxis(2,iw)*xaxis(2,iw) + &
- xaxis(3,iw)*xaxis(3,iw))
- IF (xnorm < eps6) CALL errore ('read_nnkp',' |xaxis| < eps ',1)
- znorm = sqrt(zaxis(1,iw)*zaxis(1,iw) + zaxis(2,iw)*zaxis(2,iw) + &
- zaxis(3,iw)*zaxis(3,iw))
- IF (znorm < eps6) CALL errore ('read_nnkp',' |zaxis| < eps ',1)
- coseno = (xaxis(1,iw)*zaxis(1,iw) + xaxis(2,iw)*zaxis(2,iw) + &
- xaxis(3,iw)*zaxis(3,iw))/xnorm/znorm
- IF (abs(coseno) > eps6) &
- CALL errore('read_nnkp',' xaxis and zaxis are not orthogonal !',1)
- IF (alpha_w(iw) < eps6) &
- CALL errore('read_nnkp',' zona value must be positive', 1)
- ! convert wannier center in cartesian coordinates (in unit of alat)
- CALL cryst_to_cart( 1, center_w(:,iw), at, 1 )
- if(noncolin.and..not.old_spinor_proj) then
- READ(iun_nnkp,*) spin_eig(iw),(spin_qaxis(i,iw),i=1,3)
- xnorm = sqrt(spin_qaxis(1,iw)*spin_qaxis(1,iw) + spin_qaxis(2,iw)*spin_qaxis(2,iw) + &
- spin_qaxis(3,iw)*spin_qaxis(3,iw))
- IF (xnorm < eps6) CALL errore ('read_nnkp',' |xaxis| < eps ',1)
- spin_qaxis(:,iw)=spin_qaxis(:,iw)/xnorm
- endif
- ENDDO
- ENDIF
-
- ! automatic projections
- IF (ionode) THEN
- CALL scan_file_to('auto_projections',found)
- IF (found) THEN
- READ (iun_nnkp, *) n_wannier
- READ (iun_nnkp, *) tmp_auto
-
- IF (scdm_proj) THEN
- IF (n_proj > 0) THEN
- WRITE(stdout,'(//, " ****** begin Error message ******",/)')
- WRITE(stdout,'(/," Found a projection block, an auto_projections block",/)')
- WRITE(stdout,'(/," and scdm_proj = T in the input file. These three options are inconsistent.",/)')
- WRITE(stdout,'(/," Please refer to the Wannier90 User guide for correct use of these flags.",/)')
- WRITE(stdout,'(/, " ****** end Error message ******",//)')
- CALL errore( 'pw2wannier90', 'Inconsistent options for projections.', 1 )
- ELSE
- IF (tmp_auto /= 0) CALL errore( 'pw2wannier90', 'Second entry in auto_projections block is not 0. ' // &
- 'See Wannier90 User Guide in the auto_projections section for clarifications.', 1 )
- ENDIF
- ELSE
- ! Fire an error whether or not a projections block is found
- CALL errore( 'pw2wannier90', 'scdm_proj = F but found an auto_projections block in '&
- &//trim(seedname)//'.nnkp', 1 )
- ENDIF
- ELSE
- IF (scdm_proj) THEN
- ! Fire an error whether or not a projections block is found
- CALL errore( 'pw2wannier90', 'scdm_proj = T but cannot find an auto_projections block in '&
- &//trim(seedname)//'.nnkp', 1 )
- ENDIF
- ENDIF
- ENDIF
-
- ! Broadcast
- CALL mp_bcast(n_wannier,ionode_id, world_comm)
- CALL mp_bcast(center_w,ionode_id, world_comm)
- CALL mp_bcast(l_w,ionode_id, world_comm)
- CALL mp_bcast(mr_w,ionode_id, world_comm)
- CALL mp_bcast(r_w,ionode_id, world_comm)
- CALL mp_bcast(zaxis,ionode_id, world_comm)
- CALL mp_bcast(xaxis,ionode_id, world_comm)
- CALL mp_bcast(alpha_w,ionode_id, world_comm)
- if(noncolin.and..not.old_spinor_proj) then
- CALL mp_bcast(spin_eig,ionode_id, world_comm)
- CALL mp_bcast(spin_qaxis,ionode_id, world_comm)
- end if
-
- WRITE(stdout,'(" - Number of wannier functions is ok (",i3,")")') n_wannier
-
- IF (.not. scdm_proj) WRITE(stdout,*) ' - All guiding functions are given '
- !
- WRITE(stdout,*)
- WRITE(stdout,*) 'Projections:'
- DO iw=1,n_proj
- WRITE(stdout,'(3f12.6,3i3,f12.6)') &
- center_w(1:3,iw),l_w(iw),mr_w(iw),r_w(iw),alpha_w(iw)
- ENDDO
-
- IF (ionode) THEN ! read from ionode only
- CALL scan_file_to('nnkpts',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find nnkpts block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- READ (iun_nnkp,*) nnb
- ENDIF
-
- ! Broadcast
- CALL mp_bcast(nnb,ionode_id, world_comm)
- !
- nnbx = max (nnbx, nnb )
- !
- ALLOCATE ( kpb(iknum,nnbx), g_kpb(3,iknum,nnbx),&
- ig_(iknum,nnbx), ig_check(iknum,nnbx) )
- ALLOCATE( zerophase(iknum,nnbx) )
- zerophase = .false.
-
- ! read data about neighbours
- WRITE(stdout,*)
- WRITE(stdout,*) ' Reading data about k-point neighbours '
- WRITE(stdout,*)
-
- IF (ionode) THEN
- DO ik=1, iknum
- DO ib = 1, nnb
- READ(iun_nnkp,*) idum, kpb(ik,ib), (g_kpb(ipol,ik,ib), ipol =1,3)
- ENDDO
- ENDDO
- ENDIF
-
- ! Broadcast
- CALL mp_bcast(kpb,ionode_id, world_comm)
- CALL mp_bcast(g_kpb,ionode_id, world_comm)
-
- DO ik=1, iknum
- DO ib = 1, nnb
- IF ( (g_kpb(1,ik,ib).eq.0) .and. &
- (g_kpb(2,ik,ib).eq.0) .and. &
- (g_kpb(3,ik,ib).eq.0) ) zerophase(ik,ib) = .true.
- g_(:) = REAL( g_kpb(:,ik,ib) )
- CALL cryst_to_cart (1, g_, bg, 1)
- gg_ = g_(1)*g_(1) + g_(2)*g_(2) + g_(3)*g_(3)
- ig_(ik,ib) = 0
- ig = 1
- DO WHILE (gg(ig) <= gg_ + eps6)
- IF ( (abs(g(1,ig)-g_(1)) < eps6) .and. &
- (abs(g(2,ig)-g_(2)) < eps6) .and. &
- (abs(g(3,ig)-g_(3)) < eps6) ) ig_(ik,ib) = ig
- ig= ig +1
- ENDDO
- ENDDO
- ENDDO
- ig_check(:,:) = ig_(:,:)
- CALL mp_sum( ig_check, intra_pool_comm )
- DO ik=1, iknum
- DO ib = 1, nnb
- IF (ig_check(ik,ib) ==0) &
- CALL errore('read_nnkp', &
- ' g_kpb vector is not in the list of Gs', 100*ik+ib )
- ENDDO
- ENDDO
- DEALLOCATE (ig_check)
-
- WRITE(stdout,*) ' All neighbours are found '
- WRITE(stdout,*)
-
- ALLOCATE( excluded_band(nbnd) )
-
- IF (ionode) THEN ! read from ionode only
- CALL scan_file_to('exclude_bands',found)
- if(.not.found) then
- CALL errore( 'pw2wannier90', 'Could not find exclude_bands block in '&
- &//trim(seedname)//'.nnkp', 1 )
- endif
- READ (iun_nnkp,*) nexband
- excluded_band(1:nbnd)=.false.
- DO i=1,nexband
- READ(iun_nnkp,*) indexb
- IF (indexb<1 .or. indexb>nbnd) &
- CALL errore('read_nnkp',' wrong excluded band index ', 1)
- excluded_band(indexb)=.true.
- ENDDO
- ENDIF
- num_bands=nbnd-nexband
-
- ! Broadcast
- CALL mp_bcast(nexband,ionode_id, world_comm)
- CALL mp_bcast(excluded_band,ionode_id, world_comm)
- CALL mp_bcast(num_bands,ionode_id, world_comm)
-
- IF (ionode) CLOSE (iun_nnkp) ! ionode only
-
- RETURN
-END SUBROUTINE read_nnkp
-!
-!-----------------------------------------------------------------------
-SUBROUTINE scan_file_to (keyword,found)
- !-----------------------------------------------------------------------
- !
- USE wannier, ONLY :iun_nnkp
- USE io_global, ONLY : stdout
- IMPLICIT NONE
- CHARACTER(len=*), intent(in) :: keyword
- logical, intent(out) :: found
- CHARACTER(len=80) :: line1, line2
-!
-! by uncommenting the following line the file scan restarts every time
-! from the beginning thus making the reading independent on the order
-! of data-blocks
-! rewind (iun_nnkp)
-!
-10 CONTINUE
- READ(iun_nnkp,*,end=20) line1, line2
- IF(line1/='begin') GOTO 10
- IF(line2/=keyword) GOTO 10
- found=.true.
- RETURN
-20 found=.false.
- rewind (iun_nnkp)
-
-END SUBROUTINE scan_file_to
-!
-!-----------------------------------------------------------------------
-SUBROUTINE pw2wan_set_symm (nsym, sr, tvec)
- !-----------------------------------------------------------------------
- !
- ! Uses nkqs and index_sym from module pw2wan, computes rir
- !
- USE symm_base, ONLY : s, ftau, allfrac
- USE fft_base, ONLY : dffts
- USE cell_base, ONLY : at, bg
- USE wannier, ONLY : rir, read_sym
- USE kinds, ONLY : DP
- USE io_global, ONLY : stdout
- !
- IMPLICIT NONE
- !
- INTEGER , intent(in) :: nsym
- REAL(DP) , intent(in) :: sr(3,3,nsym), tvec(3,nsym)
- REAL(DP) :: st(3,3), v(3)
- INTEGER, allocatable :: s_in(:,:,:), ftau_in(:,:)
- !REAL(DP), allocatable:: ftau_in(:,:)
- INTEGER :: nxxs, nr1,nr2,nr3, nr1x,nr2x,nr3x
- INTEGER :: ikq, isym, i,j,k, ri,rj,rk, ir
- LOGICAL :: ispresent(nsym)
- !
- nr1 = dffts%nr1
- nr2 = dffts%nr2
- nr3 = dffts%nr3
- nr1x= dffts%nr1x
- nr2x= dffts%nr2x
- nr3x= dffts%nr3x
- nxxs = nr1x*nr2x*nr3x
- !
- ! sr -> s
- ALLOCATE(s_in(3,3,nsym), ftau_in(3,nsym))
- IF(read_sym ) THEN
- IF(allfrac) THEN
- call errore("pw2wan_set_symm", "use_all_frac = .true. + read_sym = .true. not supported", 1)
- END IF
- DO isym = 1, nsym
- !st = transpose( matmul(transpose(bg), sr(:,:,isym)) )
- st = transpose( matmul(transpose(bg), transpose(sr(:,:,isym))) )
- s_in(:,:,isym) = nint( matmul(transpose(at), st) )
- v = matmul(transpose(bg), tvec(:,isym))
- ftau_in(1,isym) = nint(v(1)*nr1)
- ftau_in(2,isym) = nint(v(2)*nr2)
- ftau_in(3,isym) = nint(v(3)*nr3)
- END DO
- IF( any(s(:,:,1:nsym) /= s_in(:,:,1:nsym)) .or. any(ftau_in(:,1:nsym) /= ftau(:,1:nsym)) ) THEN
- write(stdout,*) " Input symmetry is different from crystal symmetry"
- write(stdout,*)
- END IF
- ELSE
- s_in = s(:,:,1:nsym)
- ftau_in = ftau(:,1:nsym)
- END IF
- !
- IF(.not. allocated(rir)) ALLOCATE(rir(nxxs,nsym))
- rir = 0
- ispresent(1:nsym) = .false.
-
- DO isym = 1, nsym
- IF ( mod(s_in(2, 1, isym) * nr1, nr2) /= 0 .or. &
- mod(s_in(3, 1, isym) * nr1, nr3) /= 0 .or. &
- mod(s_in(1, 2, isym) * nr2, nr1) /= 0 .or. &
- mod(s_in(3, 2, isym) * nr2, nr3) /= 0 .or. &
- mod(s_in(1, 3, isym) * nr3, nr1) /= 0 .or. &
- mod(s_in(2, 3, isym) * nr3, nr2) /= 0 ) THEN
- CALL errore ('pw2waninit',' smooth grid is not compatible with &
- & symmetry: change cutoff',isym)
- ENDIF
- DO ir=1, nxxs
- rir(ir,isym) = ir
- ENDDO
- DO k = 1, nr3
- DO j = 1, nr2
- DO i = 1, nr1
- CALL ruotaijk (s_in(:,:,isym), (/0,0,0/), i,j,k, nr1,nr2,nr3, ri,rj,rk)
- !
- ir = i + ( j-1)*nr1x + ( k-1)*nr1x*nr2x
- rir(ir,isym) = ri + (rj-1)*nr1x + (rk-1)*nr1x*nr2x
- ENDDO
- ENDDO
- ENDDO
- ENDDO
- DEALLOCATE(s_in, ftau_in)
-END SUBROUTINE pw2wan_set_symm
-
-!-----------------------------------------------------------------------
-SUBROUTINE compute_dmn
- !Calculate d_matrix_wann/band for site-symmetry mode given by Rei Sakuma.
- !Contributions for this subroutine:
- ! Yoshiro Nohara (June to July, 2016)
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode, ionode_id
- USE kinds, ONLY: DP
- USE wvfct, ONLY : nbnd, npwx
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc, psic, psic_nc
- USE fft_base, ONLY : dffts, dfftp
- USE fft_interfaces, ONLY : fwfft, invfft
- USE klist, ONLY : nkstot, xk, igk_k, ngk
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE cell_base, ONLY : omega, alat, tpiba, at, bg
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE constants, ONLY : tpi, bohr => BOHR_RADIUS_ANGS
- USE uspp, ONLY : nkb, vkb
- USE uspp_param, ONLY : upf, nh, lmaxq, nhm
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum, mp_bcast
- USE mp_world, ONLY : world_comm
- USE noncollin_module,ONLY : noncolin, npol
- USE gvecw, ONLY : gcutw
- USE wannier
- USE symm_base, ONLY : nsymin=>nsym,srin=>sr,ftin=>ft,invsin=>invs
- USE fft_base, ONLY : dffts
- USE scatter_mod, ONLY : gather_grid, scatter_grid
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
- !
- real(DP), parameter :: p12(3,12)=reshape( &
- (/0d0, 0d0, 1.00000000000000d0, &
- 0.894427190999916d0, 0d0, 0.447213595499958d0, &
- 0.276393202250021d0, 0.850650808352040d0, 0.447213595499958d0, &
- -0.723606797749979d0, 0.525731112119134d0, 0.447213595499958d0, &
- -0.723606797749979d0, -0.525731112119134d0, 0.447213595499958d0, &
- 0.276393202250021d0, -0.850650808352040d0, 0.447213595499958d0, &
- 0.723606797749979d0, 0.525731112119134d0, -0.447213595499958d0, &
- -0.276393202250021d0, 0.850650808352040d0, -0.447213595499958d0, &
- -0.894427190999916d0, 0d0, -0.447213595499958d0, &
- -0.276393202250021d0, -0.850650808352040d0, -0.447213595499958d0,&
- 0.723606797749979d0, -0.525731112119134d0, -0.447213595499958d0,&
- 0d0, 0d0, -1.00000000000000d0/),(/3,12/))
- real(DP), parameter :: p20(3,20)=reshape( &
- (/0.525731112119134d0, 0.381966011250105d0, 0.850650808352040d0, &
- -0.200811415886227d0, 0.618033988749895d0, 0.850650808352040d0, &
- -0.649839392465813d0, 0d0, 0.850650808352040d0, &
- -0.200811415886227d0, -0.618033988749895d0, 0.850650808352040d0, &
- 0.525731112119134d0, -0.381966011250105d0, 0.850650808352040d0, &
- 0.850650808352040d0, 0.618033988749895d0, 0.200811415886227d0, &
- -0.324919696232906d0, 1.00000000000000d0, 0.200811415886227d0, &
- -1.05146222423827d0, 0d0, 0.200811415886227d0, &
- -0.324919696232906d0, -1.00000000000000d0, 0.200811415886227d0, &
- 0.850650808352040d0, -0.618033988749895d0, 0.200811415886227d0, &
- 0.324919696232906d0, 1.00000000000000d0, -0.200811415886227d0, &
- -0.850650808352040d0, 0.618033988749895d0, -0.200811415886227d0, &
- -0.850650808352040d0, -0.618033988749895d0, -0.200811415886227d0, &
- 0.324919696232906d0, -1.00000000000000d0, -0.200811415886227d0, &
- 1.05146222423827d0, 0d0, -0.200811415886227d0, &
- 0.200811415886227d0, 0.618033988749895d0, -0.850650808352040d0, &
- -0.525731112119134d0, 0.381966011250105d0, -0.850650808352040d0, &
- -0.525731112119134d0, -0.381966011250105d0, -0.850650808352040d0, &
- 0.200811415886227d0, -0.618033988749895d0, -0.850650808352040d0, &
- 0.649839392465813d0, 0d0, -0.850650808352040d0/),(/3,20/))
- real(DP), parameter :: pwg(2)=(/2.976190476190479d-2,3.214285714285711d-2/)
- !
- INTEGER :: npw, mmn_tot, ik, ikp, ipol, isym, npwq, i, m, n, ir, jsym
- INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt, nir
- INTEGER :: ikevc, ikpevcq, s, counter, iun_dmn, ig, igp, ip, jp, np, iw, jw
- COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
- becp2(:,:), Mkb(:,:), aux_nc(:,:)
- real(DP), ALLOCATABLE :: rbecp2(:,:),sr(:,:,:)
- COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:), phs(:,:)
- real(DP), ALLOCATABLE :: qg(:), workg(:)
- real(DP), ALLOCATABLE :: ylm(:,:), dxk(:,:), tvec(:,:), dylm(:,:), wws(:,:,:), vps2t(:,:,:), vaxis(:,:,:)
- INTEGER, ALLOCATABLE :: iks2k(:,:),iks2g(:,:),ik2ir(:),ir2ik(:)
- INTEGER, ALLOCATABLE :: iw2ip(:),ip2iw(:),ips2p(:,:),invs(:)
- logical, ALLOCATABLE :: lfound(:)
- COMPLEX(DP) :: mmn, zdotc, phase1
- real(DP) :: arg, g_(3),v1(3),v2(3),v3(3),v4(3),v5(3),err,ermx,dvec(3,32),dwgt(32),dvec2(3,32),dmat(3,3)
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp
- INTEGER :: nn,inn,loop,loop2
- LOGICAL :: nn_found
- INTEGER :: istart,iend
- INTEGER :: ibnd_n, ibnd_m,nsym, nxxs
- COMPLEX(DP), ALLOCATABLE :: psic_all(:), temppsic_all(:)
- LOGICAL :: have_sym
-
- CALL start_clock( 'compute_dmn' )
-
- IF (wan_mode=='standalone') THEN
- iun_dmn = find_free_unit()
- END IF
- dmat=0d0
- dmat(1,1)=1d0
- dmat(2,2)=1d0
- dmat(3,3)=1d0
- if(read_sym)then
- write(stdout,*) ' Reading symmetry from file '//trim(seedname)//'.sym'
- write(stdout,*) ' '
- if(ionode) then
- inquire(file=trim(seedname)//".sym",exist=have_sym)
- if(.not. have_sym) then
- call errore( 'pw2wannier90', 'Could not find the file '&
- &//trim(seedname)//'.sym', 1 )
- endif
- open(unit=iun_dmn, file=trim(seedname)//".sym",form='formatted')
- read(iun_dmn,*) nsym
- end if
- call mp_bcast(nsym,ionode_id, world_comm)
- allocate(invs(nsym),sr(3,3,nsym),tvec(3,nsym))
- invs=-999
- if(ionode) then
- do isym=1,nsym
- read(iun_dmn,*)
- read(iun_dmn,*) sr(:,:,isym), tvec(:,isym)
- end do
- close(iun_dmn)
- end if
- call mp_bcast(sr, ionode_id, world_comm)
- call mp_bcast(tvec, ionode_id, world_comm)
- do isym=1,nsym
- do jsym=1,nsym
- if(invs(jsym).ge.1) cycle
- v1=matmul(matmul(tvec(:,isym),sr(:,:,jsym))+tvec(:,jsym),bg)
- if(sum(abs(matmul(sr(:,:,isym),sr(:,:,jsym))-dmat))+sum(abs(v1-dble(nint(v1)))).lt.1d-3) then
- invs(isym)=jsym
- invs(jsym)=isym
- end if
- end do
- end do
- else
- nsym=nsymin
- allocate(sr(3,3,nsym),invs(nsym),tvec(3,nsym))
- ! original sr corresponds to transpose(s)
- ! so here we use sr = transpose(original sr)
- do isym=1,nsym
- sr(:,:,isym)=transpose(srin(:,:,isym))
- end do
- invs=invsin(1:nsym)
- tvec=matmul(at(:,:),ftin(:,1:nsym))
- if(ionode)then
- open(unit=iun_dmn, file=trim(seedname)//".sym",form='formatted')
- write(iun_dmn,"(i5)") nsym
- do isym=1,nsym
- write(iun_dmn,*)
- write(iun_dmn,"(1p,3e23.15)") sr(:,:,isym), tvec(:,isym)
- end do
- close(iun_dmn)
- end if
- end if
- do isym=1,nsym
- if(invs(isym).le.0.or.invs(isym).ge.nsym+1) then
- call errore("compute_dmn", "out of range in invs", invs(isym))
- end if
- v1=matmul(matmul(tvec(:,isym),sr(:,:,invs(isym)))+tvec(:,invs(isym)),bg)
- if(sum(abs(matmul(sr(:,:,isym),sr(:,:,invs(isym)))-dmat))+sum(abs(v1-dble(nint(v1)))).gt.1d-3) then
- call errore("compute_dmn", "inconsistent invs", 1)
- end if
- end do
-
- CALL pw2wan_set_symm ( nsym, sr, tvec )
-
- any_uspp = any(upf(1:ntyp)%tvanp)
-
- ALLOCATE( phase(dffts%nnr) )
- ALLOCATE( evcq(npol*npwx,nbnd) )
-
- IF(noncolin) CALL errore('compute_dmn','Non-collinear not implemented',1)
- IF (gamma_only) CALL errore('compute_dmn','gamma-only not implemented',1)
- IF (wan_mode=='library') CALL errore('compute_dmn','library mode not implemented',1)
-
- ALLOCATE( aux(npwx) )
-
- allocate(lfound(max(iknum,ngm)))
- if(.not.allocated(iks2k)) allocate(iks2k(iknum,nsym))
- iks2k=-999 !Sym.op.(isym) moves k(iks2k(ik,isym)) to k(ik) + G(iks2g(ik,isym)).
- do isym=1,nsym
- lfound=.false.
- do ik=1,iknum
- v1=xk(:,ik)
- v2=matmul(sr(:,:,isym),v1)
- do ikp=1,iknum
- if(lfound(ikp)) cycle
- v3=xk(:,ikp)
- v4=matmul(v2-v3,at)
- if(sum(abs(nint(v4)-v4)).lt.1d-5) then
- iks2k(ik,isym)=ikp
- lfound(ikp)=.true.
- end if
- if(iks2k(ik,isym).ge.1) exit
- end do
- end do
- end do
- deallocate(lfound)
- !if(count(iks2k.le.0).ne.0) call errore("compute_dmn", "inconsistent in iks2k", count(iks2k.le.0))
- if(.not.allocated(iks2g)) allocate(iks2g(iknum,nsym))
- iks2g=-999 !See above.
- do isym=1,nsym
- do ik=1,iknum
- ikp=iks2k(ik,isym)
- v1=xk(:,ikp)
- v2=matmul(v1,sr(:,:,isym))
- v3=xk(:,ik)
- do ig=1,ngm
- v4=g(:,ig)
- if(sum(abs(v3+v4-v2)).lt.1d-5) iks2g(ik,isym)=ig
- if(iks2g(ik,isym).ge.1) exit
- end do
- end do
- end do
- !if(count(iks2g.le.0).ne.0) call errore("compute_dmn", "inconsistent in iks2g", count(iks2g.le.0))
- !
- if(.not.allocated(ik2ir)) allocate(ik2ir(iknum))
- ik2ir=-999 !Gives irreducible-k points from regular-k points.
- if(.not.allocated(ir2ik)) allocate(ir2ik(iknum))
- ir2ik=-999 !Gives regular-k points from irreducible-k points.
- allocate(lfound(iknum))
- lfound=.false.
- nir=0
- do ik=1,iknum
- if(lfound(ik)) cycle
- lfound(ik)=.true.
- nir=nir+1
- ir2ik(nir)=ik
- ik2ir(ik)=nir
- do isym=1,nsym
- ikp=iks2k(ik,isym)
- if(lfound(ikp)) cycle
- lfound(ikp)=.true.
- ik2ir(ikp)=nir
- end do
- end do
- deallocate(lfound)
- !write(stdout,"(a)") "ik2ir(ir2ik)="
- !write(stdout,"(10i9)") ik2ir(ir2ik(1:nir))
- !write(stdout,"(a)") "ir2ik(ik2ir)="
- !write(stdout,"(10i9)") ir2ik(ik2ir(1:iknum))
-
- allocate(iw2ip(n_wannier),ip2iw(n_wannier))
- np=0 !Conversion table between Wannier and position indexes.
- do iw=1,n_wannier
- v1=center_w(:,iw)
- jp=0
- do ip=1,np
- if(sum(abs(v1-center_w(:,ip2iw(ip)))).lt.1d-2) then
- jp=ip
- exit
- end if
- end do
- if(jp.eq.0) then
- np=np+1
- iw2ip(iw)=np
- ip2iw(np)=iw
- else
- iw2ip(iw)=jp
- end if
- end do
- !write(stdout,"(a,10i9)") "iw2ip(ip2iw)="
- !write(stdout,"(10i9)") iw2ip(ip2iw(1:np))
- !write(stdout,"(a)") "ip2iw(iw2ip)="
- !write(stdout,"(10i9)") ip2iw(iw2ip(1:n_wannier))
- allocate(ips2p(np,nsym),lfound(np))
- ips2p=-999 !See below.
- write(stdout,"(a,i5)") " Number of symmetry operators = ", nsym
- do isym=1,nsym
- write(stdout,"(2x,i5,a)") isym, "-th symmetry operators is"
- write(stdout,"(3f15.7)") sr(:,:,isym), tvec(:,isym) !Writing rotation matrix and translation vector in Cartesian coordinates.
- if(isym.eq.1) then
- dmat=sr(:,:,isym)
- dmat(1,1)=dmat(1,1)-1d0
- dmat(2,2)=dmat(2,2)-1d0
- dmat(3,3)=dmat(3,3)-1d0
- if(sum(abs(dmat))+sum(abs(tvec(:,isym))).gt.1d-5) then
- call errore("compute_dmn", "Error: 1st-symmetry operator is not identical one.", 1)
- end if
- end if
- end do
- do isym=1,nsym
- lfound=.false.
- do ip=1,np
- v1=center_w(:,ip2iw(ip))
- v2=matmul(sr(:,:,isym),(v1+tvec(:,isym)))
- do jp=1,np
- if(lfound(jp)) cycle
- v3=center_w(:,ip2iw(jp))
- v4=matmul(v3-v2,bg)
- if(sum(abs(dble(nint(v4))-v4)).lt.1d-2) then
- lfound(jp)=.true.
- ips2p(ip,isym)=jp
- exit !Sym.op.(isym) moves position(ips2p(ip,isym)) to position(ip) + T, where
- end if !T is given by vps2t(:,ip,isym).
- end do
- if(ips2p(ip,isym).le.0) then
- write(stdout,"(a,3f18.10,a,3f18.10,a)")" Could not find ",v2,"(",matmul(v2,bg),")"
- write(stdout,"(a,3f18.10,a,3f18.10,a)")" coming from ",v1,"(",matmul(v1,bg),")"
- write(stdout,"(a,i5,a )")" of Wannier site",ip,"."
- call errore("compute_dmn", "Error: missing Wannier sites, see the output.", 1)
- end if
- end do
- end do
- allocate(vps2t(3,np,nsym)) !See above.
- do isym=1,nsym
- do ip=1,np
- v1=center_w(:,ip2iw(ip))
- jp=ips2p(ip,isym)
- v2=center_w(:,ip2iw(jp))
- v3=matmul(v2,sr(:,:,isym))-tvec(:,isym)
- vps2t(:,ip,isym)=v3-v1
- end do
- end do
- dvec(:,1:12)=p12
- dvec(:,13:32)=p20
- do ip=1,32
- dvec(:,ip)=dvec(:,ip)/sqrt(sum(dvec(:,ip)**2))
- end do
- dwgt(1:12)=pwg(1)
- dwgt(13:32)=pwg(2)
- !write(stdout,*) sum(dwgt) !Checking the weight sum to be 1.
- allocate(dylm(32,5),vaxis(3,3,n_wannier))
- dylm=0d0
- vaxis=0d0
- do ip=1,5
- CALL ylm_wannier(dylm(1,ip),2,ip,dvec,32)
- end do
- !do ip=1,5
- ! write(stdout,"(5f25.15)") (sum(dylm(:,ip)*dylm(:,jp)*dwgt)*2d0*tpi,jp=1,5)
- !end do !Checking spherical integral.
- allocate(wws(n_wannier,n_wannier,nsym))
- wws=0d0
- do iw=1,n_wannier
- call set_u_matrix (xaxis(:,iw),zaxis(:,iw),vaxis(:,:,iw))
- end do
- do isym=1,nsym
- do iw=1,n_wannier
- ip=iw2ip(iw)
- jp=ips2p(ip,isym)
- CALL ylm_wannier(dylm(1,1),l_w(iw),mr_w(iw),matmul(vaxis(:,:,iw),dvec),32)
- do jw=1,n_wannier
- if(iw2ip(jw).ne.jp) cycle
- do ir=1,32
- dvec2(:,ir)=matmul(sr(:,:,isym),dvec(:,ir))
- end do
- CALL ylm_wannier(dylm(1,2),l_w(jw),mr_w(jw),matmul(vaxis(:,:,jw),dvec2),32)
- wws(jw,iw,isym)=sum(dylm(:,1)*dylm(:,2)*dwgt)*2d0*tpi ! for sym.op.(isym).
- end do
- end do
- end do
- deallocate(dylm,vaxis)
- do isym=1,nsym
- do iw=1,n_wannier
- err=abs((sum(wws(:,iw,isym)**2)+sum(wws(iw,:,isym)**2))*.5d0-1d0)
- if(err.gt.1d-3) then
- write(stdout,"(a,i5,a,i5,a)") "compute_dmn: Symmetry operator (", isym, &
- ") could not transform Wannier function (", iw, ")."
- write(stdout,"(a,f15.7,a )") "compute_dmn: The error is ", err, "."
- call errore("compute_dmn", "Error: missing Wannier functions, see the output.", 1)
- end if
- end do
- end do
-
- IF (wan_mode=='standalone') THEN
- iun_dmn = find_free_unit()
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- IF (ionode) THEN
- OPEN (unit=iun_dmn, file=trim(seedname)//".dmn",form='formatted')
- WRITE (iun_dmn,*) header
- WRITE (iun_dmn,"(4i9)") nbnd-nexband, nsym, nir, iknum
- ENDIF
- ENDIF
-
- IF (ionode) THEN
- WRITE (iun_dmn,*)
- WRITE (iun_dmn,"(10i9)") ik2ir(1:iknum)
- WRITE (iun_dmn,*)
- WRITE (iun_dmn,"(10i9)") ir2ik(1:nir)
- do ir=1,nir
- WRITE (iun_dmn,*)
- WRITE (iun_dmn,"(10i9)") iks2k(ir2ik(ir),:)
- enddo
- ENDIF
- allocate(phs(n_wannier,n_wannier))
- phs=(0d0,0d0)
- WRITE(stdout,'(/)')
- WRITE(stdout,'(a,i8)') ' DMN(d_matrix_wann): nir = ',nir
- DO ir=1,nir
- ik=ir2ik(ir)
- WRITE (stdout,'(i8)',advance='no') ir
- IF( MOD(ir,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- do isym=1,nsym
- do iw=1,n_wannier
- ip=iw2ip(iw)
- jp=ips2p(ip,invs(isym))
- jw=ip2iw(jp)
- v1 = xk(:,iks2k(ik,isym)) - matmul(sr(:,:,isym),xk(:,ik))
- v2 = matmul(v1, sr(:,:,isym))
- phs(iw,iw)=exp(dcmplx(0d0,+sum(vps2t(:,jp,isym)*xk(:,ik))*tpi)) & !Phase of T.k with lattice vectors T of above.
- *exp(dcmplx(0d0,+sum(tvec(:,isym)*v2)*tpi)) !Phase of t.G with translation vector t(isym).
- end do
- IF (ionode) then
- WRITE (iun_dmn,*)
- WRITE (iun_dmn,"(1p,(' (',e18.10,',',e18.10,')'))") matmul(phs,dcmplx(wws(:,:,isym),0d0))
- end if
- end do
- end do
- if(mod(nir,10) /= 0) WRITE(stdout,*)
- WRITE(stdout,*) ' DMN(d_matrix_wann) calculated'
- deallocate(phs)
- !
- ! USPP
- !
- !
- IF(any_uspp) THEN
- CALL init_us_1
- CALL allocate_bec_type ( nkb, nbnd, becp )
- IF (gamma_only) THEN
- call errore("compute_dmn", "gamma-only mode not implemented", 1)
- ELSE
- ALLOCATE ( becp2(nkb,nbnd) )
- ENDIF
- ENDIF
- !
- ! qb is FT of Q(r)
- !
- nbt = nsym*nir!nnb * iknum
- !
- ALLOCATE( qg(nbt) )
- ALLOCATE (dxk(3,nbt))
- !
- ind = 0
- DO ir=1,nir
- ik=ir2ik(ir)
- DO isym=1,nsym!nnb
- ind = ind + 1
- ! ikp = kpb(ik,ib)
- !
- ! g_(:) = REAL( g_kpb(:,ik,ib) )
- ! CALL cryst_to_cart (1, g_, bg, 1)
- dxk(:,ind) = 0d0!xk(:,ikp) +g_(:) - xk(:,ik)
- qg(ind) = dxk(1,ind)*dxk(1,ind)+dxk(2,ind)*dxk(2,ind)+dxk(3,ind)*dxk(3,ind)
- ENDDO
- ! write (stdout,'(i3,12f8.4)') ik, qg((ik-1)*nnb+1:ik*nnb)
- ENDDO
- !
- ! USPP
- !
- IF(any_uspp) THEN
-
- ALLOCATE( ylm(nbt,lmaxq*lmaxq), qgm(nbt) )
- ALLOCATE( qb (nhm, nhm, ntyp, nbt) )
- !
- CALL ylmr2 (lmaxq*lmaxq, nbt, dxk, qg, ylm)
- qg(:) = sqrt(qg(:)) * tpiba
- !
- DO nt = 1, ntyp
- IF (upf(nt)%tvanp ) THEN
- DO ih = 1, nh (nt)
- DO jh = 1, nh (nt)
- CALL qvan2 (nbt, ih, jh, nt, qg, qgm, ylm)
- qb (ih, jh, nt, 1:nbt) = omega * qgm(1:nbt)
- ENDDO
- ENDDO
- ENDIF
- ENDDO
- !
- DEALLOCATE (qg, qgm, ylm )
- !
- ENDIF
-
- WRITE(stdout,'(/)')
- WRITE(stdout,'(a,i8)') ' DMN(d_matrix_band): nir = ',nir
- !
- ALLOCATE( Mkb(nbnd,nbnd) )
- ALLOCATE( workg(npwx) )
- !
- ! Set up variables and stuff needed to rotate wavefunctions
- nxxs = dffts%nr1x *dffts%nr2x *dffts%nr3x
- ALLOCATE(psic_all(nxxs), temppsic_all(nxxs) )
- !
- ind = 0
- DO ir=1,nir
- ik=ir2ik(ir)
- WRITE (stdout,'(i8)',advance='no') ir
- IF( MOD(ir,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- ikevc = ik + ikstart - 1
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
- npw = ngk(ik)
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
- ! below we compute the product of beta functions with |psi>
- CALL calbec (npw, vkb, evc, becp)
- ENDIF
- !
- !
- DO isym=1,nsym
- ind = ind + 1
- ikp = iks2k(ik,isym)
- ! read wfc at k+b
- ikpevcq = ikp + ikstart - 1
- ! if(noncolin) then
- ! call davcio (evcq_nc, 2*nwordwfc, iunwfc, ikpevcq, -1 )
- ! else
- CALL davcio (evcq, 2*nwordwfc, iunwfc, ikpevcq, -1 )
- ! end if
- npwq = ngk(ikp)
- do n=1,nbnd
- do ip=1,npwq !applying translation vector t.
- evcq(ip,n)=evcq(ip,n)*exp(dcmplx(0d0,+sum((matmul(g(:,igk_k(ip,ikp)),sr(:,:,isym))+xk(:,ik))*tvec(:,isym))*tpi))
- end do
- end do
- ! compute the phase
- phase(:) = (0.d0,0.d0)
- ! missing phase G of above is given here and below.
- IF(iks2g(ik,isym) >= 0) phase(dffts%nl(iks2g(ik,isym)))=(1d0,0d0)
- CALL invfft ('Wave', phase, dffts)
- do n=1,nbnd
- if(excluded_band(n)) cycle
- psic(:) = (0.d0, 0.d0)
- psic(dffts%nl(igk_k(1:npwq,ikp))) = evcq(1:npwq,n)
- ! go to real space
- CALL invfft ('Wave', psic, dffts)
-#if defined(__MPI)
- ! gather among all the CPUs
- CALL gather_grid(dffts, psic, temppsic_all)
- ! apply rotation
- !psic_all(1:nxxs) = temppsic_all(rir(1:nxxs,isym))
- psic_all(rir(1:nxxs,isym)) = temppsic_all(1:nxxs)
- ! scatter back a piece to each CPU
- CALL scatter_grid(dffts, psic_all, psic)
-#else
- psic(rir(1:nxxs, isym)) = psic(1:nxxs)
-#endif
- ! apply phase k -> k+G
- psic(1:dffts%nnr) = psic(1:dffts%nnr) * phase(1:dffts%nnr)
- ! go back to G space
- CALL fwfft ('Wave', psic, dffts)
- evcq(1:npw,n) = psic(dffts%nl (igk_k(1:npw,ik) ) )
- end do
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
- ! below we compute the product of beta functions with |psi>
- IF (gamma_only) THEN
- call errore("compute_dmn", "gamma-only mode not implemented", 1)
- ELSE
- CALL calbec ( npw, vkb, evcq, becp2 )
- ENDIF
- ENDIF
- !
- !
- Mkb(:,:) = (0.0d0,0.0d0)
- !
- IF (any_uspp) THEN
- ijkb0 = 0
- DO nt = 1, ntyp
- IF ( upf(nt)%tvanp ) THEN
- DO na = 1, nat
- !
- arg = dot_product( dxk(:,ind), tau(:,na) ) * tpi
- phase1 = cmplx( cos(arg), -sin(arg) ,kind=DP)
- !
- IF ( ityp(na) == nt ) THEN
- DO jh = 1, nh(nt)
- jkb = ijkb0 + jh
- DO ih = 1, nh(nt)
- ikb = ijkb0 + ih
- !
- DO m = 1,nbnd
- IF (excluded_band(m)) CYCLE
- IF (gamma_only) THEN
- call errore("compute_dmn", "gamma-only mode not implemented", 1)
- ELSE
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * qb(ih,jh,nt,ind) * &
- conjg( becp%k(ikb,m) ) * becp2(jkb,n)
- ENDDO
- ENDIF
- ENDDO ! m
- ENDDO !ih
- ENDDO !jh
- ijkb0 = ijkb0 + nh(nt)
- ENDIF !ityp
- ENDDO !nat
- ELSE !tvanp
- DO na = 1, nat
- IF ( ityp(na) == nt ) ijkb0 = ijkb0 + nh(nt)
- ENDDO
- ENDIF !tvanp
- ENDDO !ntyp
- ENDIF ! any_uspp
- !
- !
- ! loops on bands
- !
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE (iun_dmn,*)
- ENDIF
- !
- DO m=1,nbnd
- IF (excluded_band(m)) CYCLE
- !
- !
- ! Mkb(m,n) = Mkb(m,n) + \sum_{ijI} qb_{ij}^I * e^-i(0*tau_I)
- ! < beta_j,k2 | psi_n,k2 >
- !
- IF (gamma_only) THEN
- call errore("compute_dmn", "gamma-only mode not implemented", 1)
- ELSEIF(noncolin) THEN
- call errore("compute_dmn", "Non-collinear not implemented", 1)
- ELSE
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- mmn = zdotc (npw, evc(1,m),1,evcq(1,n),1)
- CALL mp_sum(mmn, intra_pool_comm)
- Mkb(m,n) = mmn + Mkb(m,n)
- ENDDO
- ENDIF
- ENDDO ! m
-
- ibnd_n = 0
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- ibnd_n = ibnd_n + 1
- ibnd_m = 0
- DO m=1,nbnd
- IF (excluded_band(m)) CYCLE
- ibnd_m = ibnd_m + 1
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE (iun_dmn,"(1p,(' (',e18.10,',',e18.10,')'))")dconjg(Mkb(n,m))
- ELSEIF (wan_mode=='library') THEN
- call errore("compute_dmn", "library mode not implemented", 1)
- ELSE
- CALL errore('compute_dmn',' value of wan_mode not recognised',1)
- ENDIF
- ENDDO
- ENDDO
- ENDDO !isym
- ENDDO !ik
-
- if(mod(nir,10) /= 0) WRITE(stdout,*)
- WRITE(stdout,*) ' DMN(d_matrix_band) calculated'
-
- IF (ionode .and. wan_mode=='standalone') CLOSE (iun_dmn)
-
- DEALLOCATE (Mkb, dxk, phase)
- DEALLOCATE(temppsic_all, psic_all)
- DEALLOCATE(aux)
- DEALLOCATE(evcq)
-
- IF(any_uspp) THEN
- DEALLOCATE ( qb)
- CALL deallocate_bec_type (becp)
- IF (gamma_only) THEN
- CALL errore('compute_dmn','gamma-only not implemented',1)
- ELSE
- DEALLOCATE (becp2)
- ENDIF
- ENDIF
- !
- CALL stop_clock( 'compute_dmn' )
-
- RETURN
-END SUBROUTINE compute_dmn
-!
-!-----------------------------------------------------------------------
-SUBROUTINE compute_mmn
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode
- USE kinds, ONLY: DP
- USE wvfct, ONLY : nbnd, npwx
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc, psic, psic_nc
- USE fft_base, ONLY : dffts, dfftp
- USE fft_interfaces, ONLY : fwfft, invfft
- USE klist, ONLY : nkstot, xk, igk_k, ngk
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE cell_base, ONLY : omega, alat, tpiba, at, bg
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE constants, ONLY : tpi
- USE uspp, ONLY : nkb, vkb
- USE uspp_param, ONLY : upf, nh, lmaxq, nhm
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum
- USE noncollin_module,ONLY : noncolin, npol
- USE spin_orb, ONLY : lspinorb
- USE gvecw, ONLY : gcutw
- USE wannier
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
- !
- INTEGER :: npw, mmn_tot, ik, ikp, ipol, ib, npwq, i, m, n
- INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
- INTEGER :: ikevc, ikpevcq, s, counter
- COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
- becp2(:,:), Mkb(:,:), aux_nc(:,:), becp2_nc(:,:,:)
- real(DP), ALLOCATABLE :: rbecp2(:,:)
- COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:), qq_so(:,:,:,:)
- real(DP), ALLOCATABLE :: qg(:), ylm(:,:), dxk(:,:)
- COMPLEX(DP) :: mmn, zdotc, phase1
- real(DP) :: arg, g_(3)
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp
- INTEGER :: nn,inn,loop,loop2
- LOGICAL :: nn_found
- INTEGER :: istart,iend
- INTEGER :: ibnd_n, ibnd_m
-
-
- CALL start_clock( 'compute_mmn' )
-
- any_uspp = any(upf(1:ntyp)%tvanp)
-
- ALLOCATE( phase(dffts%nnr) )
- ALLOCATE( evcq(npol*npwx,nbnd) )
-
- IF(noncolin) THEN
- ALLOCATE( aux_nc(npwx,npol) )
- ELSE
- ALLOCATE( aux(npwx) )
- ENDIF
-
- IF (gamma_only) ALLOCATE(aux2(npwx))
-
- IF (wan_mode=='library') ALLOCATE(m_mat(num_bands,num_bands,nnb,iknum))
-
- IF (wan_mode=='standalone') THEN
- iun_mmn = find_free_unit()
- IF (ionode) OPEN (unit=iun_mmn, file=trim(seedname)//".mmn",form='formatted')
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- IF (ionode) THEN
- WRITE (iun_mmn,*) header
- WRITE (iun_mmn,*) nbnd-nexband, iknum, nnb
- ENDIF
- ENDIF
-
- !
- ! USPP
- !
- !
- IF(any_uspp) THEN
- CALL init_us_1
- CALL allocate_bec_type ( nkb, nbnd, becp )
- IF (gamma_only) THEN
- ALLOCATE ( rbecp2(nkb,nbnd))
- else if (noncolin) then
- ALLOCATE ( becp2_nc(nkb,2,nbnd) )
- ELSE
- ALLOCATE ( becp2(nkb,nbnd) )
- ENDIF
- !
- ! qb is FT of Q(r)
- !
- nbt = nnb * iknum
- !
- ALLOCATE( qg(nbt) )
- ALLOCATE (dxk(3,nbt))
- !
- ind = 0
- DO ik=1,iknum
- DO ib=1,nnb
- ind = ind + 1
- ikp = kpb(ik,ib)
- !
- g_(:) = REAL( g_kpb(:,ik,ib) )
- CALL cryst_to_cart (1, g_, bg, 1)
- dxk(:,ind) = xk(:,ikp) +g_(:) - xk(:,ik)
- qg(ind) = dxk(1,ind)*dxk(1,ind)+dxk(2,ind)*dxk(2,ind)+dxk(3,ind)*dxk(3,ind)
- ENDDO
-! write (stdout,'(i3,12f8.4)') ik, qg((ik-1)*nnb+1:ik*nnb)
- ENDDO
-
- ALLOCATE( ylm(nbt,lmaxq*lmaxq), qgm(nbt) )
- ALLOCATE( qb (nhm, nhm, ntyp, nbt) )
- ALLOCATE( qq_so (nhm, nhm, 4, ntyp) )
- !
- CALL ylmr2 (lmaxq*lmaxq, nbt, dxk, qg, ylm)
- qg(:) = sqrt(qg(:)) * tpiba
- !
- DO nt = 1, ntyp
- IF (upf(nt)%tvanp ) THEN
- DO ih = 1, nh (nt)
- DO jh = 1, nh (nt)
- CALL qvan2 (nbt, ih, jh, nt, qg, qgm, ylm)
- qb (ih, jh, nt, 1:nbt) = omega * qgm(1:nbt)
- ENDDO
- ENDDO
- ENDIF
- ENDDO
- !
- DEALLOCATE (qg, qgm, ylm )
- !
- ENDIF
-
- WRITE(stdout,'(a,i8)') ' MMN: iknum = ',iknum
- !
- ALLOCATE( Mkb(nbnd,nbnd) )
- !
- ind = 0
- DO ik=1,iknum
- WRITE (stdout,'(i8)',advance='no') ik
- IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- ikevc = ik + ikstart - 1
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
- npw = ngk(ik)
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
- ! below we compute the product of beta functions with |psi>
- CALL calbec (npw, vkb, evc, becp)
- ENDIF
- !
- !
- !do ib=1,nnb(ik)
- DO ib=1,nnb
- ind = ind + 1
- ikp = kpb(ik,ib)
-! read wfc at k+b
- ikpevcq = ikp + ikstart - 1
-! if(noncolin) then
-! call davcio (evcq_nc, 2*nwordwfc, iunwfc, ikpevcq, -1 )
-! else
- CALL davcio (evcq, 2*nwordwfc, iunwfc, ikpevcq, -1 )
-! end if
-! compute the phase
- IF (.not.zerophase(ik,ib)) THEN
- phase(:) = (0.d0,0.d0)
- IF ( ig_(ik,ib)>0) phase( dffts%nl(ig_(ik,ib)) ) = (1.d0,0.d0)
- CALL invfft ('Wave', phase, dffts)
- ENDIF
- !
- ! USPP
- !
- npwq = ngk(ikp)
- IF(any_uspp) THEN
- CALL init_us_2 (npwq, igk_k(1,ikp), xk(1,ikp), vkb)
- ! below we compute the product of beta functions with |psi>
- IF (gamma_only) THEN
- CALL calbec ( npwq, vkb, evcq, rbecp2 )
- else if (noncolin) then
- CALL calbec ( npwq, vkb, evcq, becp2_nc )
-
- if (lspinorb) then
- qq_so = (0.0d0, 0.0d0)
- call transform_qq_so(qb(:,:,:,ind), qq_so)
- endif
-
- ELSE
- CALL calbec ( npwq, vkb, evcq, becp2 )
- ENDIF
- ENDIF
- !
- !
- Mkb(:,:) = (0.0d0,0.0d0)
- !
- IF (any_uspp) THEN
- ijkb0 = 0
- DO nt = 1, ntyp
- IF ( upf(nt)%tvanp ) THEN
- DO na = 1, nat
- !
- arg = dot_product( dxk(:,ind), tau(:,na) ) * tpi
- phase1 = cmplx( cos(arg), -sin(arg) ,kind=DP)
- !
- IF ( ityp(na) == nt ) THEN
- DO jh = 1, nh(nt)
- jkb = ijkb0 + jh
- DO ih = 1, nh(nt)
- ikb = ijkb0 + ih
- !
- DO m = 1,nbnd
- IF (excluded_band(m)) CYCLE
- IF (gamma_only) THEN
- DO n=1,m ! Mkb(m,n) is symmetric in m and n for gamma_only case
- IF (excluded_band(n)) CYCLE
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * qb(ih,jh,nt,ind) * &
- becp%r(ikb,m) * rbecp2(jkb,n)
- ENDDO
- else if (noncolin) then
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- if (lspinorb) then
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * ( &
- qq_so(ih,jh,1,nt) * conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 1, n) &
- + qq_so(ih,jh,2,nt) * conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 2, n) &
- + qq_so(ih,jh,3,nt) * conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 1, n) &
- + qq_so(ih,jh,4,nt) * conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 2, n) &
- )
- else
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * qb(ih,jh,nt,ind) * &
- (conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 1, n) &
- + conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 2, n) )
- endif
- ENDDO
- ELSE
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- Mkb(m,n) = Mkb(m,n) + &
- phase1 * qb(ih,jh,nt,ind) * &
- conjg( becp%k(ikb,m) ) * becp2(jkb,n)
- ENDDO
- ENDIF
- ENDDO ! m
- ENDDO !ih
- ENDDO !jh
- ijkb0 = ijkb0 + nh(nt)
- ENDIF !ityp
- ENDDO !nat
- ELSE !tvanp
- DO na = 1, nat
- IF ( ityp(na) == nt ) ijkb0 = ijkb0 + nh(nt)
- ENDDO
- ENDIF !tvanp
- ENDDO !ntyp
- ENDIF ! any_uspp
- !
- !
-! loops on bands
- !
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE (iun_mmn,'(7i5)') ik, ikp, (g_kpb(ipol,ik,ib), ipol=1,3)
- ENDIF
- !
- DO m=1,nbnd
- IF (excluded_band(m)) CYCLE
- !
- IF(noncolin) THEN
- psic_nc(:,:) = (0.d0, 0.d0)
- DO ipol=1,2!npol
- istart=(ipol-1)*npwx+1
- iend=istart+npw-1
- psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol ) = evc(istart:iend, m)
- IF (.not.zerophase(ik,ib)) THEN
- CALL invfft ('Wave', psic_nc(:,ipol), dffts)
- psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * &
- phase(1:dffts%nnr)
- CALL fwfft ('Wave', psic_nc(:,ipol), dffts)
- ENDIF
- aux_nc(1:npwq,ipol) = psic_nc(dffts%nl (igk_k(1:npwq,ikp)),ipol )
- ENDDO
- ELSE
- psic(:) = (0.d0, 0.d0)
- psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw, m)
- IF(gamma_only) psic(dffts%nlm(igk_k(1:npw,ik) ) ) = conjg(evc (1:npw, m))
- IF (.not.zerophase(ik,ib)) THEN
- CALL invfft ('Wave', psic, dffts)
- psic(1:dffts%nnr) = psic(1:dffts%nnr) * phase(1:dffts%nnr)
- CALL fwfft ('Wave', psic, dffts)
- ENDIF
- aux(1:npwq) = psic(dffts%nl (igk_k(1:npwq,ikp) ) )
- ENDIF
- IF(gamma_only) THEN
- IF (gstart==2) psic(dffts%nlm(1)) = (0.d0,0.d0)
- aux2(1:npwq) = conjg(psic(dffts%nlm(igk_k(1:npwq,ikp) ) ) )
- ENDIF
- !
- ! Mkb(m,n) = Mkb(m,n) + \sum_{ijI} qb_{ij}^I * e^-i(b*tau_I)
- ! < beta_j,k2 | psi_n,k2 >
- !
- IF (gamma_only) THEN
- DO n=1,m ! Mkb(m,n) is symmetric in m and n for gamma_only case
- IF (excluded_band(n)) CYCLE
- mmn = zdotc (npwq, aux,1,evcq(1,n),1) &
- + conjg(zdotc(npwq,aux2,1,evcq(1,n),1))
- CALL mp_sum(mmn, intra_pool_comm)
- Mkb(m,n) = mmn + Mkb(m,n)
- IF (m/=n) Mkb(n,m) = Mkb(m,n) ! fill other half of matrix by symmetry
- ENDDO
- ELSEIF(noncolin) THEN
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- mmn=(0.d0, 0.d0)
-! do ipol=1,2
-! mmn = mmn+zdotc (npwq, aux_nc(1,ipol),1,evcq_nc(1,ipol,n),1)
- mmn = mmn + zdotc (npwq, aux_nc(1,1),1,evcq(1,n),1) &
- + zdotc (npwq, aux_nc(1,2),1,evcq(npwx+1,n),1)
-! end do
- CALL mp_sum(mmn, intra_pool_comm)
- Mkb(m,n) = mmn + Mkb(m,n)
- ENDDO
- ELSE
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- mmn = zdotc (npwq, aux,1,evcq(1,n),1)
- CALL mp_sum(mmn, intra_pool_comm)
- Mkb(m,n) = mmn + Mkb(m,n)
- ENDDO
- ENDIF
- ENDDO ! m
-
- ibnd_n = 0
- DO n=1,nbnd
- IF (excluded_band(n)) CYCLE
- ibnd_n = ibnd_n + 1
- ibnd_m = 0
- DO m=1,nbnd
- IF (excluded_band(m)) CYCLE
- ibnd_m = ibnd_m + 1
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE (iun_mmn,'(2f18.12)') Mkb(m,n)
- ELSEIF (wan_mode=='library') THEN
- m_mat(ibnd_m,ibnd_n,ib,ik)=Mkb(m,n)
- ELSE
- CALL errore('compute_mmn',' value of wan_mode not recognised',1)
- ENDIF
- ENDDO
- ENDDO
-
- ENDDO !ib
- ENDDO !ik
-
- IF (ionode .and. wan_mode=='standalone') CLOSE (iun_mmn)
-
- IF (gamma_only) DEALLOCATE(aux2)
- DEALLOCATE (Mkb, phase)
- IF (any_uspp) DEALLOCATE (dxk)
- IF(noncolin) THEN
- DEALLOCATE(aux_nc)
- ELSE
- DEALLOCATE(aux)
- ENDIF
- DEALLOCATE(evcq)
-
- IF(any_uspp) THEN
- DEALLOCATE ( qb)
- DEALLOCATE (qq_so)
- CALL deallocate_bec_type (becp)
- IF (gamma_only) THEN
- DEALLOCATE (rbecp2)
- else if (noncolin) then
- deallocate (becp2_nc)
- ELSE
- DEALLOCATE (becp2)
- ENDIF
- ENDIF
-!
- WRITE(stdout,'(/)')
- WRITE(stdout,*) ' MMN calculated'
-
- CALL stop_clock( 'compute_mmn' )
-
- RETURN
-END SUBROUTINE compute_mmn
-
-!-----------------------------------------------------------------------
-SUBROUTINE compute_spin
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode
- USE kinds, ONLY: DP
- USE wvfct, ONLY : nbnd, npwx
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc, psic, psic_nc
- USE fft_base, ONLY : dffts, dfftp
- USE fft_interfaces, ONLY : fwfft, invfft
- USE klist, ONLY : nkstot, xk, ngk, igk_k
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE cell_base, ONLY : alat, at, bg
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE constants, ONLY : tpi
- USE uspp, ONLY : nkb, vkb
- USE uspp_param, ONLY : upf, nh, lmaxq
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum
- USE noncollin_module,ONLY : noncolin, npol
- USE gvecw, ONLY : gcutw
- USE wannier
- ! begin change Lopez, Thonhauser, Souza
- USE mp, ONLY : mp_barrier
- USE scf, ONLY : vrs, vltot, v, kedtau
- USE gvecs, ONLY : doublegrid
- USE lsda_mod, ONLY : nspin
- USE constants, ONLY : rytoev
-
- USE uspp_param, ONLY : upf, nh, nhm
- USE uspp, ONLY: qq_nt, nhtol,nhtoj, indv
- USE spin_orb, ONLY : fcoef
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
- !
- INTEGER :: npw, mmn_tot, ik, ikp, ipol, ib, i, m, n
- INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
- INTEGER :: ikevc, ikpevcq, s, counter
- COMPLEX(DP) :: mmn, zdotc, phase1
- real(DP) :: arg, g_(3)
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp
- INTEGER :: nn,inn,loop,loop2
- LOGICAL :: nn_found
- INTEGER :: istart,iend
- COMPLEX(DP) :: sigma_x,sigma_y,sigma_z,cdum1,cdum2
- complex(DP), allocatable :: spn(:,:), spn_aug(:,:)
-
- integer :: np, is1, is2, kh, kkb
- complex(dp) :: sigma_x_aug, sigma_y_aug, sigma_z_aug
- COMPLEX(DP), ALLOCATABLE :: be_n(:,:), be_m(:,:)
-
-
- any_uspp = any(upf(1:ntyp)%tvanp)
-
- if (any_uspp) then
- CALL init_us_1
- CALL allocate_bec_type ( nkb, nbnd, becp )
- ALLOCATE(be_n(nhm,2))
- ALLOCATE(be_m(nhm,2))
- endif
-
-
- if (write_spn) allocate(spn(3,(num_bands*(num_bands+1))/2))
- if (write_spn) allocate(spn_aug(3,(num_bands*(num_bands+1))/2))
- spn_aug = (0.0d0, 0.0d0)
-!ivo
-! not sure this is really needed
- if((write_spn.or.write_uhu.or.write_uIu).and.wan_mode=='library')&
- call errore('pw2wannier90',&
- 'write_spn, write_uhu, and write_uIu not meant to work library mode',1)
-!endivo
-
- IF(write_spn.and.noncolin) THEN
- IF (ionode) then
- iun_spn = find_free_unit()
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- if(spn_formatted) then
- OPEN (unit=iun_spn, file=trim(seedname)//".spn",form='formatted')
- WRITE (iun_spn,*) header !ivo
- WRITE (iun_spn,*) nbnd-nexband,iknum
- else
- OPEN (unit=iun_spn, file=trim(seedname)//".spn",form='unformatted')
- WRITE (iun_spn) header !ivo
- WRITE (iun_spn) nbnd-nexband,iknum
- endif
- ENDIF
- ENDIF
- !
- WRITE(stdout,'(a,i8)') ' iknum = ',iknum
-
- ind = 0
- DO ik=1,iknum
- WRITE (stdout,'(i8)') ik
- ikevc = ik + ikstart - 1
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
- npw = ngk(ik)
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
- ! below we compute the product of beta functions with |psi>
- CALL calbec (npw, vkb, evc, becp)
- ENDIF
-
-
- IF(write_spn.and.noncolin) THEN
- counter=0
- DO m=1,nbnd
- if(excluded_band(m)) cycle !ivo
- DO n=1,m
- if(excluded_band(n)) cycle !ivo
- cdum1=zdotc(npw,evc(1,n),1,evc(npwx+1,m),1)
- call mp_sum(cdum1,intra_pool_comm)
- cdum2=zdotc(npw,evc(npwx+1,n),1,evc(1,m),1)
- call mp_sum(cdum2,intra_pool_comm)
- sigma_x=cdum1+cdum2
- sigma_y=cmplx_i*(cdum2-cdum1)
- sigma_z=zdotc(npw,evc(1,n),1,evc(1,m),1)&
- -zdotc(npw,evc(npwx+1,n),1,evc(npwx+1,m),1)
- call mp_sum(sigma_z,intra_pool_comm)
- counter=counter+1
- spn(1,counter)=sigma_x
- spn(2,counter)=sigma_y
- spn(3,counter)=sigma_z
-
- if (any_uspp) then
- sigma_x_aug = (0.0d0, 0.0d0)
- sigma_y_aug = (0.0d0, 0.0d0)
- sigma_z_aug = (0.0d0, 0.0d0)
- ijkb0 = 0
-
- DO np = 1, ntyp
- IF ( upf(np)%tvanp ) THEN
- DO na = 1, nat
- IF (ityp(na)==np) THEN
- be_m = 0.d0
- be_n = 0.d0
- DO ih = 1, nh(np)
- ikb = ijkb0 + ih
- IF (upf(np)%has_so) THEN
- DO kh = 1, nh(np)
- IF ((nhtol(kh,np)==nhtol(ih,np)).and. &
- (nhtoj(kh,np)==nhtoj(ih,np)).and. &
- (indv(kh,np)==indv(ih,np))) THEN
- kkb=ijkb0 + kh
- DO is1=1,2
- DO is2=1,2
- be_n(ih,is1)=be_n(ih,is1)+ &
- fcoef(ih,kh,is1,is2,np)* &
- becp%nc(kkb,is2,n)
-
- be_m(ih,is1)=be_m(ih,is1)+ &
- fcoef(ih,kh,is1,is2,np)* &
- becp%nc(kkb,is2,m)
- ENDDO
- ENDDO
- ENDIF
- ENDDO
- ELSE
- DO is1=1,2
- be_n(ih, is1) = becp%nc(ikb, is1, n)
- be_m(ih, is1) = becp%nc(ikb, is1, m)
- ENDDO
- ENDIF
- ENDDO
- DO ih = 1, nh(np)
- DO jh = 1, nh(np)
- sigma_x_aug = sigma_x_aug &
- + qq_nt(ih,jh,np) * ( be_m(jh,2)*conjg(be_n(ih,1))+ be_m(jh,1)*conjg(be_n(ih,2)) )
-
- sigma_y_aug = sigma_y_aug &
- + qq_nt(ih,jh,np) * ( &
- be_m(jh,1) * conjg(be_n(ih,2)) &
- - be_m(jh,2) * conjg(be_n(ih,1)) &
- ) * (0.0d0, 1.0d0)
-
- sigma_z_aug = sigma_z_aug &
- + qq_nt(ih,jh,np) * ( be_m(jh,1)*conjg(be_n(ih,1)) - be_m(jh,2)*conjg(be_n(ih,2)) )
- ENDDO
- ENDDO
- ijkb0 = ijkb0 + nh(np)
- ENDIF
- ENDDO
- ELSE
- DO na = 1, nat
- IF ( ityp(na) == np ) ijkb0 = ijkb0 + nh(np)
- ENDDO
- ENDIF
- ENDDO
- spn_aug(1, counter) = sigma_x_aug
- spn_aug(2, counter) = sigma_y_aug
- spn_aug(3, counter) = sigma_z_aug
- endif
- ENDDO
- ENDDO
- if(ionode) then ! root node for i/o
- if(spn_formatted) then ! slow formatted way
- counter=0
- do m=1,num_bands
- do n=1,m
- counter=counter+1
- do s=1,3
- write(iun_spn,'(2es26.16)') spn(s,counter) + spn_aug(s,counter)
- enddo
- enddo
- enddo
- else ! fast unformatted way
- write(iun_spn) ((spn(s,m) + spn_aug(s,m),s=1,3),m=1,((num_bands*(num_bands+1))/2))
- endif
- endif ! end of root activity
-
-
- ENDIF
-
- end DO
-
- IF (ionode .and. write_spn .and. noncolin) CLOSE (iun_spn)
-
- if(write_spn.and.noncolin) deallocate(spn, spn_aug)
- if (any_uspp) then
- deallocate(be_n, be_m)
- call deallocate_bec_type(becp)
- endif
-
- WRITE(stdout,*)
- WRITE(stdout,*) ' SPIN calculated'
-
- RETURN
-END SUBROUTINE compute_spin
-
-!-----------------------------------------------------------------------
-SUBROUTINE compute_orb
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode
- USE kinds, ONLY: DP
- USE wvfct, ONLY : nbnd, npwx, current_k
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc, psic, psic_nc
- USE fft_base, ONLY : dffts, dfftp
- USE fft_interfaces, ONLY : fwfft, invfft
- USE klist, ONLY : nkstot, xk, ngk, igk_k
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE cell_base, ONLY : tpiba2, alat, at, bg
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE constants, ONLY : tpi
- USE uspp, ONLY : nkb, vkb
- USE uspp_param, ONLY : upf, nh, lmaxq
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum
- USE noncollin_module,ONLY : noncolin, npol
- USE gvecw, ONLY : gcutw
- USE wannier
- ! begin change Lopez, Thonhauser, Souza
- USE mp, ONLY : mp_barrier
- USE scf, ONLY : vrs, vltot, v, kedtau
- USE gvecs, ONLY : doublegrid
- USE lsda_mod, ONLY : nspin
- USE constants, ONLY : rytoev
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
- !
- INTEGER :: mmn_tot, ik, ikp, ipol, ib, npw, i, m, n
- INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
- INTEGER :: ikevc, ikpevcq, s, counter
- COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
- becp2(:,:), Mkb(:,:), aux_nc(:,:)
- real(DP), ALLOCATABLE :: rbecp2(:,:)
- COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:)
- real(DP), ALLOCATABLE :: qg(:), ylm(:,:), workg(:)
- COMPLEX(DP) :: mmn, zdotc, phase1
- real(DP) :: arg, g_(3)
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp
- INTEGER :: nn,inn,loop,loop2
- LOGICAL :: nn_found
- INTEGER :: istart,iend
- ! begin change Lopez, Thonhauser, Souza
- COMPLEX(DP) :: sigma_x,sigma_y,sigma_z,cdum1,cdum2
- integer :: npw_b1, npw_b2, i_b1, i_b2, ikp_b1, ikp_b2
- integer, allocatable :: igk_b1(:), igk_b2(:)
- complex(DP), allocatable :: evc_b1(:,:),evc_b2(:,:),evc_aux(:,:),H_evc(:,:)
- complex(DP), allocatable :: uHu(:,:),uIu(:,:),spn(:,:)
- ! end change Lopez, Thonhauser, Souza
-
- any_uspp = any(upf(1:ntyp)%tvanp)
-
- IF(any_uspp .and. noncolin) CALL errore('pw2wannier90',&
- 'NCLS calculation not implimented with USP',1)
-
- ALLOCATE( phase(dffts%nnr) )
- ALLOCATE( evcq(npol*npwx,nbnd) )
-
- IF(noncolin) THEN
- ALLOCATE( aux_nc(npwx,npol) )
- ELSE
- ALLOCATE( aux(npwx) )
- ENDIF
-
- IF (gamma_only) ALLOCATE(aux2(npwx))
-
- IF (wan_mode=='library') ALLOCATE(m_mat(num_bands,num_bands,nnb,iknum))
-
- if (write_uHu) allocate(uhu(num_bands,num_bands))
- if (write_uIu) allocate(uIu(num_bands,num_bands))
-
-
-!ivo
-! not sure this is really needed
- if((write_uhu.or.write_uIu).and.wan_mode=='library')&
- call errore('pw2wannier90',&
- 'write_uhu, and write_uIu not meant to work library mode',1)
-!endivo
-
-
- !
- !
- ! begin change Lopez, Thonhauser, Souza
- !
- !====================================================================
- !
- ! The following code was inserted by Timo Thonhauser, Ivo Souza, and
- ! Graham Lopez in order to calculate the matrix elements
- ! necessary for the Wannier interpolation
- ! of the orbital magnetization
- !
- !====================================================================
- !
- !
- !
- if(write_uHu.or.write_uIu) then !ivo
- !
- if(gamma_only) call errore('pw2wannier90',&
- 'write_uHu and write_uIu not yet implemented for gamma_only case',1) !ivo
- if(any_uspp) call errore('pw2wannier90',&
- 'write_uHu and write_uIu not yet implemented with USP',1) !ivo
- !
- !
- allocate(igk_b1(npwx),igk_b2(npwx),evc_b1(npol*npwx,nbnd),&
- evc_b2(npol*npwx,nbnd),&
- evc_aux(npol*npwx,nbnd))
- !
- if(write_uHu) then
- allocate(H_evc(npol*npwx,nbnd))
- write(stdout,*)
- write(stdout,*) ' -----------------'
- write(stdout,*) ' *** Compute uHu '
- write(stdout,*) ' -----------------'
- write(stdout,*)
- iun_uhu = find_free_unit()
- if (ionode) then
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- if(uHu_formatted) then
- open (unit=iun_uhu, file=TRIM(seedname)//".uHu",form='FORMATTED')
- write (iun_uhu,*) header
- write (iun_uhu,*) nbnd, iknum, nnb
- else
- open (unit=iun_uhu, file=TRIM(seedname)//".uHu",form='UNFORMATTED')
- write (iun_uhu) header
- write (iun_uhu) nbnd, iknum, nnb
- endif
- endif
- endif
- if(write_uIu) then
- write(stdout,*)
- write(stdout,*) ' -----------------'
- write(stdout,*) ' *** Compute uIu '
- write(stdout,*) ' -----------------'
- write(stdout,*)
- iun_uIu = find_free_unit()
- if (ionode) then
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- if(uIu_formatted) then
- open (unit=iun_uIu, file=TRIM(seedname)//".uIu",form='FORMATTED')
- write (iun_uIu,*) header
- write (iun_uIu,*) nbnd, iknum, nnb
- else
- open (unit=iun_uIu, file=TRIM(seedname)//".uIu",form='UNFORMATTED')
- write (iun_uIu) header
- write (iun_uIu) nbnd, iknum, nnb
- endif
- endif
- endif
-
- CALL set_vrs(vrs,vltot,v%of_r,kedtau,v%kin_r,dfftp%nnr,nspin,doublegrid)
- call allocate_bec_type ( nkb, nbnd, becp )
- ALLOCATE( workg(npwx) )
-
- write(stdout,'(a,i8)') ' iknum = ',iknum
- do ik = 1, iknum ! loop over k points
- !
- write (stdout,'(i8)') ik
- !
- npw = ngk(ik)
- ! sort the wfc at k and set up stuff for h_psi
- current_k=ik
- CALL init_us_2(npw,igk_k(1,ik),xk(1,ik),vkb)
- !
- ! compute " H | u_n,k+b2 > "
- !
- do i_b2 = 1, nnb ! nnb = # of nearest neighbors
- !
- ! read wfc at k+b2
- ikp_b2 = kpb(ik,i_b2) ! for kpoint 'ik', index of neighbor 'i_b2'
- !
-! call davcio (evc_b2, 2*nwordwfc, iunwfc, ikp_b2, -1 ) !ivo
- call davcio (evc_b2, 2*nwordwfc, iunwfc, ikp_b2+ikstart-1, -1 ) !ivo
-! call gk_sort (xk(1,ikp_b2), ngm, g, gcutw, npw_b2, igk_b2, workg)
-! ivo; igkq -> igk_k(:,ikp_b2), npw_b2 -> ngk(ikp_b2), replaced by PG
- npw_b2=ngk(ikp_b2)
- !
- ! compute the phase
- phase(:) = ( 0.0D0, 0.0D0 )
- if (ig_(ik,i_b2)>0) phase( dffts%nl(ig_(ik,i_b2)) ) = ( 1.0D0, 0.0D0 )
- call invfft('Wave', phase, dffts)
- !
- ! loop on bands
- evc_aux = ( 0.0D0, 0.0D0 )
- do n = 1, nbnd
- !ivo replaced dummy m --> n everywhere on this do loop,
- ! for consistency w/ band indices in comments
- if (excluded_band(n)) cycle
- if(noncolin) then
- psic_nc = ( 0.0D0, 0.0D0 ) !ivo
- do ipol = 1, 2
-! psic_nc = ( 0.0D0, 0.0D0 ) !ivo
- istart=(ipol-1)*npwx+1
- iend=istart+npw_b2-1 !ivo npw_b1 --> npw_b2
- psic_nc(dffts%nl (igk_k(1:npw_b2,ikp_b2) ),ipol ) = &
- evc_b2(istart:iend, n)
- ! ivo igk_b1, npw_b1 --> igk_b2, npw_b2
- ! multiply by phase in real space - '1' unless neighbor is in a bordering BZ
- call invfft ('Wave', psic_nc(:,ipol), dffts)
- psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * conjg(phase(1:dffts%nnr))
- call fwfft ('Wave', psic_nc(:,ipol), dffts)
- ! save the result
- iend=istart+npw-1
- evc_aux(istart:iend,n) = psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol )
- end do
- else ! this is modeled after the pre-existing code at 1162
- psic = ( 0.0D0, 0.0D0 )
- ! Graham, changed npw --> npw_b2 on RHS. Do you agree?!
- psic(dffts%nl (igk_k(1:npw_b2,ikp_b2) ) ) = evc_b2(1:npw_b2, n)
- call invfft ('Wave', psic, dffts)
- psic(1:dffts%nnr) = psic(1:dffts%nnr) * conjg(phase(1:dffts%nnr))
- call fwfft ('Wave', psic, dffts)
- evc_aux(1:npw,n) = psic(dffts%nl (igk_k(1:npw,ik) ) )
- end if
- end do !n
-
- if(write_uHu) then !ivo
- !
- ! calculate the kinetic energy at ik, used in h_psi
- !
- CALL g2_kin (ik)
- !
- CALL h_psi(npwx, npw, nbnd, evc_aux, H_evc)
- !
- endif
- !
- ! compute " < u_m,k+b1 | "
- !
- do i_b1 = 1, nnb
- !
- ! read wfc at k+b1 !ivo replaced k+b2 --> k+b1
- ikp_b1 = kpb(ik,i_b1)
-! call davcio (evc_b1, 2*nwordwfc, iunwfc, ikp_b1, -1 ) !ivo
- call davcio (evc_b1, 2*nwordwfc, iunwfc, ikp_b1+ikstart-1, -1 ) !ivo
-
-! call gk_sort (xk(1,ikp_b1), ngm, g, gcutw, npw_b2, igk_b2, workg) !ivo
- call gk_sort (xk(1,ikp_b1), ngm, g, gcutw, npw_b1, igk_b1, workg) !ivo
- !
- ! compute the phase
- phase(:) = ( 0.0D0, 0.0D0 )
- if (ig_(ik,i_b1)>0) phase( dffts%nl(ig_(ik,i_b1)) ) = ( 1.0D0, 0.0D0 )
- !call cft3s (phase, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
- call invfft('Wave', phase, dffts)
- !
- ! loop on bands
- do m = 1, nbnd
- if (excluded_band(m)) cycle
- if(noncolin) then
- aux_nc = ( 0.0D0, 0.0D0 )
- psic_nc = ( 0.0D0, 0.0D0 ) !ivo
- do ipol = 1, 2
-! psic_nc = ( 0.0D0, 0.0D0 ) !ivo
- istart=(ipol-1)*npwx+1
- iend=istart+npw_b1-1 !ivo npw_b2 --> npw_b1
- psic_nc(dffts%nl (igk_b1(1:npw_b1) ),ipol ) = evc_b1(istart:iend, m) !ivo igk_b2,npw_b2 --> igk_b1,npw_b1
- ! multiply by phase in real space - '1' unless neighbor is in a different BZ
- call invfft ('Wave', psic_nc(:,ipol), dffts)
- !psic_nc(1:nrxxs,ipol) = psic_nc(1:nrxxs,ipol) * conjg(phase(1:nrxxs))
- psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * conjg(phase(1:dffts%nnr))
- call fwfft ('Wave', psic_nc(:,ipol), dffts)
- ! save the result
- aux_nc(1:npw,ipol) = psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol )
- end do
- else ! this is modeled after the pre-existing code at 1162
- aux = ( 0.0D0 )
- psic = ( 0.0D0, 0.0D0 )
- ! Graham, changed npw --> npw_b1 on RHS. Do you agree?!
- psic(dffts%nl (igk_b1(1:npw_b1) ) ) = evc_b1(1:npw_b1, m) !ivo igk_b2 --> igk_b1
- call invfft ('Wave', psic, dffts)
- !psic(1:nrxxs) = psic(1:nrxxs) * conjg(phase(1:nrxxs))
- psic(1:dffts%nnr) = psic(1:dffts%nnr) * conjg(phase(1:dffts%nnr))
- call fwfft ('Wave', psic, dffts)
- aux(1:npw) = psic(dffts%nl (igk_k(1:npw,ik) ) )
- end if
-
- !
- !
- if(write_uHu) then !ivo
- do n = 1, nbnd ! loop over bands of already computed ket
- if (excluded_band(n)) cycle
- if(noncolin) then
- mmn = zdotc (npw, aux_nc(1,1),1,H_evc(1,n),1) + &
- zdotc (npw, aux_nc(1,2),1,H_evc(1+npwx,n),1)
- else
- mmn = zdotc (npw, aux,1,H_evc(1,n),1)
- end if
- mmn = mmn * rytoev ! because wannier90 works in eV
- call mp_sum(mmn, intra_pool_comm)
-! if (ionode) write (iun_uhu) mmn
- uHu(n,m)=mmn
- !
- end do !n
- endif
- if(write_uIu) then !ivo
- do n = 1, nbnd ! loop over bands of already computed ket
- if (excluded_band(n)) cycle
- if(noncolin) then
- mmn = zdotc (npw, aux_nc(1,1),1,evc_aux(1,n),1) + &
- zdotc (npw, aux_nc(1,2),1,evc_aux(1+npwx,n),1)
- else
- mmn = zdotc (npw, aux,1,evc_aux(1,n),1)
- end if
- call mp_sum(mmn, intra_pool_comm)
-! if (ionode) write (iun_uIu) mmn
- uIu(n,m)=mmn
- !
- end do !n
- endif
- !
- end do ! m = 1, nbnd
- if (ionode) then ! write the files out to disk
- if(write_uhu) then
- if(uHu_formatted) then ! slow bulky way for transferable files
- do n=1,num_bands
- do m=1,num_bands
- write(iun_uHu,'(2ES20.10)') uHu(m,n)
- enddo
- enddo
- else ! the fast way
- write(iun_uHu) ((uHu(n,m),n=1,num_bands),m=1,num_bands)
- endif
- endif
- if(write_uiu) then
- if(uIu_formatted) then ! slow bulky way for transferable files
- do n=1,num_bands
- do m=1,num_bands
- write(iun_uIu,'(2ES20.10)') uIu(m,n)
- enddo
- enddo
- else ! the fast way
- write(iun_uIu) ((uIu(n,m),n=1,num_bands),m=1,num_bands)
- endif
- endif
- endif ! end of io
- end do ! i_b1
- end do ! i_b2
- end do ! ik
- DEALLOCATE (workg)
- !
- deallocate(igk_b1,igk_b2,evc_b1,evc_b2,evc_aux)
- if(write_uHu) then
- deallocate(H_evc)
- deallocate(uHu)
- end if
- if(write_uIu) deallocate(uIu)
- if (ionode.and.write_uHu) close (iun_uhu) !ivo
- if (ionode.and.write_uIu) close (iun_uIu) !ivo
- !
- else
- if(.not.write_uHu) then
- write(stdout,*)
- write(stdout,*) ' -------------------------------'
- write(stdout,*) ' *** uHu matrix is not computed '
- write(stdout,*) ' -------------------------------'
- write(stdout,*)
- endif
- if(.not.write_uIu) then
- write(stdout,*)
- write(stdout,*) ' -------------------------------'
- write(stdout,*) ' *** uIu matrix is not computed '
- write(stdout,*) ' -------------------------------'
- write(stdout,*)
- endif
- end if
- !
- !
- !
- !
- !
- !
- !====================================================================
- !
- ! END_m_orbit
- !
- !====================================================================
- !
- ! end change Lopez, Thonhauser, Souza
- !
- !
- !
-
- IF (gamma_only) DEALLOCATE(aux2)
- DEALLOCATE (phase)
- IF(noncolin) THEN
- DEALLOCATE(aux_nc)
- ELSE
- DEALLOCATE(aux)
- ENDIF
- DEALLOCATE(evcq)
- if(write_spn.and.noncolin) deallocate(spn)
-
- IF(any_uspp) THEN
- DEALLOCATE ( qb)
- CALL deallocate_bec_type (becp)
- IF (gamma_only) THEN
- DEALLOCATE (rbecp2)
- ELSE
- DEALLOCATE (becp2)
- ENDIF
- ENDIF
-!
- WRITE(stdout,*)
- WRITE(stdout,*) ' uHu calculated'
-
- RETURN
-END SUBROUTINE compute_orb
-!
-!-----------------------------------------------------------------------
-SUBROUTINE compute_amn
- !-----------------------------------------------------------------------
- !
- USE io_global, ONLY : stdout, ionode
- USE kinds, ONLY : DP
- USE klist, ONLY : nkstot, xk, ngk, igk_k
- USE wvfct, ONLY : nbnd, npwx
- USE control_flags, ONLY : gamma_only
- USE wavefunctions, ONLY : evc
- USE io_files, ONLY : nwordwfc, iunwfc
- USE gvect, ONLY : g, ngm, gstart
- USE uspp, ONLY : nkb, vkb
- USE becmod, ONLY : bec_type, becp, calbec, &
- allocate_bec_type, deallocate_bec_type
- USE wannier
- USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
- USE uspp_param, ONLY : upf
- USE mp_pools, ONLY : intra_pool_comm
- USE mp, ONLY : mp_sum
- USE noncollin_module,ONLY : noncolin, npol
- USE gvecw, ONLY : gcutw
- USE constants, ONLY : eps6
-
- IMPLICIT NONE
- !
- INTEGER, EXTERNAL :: find_free_unit
- !
- COMPLEX(DP) :: amn, zdotc,amn_tmp,fac(2)
- real(DP):: ddot
- COMPLEX(DP), ALLOCATABLE :: sgf(:,:)
- INTEGER :: ik, npw, ibnd, ibnd1, iw,i, ikevc, nt, ipol
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp, opnd, exst,spin_z_pos, spin_z_neg
- INTEGER :: istart
-
- !nocolin: we have half as many projections g(r) defined as wannier
- ! functions. We project onto (1,0) (ie up spin) and then onto
- ! (0,1) to obtain num_wann projections. jry
-
-
- !call read_gf_definition.....> this is done at the beging
-
- CALL start_clock( 'compute_amn' )
-
- any_uspp =any (upf(1:ntyp)%tvanp)
-
- IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum))
-
- IF (wan_mode=='standalone') THEN
- iun_amn = find_free_unit()
- IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted')
- ENDIF
-
- WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum
- !
- IF (wan_mode=='standalone') THEN
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime
- IF (ionode) THEN
- WRITE (iun_amn,*) header
- WRITE (iun_amn,*) nbnd-nexband, iknum, n_wannier
- !WRITE (iun_amn,*) nbnd-nexband, iknum, n_proj
- ENDIF
- ENDIF
- !
- ALLOCATE( sgf(npwx,n_proj))
- ALLOCATE( gf_spinor(2*npwx,n_proj))
- ALLOCATE( sgf_spinor(2*npwx,n_proj))
- !
- IF (any_uspp) THEN
- CALL allocate_bec_type ( nkb, n_wannier, becp)
- CALL init_us_1
- ENDIF
- !
-
- DO ik=1,iknum
- WRITE (stdout,'(i8)',advance='no') ik
- IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- ikevc = ik + ikstart - 1
-! if(noncolin) then
-! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 )
-! else
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
-! end if
- npw = ngk(ik)
- CALL generate_guiding_functions(ik) ! they are called gf(npw,n_proj)
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- if(noncolin) then
- sgf_spinor = (0.d0,0.d0)
- call orient_gf_spinor(npw)
- endif
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! USPP
- !
- IF(any_uspp) THEN
- CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
- ! below we compute the product of beta functions with trial func.
- IF (gamma_only) THEN
- CALL calbec ( npw, vkb, gf, becp, n_proj )
- ELSE if (noncolin) then
- CALL calbec ( npw, vkb, gf_spinor, becp, n_proj )
- else
- CALL calbec ( npw, vkb, gf, becp, n_proj )
- ENDIF
- ! and we use it for the product S|trial_func>
- if (noncolin) then
- CALL s_psi (npwx, npw, n_proj, gf_spinor, sgf_spinor)
- else
- CALL s_psi (npwx, npw, n_proj, gf, sgf)
- endif
-
- ELSE
- !if (noncolin) then
- ! sgf_spinor(:,:) = gf_spinor
- !else
- sgf(:,:) = gf(:,:)
- !endif
- ENDIF
- !
- noncolin_case : &
- IF(noncolin) THEN
- old_spinor_proj_case : &
- IF(old_spinor_proj) THEN
- ! we do the projection as g(r)*a(r) and g(r)*b(r)
- DO ipol=1,npol
- istart = (ipol-1)*npwx + 1
- DO iw = 1,n_proj
- ibnd1 = 0
- DO ibnd = 1,nbnd
- IF (excluded_band(ibnd)) CYCLE
- amn=(0.0_dp,0.0_dp)
- ! amn = zdotc(npw,evc_nc(1,ipol,ibnd),1,sgf(1,iw),1)
- if (any_uspp) then
- amn = zdotc(npw, evc(0,ibnd), 1, sgf_spinor(1, iw + (ipol-1)*n_proj), 1)
- amn = amn + zdotc(npw, evc(npwx+1,ibnd), 1, sgf_spinor(npwx+1, iw + (ipol-1)*n_proj), 1)
- else
- amn = zdotc(npw,evc(istart,ibnd),1,sgf(1,iw),1)
- endif
- CALL mp_sum(amn, intra_pool_comm)
- ibnd1=ibnd1+1
- IF (wan_mode=='standalone') THEN
- IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') ibnd1, iw+n_proj*(ipol-1), ik, amn
- ELSEIF (wan_mode=='library') THEN
- a_mat(ibnd1,iw+n_proj*(ipol-1),ik) = amn
- ELSE
- CALL errore('compute_amn',' value of wan_mode not recognised',1)
- ENDIF
- ENDDO
- ENDDO
- ENDDO
- ELSE old_spinor_proj_case
- DO iw = 1,n_proj
- spin_z_pos=.false.;spin_z_neg=.false.
- ! detect if spin quantisation axis is along z
- if((abs(spin_qaxis(1,iw)-0.0d0) nsp, tau
- USE uspp_param, ONLY : upf
-
- IMPLICIT NONE
-
- INTEGER, EXTERNAL :: find_free_unit
- COMPLEX(DP), ALLOCATABLE :: phase(:), nowfc1(:,:), nowfc(:,:), psi_gamma(:,:), &
- qr_tau(:), cwork(:), cwork2(:), Umat(:,:), VTmat(:,:), Amat(:,:) ! vv: complex arrays for the SVD factorization
- REAL(DP), ALLOCATABLE :: focc(:), rwork(:), rwork2(:), singval(:), rpos(:,:), cpos(:,:) ! vv: Real array for the QR factorization and SVD
- INTEGER, ALLOCATABLE :: piv(:) ! vv: Pivot array in the QR factorization
- COMPLEX(DP) :: tmp_cwork(2)
- REAL(DP):: ddot, sumk, norm_psi, f_gamma
- INTEGER :: ik, npw, ibnd, iw, ikevc, nrtot, ipt, info, lcwork, locibnd, &
- jpt,kpt,lpt, ib, istart, gamma_idx, minmn, minmn2, maxmn2, numbands, nbtot
- CHARACTER (len=9) :: cdate,ctime
- CHARACTER (len=60) :: header
- LOGICAL :: any_uspp, found_gamma
-
-#if defined(__MPI)
- INTEGER :: nxxs
- COMPLEX(DP),ALLOCATABLE :: psic_all(:)
- nxxs = dffts%nr1x * dffts%nr2x * dffts%nr3x
- ALLOCATE(psic_all(nxxs) )
-#endif
-
- ! vv: Write info about SCDM in output
- IF (TRIM(scdm_entanglement) == 'isolated') THEN
- WRITE(stdout,'(1x,a,a/)') 'Case : ',trim(scdm_entanglement)
- ELSEIF (TRIM(scdm_entanglement) == 'erfc' .OR. &
- TRIM(scdm_entanglement) == 'gaussian') THEN
- WRITE(stdout,'(1x,a,a)') 'Case : ',trim(scdm_entanglement)
- WRITE(stdout,'(1x,a,f10.3,a/,1x,a,f10.3,a/)') 'mu = ', scdm_mu, ' eV', 'sigma =', scdm_sigma, ' eV'
- ENDIF
-
- CALL start_clock( 'compute_amn' )
-
- any_uspp =any (upf(1:ntyp)%tvanp)
-
- ! vv: Error for using SCDM with non-collinear spin calculations
- IF (noncolin) THEN
- call errore('pw2wannier90','The SCDM method is not compatible with non-collinear spin yet.',1)
- ENDIF
-
- ! vv: Error for using SCDM with Ultrasoft pseudopotentials
- !IF (any_uspp) THEN
- ! call errore('pw2wannier90','The SCDM method does not work with Ultrasoft pseudopotential yet.',1)
- !ENDIF
-
- ! vv: Error for using SCDM with gamma_only
- IF (gamma_only) THEN
- call errore('pw2wannier90','The SCDM method does not work with gamma_only calculations.',1)
- ENDIF
- ! vv: Allocate all the variables for the SCDM method:
- ! 1)For the QR decomposition
- ! 2)For the unk's on the real grid
- ! 3)For the SVD
- IF(TRIM(scdm_entanglement) == 'isolated') THEN
- numbands=n_wannier
- nbtot=n_wannier + nexband
- ELSE
- numbands=nbnd-nexband
- nbtot=nbnd
- ENDIF
- nrtot = dffts%nr1*dffts%nr2*dffts%nr3
- info = 0
- minmn = MIN(numbands,nrtot)
- ALLOCATE(qr_tau(2*minmn))
- ALLOCATE(piv(nrtot))
- piv(:) = 0
- ALLOCATE(rwork(2*nrtot))
- rwork(:) = 0.0_DP
-
- ALLOCATE(kpt_latt(3,iknum))
- ALLOCATE(nowfc1(n_wannier,numbands))
- ALLOCATE(nowfc(n_wannier,numbands))
- ALLOCATE(psi_gamma(nrtot,numbands))
- ALLOCATE(focc(numbands))
- minmn2 = MIN(numbands,n_wannier)
- maxmn2 = MAX(numbands,n_wannier)
- ALLOCATE(rwork2(5*minmn2))
-
- ALLOCATE(rpos(nrtot,3))
- ALLOCATE(cpos(n_wannier,3))
- ALLOCATE(phase(n_wannier))
- ALLOCATE(singval(n_wannier))
- ALLOCATE(Umat(numbands,n_wannier))
- ALLOCATE(VTmat(n_wannier,n_wannier))
- ALLOCATE(Amat(numbands,n_wannier))
-
- IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum))
-
- IF (wan_mode=='standalone') THEN
- iun_amn = find_free_unit()
- IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted')
- ENDIF
-
- WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum
- !
- IF (wan_mode=='standalone') THEN
- CALL date_and_tim( cdate, ctime )
- header='Created on '//cdate//' at '//ctime//' with SCDM '
- IF (ionode) THEN
- WRITE (iun_amn,*) header
- WRITE (iun_amn,'(3i8,xxx,2f10.6)') numbands, iknum, n_wannier, scdm_mu, scdm_sigma
- ENDIF
- ENDIF
-
- !vv: Find Gamma-point index in the list of k-vectors
- ik = 0
- gamma_idx = 1
- sumk = -1.0_DP
- found_gamma = .false.
- kpt_latt(:,1:iknum)=xk(:,1:iknum)
- CALL cryst_to_cart(iknum,kpt_latt,at,-1)
- DO WHILE(sumk/=0.0_DP .and. ik < iknum)
- ik = ik + 1
- sumk = ABS(kpt_latt(1,ik)**2 + kpt_latt(2,ik)**2 + kpt_latt(3,ik)**2)
- IF (sumk==0.0_DP) THEN
- found_gamma = .true.
- gamma_idx = ik
- ENDIF
- END DO
- IF (.not. found_gamma) call errore('compute_amn','No Gamma point found.',1)
-
- f_gamma = 0.0_DP
- ik = gamma_idx
- locibnd = 0
- DO ibnd=1,nbtot
- IF(excluded_band(ibnd)) CYCLE
- locibnd = locibnd + 1
- ! check locibnd <= numbands
- IF (locibnd > numbands) call errore('compute_amn','Something wrong with the number of bands. Check exclude_bands.')
- IF(TRIM(scdm_entanglement) == 'isolated') THEN
- f_gamma = 1.0_DP
- ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN
- f_gamma = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma)
- ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN
- f_gamma = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2))
- ELSE
- call errore('compute_amn','scdm_entanglement value not recognized.',1)
- END IF
- CALL davcio (evc, 2*nwordwfc, iunwfc, ik, -1 )
- npw = ngk(ik)
- ! vv: Compute unk's on a real grid (the fft grid)
- psic(:) = (0.D0,0.D0)
- psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd)
- CALL invfft ('Wave', psic, dffts)
-#if defined(__MPI)
- CALL gather_grid(dffts,psic,psic_all)
- ! vv: Gamma only
- ! vv: Build Psi_k = Unk * focc
- norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP))
- psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi
- psi_gamma(1:nrtot,locibnd) = psic_all(1:nrtot)
- psi_gamma(1:nrtot,locibnd) = psi_gamma(1:nrtot,locibnd) * f_gamma
-#else
- norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP))
- psic(1:nrtot) = psic(1:nrtot)/ norm_psi
- psi_gamma(1:nrtot,locibnd) = psic(1:nrtot)
- psi_gamma(1:nrtot,locibnd) = psi_gamma(1:nrtot,locibnd) * f_gamma
-#endif
- ENDDO
-
- ! vv: Perform QR factorization with pivoting on Psi_Gamma
- ! vv: Preliminary call to define optimal values for lwork and cwork size
- CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,tmp_cwork,-1,rwork,info)
- IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
- lcwork = AINT(REAL(tmp_cwork(1)))
- tmp_cwork(:) = (0.0_DP,0.0_DP)
- piv(:) = 0
- rwork(:) = 0.0_DP
- ALLOCATE(cwork(lcwork))
- cwork(:) = (0.0_DP,0.0_DP)
-#if defined(__MPI)
- IF(ionode) THEN
- CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info)
- IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
- ENDIF
- CALL mp_bcast(piv,ionode_id,world_comm)
-#else
- ! vv: Perform QR factorization with pivoting on Psi_Gamma
- CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info)
- IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
-#endif
- DEALLOCATE(cwork)
- tmp_cwork(:) = (0.0_DP,0.0_DP)
-
- ! vv: Compute the points
- lpt = 0
- rpos(:,:) = 0.0_DP
- cpos(:,:) = 0.0_DP
- DO kpt = 0,dffts%nr3-1
- DO jpt = 0,dffts%nr2-1
- DO ipt = 0,dffts%nr1-1
- lpt = lpt + 1
- rpos(lpt,1) = REAL(ipt)/dffts%nr1
- rpos(lpt,2) = REAL(jpt)/dffts%nr2
- rpos(lpt,3) = REAL(kpt)/dffts%nr3
- ENDDO
- ENDDO
- ENDDO
- DO iw=1,n_wannier
- cpos(iw,:) = rpos(piv(iw),:)
- cpos(iw,:) = cpos(iw,:) - ANINT(cpos(iw,:))
- ENDDO
-
- DO ik=1,iknum
- WRITE (stdout,'(i8)',advance='no') ik
- IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
- FLUSH(stdout)
- ikevc = ik + ikstart - 1
-! if(noncolin) then
-! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 )
-! else
-! end if
-
- ! vv: SCDM method for generating the Amn matrix
- phase(:) = (0.0_DP,0.0_DP)
- nowfc1(:,:) = (0.0_DP,0.0_DP)
- nowfc(:,:) = (0.0_DP,0.0_DP)
- Umat(:,:) = (0.0_DP,0.0_DP)
- VTmat(:,:) = (0.0_DP,0.0_DP)
- Amat(:,:) = (0.0_DP,0.0_DP)
- singval(:) = 0.0_DP
- rwork2(:) = 0.0_DP
- locibnd = 0
- ! vv: Generate the occupation numbers matrix according to scdm_entanglement
- DO ibnd=1,nbtot
- IF (excluded_band(ibnd)) CYCLE
- locibnd = locibnd + 1
- ! vv: Define the occupation numbers matrix according to scdm_entanglement
- IF(TRIM(scdm_entanglement) == 'isolated') THEN
- focc(locibnd) = 1.0_DP
- ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN
- focc(locibnd) = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma)
- ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN
- focc(locibnd) = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2))
- ELSE
- call errore('compute_amn','scdm_entanglement value not recognized.',1)
- END IF
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
- npw = ngk(ik)
- psic(:) = (0.D0,0.D0)
- psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd)
- CALL invfft ('Wave', psic, dffts)
-#if defined(__MPI)
- CALL gather_grid(dffts,psic,psic_all)
- norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP))
- psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi
- DO iw = 1,n_wannier
- phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
- &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),&
- &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
- &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)))
- nowfc(iw,locibnd) = phase(iw)*psic_all(piv(iw))*focc(locibnd)
- ENDDO
-#else
- norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP))
- psic(1:nrtot) = psic(1:nrtot)/ norm_psi
- DO iw = 1,n_wannier
- phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
- &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),&
- &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
- &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)))
- nowfc(iw,locibnd) = phase(iw)*psic(piv(iw))*focc(locibnd)
-
- ENDDO
-#endif
- ENDDO
-
- CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
- &singval,Umat,numbands,VTmat,n_wannier,tmp_cwork,-1,rwork2,info)
- lcwork = AINT(REAL(tmp_cwork(1)))
- tmp_cwork(:) = (0.0_DP,0.0_DP)
- ALLOCATE(cwork(lcwork))
-#if defined(__MPI)
- IF(ionode) THEN
- ! vv: SVD to generate orthogonal projections
- CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
- &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info)
- IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1)
- ENDIF
- CALL mp_bcast(Umat,ionode_id,world_comm)
- CALL mp_bcast(VTmat,ionode_id,world_comm)
-#else
- ! vv: SVD to generate orthogonal projections
- CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
- &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info)
- IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1)
-#endif
- DEALLOCATE(cwork)
-
- Amat = MATMUL(Umat,VTmat)
- DO iw = 1,n_wannier
- locibnd = 0
- DO ibnd = 1,nbtot
- IF (excluded_band(ibnd)) CYCLE
- locibnd = locibnd + 1
- IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') locibnd, iw, ik, REAL(Amat(locibnd,iw)), AIMAG(Amat(locibnd,iw))
- ENDDO
- ENDDO
- ENDDO ! k-points
-
- ! vv: Deallocate all the variables for the SCDM method
- DEALLOCATE(kpt_latt)
- DEALLOCATE(psi_gamma)
- DEALLOCATE(nowfc)
- DEALLOCATE(nowfc1)
- DEALLOCATE(focc)
- DEALLOCATE(piv)
- DEALLOCATE(qr_tau)
- DEALLOCATE(rwork)
- DEALLOCATE(rwork2)
- DEALLOCATE(rpos)
- DEALLOCATE(cpos)
- DEALLOCATE(Umat)
- DEALLOCATE(VTmat)
- DEALLOCATE(Amat)
- DEALLOCATE(singval)
-
-#if defined(__MPI)
- DEALLOCATE( psic_all )
-#endif
-
- IF (ionode .and. wan_mode=='standalone') CLOSE (iun_amn)
- WRITE(stdout,'(/)')
- WRITE(stdout,*) ' AMN calculated'
- CALL stop_clock( 'compute_amn' )
-
- RETURN
-END SUBROUTINE compute_amn_with_scdm
-
-subroutine orient_gf_spinor(npw)
- use constants, only: eps6
- use noncollin_module, only: npol
- use wvfct, ONLY : npwx
- use wannier
-
- implicit none
-
- integer :: npw, iw, ipol, istart, iw_spinor
- logical :: spin_z_pos, spin_z_neg
- complex(dp) :: fac(2)
-
-
- gf_spinor = (0.0d0, 0.0d0)
- if (old_spinor_proj) then
- iw_spinor = 1
- DO ipol=1,npol
- istart = (ipol-1)*npwx + 1
- DO iw = 1,n_proj
- ! generate 2*nproj spinor functions, one for each spin channel
- gf_spinor(istart:istart+npw-1, iw_spinor) = gf(1:npw, iw)
- iw_spinor = iw_spinor + 1
- enddo
- enddo
- else
- DO iw = 1,n_proj
- spin_z_pos=.false.;spin_z_neg=.false.
- ! detect if spin quantisation axis is along z
- if((abs(spin_qaxis(1,iw)-0.0d0).unkg file
- !
- iun_parity = find_free_unit()
- IF (ionode) THEN
- OPEN (unit=iun_parity, file=trim(seedname)//".unkg",form='formatted')
- WRITE(stdout,*)"Finding the 32 unkg's per band required for parity signature."
- ENDIF
- !
- ! g_abc(:,ipw) are the coordinates of the ipw-th G vector in b1, b2, b3 basis,
- ! we compute them from g(:,ipw) by multiplying : transpose(at) with g(:,ipw)
- !
- ALLOCATE(g_abc(3,npw))
- DO igv=1,npw
- g_abc(:,igk_k(igv,kgamma))=matmul(transpose(at),g(:,igk_k(igv,kgamma)))
- ENDDO
- !
- ! Count and identify the G vectors we will be extracting for each
- ! cpu.
- !
- ig_idx=0
- num_G = 0
- DO igv=1,npw
- ! 0-th Order
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! 1
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- ! 1st Order
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- ! 2nd Order
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! yz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! yz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! z^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- ! 3rd Order
- IF ( (abs(g_abc(1,igv) - 3.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^3
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2y
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2y
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! x^2z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! x^2z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xyz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xyz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xyz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xyz
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! xz^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 2.d0 <= eps6) ) THEN ! xz^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 3.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y^3
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! y^2z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! y^2z
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! yz^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and.&
- (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) + 2.d0 <= eps6) ) THEN ! yz^2
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
- (abs(g_abc(3,igv)) - 3.d0 <= eps6) ) THEN ! z^3
- num_G(mpime+1) = num_G(mpime+1) + 1
- ig_idx(num_G(mpime+1))=igv
- CYCLE
- ENDIF
- ENDDO
- !
- ! Sum laterally across cpus num_G, so it contains
- ! the number of g_vectors on each node, and known to all cpus
- !
- CALL mp_sum(num_G, intra_pool_comm)
-
- IF (ionode) WRITE(iun_parity,*) sum(num_G)
- IF (sum(num_G) /= 32) CALL errore('write_parity', 'incorrect number of g-vectors extracted',1)
- IF (ionode) THEN
- WRITE(stdout,*)' ...done'
- WRITE(stdout,*)'G-vector splitting:'
- DO i=1,nproc
- WRITE(stdout,*)' cpu: ',i-1,' number g-vectors: ',num_G(i)
- ENDDO
- WRITE(stdout,*)' Collecting g-vectors and writing to file'
- ENDIF
-
- !
- ! Define needed intermediate arrays
- !
- ALLOCATE(evc_sub(32,nbnd,nproc))
- ALLOCATE(evc_sub_gathered(32,nbnd))
- ALLOCATE(g_abc_pre_gather(3,32,nproc))
- !
- ! Initialise
- !
- evc_sub=(0.d0,0.d0)
- evc_sub_1D=(0.d0,0.d0)
- evc_sub_gathered=(0.d0,0.d0)
- g_abc_pre_gather=0
- g_abc_1D=0
- g_abc_gathered=0
- !
- ! Compute displacements needed for filling evc_sub
- !
- displ(1)=1
- IF (nproc > 1) THEN
- DO i=2,nproc
- displ(i)=displ(i-1)+num_G(i-1)
- ENDDO
- ENDIF
- !
- ! Fill evc_sub with required fourier component from each cpu dependent evc
- !
- DO i=1,num_G(mpime+1)
- evc_sub(i+displ(mpime+1)-1,:,mpime+1)=evc(ig_idx(i),:)
- ENDDO
- !
- ! g_abc_pre_gather(:,ipw,icpu) are the coordinates of the ipw-th G vector in b1, b2, b3 basis
- ! on icpu and stored sequencially, ready for a lateral mp_sum
- !
- DO igv=1,num_G(mpime+1)
- g_abc_pre_gather(:,igv+displ(mpime+1)-1,mpime+1) = &
- matmul(transpose(at),g(:,ig_idx(igk_k(igv,kgamma))))
- ENDDO
- !
- ! Gather evc_sub and g_abc_pre_gather into common arrays to each cpu
- !
- DO ibnd=1,nbnd
- evc_sub_1D=evc_sub(:,ibnd,mpime+1)
- CALL mp_sum(evc_sub_1D, intra_pool_comm)
- evc_sub_gathered(:,ibnd)=evc_sub_1D
- ENDDO
- !
- DO i=1,3
- g_abc_1D=g_abc_pre_gather(i,:,mpime+1)
- CALL mp_sum(g_abc_1D, intra_pool_comm)
- g_abc_gathered(i,:)=g_abc_1D
- ENDDO
- !
- ! Write to file
- !
- DO ibnd=1,nbnd
- DO igv=1,32
- IF (ionode) WRITE(iun_parity,'(5i5,2f12.7)') ibnd, igv, nint(g_abc_gathered(1,igv)),&
- nint(g_abc_gathered(2,igv)),&
- nint(g_abc_gathered(3,igv)),&
- real(evc_sub_gathered(igv,ibnd)),&
- aimag(evc_sub_gathered(igv,ibnd))
- ENDDO
- ENDDO
- WRITE(stdout,*)' ...done'
- !
- IF (ionode) CLOSE(unit=iun_parity)
- !
- DEALLOCATE(evc_sub)
- DEALLOCATE(evc_sub_gathered)
- DEALLOCATE(g_abc_pre_gather)
-
- CALL stop_clock( 'write_parity' )
-
-END SUBROUTINE write_parity
-
-
-SUBROUTINE wan2sic
-
- USE io_global, ONLY : stdout
- USE kinds, ONLY : DP
- USE io_files, ONLY : iunwfc, nwordwfc, nwordwann
- USE gvect, ONLY : g, ngm
- USE wavefunctions, ONLY : evc, psic
- USE wvfct, ONLY : nbnd, npwx
- USE gvecw, ONLY : gcutw
- USE klist, ONLY : nkstot, xk, wk, ngk
- USE wannier
-
- IMPLICIT NONE
-
- INTEGER :: i, j, nn, ik, ibnd, iw, ikevc, npw
- COMPLEX(DP), ALLOCATABLE :: orbital(:,:), u_matrix(:,:,:)
- INTEGER :: iunatsicwfc = 31 ! unit for sic wfc
-
- OPEN (20, file = trim(seedname)//".dat" , form = 'formatted', status = 'unknown')
- WRITE(stdout,*) ' wannier plot '
-
- ALLOCATE ( u_matrix( n_wannier, n_wannier, nkstot) )
- ALLOCATE ( orbital( npwx, n_wannier) )
-
- !
- DO i = 1, n_wannier
- DO j = 1, n_wannier
- DO ik = 1, nkstot
- READ (20, * ) u_matrix(i,j,ik)
- !do nn = 1, nnb(ik)
- DO nn = 1, nnb
- READ (20, * ) ! m_matrix (i,j,nkp,nn)
- ENDDO
- ENDDO !nkp
- ENDDO !j
- ENDDO !i
- !
- DO ik=1,iknum
- ikevc = ik + ikstart - 1
- CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1)
- npw = ngk(ik)
- WRITE(stdout,*) 'npw ',npw
- DO iw=1,n_wannier
- DO j=1,npw
- orbital(j,iw) = (0.0d0,0.0d0)
- DO ibnd=1,n_wannier
- orbital(j,iw) = orbital(j,iw) + u_matrix(iw,ibnd,ik)*evc(j,ibnd)
- WRITE(stdout,*) j, iw, ibnd, ik, orbital(j,iw), &
- u_matrix(iw,ibnd,ik), evc(j,ibnd)
- ENDDO !ibnd
- ENDDO !j
- ENDDO !wannier
- CALL davcio (orbital, 2*nwordwann, iunatsicwfc, ikevc, +1)
- ENDDO ! k-points
-
- DEALLOCATE ( u_matrix)
- WRITE(stdout,*) ' dealloc u '
- DEALLOCATE ( orbital)
- WRITE(stdout,*) ' dealloc orbital '
- !
-END SUBROUTINE wan2sic
-
-SUBROUTINE ylm_expansion
- USE io_global, ONLY : stdout
- USE kinds, ONLY : DP
- USE random_numbers, ONLY : randy
- USE matrix_inversion
- USE wannier
- IMPLICIT NONE
- ! local variables
- INTEGER, PARAMETER :: lmax2=16
- INTEGER :: lm, i, ir, iw, m
- real(DP), ALLOCATABLE :: r(:,:), rr(:), rp(:,:), ylm_w(:), ylm(:,:), mly(:,:)
- real(DP) :: u(3,3)
-
- ALLOCATE (r(3,lmax2), rp(3,lmax2), rr(lmax2), ylm_w(lmax2))
- ALLOCATE (ylm(lmax2,lmax2), mly(lmax2,lmax2) )
-
- ! generate a set of nr=lmax2 random vectors
- DO ir=1,lmax2
- DO i=1,3
- r(i,ir) = randy() -0.5d0
- ENDDO
- ENDDO
- rr(:) = r(1,:)*r(1,:) + r(2,:)*r(2,:) + r(3,:)*r(3,:)
- !- compute ylm(ir,lm)
- CALL ylmr2(lmax2, lmax2, r, rr, ylm)
- !- store the inverse of ylm(ir,lm) in mly(lm,ir)
- CALL invmat(lmax2, ylm, mly)
- !- check that r points are independent
- CALL check_inverse(lmax2, ylm, mly)
-
- DO iw=1, n_proj
-
- !- define the u matrix that rotate the reference frame
- CALL set_u_matrix (xaxis(:,iw),zaxis(:,iw),u)
- !- find rotated r-vectors
- rp(:,:) = matmul ( u(:,:) , r(:,:) )
- !- set ylm funtion according to wannier90 (l,mr) indexing in the rotaterd points
- CALL ylm_wannier(ylm_w,l_w(iw),mr_w(iw),rp,lmax2)
-
- csph(:,iw) = matmul (mly(:,:), ylm_w(:))
-
-! write (stdout,*)
-! write (stdout,'(2i4,2(2x,3f6.3))') l_w(iw), mr_w(iw), xaxis(:,iw), zaxis(:,iw)
-! write (stdout,'(16i6)') (lm, lm=1,lmax2)
-! write (stdout,'(16f6.3)') (csph(lm,iw), lm=1,lmax2)
-
- ENDDO
- DEALLOCATE (r, rp, rr, ylm_w, ylm, mly )
-
- RETURN
-END SUBROUTINE ylm_expansion
-
-SUBROUTINE check_inverse(lmax2, ylm, mly)
- USE kinds, ONLY : DP
- USE constants, ONLY : eps8
- IMPLICIT NONE
- ! I/O variables
- INTEGER :: lmax2
- real(DP) :: ylm(lmax2,lmax2), mly(lmax2,lmax2)
- ! local variables
- real(DP), ALLOCATABLE :: uno(:,:)
- real(DP) :: capel
- INTEGER :: lm
- !
- ALLOCATE (uno(lmax2,lmax2) )
- uno = matmul(mly, ylm)
- capel = 0.d0
- DO lm = 1, lmax2
- uno(lm,lm) = uno(lm,lm) - 1.d0
- ENDDO
- capel = capel + sum ( abs(uno(1:lmax2,1:lmax2) ) )
-! write (stdout,*) "capel = ", capel
- IF (capel > eps8) CALL errore('ylm_expansion', &
- ' inversion failed: r(*,1:nr) are not all independent !!',1)
- DEALLOCATE (uno)
- RETURN
-END SUBROUTINE check_inverse
-
-SUBROUTINE set_u_matrix(x,z,u)
- USE kinds, ONLY : DP
- USE constants, ONLY : eps6
- IMPLICIT NONE
- ! I/O variables
- real(DP) :: x(3),z(3),u(3,3)
- ! local variables
- real(DP) :: xx, zz, y(3), coseno
-
- xx = sqrt(x(1)*x(1) + x(2)*x(2) + x(3)*x(3))
- IF (xx < eps6) CALL errore ('set_u_matrix',' |xaxis| < eps ',1)
-! x(:) = x(:)/xx
- zz = sqrt(z(1)*z(1) + z(2)*z(2) + z(3)*z(3))
- IF (zz < eps6) CALL errore ('set_u_matrix',' |zaxis| < eps ',1)
-! z(:) = z(:)/zz
-
- coseno = (x(1)*z(1) + x(2)*z(2) + x(3)*z(3))/xx/zz
- IF (abs(coseno) > eps6) CALL errore('set_u_matrix',' xaxis and zaxis are not orthogonal !',1)
-
- y(1) = (z(2)*x(3) - x(2)*z(3))/xx/zz
- y(2) = (z(3)*x(1) - x(3)*z(1))/xx/zz
- y(3) = (z(1)*x(2) - x(1)*z(2))/xx/zz
-
- u(1,:) = x(:)/xx
- u(2,:) = y(:)
- u(3,:) = z(:)/zz
-
-! write (stdout,'(3f10.7)') u(:,:)
-
- RETURN
-
-END SUBROUTINE set_u_matrix
-
-SUBROUTINE ylm_wannier(ylm,l,mr,r,nr)
-!
-! this routine returns in ylm(r) the values at the nr points r(1:3,1:nr)
-! of the spherical harmonic identified by indices (l,mr)
-! in table 3.1 of the wannierf90 specification.
-!
-! No reference to the particular ylm ordering internal to Quantum ESPRESSO
-! is assumed.
-!
-! If ordering in wannier90 code is changed or extended this should be the
-! only place to be modified accordingly
-!
- USE kinds, ONLY : DP
- USE constants, ONLY : pi, fpi, eps8
- IMPLICIT NONE
-! I/O variables
-!
- INTEGER :: l, mr, nr
- real(DP) :: ylm(nr), r(3,nr)
-!
-! local variables
-!
- real(DP), EXTERNAL :: s, p_z,px,py, dz2, dxz, dyz, dx2my2, dxy
- real(DP), EXTERNAL :: fz3, fxz2, fyz2, fzx2my2, fxyz, fxx2m3y2, fy3x2my2
- real(DP) :: rr, cost, phi
- INTEGER :: ir
- real(DP) :: bs2, bs3, bs6, bs12
- bs2 = 1.d0/sqrt(2.d0)
- bs3=1.d0/sqrt(3.d0)
- bs6 = 1.d0/sqrt(6.d0)
- bs12 = 1.d0/sqrt(12.d0)
-!
- IF (l > 3 .or. l < -5 ) CALL errore('ylm_wannier',' l out of range ', 1)
- IF (l>=0) THEN
- IF (mr < 1 .or. mr > 2*l+1) CALL errore('ylm_wannier','mr out of range' ,1)
- ELSE
- IF (mr < 1 .or. mr > abs(l)+1 ) CALL errore('ylm_wannier','mr out of range',1)
- ENDIF
-
- DO ir=1, nr
- rr = sqrt( r(1,ir)*r(1,ir) + r(2,ir)*r(2,ir) + r(3,ir)*r(3,ir) )
- IF (rr < eps8) CALL errore('ylm_wannier',' rr too small ',1)
-
- cost = r(3,ir) / rr
- !
- ! beware the arc tan, it is defined modulo pi
- !
- IF (r(1,ir) > eps8) THEN
- phi = atan( r(2,ir)/r(1,ir) )
- ELSEIF (r(1,ir) < -eps8 ) THEN
- phi = atan( r(2,ir)/r(1,ir) ) + pi
- ELSE
- phi = sign( pi/2.d0,r(2,ir) )
- ENDIF
-
-
- IF (l==0) THEN ! s orbital
- ylm(ir) = s(cost,phi)
- ENDIF
- IF (l==1) THEN ! p orbitals
- IF (mr==1) ylm(ir) = p_z(cost,phi)
- IF (mr==2) ylm(ir) = px(cost,phi)
- IF (mr==3) ylm(ir) = py(cost,phi)
- ENDIF
- IF (l==2) THEN ! d orbitals
- IF (mr==1) ylm(ir) = dz2(cost,phi)
- IF (mr==2) ylm(ir) = dxz(cost,phi)
- IF (mr==3) ylm(ir) = dyz(cost,phi)
- IF (mr==4) ylm(ir) = dx2my2(cost,phi)
- IF (mr==5) ylm(ir) = dxy(cost,phi)
- ENDIF
- IF (l==3) THEN ! f orbitals
- IF (mr==1) ylm(ir) = fz3(cost,phi)
- IF (mr==2) ylm(ir) = fxz2(cost,phi)
- IF (mr==3) ylm(ir) = fyz2(cost,phi)
- IF (mr==4) ylm(ir) = fzx2my2(cost,phi)
- IF (mr==5) ylm(ir) = fxyz(cost,phi)
- IF (mr==6) ylm(ir) = fxx2m3y2(cost,phi)
- IF (mr==7) ylm(ir) = fy3x2my2(cost,phi)
- ENDIF
- IF (l==-1) THEN ! sp hybrids
- IF (mr==1) ylm(ir) = bs2 * ( s(cost,phi) + px(cost,phi) )
- IF (mr==2) ylm(ir) = bs2 * ( s(cost,phi) - px(cost,phi) )
- ENDIF
- IF (l==-2) THEN ! sp2 hybrids
- IF (mr==1) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)+bs2*py(cost,phi)
- IF (mr==2) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)-bs2*py(cost,phi)
- IF (mr==3) ylm(ir) = bs3*s(cost,phi) +2.d0*bs6*px(cost,phi)
- ENDIF
- IF (l==-3) THEN ! sp3 hybrids
- IF (mr==1) ylm(ir) = 0.5d0*(s(cost,phi)+px(cost,phi)+py(cost,phi)+p_z(cost,phi))
- IF (mr==2) ylm(ir) = 0.5d0*(s(cost,phi)+px(cost,phi)-py(cost,phi)-p_z(cost,phi))
- IF (mr==3) ylm(ir) = 0.5d0*(s(cost,phi)-px(cost,phi)+py(cost,phi)-p_z(cost,phi))
- IF (mr==4) ylm(ir) = 0.5d0*(s(cost,phi)-px(cost,phi)-py(cost,phi)+p_z(cost,phi))
- ENDIF
- IF (l==-4) THEN ! sp3d hybrids
- IF (mr==1) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)+bs2*py(cost,phi)
- IF (mr==2) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)-bs2*py(cost,phi)
- IF (mr==3) ylm(ir) = bs3*s(cost,phi) +2.d0*bs6*px(cost,phi)
- IF (mr==4) ylm(ir) = bs2*p_z(cost,phi)+bs2*dz2(cost,phi)
- IF (mr==5) ylm(ir) =-bs2*p_z(cost,phi)+bs2*dz2(cost,phi)
- ENDIF
- IF (l==-5) THEN ! sp3d2 hybrids
- IF (mr==1) ylm(ir) = bs6*s(cost,phi)-bs2*px(cost,phi)-bs12*dz2(cost,phi)+.5d0*dx2my2(cost,phi)
- IF (mr==2) ylm(ir) = bs6*s(cost,phi)+bs2*px(cost,phi)-bs12*dz2(cost,phi)+.5d0*dx2my2(cost,phi)
- IF (mr==3) ylm(ir) = bs6*s(cost,phi)-bs2*py(cost,phi)-bs12*dz2(cost,phi)-.5d0*dx2my2(cost,phi)
- IF (mr==4) ylm(ir) = bs6*s(cost,phi)+bs2*py(cost,phi)-bs12*dz2(cost,phi)-.5d0*dx2my2(cost,phi)
- IF (mr==5) ylm(ir) = bs6*s(cost,phi)-bs2*p_z(cost,phi)+bs3*dz2(cost,phi)
- IF (mr==6) ylm(ir) = bs6*s(cost,phi)+bs2*p_z(cost,phi)+bs3*dz2(cost,phi)
- ENDIF
-
- ENDDO
-
- RETURN
-
-END SUBROUTINE ylm_wannier
-
-!======== l = 0 =====================================================================
-FUNCTION s(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) :: s, cost,phi
- s = 1.d0/ sqrt(fpi)
- RETURN
-END FUNCTION s
-!======== l = 1 =====================================================================
-FUNCTION p_z(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::p_z, cost,phi
- p_z = sqrt(3.d0/fpi) * cost
- RETURN
-END FUNCTION p_z
-FUNCTION px(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::px, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- px = sqrt(3.d0/fpi) * sint * cos(phi)
- RETURN
-END FUNCTION px
-FUNCTION py(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::py, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- py = sqrt(3.d0/fpi) * sint * sin(phi)
- RETURN
-END FUNCTION py
-!======== l = 2 =====================================================================
-FUNCTION dz2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dz2, cost, phi
- dz2 = sqrt(1.25d0/fpi) * (3.d0* cost*cost-1.d0)
- RETURN
-END FUNCTION dz2
-FUNCTION dxz(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dxz, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- dxz = sqrt(15.d0/fpi) * sint*cost * cos(phi)
- RETURN
-END FUNCTION dxz
-FUNCTION dyz(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dyz, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- dyz = sqrt(15.d0/fpi) * sint*cost * sin(phi)
- RETURN
-END FUNCTION dyz
-FUNCTION dx2my2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dx2my2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- dx2my2 = sqrt(3.75d0/fpi) * sint*sint * cos(2.d0*phi)
- RETURN
-END FUNCTION dx2my2
-FUNCTION dxy(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : fpi
- IMPLICIT NONE
- real(DP) ::dxy, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- dxy = sqrt(3.75d0/fpi) * sint*sint * sin(2.d0*phi)
- RETURN
-END FUNCTION dxy
-!======== l = 3 =====================================================================
-FUNCTION fz3(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fz3, cost, phi
- fz3 = 0.25d0*sqrt(7.d0/pi) * ( 5.d0 * cost * cost - 3.d0 ) * cost
- RETURN
-END FUNCTION fz3
-FUNCTION fxz2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fxz2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fxz2 = 0.25d0*sqrt(10.5d0/pi) * ( 5.d0 * cost * cost - 1.d0 ) * sint * cos(phi)
- RETURN
-END FUNCTION fxz2
-FUNCTION fyz2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fyz2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fyz2 = 0.25d0*sqrt(10.5d0/pi) * ( 5.d0 * cost * cost - 1.d0 ) * sint * sin(phi)
- RETURN
-END FUNCTION fyz2
-FUNCTION fzx2my2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fzx2my2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fzx2my2 = 0.25d0*sqrt(105d0/pi) * sint * sint * cost * cos(2.d0*phi)
- RETURN
-END FUNCTION fzx2my2
-FUNCTION fxyz(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fxyz, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fxyz = 0.25d0*sqrt(105d0/pi) * sint * sint * cost * sin(2.d0*phi)
- RETURN
-END FUNCTION fxyz
-FUNCTION fxx2m3y2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fxx2m3y2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fxx2m3y2 = 0.25d0*sqrt(17.5d0/pi) * sint * sint * sint * cos(3.d0*phi)
- RETURN
-END FUNCTION fxx2m3y2
-FUNCTION fy3x2my2(cost,phi)
- USE kinds, ONLY : DP
- USE constants, ONLY : pi
- IMPLICIT NONE
- real(DP) ::fy3x2my2, cost, phi, sint
- sint = sqrt(abs(1.d0 - cost*cost))
- fy3x2my2 = 0.25d0*sqrt(17.5d0/pi) * sint * sint * sint * sin(3.d0*phi)
- RETURN
-END FUNCTION fy3x2my2
-!
-!
-!-----------------------------------------------------------------------
-SUBROUTINE radialpart(ng, q, alfa, rvalue, lmax, radial)
- !-----------------------------------------------------------------------
- !
- ! This routine computes a table with the radial Fourier transform
- ! of the radial functions.
- !
- USE kinds, ONLY : dp
- USE constants, ONLY : fpi
- USE cell_base, ONLY : omega
- !
- IMPLICIT NONE
- ! I/O
- INTEGER :: ng, rvalue, lmax
- real(DP) :: q(ng), alfa, radial(ng,0:lmax)
- ! local variables
- real(DP), PARAMETER :: xmin=-6.d0, dx=0.025d0, rmax=10.d0
-
- real(DP) :: rad_int, pref, x
- INTEGER :: l, lp1, ir, ig, mesh_r
- real(DP), ALLOCATABLE :: bes(:), func_r(:), r(:), rij(:), aux(:)
-
- mesh_r = nint ( ( log ( rmax ) - xmin ) / dx + 1 )
- ALLOCATE ( bes(mesh_r), func_r(mesh_r), r(mesh_r), rij(mesh_r) )
- ALLOCATE ( aux(mesh_r))
- !
- ! compute the radial mesh
- !
- DO ir = 1, mesh_r
- x = xmin + dble (ir - 1) * dx
- r (ir) = exp (x) / alfa
- rij (ir) = dx * r (ir)
- ENDDO
- !
- IF (rvalue==1) func_r(:) = 2.d0 * alfa**(3.d0/2.d0) * exp(-alfa*r(:))
- IF (rvalue==2) func_r(:) = 1.d0/sqrt(8.d0) * alfa**(3.d0/2.d0) * &
- (2.0d0 - alfa*r(:)) * exp(-alfa*r(:)*0.5d0)
- IF (rvalue==3) func_r(:) = sqrt(4.d0/27.d0) * alfa**(3.0d0/2.0d0) * &
- (1.d0 - 2.0d0/3.0d0*alfa*r(:) + 2.d0*(alfa*r(:))**2/27.d0) * &
- exp(-alfa*r(:)/3.0d0)
- pref = fpi/sqrt(omega)
- !
- DO l = 0, lmax
- DO ig=1,ng
- CALL sph_bes (mesh_r, r(1), q(ig), l, bes)
- aux(:) = bes(:) * func_r(:) * r(:) * r(:)
- ! second r factor added upo suggestion by YY Liang
- CALL simpson (mesh_r, aux, rij, rad_int)
- radial(ig,l) = rad_int * pref
- ENDDO
- ENDDO
-
- DEALLOCATE (bes, func_r, r, rij, aux )
- RETURN
-END SUBROUTINE radialpart
-
-
+!
+! Copyright (C) 2003-2013 Quantum ESPRESSO and Wannier90 groups
+! This file is distributed under the terms of the
+! GNU General Public License. See the file `License'
+! in the root directory of the present distribution,
+! or http://www.gnu.org/copyleft/gpl.txt .
+!
+! pw2wannier was written by Stefano de Gironcoli
+! with later additions by
+! Jonathan Yates - spinors
+! Arash Mostofi - gamma point and transport things
+! Timo Thonhauser, Graham Lopez, Ivo Souza
+! uHu, uIu terms for orbital magnetisation
+! please send bugs and comments to
+! Jonathan Yates and Arash Mostofi
+! Takashi Koretsune and Florian Thoele -- noncollinear and USPPs
+! Valerio Vitale - Selected columns of density matrix (SCDM)
+!
+!
+! NOTE: old_spinor_proj is still available for compatibility with old
+! nnkp files but should be removed soon.
+!
+!
+module wannier
+ USE kinds, only : DP
+ !integer, allocatable :: nnb(:) ! #b (ik)
+ integer :: nnb ! #b
+ integer, allocatable :: kpb(:,:) ! k+b (ik,ib)
+ integer, allocatable :: g_kpb(:,:,:) ! G_k+b (ipol,ik,ib)
+ integer, allocatable :: ig_(:,:) ! G_k+b (ipol,ik,ib)
+ integer, allocatable :: lw(:,:), mw(:,:) ! l and m of wannier (16,n_wannier)
+ integer, allocatable :: num_sph(:) ! num. func. in lin. comb., (n_wannier)
+ logical, allocatable :: excluded_band(:)
+ ! begin change Lopez, Thonhauser, Souza
+ integer :: iun_nnkp,iun_mmn,iun_amn,iun_band,iun_spn,iun_plot,iun_parity,&
+ nnbx,nexband,iun_uhu,&
+ iun_uIu !ivo
+ ! end change Lopez, Thonhauser, Souza
+ integer :: n_wannier !number of WF
+ integer :: n_proj !number of projection
+ complex(DP), allocatable :: gf(:,:) ! guding_function(npwx,n_wannier)
+ complex(DP), allocatable :: gf_spinor(:,:)
+ complex(DP), allocatable :: sgf_spinor(:,:)
+ integer :: ispinw, ikstart, ikstop, iknum
+ character(LEN=15) :: wan_mode ! running mode
+ logical :: logwann, wvfn_formatted, write_unk, write_eig, &
+ ! begin change Lopez, Thonhauser, Souza
+ write_amn,write_mmn,reduce_unk,write_spn,&
+ write_unkg,write_uhu,&
+ write_dmn,read_sym, & !YN
+ write_uIu, spn_formatted, uHu_formatted, uIu_formatted, & !ivo
+ ! end change Lopez, Thonhauser, Souza
+ ! vv: Begin SCDM keywords
+ scdm_proj
+ character(LEN=15) :: scdm_entanglement
+ real(DP) :: scdm_mu, scdm_sigma
+ ! vv: End SCDM keywords
+ ! run check for regular mesh
+ logical :: regular_mesh = .true.
+ ! input data from nnkp file
+ real(DP), allocatable :: center_w(:,:) ! center_w(3,n_wannier)
+ integer, allocatable :: spin_eig(:)
+ real(DP), allocatable :: spin_qaxis(:,:)
+ integer, allocatable :: l_w(:), mr_w(:) ! l and mr of wannier (n_wannier) as from table 3.1,3.2 of spec.
+ integer, allocatable :: r_w(:) ! index of radial function (n_wannier) as from table 3.3 of spec.
+ real(DP), allocatable :: xaxis(:,:),zaxis(:,:) ! xaxis and zaxis(3,n_wannier)
+ real(DP), allocatable :: alpha_w(:) ! alpha_w(n_wannier) ( called zona in wannier spec)
+ !
+ real(DP), allocatable :: csph(:,:) ! expansion coefficients of gf on QE ylm function (16,n_wannier)
+ CHARACTER(len=256) :: seedname = 'wannier' ! prepended to file names in wannier90
+ ! For implementation of wannier_lib
+ integer :: mp_grid(3) ! dimensions of MP k-point grid
+ real(DP) :: rlatt(3,3),glatt(3,3) ! real and recip lattices (Cartesian co-ords, units of Angstrom)
+ real(DP), allocatable :: kpt_latt(:,:) ! k-points in crystal co-ords. kpt_latt(3,iknum)
+ real(DP), allocatable :: atcart(:,:) ! atom centres in Cartesian co-ords and Angstrom units. atcart(3,nat)
+ integer :: num_bands ! number of bands left after exclusions
+ character(len=3), allocatable :: atsym(:) ! atomic symbols. atsym(nat)
+ integer :: num_nnmax=12
+ complex(DP), allocatable :: m_mat(:,:,:,:), a_mat(:,:,:)
+ complex(DP), allocatable :: u_mat(:,:,:), u_mat_opt(:,:,:)
+ logical, allocatable :: lwindow(:,:)
+ real(DP), allocatable :: wann_centers(:,:),wann_spreads(:)
+ real(DP) :: spreads(3)
+ real(DP), allocatable :: eigval(:,:)
+ logical :: old_spinor_proj ! for compatability for nnkp files prior to W90v2.0
+ integer,allocatable :: rir(:,:)
+ logical,allocatable :: zerophase(:,:)
+end module wannier
+!
+
+
+!------------------------------------------------------------------------
+PROGRAM pw2wannier90
+ ! This is the interface to the Wannier90 code: see http://www.wannier.org
+ !------------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode, ionode_id
+ USE mp_global, ONLY : mp_startup
+ USE mp_pools, ONLY : npool
+ USE mp, ONLY : mp_bcast
+ USE mp_world, ONLY : world_comm
+ USE cell_base, ONLY : at, bg
+ USE lsda_mod, ONLY : nspin, isk
+ USE klist, ONLY : nkstot
+ USE io_files, ONLY : prefix, tmp_dir
+ USE noncollin_module, ONLY : noncolin
+ USE control_flags, ONLY : gamma_only
+ USE environment,ONLY : environment_start, environment_end
+ USE wannier
+ !
+ IMPLICIT NONE
+ !
+ CHARACTER(LEN=256), EXTERNAL :: trimcheck
+ !
+ INTEGER :: ios
+ CHARACTER(len=4) :: spin_component
+ CHARACTER(len=256) :: outdir
+
+ ! these are in wannier module.....-> integer :: ispinw, ikstart, ikstop, iknum
+ NAMELIST / inputpp / outdir, prefix, spin_component, wan_mode, &
+ seedname, write_unk, write_amn, write_mmn, write_spn, write_eig,&
+ ! begin change Lopez, Thonhauser, Souza
+ wvfn_formatted, reduce_unk, write_unkg, write_uhu,&
+ write_dmn, read_sym, & !YN:
+ write_uIu, spn_formatted, uHu_formatted, uIu_formatted,& !ivo
+ ! end change Lopez, Thonhauser, Souza
+ regular_mesh,& !gresch
+ ! begin change Vitale
+ scdm_proj, scdm_entanglement, scdm_mu, scdm_sigma
+ ! end change Vitale
+ !
+ ! initialise environment
+ !
+#if defined(__MPI)
+ CALL mp_startup ( )
+#endif
+ !! not sure if this should be called also in 'library' mode or not !!
+ CALL environment_start ( 'PW2WANNIER' )
+ !
+ CALL start_clock( 'init_pw2wan' )
+ !
+ ! Read input on i/o node and broadcast to the rest
+ !
+ ios = 0
+ IF(ionode) THEN
+ !
+ ! Check to see if we are reading from a file
+ !
+ CALL input_from_file()
+ !
+ ! set default values for variables in namelist
+ !
+ CALL get_environment_variable( 'ESPRESSO_TMPDIR', outdir )
+ IF ( trim( outdir ) == ' ' ) outdir = './'
+ prefix = ' '
+ seedname = 'wannier'
+ spin_component = 'none'
+ wan_mode = 'standalone'
+ wvfn_formatted = .false.
+ spn_formatted=.false.
+ uHu_formatted=.false.
+ uIu_formatted=.false.
+ write_unk = .false.
+ write_amn = .true.
+ write_mmn = .true.
+ write_spn = .false.
+ write_eig = .true.
+ ! begin change Lopez, Thonhauser, Souza
+ write_uhu = .false.
+ write_uIu = .false. !ivo
+ ! end change Lopez, Thonhauser, Souza
+ reduce_unk= .false.
+ write_unkg= .false.
+ write_dmn = .false. !YN:
+ read_sym = .false. !YN:
+ scdm_proj = .false.
+ scdm_entanglement = 'isolated'
+ scdm_mu = 0.0_dp
+ scdm_sigma = 1.0_dp
+ !
+ ! reading the namelist inputpp
+ !
+ READ (5, inputpp, iostat=ios)
+ !
+ ! Check of namelist variables
+ !
+ tmp_dir = trimcheck(outdir)
+ ! back to all nodes
+ ENDIF
+ !
+ CALL mp_bcast(ios,ionode_id, world_comm)
+ IF (ios /= 0) CALL errore( 'pw2wannier90', 'reading inputpp namelist', abs(ios))
+ !
+ ! broadcast input variable to all nodes
+ !
+ CALL mp_bcast(outdir,ionode_id, world_comm)
+ CALL mp_bcast(tmp_dir,ionode_id, world_comm)
+ CALL mp_bcast(prefix,ionode_id, world_comm)
+ CALL mp_bcast(seedname,ionode_id, world_comm)
+ CALL mp_bcast(spin_component,ionode_id, world_comm)
+ CALL mp_bcast(wan_mode,ionode_id, world_comm)
+ CALL mp_bcast(wvfn_formatted,ionode_id, world_comm)
+ CALL mp_bcast(write_unk,ionode_id, world_comm)
+ CALL mp_bcast(write_amn,ionode_id, world_comm)
+ CALL mp_bcast(write_mmn,ionode_id, world_comm)
+ CALL mp_bcast(write_eig,ionode_id, world_comm)
+ ! begin change Lopez, Thonhauser, Souza
+ CALL mp_bcast(write_uhu,ionode_id, world_comm)
+ CALL mp_bcast(write_uIu,ionode_id, world_comm) !ivo
+ ! end change Lopez, Thonhauser, Souza
+ CALL mp_bcast(write_spn,ionode_id, world_comm)
+ CALL mp_bcast(reduce_unk,ionode_id, world_comm)
+ CALL mp_bcast(write_unkg,ionode_id, world_comm)
+ CALL mp_bcast(write_dmn,ionode_id, world_comm)
+ CALL mp_bcast(read_sym,ionode_id, world_comm)
+ CALL mp_bcast(scdm_proj,ionode_id, world_comm)
+ CALL mp_bcast(scdm_entanglement,ionode_id, world_comm)
+ CALL mp_bcast(scdm_mu,ionode_id, world_comm)
+ CALL mp_bcast(scdm_sigma,ionode_id, world_comm)
+ !
+ ! Check: kpoint distribution with pools not implemented
+ !
+ IF ( npool > 1 ) CALL errore( 'pw2wannier90', 'pools not implemented', npool )
+ !
+ ! Now allocate space for pwscf variables, read and check them.
+ !
+ logwann = .true.
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Reading nscf_save data'
+ CALL read_file
+ WRITE(stdout,*)
+ !
+ IF (noncolin.and.gamma_only) CALL errore('pw2wannier90',&
+ 'Non-collinear and gamma_only not implemented',1)
+ IF (noncolin.and.scdm_proj) CALL errore('pw2wannier90',&
+ 'Non-collinear and SCDM not implemented',1)
+ IF (gamma_only.and.scdm_proj) CALL errore('pw2wannier90',&
+ 'Gamma_only and SCDM not implemented',1)
+ IF (scdm_proj) then
+ IF ((trim(scdm_entanglement) /= 'isolated') .AND. &
+ (trim(scdm_entanglement) /= 'erfc') .AND. &
+ (trim(scdm_entanglement) /= 'gaussian')) then
+ call errore('pw2wannier90', &
+ 'Can not recognize the choice for scdm_entanglement. ' &
+ //'Valid options are: isolated, erfc and gaussian')
+ ENDIF
+ ENDIF
+ IF (scdm_sigma <= 0._dp) &
+ call errore('pw2wannier90','Sigma in the SCDM method must be positive.')
+ !
+ SELECT CASE ( trim( spin_component ) )
+ CASE ( 'up' )
+ WRITE(stdout,*) ' Spin CASE ( up )'
+ ispinw = 1
+ ikstart = 1
+ ikstop = nkstot/2
+ iknum = nkstot/2
+ CASE ( 'down' )
+ WRITE(stdout,*) ' Spin CASE ( down )'
+ ispinw = 2
+ ikstart = nkstot/2 + 1
+ ikstop = nkstot
+ iknum = nkstot/2
+ CASE DEFAULT
+ IF(noncolin) THEN
+ WRITE(stdout,*) ' Spin CASE ( non-collinear )'
+ ELSE
+ WRITE(stdout,*) ' Spin CASE ( default = unpolarized )'
+ ENDIF
+ ispinw = 0
+ ikstart = 1
+ ikstop = nkstot
+ iknum = nkstot
+ END SELECT
+ !
+ CALL stop_clock( 'init_pw2wan' )
+ !
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Wannier mode is: ',wan_mode
+ WRITE(stdout,*)
+ !
+ IF(wan_mode=='standalone') THEN
+ !
+ WRITE(stdout,*) ' -----------------'
+ WRITE(stdout,*) ' *** Reading nnkp '
+ WRITE(stdout,*) ' -----------------'
+ WRITE(stdout,*)
+ CALL read_nnkp
+ WRITE(stdout,*) ' Opening pp-files '
+ CALL openfil_pp
+ CALL ylm_expansion
+ WRITE(stdout,*)
+ WRITE(stdout,*)
+ if(write_dmn)then
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*) ' *** Compute DMN '
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*)
+ CALL compute_dmn !YN:
+ WRITE(stdout,*)
+ end if
+ IF(write_amn) THEN
+ IF(scdm_proj) THEN
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*) ' *** Compute A with SCDM-k'
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*)
+ CALL compute_amn_with_scdm
+ ELSE
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*) ' *** Compute A projections'
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*)
+ CALL compute_amn
+ ENDIF
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*) ' *** A matrix is not computed '
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ IF(write_mmn) THEN
+ WRITE(stdout,*) ' ---------------'
+ WRITE(stdout,*) ' *** Compute M '
+ WRITE(stdout,*) ' ---------------'
+ WRITE(stdout,*)
+ CALL compute_mmn
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*) ' *** M matrix is not computed '
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ if(noncolin) then
+ IF(write_spn) THEN
+ WRITE(stdout,*) ' ------------------'
+ WRITE(stdout,*) ' *** Compute Spin '
+ WRITE(stdout,*) ' ------------------'
+ WRITE(stdout,*)
+ CALL compute_spin
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' --------------------------------'
+ WRITE(stdout,*) ' *** Spin matrix is not computed '
+ WRITE(stdout,*) ' --------------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ elseif(write_spn) then
+ write(stdout,*) ' -----------------------------------'
+ write(stdout,*) ' *** Non-collinear calculation is '
+ write(stdout,*) ' required for spin '
+ write(stdout,*) ' term to be computed '
+ write(stdout,*) ' -----------------------------------'
+ endif
+ IF(write_uHu.or.write_uIu) THEN
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*) ' *** Compute Orb '
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*)
+ CALL compute_orb
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------------'
+ WRITE(stdout,*) ' *** Orbital terms are not computed '
+ WRITE(stdout,*) ' -----------------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ IF(write_eig) THEN
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*) ' *** Write bands '
+ WRITE(stdout,*) ' ----------------'
+ WRITE(stdout,*)
+ CALL write_band
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*) ' *** Bands are not written '
+ WRITE(stdout,*) ' --------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ IF(write_unk) THEN
+ WRITE(stdout,*) ' --------------------'
+ WRITE(stdout,*) ' *** Write plot info '
+ WRITE(stdout,*) ' --------------------'
+ WRITE(stdout,*)
+ CALL write_plot
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*) ' *** Plot info is not printed '
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ IF(write_unkg) THEN
+ WRITE(stdout,*) ' --------------------'
+ WRITE(stdout,*) ' *** Write parity info '
+ WRITE(stdout,*) ' --------------------'
+ WRITE(stdout,*)
+ CALL write_parity
+ WRITE(stdout,*)
+ ELSE
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*) ' *** Parity info is not printed '
+ WRITE(stdout,*) ' -----------------------------'
+ WRITE(stdout,*)
+ ENDIF
+ WRITE(stdout,*) ' ------------'
+ WRITE(stdout,*) ' *** Stop pp '
+ WRITE(stdout,*) ' ------------'
+ WRITE(stdout,*)
+ !
+ IF ( ionode ) WRITE( stdout, * )
+ CALL print_clock( 'init_pw2wan' )
+ if(write_dmn ) CALL print_clock( 'compute_dmn' )!YN:
+ IF(write_amn ) CALL print_clock( 'compute_amn' )
+ IF(write_mmn ) CALL print_clock( 'compute_mmn' )
+ IF(write_unk ) CALL print_clock( 'write_unk' )
+ IF(write_unkg ) CALL print_clock( 'write_parity' )
+ !! not sure if this should be called also in 'library' mode or not !!
+ CALL environment_end ( 'PW2WANNIER' )
+ IF ( ionode ) WRITE( stdout, * )
+ CALL stop_pp
+ !
+ ENDIF
+ !
+ IF(wan_mode=='library') THEN
+ !
+! seedname='wannier'
+ WRITE(stdout,*) ' Setting up...'
+ CALL setup_nnkp
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Opening pp-files '
+ CALL openfil_pp
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Ylm expansion'
+ CALL ylm_expansion
+ WRITE(stdout,*)
+ CALL compute_amn
+ CALL compute_mmn
+ if(noncolin) then
+ IF(write_spn) THEN
+ CALL compute_spin
+ ENDIF
+ ENDIF
+ IF(write_uHu.or.write_uIu) THEN
+ CALL compute_orb
+ ENDIF
+ CALL write_band
+ IF(write_unk) CALL write_plot
+ IF(write_unkg) THEN
+ CALL write_parity
+ ENDIF
+ CALL run_wannier
+ CALL lib_dealloc
+ CALL stop_pp
+ !
+ ENDIF
+ !
+ IF(wan_mode=='wannier2sic') THEN
+ !
+ CALL read_nnkp
+ CALL wan2sic
+ !
+ ENDIF
+ !
+ STOP
+END PROGRAM pw2wannier90
+!
+!-----------------------------------------------------------------------
+SUBROUTINE lib_dealloc
+ !-----------------------------------------------------------------------
+ !
+ USE wannier
+
+ IMPLICIT NONE
+
+ DEALLOCATE(m_mat,u_mat,u_mat_opt,a_mat,eigval)
+
+ RETURN
+END SUBROUTINE lib_dealloc
+!
+!-----------------------------------------------------------------------
+SUBROUTINE setup_nnkp
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode, ionode_id
+ USE kinds, ONLY : DP
+ USE constants, ONLY : eps6, tpi, bohr => BOHR_RADIUS_ANGS
+ USE cell_base, ONLY : at, bg, alat
+ USE gvect, ONLY : g, gg
+ USE ions_base, ONLY : nat, tau, ityp, atm
+ USE klist, ONLY : xk
+ USE mp, ONLY : mp_bcast, mp_sum
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp_world, ONLY : world_comm
+ USE wvfct, ONLY : nbnd,npwx
+ USE control_flags, ONLY : gamma_only
+ USE noncollin_module, ONLY : noncolin
+ USE wannier
+
+ IMPLICIT NONE
+ real(DP) :: g_(3), gg_
+ INTEGER :: ik, ib, ig, iw, ia, indexb, TYPE
+ INTEGER, ALLOCATABLE :: ig_check(:,:)
+ real(DP) :: xnorm, znorm, coseno
+ INTEGER :: exclude_bands(nbnd)
+
+ ! aam: translations between PW2Wannier90 and Wannier90
+ ! pw2wannier90 <==> Wannier90
+ ! nbnd num_bands_tot
+ ! n_wannier num_wann
+ ! num_bands num_bands
+ ! nat num_atoms
+ ! iknum num_kpts
+ ! rlatt transpose(real_lattice)
+ ! glatt transpose(recip_lattice)
+ ! kpt_latt kpt_latt
+ ! nnb nntot
+ ! kpb nnlist
+ ! g_kpb nncell
+ ! mp_grid mp_grid
+ ! center_w proj_site
+ ! l_w,mr_w,r_w proj_l,proj_m,proj_radial
+ ! xaxis,zaxis proj_x,proj_z
+ ! alpha_w proj_zona
+ ! exclude_bands exclude_bands
+ ! atcart atoms_cart
+ ! atsym atom_symbols
+
+ ALLOCATE( kpt_latt(3,iknum) )
+ ALLOCATE( atcart(3,nat), atsym(nat) )
+ ALLOCATE( kpb(iknum,num_nnmax), g_kpb(3,iknum,num_nnmax) )
+ ALLOCATE( center_w(3,nbnd), alpha_w(nbnd), l_w(nbnd), &
+ mr_w(nbnd), r_w(nbnd), zaxis(3,nbnd), xaxis(3,nbnd) )
+ ALLOCATE( excluded_band(nbnd) )
+
+ ! real lattice (Cartesians, Angstrom)
+ rlatt(:,:) = transpose(at(:,:))*alat*bohr
+ ! reciprocal lattice (Cartesians, Angstrom)
+ glatt(:,:) = transpose(bg(:,:))*tpi/(alat*bohr)
+ ! convert Cartesian k-points to crystallographic co-ordinates
+ kpt_latt(:,1:iknum)=xk(:,1:iknum)
+ CALL cryst_to_cart(iknum,kpt_latt,at,-1)
+ ! atom co-ordinates in Cartesian co-ords and Angstrom units
+ atcart(:,:) = tau(:,:)*bohr*alat
+ ! atom symbols
+ DO ia=1,nat
+ TYPE=ityp(ia)
+ atsym(ia)=atm(TYPE)
+ ENDDO
+
+ ! MP grid dimensions
+ CALL find_mp_grid()
+
+ WRITE(stdout,'(" - Number of atoms is (",i3,")")') nat
+
+#if defined(__WANLIB)
+ IF (ionode) THEN
+ CALL wannier_setup(seedname,mp_grid,iknum,rlatt, & ! input
+ glatt,kpt_latt,nbnd,nat,atsym,atcart,gamma_only,noncolin, & ! input
+ nnb,kpb,g_kpb,num_bands,n_wannier,center_w, & ! output
+ l_w,mr_w,r_w,zaxis,xaxis,alpha_w,exclude_bands) ! output
+ ENDIF
+#endif
+
+ CALL mp_bcast(nnb,ionode_id, world_comm)
+ CALL mp_bcast(kpb,ionode_id, world_comm)
+ CALL mp_bcast(g_kpb,ionode_id, world_comm)
+ CALL mp_bcast(num_bands,ionode_id, world_comm)
+ CALL mp_bcast(n_wannier,ionode_id, world_comm)
+ CALL mp_bcast(center_w,ionode_id, world_comm)
+ CALL mp_bcast(l_w,ionode_id, world_comm)
+ CALL mp_bcast(mr_w,ionode_id, world_comm)
+ CALL mp_bcast(r_w,ionode_id, world_comm)
+ CALL mp_bcast(zaxis,ionode_id, world_comm)
+ CALL mp_bcast(xaxis,ionode_id, world_comm)
+ CALL mp_bcast(alpha_w,ionode_id, world_comm)
+ CALL mp_bcast(exclude_bands,ionode_id, world_comm)
+
+ IF(noncolin) THEN
+ n_proj=n_wannier/2
+ ELSE
+ n_proj=n_wannier
+ ENDIF
+
+ ALLOCATE( gf(npwx,n_proj), csph(16,n_proj) )
+
+ WRITE(stdout,'(" - Number of wannier functions is (",i3,")")') n_wannier
+
+ excluded_band(1:nbnd)=.false.
+ nexband=0
+ band_loop: DO ib=1,nbnd
+ indexb=exclude_bands(ib)
+ IF (indexb>nbnd .or. indexb<0) THEN
+ CALL errore('setup_nnkp',' wrong excluded band index ', 1)
+ ELSEIF (indexb==0) THEN
+ exit band_loop
+ ELSE
+ nexband=nexband+1
+ excluded_band(indexb)=.true.
+ ENDIF
+ ENDDO band_loop
+
+ IF ( (nbnd-nexband)/=num_bands ) &
+ CALL errore('setup_nnkp',' something wrong with num_bands',1)
+
+ DO iw=1,n_proj
+ xnorm = sqrt(xaxis(1,iw)*xaxis(1,iw) + xaxis(2,iw)*xaxis(2,iw) + &
+ xaxis(3,iw)*xaxis(3,iw))
+ IF (xnorm < eps6) CALL errore ('setup_nnkp',' |xaxis| < eps ',1)
+ znorm = sqrt(zaxis(1,iw)*zaxis(1,iw) + zaxis(2,iw)*zaxis(2,iw) + &
+ zaxis(3,iw)*zaxis(3,iw))
+ IF (znorm < eps6) CALL errore ('setup_nnkp',' |zaxis| < eps ',1)
+ coseno = (xaxis(1,iw)*zaxis(1,iw) + xaxis(2,iw)*zaxis(2,iw) + &
+ xaxis(3,iw)*zaxis(3,iw))/xnorm/znorm
+ IF (abs(coseno) > eps6) &
+ CALL errore('setup_nnkp',' xaxis and zaxis are not orthogonal !',1)
+ IF (alpha_w(iw) < eps6) &
+ CALL errore('setup_nnkp',' zona value must be positive', 1)
+ ! convert wannier center in cartesian coordinates (in unit of alat)
+ CALL cryst_to_cart( 1, center_w(:,iw), at, 1 )
+ ENDDO
+ WRITE(stdout,*) ' - All guiding functions are given '
+
+ nnbx=0
+ nnb=max(nnbx,nnb)
+
+ ALLOCATE( ig_(iknum,nnb), ig_check(iknum,nnb) )
+ ALLOCATE( zerophase(iknum,nnb) )
+ zerophase = .false.
+
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ IF ( (g_kpb(1,ik,ib).eq.0) .and. &
+ (g_kpb(2,ik,ib).eq.0) .and. &
+ (g_kpb(3,ik,ib).eq.0) ) zerophase(ik,ib) = .true.
+ g_(:) = REAL( g_kpb(:,ik,ib) )
+ CALL cryst_to_cart (1, g_, bg, 1)
+ gg_ = g_(1)*g_(1) + g_(2)*g_(2) + g_(3)*g_(3)
+ ig_(ik,ib) = 0
+ ig = 1
+ DO WHILE (gg(ig) <= gg_ + eps6)
+ IF ( (abs(g(1,ig)-g_(1)) < eps6) .and. &
+ (abs(g(2,ig)-g_(2)) < eps6) .and. &
+ (abs(g(3,ig)-g_(3)) < eps6) ) ig_(ik,ib) = ig
+ ig= ig +1
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ig_check(:,:) = ig_(:,:)
+ CALL mp_sum( ig_check, intra_pool_comm )
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ IF (ig_check(ik,ib) ==0) &
+ CALL errore('setup_nnkp', &
+ ' g_kpb vector is not in the list of Gs', 100*ik+ib )
+ ENDDO
+ ENDDO
+ DEALLOCATE (ig_check)
+
+ WRITE(stdout,*) ' - All neighbours are found '
+ WRITE(stdout,*)
+
+ RETURN
+END SUBROUTINE setup_nnkp
+ !
+ !-----------------------------------------------------------------------
+SUBROUTINE run_wannier
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : ionode, ionode_id
+ USE ions_base, ONLY : nat
+ USE mp, ONLY : mp_bcast
+ USE mp_world, ONLY : world_comm
+ USE control_flags, ONLY : gamma_only
+ USE wannier
+
+ IMPLICIT NONE
+
+ ALLOCATE(u_mat(n_wannier,n_wannier,iknum))
+ ALLOCATE(u_mat_opt(num_bands,n_wannier,iknum))
+ ALLOCATE(lwindow(num_bands,iknum))
+ ALLOCATE(wann_centers(3,n_wannier))
+ ALLOCATE(wann_spreads(n_wannier))
+
+#if defined(__WANLIB)
+ IF (ionode) THEN
+ CALL wannier_run(seedname,mp_grid,iknum,rlatt, & ! input
+ glatt,kpt_latt,num_bands,n_wannier,nnb,nat, & ! input
+ atsym,atcart,gamma_only,m_mat,a_mat,eigval, & ! input
+ u_mat,u_mat_opt,lwindow,wann_centers,wann_spreads,spreads) ! output
+ ENDIF
+#endif
+
+ CALL mp_bcast(u_mat,ionode_id, world_comm)
+ CALL mp_bcast(u_mat_opt,ionode_id, world_comm)
+ CALL mp_bcast(lwindow,ionode_id, world_comm)
+ CALL mp_bcast(wann_centers,ionode_id, world_comm)
+ CALL mp_bcast(wann_spreads,ionode_id, world_comm)
+ CALL mp_bcast(spreads,ionode_id, world_comm)
+
+ RETURN
+END SUBROUTINE run_wannier
+!-----------------------------------------------------------------------
+!
+SUBROUTINE find_mp_grid()
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout
+ USE kinds, ONLY: DP
+ USE wannier
+
+ IMPLICIT NONE
+
+ ! <<>>
+ INTEGER :: ik,ntemp,ii
+ real(DP) :: min_k,temp(3,iknum),mpg1
+
+ min_k=minval(kpt_latt(1,:))
+ ii=0
+ DO ik=1,iknum
+ IF (kpt_latt(1,ik)==min_k) THEN
+ ii=ii+1
+ temp(:,ii)=kpt_latt(:,ik)
+ ENDIF
+ ENDDO
+ ntemp=ii
+
+ min_k=minval(temp(2,1:ntemp))
+ ii=0
+ DO ik=1,ntemp
+ IF (temp(2,ik)==min_k) THEN
+ ii=ii+1
+ ENDIF
+ ENDDO
+ mp_grid(3)=ii
+
+ min_k=minval(temp(3,1:ntemp))
+ ii=0
+ DO ik=1,ntemp
+ IF (temp(3,ik)==min_k) THEN
+ ii=ii+1
+ ENDIF
+ ENDDO
+ mp_grid(2)=ii
+
+ IF ( (mp_grid(2)==0) .or. (mp_grid(3)==0) ) &
+ CALL errore('find_mp_grid',' one or more mp_grid dimensions is zero', 1)
+
+ mpg1=iknum/(mp_grid(2)*mp_grid(3))
+
+ mp_grid(1) = nint(mpg1)
+
+ WRITE(stdout,*)
+ WRITE(stdout,'(3(a,i3))') ' MP grid is ',mp_grid(1),' x',mp_grid(2),' x',mp_grid(3)
+
+ IF (real(mp_grid(1),kind=DP)/=mpg1) &
+ CALL errore('find_mp_grid',' determining mp_grid failed', 1)
+
+ RETURN
+END SUBROUTINE find_mp_grid
+!-----------------------------------------------------------------------
+!
+SUBROUTINE read_nnkp
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode, ionode_id
+ USE kinds, ONLY: DP
+ USE constants, ONLY : eps6, tpi, bohr => BOHR_RADIUS_ANGS
+ USE cell_base, ONLY : at, bg, alat
+ USE gvect, ONLY : g, gg
+ USE klist, ONLY : nkstot, xk
+ USE mp, ONLY : mp_bcast, mp_sum
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp_world, ONLY : world_comm
+ USE wvfct, ONLY : npwx, nbnd
+ USE noncollin_module, ONLY : noncolin
+ USE wannier
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ real(DP) :: g_(3), gg_
+ INTEGER :: ik, ib, ig, ipol, iw, idum, indexb
+ INTEGER numk, i, j
+ INTEGER, ALLOCATABLE :: ig_check(:,:)
+ real(DP) :: xx(3), xnorm, znorm, coseno
+ LOGICAL :: have_nnkp,found
+ INTEGER :: tmp_auto ! vv: Needed for the selection of projections with SCDM
+
+ IF (ionode) THEN ! Read nnkp file on ionode only
+
+ INQUIRE(file=trim(seedname)//".nnkp",exist=have_nnkp)
+ IF(.not. have_nnkp) THEN
+ CALL errore( 'pw2wannier90', 'Could not find the file '&
+ &//trim(seedname)//'.nnkp', 1 )
+ ENDIF
+
+ iun_nnkp = find_free_unit()
+ OPEN (unit=iun_nnkp, file=trim(seedname)//".nnkp",form='formatted', status="old")
+
+ ENDIF
+
+ nnbx=0
+
+ ! check the information from *.nnkp with the nscf_save data
+ WRITE(stdout,*) ' Checking info from wannier.nnkp file'
+ WRITE(stdout,*)
+
+ IF (ionode) THEN ! read from ionode only
+
+ CALL scan_file_to('real_lattice',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find real_lattice block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ DO j=1,3
+ READ(iun_nnkp,*) (rlatt(i,j),i=1,3)
+ DO i = 1,3
+ rlatt(i,j) = rlatt(i,j)/(alat*bohr)
+ ENDDO
+ ENDDO
+ DO j=1,3
+ DO i=1,3
+ IF(abs(rlatt(i,j)-at(i,j))>eps6) THEN
+ WRITE(stdout,*) ' Something wrong! '
+ WRITE(stdout,*) ' rlatt(i,j) =',rlatt(i,j), ' at(i,j)=',at(i,j)
+ CALL errore( 'pw2wannier90', 'Direct lattice mismatch', 3*j+i )
+ ENDIF
+ ENDDO
+ ENDDO
+ WRITE(stdout,*) ' - Real lattice is ok'
+
+ CALL scan_file_to('recip_lattice',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find recip_lattice block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ DO j=1,3
+ READ(iun_nnkp,*) (glatt(i,j),i=1,3)
+ DO i = 1,3
+ glatt(i,j) = (alat*bohr)*glatt(i,j)/tpi
+ ENDDO
+ ENDDO
+ DO j=1,3
+ DO i=1,3
+ IF(abs(glatt(i,j)-bg(i,j))>eps6) THEN
+ WRITE(stdout,*) ' Something wrong! '
+ WRITE(stdout,*) ' glatt(i,j)=',glatt(i,j), ' bg(i,j)=',bg(i,j)
+ CALL errore( 'pw2wannier90', 'Reciprocal lattice mismatch', 3*j+i )
+ ENDIF
+ ENDDO
+ ENDDO
+ WRITE(stdout,*) ' - Reciprocal lattice is ok'
+
+ CALL scan_file_to('kpoints',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find kpoints block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ READ(iun_nnkp,*) numk
+ IF(numk/=iknum) THEN
+ WRITE(stdout,*) ' Something wrong! '
+ WRITE(stdout,*) ' numk=',numk, ' iknum=',iknum
+ CALL errore( 'pw2wannier90', 'Wrong number of k-points', numk)
+ ENDIF
+ IF(regular_mesh) THEN
+ DO i=1,numk
+ READ(iun_nnkp,*) xx(1), xx(2), xx(3)
+ CALL cryst_to_cart( 1, xx, bg, 1 )
+ IF(abs(xx(1)-xk(1,i))>eps6.or. &
+ abs(xx(2)-xk(2,i))>eps6.or. &
+ abs(xx(3)-xk(3,i))>eps6) THEN
+ WRITE(stdout,*) ' Something wrong! '
+ WRITE(stdout,*) ' k-point ',i,' is wrong'
+ WRITE(stdout,*) xx(1), xx(2), xx(3)
+ WRITE(stdout,*) xk(1,i), xk(2,i), xk(3,i)
+ CALL errore( 'pw2wannier90', 'problems with k-points', i )
+ ENDIF
+ ENDDO
+ ENDIF ! regular mesh check
+ WRITE(stdout,*) ' - K-points are ok'
+
+ ENDIF ! ionode
+
+ ! Broadcast
+ CALL mp_bcast(rlatt,ionode_id, world_comm)
+ CALL mp_bcast(glatt,ionode_id, world_comm)
+
+ IF (ionode) THEN ! read from ionode only
+ if(noncolin) then
+ old_spinor_proj=.false.
+ CALL scan_file_to('spinor_projections',found)
+ if(.not.found) then
+ !try old style projections
+ CALL scan_file_to('projections',found)
+ if(found) then
+ old_spinor_proj=.true.
+ else
+ CALL errore( 'pw2wannier90', 'Could not find projections block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ end if
+ else
+ old_spinor_proj=.false.
+ CALL scan_file_to('projections',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find projections block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ endif
+ READ(iun_nnkp,*) n_proj
+ ENDIF
+
+ ! Broadcast
+ CALL mp_bcast(n_proj,ionode_id, world_comm)
+ CALL mp_bcast(old_spinor_proj,ionode_id, world_comm)
+
+ IF(old_spinor_proj)THEN
+ WRITE(stdout,'(//," ****** begin WARNING ****** ",/)')
+ WRITE(stdout,'(" The pw.x calculation was done with non-collinear spin ")')
+ WRITE(stdout,'(" but spinor = T was not specified in the wannier90 .win file!")')
+ WRITE(stdout,'(" Please set spinor = T and rerun wannier90.x -pp ")')
+! WRITE(stdout,'(/," If you are trying to reuse an old nnkp file, you can remove ")')
+! WRITE(stdout,'(" this check from pw2wannir90.f90 line 870, and recompile. ")')
+ WRITE(stdout,'(/," ****** end WARNING ****** ",//)')
+! CALL errore("pw2wannier90","Spinorbit without spinor=T",1)
+ ENDIF
+
+ ! It is not clear if the next instruction is required or not, it probably depend
+ ! on the version of wannier90 that was used to generate the nnkp file:
+ IF(old_spinor_proj) THEN
+ n_wannier=n_proj*2
+ ELSE
+ n_wannier=n_proj
+ ENDIF
+
+ ALLOCATE( center_w(3,n_proj), alpha_w(n_proj), gf(npwx,n_proj), &
+ l_w(n_proj), mr_w(n_proj), r_w(n_proj), &
+ zaxis(3,n_proj), xaxis(3,n_proj), csph(16,n_proj) )
+ if(noncolin.and..not.old_spinor_proj) then
+ ALLOCATE( spin_eig(n_proj),spin_qaxis(3,n_proj) )
+ endif
+
+ IF (ionode) THEN ! read from ionode only
+ DO iw=1,n_proj
+ READ(iun_nnkp,*) (center_w(i,iw), i=1,3), l_w(iw), mr_w(iw), r_w(iw)
+ READ(iun_nnkp,*) (zaxis(i,iw),i=1,3),(xaxis(i,iw),i=1,3),alpha_w(iw)
+ xnorm = sqrt(xaxis(1,iw)*xaxis(1,iw) + xaxis(2,iw)*xaxis(2,iw) + &
+ xaxis(3,iw)*xaxis(3,iw))
+ IF (xnorm < eps6) CALL errore ('read_nnkp',' |xaxis| < eps ',1)
+ znorm = sqrt(zaxis(1,iw)*zaxis(1,iw) + zaxis(2,iw)*zaxis(2,iw) + &
+ zaxis(3,iw)*zaxis(3,iw))
+ IF (znorm < eps6) CALL errore ('read_nnkp',' |zaxis| < eps ',1)
+ coseno = (xaxis(1,iw)*zaxis(1,iw) + xaxis(2,iw)*zaxis(2,iw) + &
+ xaxis(3,iw)*zaxis(3,iw))/xnorm/znorm
+ IF (abs(coseno) > eps6) &
+ CALL errore('read_nnkp',' xaxis and zaxis are not orthogonal !',1)
+ IF (alpha_w(iw) < eps6) &
+ CALL errore('read_nnkp',' zona value must be positive', 1)
+ ! convert wannier center in cartesian coordinates (in unit of alat)
+ CALL cryst_to_cart( 1, center_w(:,iw), at, 1 )
+ if(noncolin.and..not.old_spinor_proj) then
+ READ(iun_nnkp,*) spin_eig(iw),(spin_qaxis(i,iw),i=1,3)
+ xnorm = sqrt(spin_qaxis(1,iw)*spin_qaxis(1,iw) + spin_qaxis(2,iw)*spin_qaxis(2,iw) + &
+ spin_qaxis(3,iw)*spin_qaxis(3,iw))
+ IF (xnorm < eps6) CALL errore ('read_nnkp',' |xaxis| < eps ',1)
+ spin_qaxis(:,iw)=spin_qaxis(:,iw)/xnorm
+ endif
+ ENDDO
+ ENDIF
+
+ ! automatic projections
+ IF (ionode) THEN
+ CALL scan_file_to('auto_projections',found)
+ IF (found) THEN
+ READ (iun_nnkp, *) n_wannier
+ READ (iun_nnkp, *) tmp_auto
+
+ IF (scdm_proj) THEN
+ IF (n_proj > 0) THEN
+ WRITE(stdout,'(//, " ****** begin Error message ******",/)')
+ WRITE(stdout,'(/," Found a projection block, an auto_projections block",/)')
+ WRITE(stdout,'(/," and scdm_proj = T in the input file. These three options are inconsistent.",/)')
+ WRITE(stdout,'(/," Please refer to the Wannier90 User guide for correct use of these flags.",/)')
+ WRITE(stdout,'(/, " ****** end Error message ******",//)')
+ CALL errore( 'pw2wannier90', 'Inconsistent options for projections.', 1 )
+ ELSE
+ IF (tmp_auto /= 0) CALL errore( 'pw2wannier90', 'Second entry in auto_projections block is not 0. ' // &
+ 'See Wannier90 User Guide in the auto_projections section for clarifications.', 1 )
+ ENDIF
+ ELSE
+ ! Fire an error whether or not a projections block is found
+ CALL errore( 'pw2wannier90', 'scdm_proj = F but found an auto_projections block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ ENDIF
+ ELSE
+ IF (scdm_proj) THEN
+ ! Fire an error whether or not a projections block is found
+ CALL errore( 'pw2wannier90', 'scdm_proj = T but cannot find an auto_projections block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ ENDIF
+ ENDIF
+ ENDIF
+
+ ! Broadcast
+ CALL mp_bcast(n_wannier,ionode_id, world_comm)
+ CALL mp_bcast(center_w,ionode_id, world_comm)
+ CALL mp_bcast(l_w,ionode_id, world_comm)
+ CALL mp_bcast(mr_w,ionode_id, world_comm)
+ CALL mp_bcast(r_w,ionode_id, world_comm)
+ CALL mp_bcast(zaxis,ionode_id, world_comm)
+ CALL mp_bcast(xaxis,ionode_id, world_comm)
+ CALL mp_bcast(alpha_w,ionode_id, world_comm)
+ if(noncolin.and..not.old_spinor_proj) then
+ CALL mp_bcast(spin_eig,ionode_id, world_comm)
+ CALL mp_bcast(spin_qaxis,ionode_id, world_comm)
+ end if
+
+ WRITE(stdout,'(" - Number of wannier functions is ok (",i3,")")') n_wannier
+
+ IF (.not. scdm_proj) WRITE(stdout,*) ' - All guiding functions are given '
+ !
+ WRITE(stdout,*)
+ WRITE(stdout,*) 'Projections:'
+ DO iw=1,n_proj
+ WRITE(stdout,'(3f12.6,3i3,f12.6)') &
+ center_w(1:3,iw),l_w(iw),mr_w(iw),r_w(iw),alpha_w(iw)
+ ENDDO
+
+ IF (ionode) THEN ! read from ionode only
+ CALL scan_file_to('nnkpts',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find nnkpts block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ READ (iun_nnkp,*) nnb
+ ENDIF
+
+ ! Broadcast
+ CALL mp_bcast(nnb,ionode_id, world_comm)
+ !
+ nnbx = max (nnbx, nnb )
+ !
+ ALLOCATE ( kpb(iknum,nnbx), g_kpb(3,iknum,nnbx),&
+ ig_(iknum,nnbx), ig_check(iknum,nnbx) )
+ ALLOCATE( zerophase(iknum,nnbx) )
+ zerophase = .false.
+
+ ! read data about neighbours
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' Reading data about k-point neighbours '
+ WRITE(stdout,*)
+
+ IF (ionode) THEN
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ READ(iun_nnkp,*) idum, kpb(ik,ib), (g_kpb(ipol,ik,ib), ipol =1,3)
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ! Broadcast
+ CALL mp_bcast(kpb,ionode_id, world_comm)
+ CALL mp_bcast(g_kpb,ionode_id, world_comm)
+
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ IF ( (g_kpb(1,ik,ib).eq.0) .and. &
+ (g_kpb(2,ik,ib).eq.0) .and. &
+ (g_kpb(3,ik,ib).eq.0) ) zerophase(ik,ib) = .true.
+ g_(:) = REAL( g_kpb(:,ik,ib) )
+ CALL cryst_to_cart (1, g_, bg, 1)
+ gg_ = g_(1)*g_(1) + g_(2)*g_(2) + g_(3)*g_(3)
+ ig_(ik,ib) = 0
+ ig = 1
+ DO WHILE (gg(ig) <= gg_ + eps6)
+ IF ( (abs(g(1,ig)-g_(1)) < eps6) .and. &
+ (abs(g(2,ig)-g_(2)) < eps6) .and. &
+ (abs(g(3,ig)-g_(3)) < eps6) ) ig_(ik,ib) = ig
+ ig= ig +1
+ ENDDO
+ ENDDO
+ ENDDO
+ ig_check(:,:) = ig_(:,:)
+ CALL mp_sum( ig_check, intra_pool_comm )
+ DO ik=1, iknum
+ DO ib = 1, nnb
+ IF (ig_check(ik,ib) ==0) &
+ CALL errore('read_nnkp', &
+ ' g_kpb vector is not in the list of Gs', 100*ik+ib )
+ ENDDO
+ ENDDO
+ DEALLOCATE (ig_check)
+
+ WRITE(stdout,*) ' All neighbours are found '
+ WRITE(stdout,*)
+
+ ALLOCATE( excluded_band(nbnd) )
+
+ IF (ionode) THEN ! read from ionode only
+ CALL scan_file_to('exclude_bands',found)
+ if(.not.found) then
+ CALL errore( 'pw2wannier90', 'Could not find exclude_bands block in '&
+ &//trim(seedname)//'.nnkp', 1 )
+ endif
+ READ (iun_nnkp,*) nexband
+ excluded_band(1:nbnd)=.false.
+ DO i=1,nexband
+ READ(iun_nnkp,*) indexb
+ IF (indexb<1 .or. indexb>nbnd) &
+ CALL errore('read_nnkp',' wrong excluded band index ', 1)
+ excluded_band(indexb)=.true.
+ ENDDO
+ ENDIF
+ num_bands=nbnd-nexband
+
+ ! Broadcast
+ CALL mp_bcast(nexband,ionode_id, world_comm)
+ CALL mp_bcast(excluded_band,ionode_id, world_comm)
+ CALL mp_bcast(num_bands,ionode_id, world_comm)
+
+ IF (ionode) CLOSE (iun_nnkp) ! ionode only
+
+ RETURN
+END SUBROUTINE read_nnkp
+!
+!-----------------------------------------------------------------------
+SUBROUTINE scan_file_to (keyword,found)
+ !-----------------------------------------------------------------------
+ !
+ USE wannier, ONLY :iun_nnkp
+ USE io_global, ONLY : stdout
+ IMPLICIT NONE
+ CHARACTER(len=*), intent(in) :: keyword
+ logical, intent(out) :: found
+ CHARACTER(len=80) :: line1, line2
+!
+! by uncommenting the following line the file scan restarts every time
+! from the beginning thus making the reading independent on the order
+! of data-blocks
+! rewind (iun_nnkp)
+!
+10 CONTINUE
+ READ(iun_nnkp,*,end=20) line1, line2
+ IF(line1/='begin') GOTO 10
+ IF(line2/=keyword) GOTO 10
+ found=.true.
+ RETURN
+20 found=.false.
+ rewind (iun_nnkp)
+
+END SUBROUTINE scan_file_to
+!
+!-----------------------------------------------------------------------
+SUBROUTINE pw2wan_set_symm (nsym, sr, tvec)
+ !-----------------------------------------------------------------------
+ !
+ ! Uses nkqs and index_sym from module pw2wan, computes rir
+ !
+ USE symm_base, ONLY : s, ftau, allfrac
+ USE fft_base, ONLY : dffts
+ USE cell_base, ONLY : at, bg
+ USE wannier, ONLY : rir, read_sym
+ USE kinds, ONLY : DP
+ USE io_global, ONLY : stdout
+ !
+ IMPLICIT NONE
+ !
+ INTEGER , intent(in) :: nsym
+ REAL(DP) , intent(in) :: sr(3,3,nsym), tvec(3,nsym)
+ REAL(DP) :: st(3,3), v(3)
+ INTEGER, allocatable :: s_in(:,:,:), ftau_in(:,:)
+ !REAL(DP), allocatable:: ftau_in(:,:)
+ INTEGER :: nxxs, nr1,nr2,nr3, nr1x,nr2x,nr3x
+ INTEGER :: ikq, isym, i,j,k, ri,rj,rk, ir
+ LOGICAL :: ispresent(nsym)
+ !
+ nr1 = dffts%nr1
+ nr2 = dffts%nr2
+ nr3 = dffts%nr3
+ nr1x= dffts%nr1x
+ nr2x= dffts%nr2x
+ nr3x= dffts%nr3x
+ nxxs = nr1x*nr2x*nr3x
+ !
+ ! sr -> s
+ ALLOCATE(s_in(3,3,nsym), ftau_in(3,nsym))
+ IF(read_sym ) THEN
+ IF(allfrac) THEN
+ call errore("pw2wan_set_symm", "use_all_frac = .true. + read_sym = .true. not supported", 1)
+ END IF
+ DO isym = 1, nsym
+ !st = transpose( matmul(transpose(bg), sr(:,:,isym)) )
+ st = transpose( matmul(transpose(bg), transpose(sr(:,:,isym))) )
+ s_in(:,:,isym) = nint( matmul(transpose(at), st) )
+ v = matmul(transpose(bg), tvec(:,isym))
+ ftau_in(1,isym) = nint(v(1)*nr1)
+ ftau_in(2,isym) = nint(v(2)*nr2)
+ ftau_in(3,isym) = nint(v(3)*nr3)
+ END DO
+ IF( any(s(:,:,1:nsym) /= s_in(:,:,1:nsym)) .or. any(ftau_in(:,1:nsym) /= ftau(:,1:nsym)) ) THEN
+ write(stdout,*) " Input symmetry is different from crystal symmetry"
+ write(stdout,*)
+ END IF
+ ELSE
+ s_in = s(:,:,1:nsym)
+ ftau_in = ftau(:,1:nsym)
+ END IF
+ !
+ IF(.not. allocated(rir)) ALLOCATE(rir(nxxs,nsym))
+ rir = 0
+ ispresent(1:nsym) = .false.
+
+ DO isym = 1, nsym
+ IF ( mod(s_in(2, 1, isym) * nr1, nr2) /= 0 .or. &
+ mod(s_in(3, 1, isym) * nr1, nr3) /= 0 .or. &
+ mod(s_in(1, 2, isym) * nr2, nr1) /= 0 .or. &
+ mod(s_in(3, 2, isym) * nr2, nr3) /= 0 .or. &
+ mod(s_in(1, 3, isym) * nr3, nr1) /= 0 .or. &
+ mod(s_in(2, 3, isym) * nr3, nr2) /= 0 ) THEN
+ CALL errore ('pw2waninit',' smooth grid is not compatible with &
+ & symmetry: change cutoff',isym)
+ ENDIF
+ DO ir=1, nxxs
+ rir(ir,isym) = ir
+ ENDDO
+ DO k = 1, nr3
+ DO j = 1, nr2
+ DO i = 1, nr1
+ CALL ruotaijk (s_in(:,:,isym), (/0,0,0/), i,j,k, nr1,nr2,nr3, ri,rj,rk)
+ !
+ ir = i + ( j-1)*nr1x + ( k-1)*nr1x*nr2x
+ rir(ir,isym) = ri + (rj-1)*nr1x + (rk-1)*nr1x*nr2x
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ DEALLOCATE(s_in, ftau_in)
+END SUBROUTINE pw2wan_set_symm
+
+!-----------------------------------------------------------------------
+SUBROUTINE compute_dmn
+ !Calculate d_matrix_wann/band for site-symmetry mode given by Rei Sakuma.
+ !Contributions for this subroutine:
+ ! Yoshiro Nohara (June to July, 2016)
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode, ionode_id
+ USE kinds, ONLY: DP
+ USE wvfct, ONLY : nbnd, npwx
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc, psic, psic_nc
+ USE fft_base, ONLY : dffts, dfftp
+ USE fft_interfaces, ONLY : fwfft, invfft
+ USE klist, ONLY : nkstot, xk, igk_k, ngk
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE cell_base, ONLY : omega, alat, tpiba, at, bg
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE constants, ONLY : tpi, bohr => BOHR_RADIUS_ANGS
+ USE uspp, ONLY : nkb, vkb
+ USE uspp_param, ONLY : upf, nh, lmaxq, nhm
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum, mp_bcast
+ USE mp_world, ONLY : world_comm
+ USE noncollin_module,ONLY : noncolin, npol
+ USE gvecw, ONLY : gcutw
+ USE wannier
+ USE symm_base, ONLY : nsymin=>nsym,srin=>sr,ftin=>ft,invsin=>invs
+ USE fft_base, ONLY : dffts
+ USE scatter_mod, ONLY : gather_grid, scatter_grid
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
+ !
+ real(DP), parameter :: p12(3,12)=reshape( &
+ (/0d0, 0d0, 1.00000000000000d0, &
+ 0.894427190999916d0, 0d0, 0.447213595499958d0, &
+ 0.276393202250021d0, 0.850650808352040d0, 0.447213595499958d0, &
+ -0.723606797749979d0, 0.525731112119134d0, 0.447213595499958d0, &
+ -0.723606797749979d0, -0.525731112119134d0, 0.447213595499958d0, &
+ 0.276393202250021d0, -0.850650808352040d0, 0.447213595499958d0, &
+ 0.723606797749979d0, 0.525731112119134d0, -0.447213595499958d0, &
+ -0.276393202250021d0, 0.850650808352040d0, -0.447213595499958d0, &
+ -0.894427190999916d0, 0d0, -0.447213595499958d0, &
+ -0.276393202250021d0, -0.850650808352040d0, -0.447213595499958d0,&
+ 0.723606797749979d0, -0.525731112119134d0, -0.447213595499958d0,&
+ 0d0, 0d0, -1.00000000000000d0/),(/3,12/))
+ real(DP), parameter :: p20(3,20)=reshape( &
+ (/0.525731112119134d0, 0.381966011250105d0, 0.850650808352040d0, &
+ -0.200811415886227d0, 0.618033988749895d0, 0.850650808352040d0, &
+ -0.649839392465813d0, 0d0, 0.850650808352040d0, &
+ -0.200811415886227d0, -0.618033988749895d0, 0.850650808352040d0, &
+ 0.525731112119134d0, -0.381966011250105d0, 0.850650808352040d0, &
+ 0.850650808352040d0, 0.618033988749895d0, 0.200811415886227d0, &
+ -0.324919696232906d0, 1.00000000000000d0, 0.200811415886227d0, &
+ -1.05146222423827d0, 0d0, 0.200811415886227d0, &
+ -0.324919696232906d0, -1.00000000000000d0, 0.200811415886227d0, &
+ 0.850650808352040d0, -0.618033988749895d0, 0.200811415886227d0, &
+ 0.324919696232906d0, 1.00000000000000d0, -0.200811415886227d0, &
+ -0.850650808352040d0, 0.618033988749895d0, -0.200811415886227d0, &
+ -0.850650808352040d0, -0.618033988749895d0, -0.200811415886227d0, &
+ 0.324919696232906d0, -1.00000000000000d0, -0.200811415886227d0, &
+ 1.05146222423827d0, 0d0, -0.200811415886227d0, &
+ 0.200811415886227d0, 0.618033988749895d0, -0.850650808352040d0, &
+ -0.525731112119134d0, 0.381966011250105d0, -0.850650808352040d0, &
+ -0.525731112119134d0, -0.381966011250105d0, -0.850650808352040d0, &
+ 0.200811415886227d0, -0.618033988749895d0, -0.850650808352040d0, &
+ 0.649839392465813d0, 0d0, -0.850650808352040d0/),(/3,20/))
+ real(DP), parameter :: pwg(2)=(/2.976190476190479d-2,3.214285714285711d-2/)
+ !
+ INTEGER :: npw, mmn_tot, ik, ikp, ipol, isym, npwq, i, m, n, ir, jsym
+ INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt, nir
+ INTEGER :: ikevc, ikpevcq, s, counter, iun_dmn, ig, igp, ip, jp, np, iw, jw
+ COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
+ becp2(:,:), Mkb(:,:), aux_nc(:,:)
+ real(DP), ALLOCATABLE :: rbecp2(:,:),sr(:,:,:)
+ COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:), phs(:,:)
+ real(DP), ALLOCATABLE :: qg(:), workg(:)
+ real(DP), ALLOCATABLE :: ylm(:,:), dxk(:,:), tvec(:,:), dylm(:,:), wws(:,:,:), vps2t(:,:,:), vaxis(:,:,:)
+ INTEGER, ALLOCATABLE :: iks2k(:,:),iks2g(:,:),ik2ir(:),ir2ik(:)
+ INTEGER, ALLOCATABLE :: iw2ip(:),ip2iw(:),ips2p(:,:),invs(:)
+ logical, ALLOCATABLE :: lfound(:)
+ COMPLEX(DP) :: mmn, zdotc, phase1
+ real(DP) :: arg, g_(3),v1(3),v2(3),v3(3),v4(3),v5(3),err,ermx,dvec(3,32),dwgt(32),dvec2(3,32),dmat(3,3)
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp
+ INTEGER :: nn,inn,loop,loop2
+ LOGICAL :: nn_found
+ INTEGER :: istart,iend
+ INTEGER :: ibnd_n, ibnd_m,nsym, nxxs
+ COMPLEX(DP), ALLOCATABLE :: psic_all(:), temppsic_all(:)
+ LOGICAL :: have_sym
+
+ CALL start_clock( 'compute_dmn' )
+
+ IF (wan_mode=='standalone') THEN
+ iun_dmn = find_free_unit()
+ END IF
+ dmat=0d0
+ dmat(1,1)=1d0
+ dmat(2,2)=1d0
+ dmat(3,3)=1d0
+ if(read_sym)then
+ write(stdout,*) ' Reading symmetry from file '//trim(seedname)//'.sym'
+ write(stdout,*) ' '
+ if(ionode) then
+ inquire(file=trim(seedname)//".sym",exist=have_sym)
+ if(.not. have_sym) then
+ call errore( 'pw2wannier90', 'Could not find the file '&
+ &//trim(seedname)//'.sym', 1 )
+ endif
+ open(unit=iun_dmn, file=trim(seedname)//".sym",form='formatted')
+ read(iun_dmn,*) nsym
+ end if
+ call mp_bcast(nsym,ionode_id, world_comm)
+ allocate(invs(nsym),sr(3,3,nsym),tvec(3,nsym))
+ invs=-999
+ if(ionode) then
+ do isym=1,nsym
+ read(iun_dmn,*)
+ read(iun_dmn,*) sr(:,:,isym), tvec(:,isym)
+ end do
+ close(iun_dmn)
+ end if
+ call mp_bcast(sr, ionode_id, world_comm)
+ call mp_bcast(tvec, ionode_id, world_comm)
+ do isym=1,nsym
+ do jsym=1,nsym
+ if(invs(jsym).ge.1) cycle
+ v1=matmul(matmul(tvec(:,isym),sr(:,:,jsym))+tvec(:,jsym),bg)
+ if(sum(abs(matmul(sr(:,:,isym),sr(:,:,jsym))-dmat))+sum(abs(v1-dble(nint(v1)))).lt.1d-3) then
+ invs(isym)=jsym
+ invs(jsym)=isym
+ end if
+ end do
+ end do
+ else
+ nsym=nsymin
+ allocate(sr(3,3,nsym),invs(nsym),tvec(3,nsym))
+ ! original sr corresponds to transpose(s)
+ ! so here we use sr = transpose(original sr)
+ do isym=1,nsym
+ sr(:,:,isym)=transpose(srin(:,:,isym))
+ end do
+ invs=invsin(1:nsym)
+ tvec=matmul(at(:,:),ftin(:,1:nsym))
+ if(ionode)then
+ open(unit=iun_dmn, file=trim(seedname)//".sym",form='formatted')
+ write(iun_dmn,"(i5)") nsym
+ do isym=1,nsym
+ write(iun_dmn,*)
+ write(iun_dmn,"(1p,3e23.15)") sr(:,:,isym), tvec(:,isym)
+ end do
+ close(iun_dmn)
+ end if
+ end if
+ do isym=1,nsym
+ if(invs(isym).le.0.or.invs(isym).ge.nsym+1) then
+ call errore("compute_dmn", "out of range in invs", invs(isym))
+ end if
+ v1=matmul(matmul(tvec(:,isym),sr(:,:,invs(isym)))+tvec(:,invs(isym)),bg)
+ if(sum(abs(matmul(sr(:,:,isym),sr(:,:,invs(isym)))-dmat))+sum(abs(v1-dble(nint(v1)))).gt.1d-3) then
+ call errore("compute_dmn", "inconsistent invs", 1)
+ end if
+ end do
+
+ CALL pw2wan_set_symm ( nsym, sr, tvec )
+
+ any_uspp = any(upf(1:ntyp)%tvanp)
+
+ ALLOCATE( phase(dffts%nnr) )
+ ALLOCATE( evcq(npol*npwx,nbnd) )
+
+ IF(noncolin) CALL errore('compute_dmn','Non-collinear not implemented',1)
+ IF (gamma_only) CALL errore('compute_dmn','gamma-only not implemented',1)
+ IF (wan_mode=='library') CALL errore('compute_dmn','library mode not implemented',1)
+
+ ALLOCATE( aux(npwx) )
+
+ allocate(lfound(max(iknum,ngm)))
+ if(.not.allocated(iks2k)) allocate(iks2k(iknum,nsym))
+ iks2k=-999 !Sym.op.(isym) moves k(iks2k(ik,isym)) to k(ik) + G(iks2g(ik,isym)).
+ do isym=1,nsym
+ lfound=.false.
+ do ik=1,iknum
+ v1=xk(:,ik)
+ v2=matmul(sr(:,:,isym),v1)
+ do ikp=1,iknum
+ if(lfound(ikp)) cycle
+ v3=xk(:,ikp)
+ v4=matmul(v2-v3,at)
+ if(sum(abs(nint(v4)-v4)).lt.1d-5) then
+ iks2k(ik,isym)=ikp
+ lfound(ikp)=.true.
+ end if
+ if(iks2k(ik,isym).ge.1) exit
+ end do
+ end do
+ end do
+ deallocate(lfound)
+ !if(count(iks2k.le.0).ne.0) call errore("compute_dmn", "inconsistent in iks2k", count(iks2k.le.0))
+ if(.not.allocated(iks2g)) allocate(iks2g(iknum,nsym))
+ iks2g=-999 !See above.
+ do isym=1,nsym
+ do ik=1,iknum
+ ikp=iks2k(ik,isym)
+ v1=xk(:,ikp)
+ v2=matmul(v1,sr(:,:,isym))
+ v3=xk(:,ik)
+ do ig=1,ngm
+ v4=g(:,ig)
+ if(sum(abs(v3+v4-v2)).lt.1d-5) iks2g(ik,isym)=ig
+ if(iks2g(ik,isym).ge.1) exit
+ end do
+ end do
+ end do
+ !if(count(iks2g.le.0).ne.0) call errore("compute_dmn", "inconsistent in iks2g", count(iks2g.le.0))
+ !
+ if(.not.allocated(ik2ir)) allocate(ik2ir(iknum))
+ ik2ir=-999 !Gives irreducible-k points from regular-k points.
+ if(.not.allocated(ir2ik)) allocate(ir2ik(iknum))
+ ir2ik=-999 !Gives regular-k points from irreducible-k points.
+ allocate(lfound(iknum))
+ lfound=.false.
+ nir=0
+ do ik=1,iknum
+ if(lfound(ik)) cycle
+ lfound(ik)=.true.
+ nir=nir+1
+ ir2ik(nir)=ik
+ ik2ir(ik)=nir
+ do isym=1,nsym
+ ikp=iks2k(ik,isym)
+ if(lfound(ikp)) cycle
+ lfound(ikp)=.true.
+ ik2ir(ikp)=nir
+ end do
+ end do
+ deallocate(lfound)
+ !write(stdout,"(a)") "ik2ir(ir2ik)="
+ !write(stdout,"(10i9)") ik2ir(ir2ik(1:nir))
+ !write(stdout,"(a)") "ir2ik(ik2ir)="
+ !write(stdout,"(10i9)") ir2ik(ik2ir(1:iknum))
+
+ allocate(iw2ip(n_wannier),ip2iw(n_wannier))
+ np=0 !Conversion table between Wannier and position indexes.
+ do iw=1,n_wannier
+ v1=center_w(:,iw)
+ jp=0
+ do ip=1,np
+ if(sum(abs(v1-center_w(:,ip2iw(ip)))).lt.1d-2) then
+ jp=ip
+ exit
+ end if
+ end do
+ if(jp.eq.0) then
+ np=np+1
+ iw2ip(iw)=np
+ ip2iw(np)=iw
+ else
+ iw2ip(iw)=jp
+ end if
+ end do
+ !write(stdout,"(a,10i9)") "iw2ip(ip2iw)="
+ !write(stdout,"(10i9)") iw2ip(ip2iw(1:np))
+ !write(stdout,"(a)") "ip2iw(iw2ip)="
+ !write(stdout,"(10i9)") ip2iw(iw2ip(1:n_wannier))
+ allocate(ips2p(np,nsym),lfound(np))
+ ips2p=-999 !See below.
+ write(stdout,"(a,i5)") " Number of symmetry operators = ", nsym
+ do isym=1,nsym
+ write(stdout,"(2x,i5,a)") isym, "-th symmetry operators is"
+ write(stdout,"(3f15.7)") sr(:,:,isym), tvec(:,isym) !Writing rotation matrix and translation vector in Cartesian coordinates.
+ if(isym.eq.1) then
+ dmat=sr(:,:,isym)
+ dmat(1,1)=dmat(1,1)-1d0
+ dmat(2,2)=dmat(2,2)-1d0
+ dmat(3,3)=dmat(3,3)-1d0
+ if(sum(abs(dmat))+sum(abs(tvec(:,isym))).gt.1d-5) then
+ call errore("compute_dmn", "Error: 1st-symmetry operator is not identical one.", 1)
+ end if
+ end if
+ end do
+ do isym=1,nsym
+ lfound=.false.
+ do ip=1,np
+ v1=center_w(:,ip2iw(ip))
+ v2=matmul(sr(:,:,isym),(v1+tvec(:,isym)))
+ do jp=1,np
+ if(lfound(jp)) cycle
+ v3=center_w(:,ip2iw(jp))
+ v4=matmul(v3-v2,bg)
+ if(sum(abs(dble(nint(v4))-v4)).lt.1d-2) then
+ lfound(jp)=.true.
+ ips2p(ip,isym)=jp
+ exit !Sym.op.(isym) moves position(ips2p(ip,isym)) to position(ip) + T, where
+ end if !T is given by vps2t(:,ip,isym).
+ end do
+ if(ips2p(ip,isym).le.0) then
+ write(stdout,"(a,3f18.10,a,3f18.10,a)")" Could not find ",v2,"(",matmul(v2,bg),")"
+ write(stdout,"(a,3f18.10,a,3f18.10,a)")" coming from ",v1,"(",matmul(v1,bg),")"
+ write(stdout,"(a,i5,a )")" of Wannier site",ip,"."
+ call errore("compute_dmn", "Error: missing Wannier sites, see the output.", 1)
+ end if
+ end do
+ end do
+ allocate(vps2t(3,np,nsym)) !See above.
+ do isym=1,nsym
+ do ip=1,np
+ v1=center_w(:,ip2iw(ip))
+ jp=ips2p(ip,isym)
+ v2=center_w(:,ip2iw(jp))
+ v3=matmul(v2,sr(:,:,isym))-tvec(:,isym)
+ vps2t(:,ip,isym)=v3-v1
+ end do
+ end do
+ dvec(:,1:12)=p12
+ dvec(:,13:32)=p20
+ do ip=1,32
+ dvec(:,ip)=dvec(:,ip)/sqrt(sum(dvec(:,ip)**2))
+ end do
+ dwgt(1:12)=pwg(1)
+ dwgt(13:32)=pwg(2)
+ !write(stdout,*) sum(dwgt) !Checking the weight sum to be 1.
+ allocate(dylm(32,5),vaxis(3,3,n_wannier))
+ dylm=0d0
+ vaxis=0d0
+ do ip=1,5
+ CALL ylm_wannier(dylm(1,ip),2,ip,dvec,32)
+ end do
+ !do ip=1,5
+ ! write(stdout,"(5f25.15)") (sum(dylm(:,ip)*dylm(:,jp)*dwgt)*2d0*tpi,jp=1,5)
+ !end do !Checking spherical integral.
+ allocate(wws(n_wannier,n_wannier,nsym))
+ wws=0d0
+ do iw=1,n_wannier
+ call set_u_matrix (xaxis(:,iw),zaxis(:,iw),vaxis(:,:,iw))
+ end do
+ do isym=1,nsym
+ do iw=1,n_wannier
+ ip=iw2ip(iw)
+ jp=ips2p(ip,isym)
+ CALL ylm_wannier(dylm(1,1),l_w(iw),mr_w(iw),matmul(vaxis(:,:,iw),dvec),32)
+ do jw=1,n_wannier
+ if(iw2ip(jw).ne.jp) cycle
+ do ir=1,32
+ dvec2(:,ir)=matmul(sr(:,:,isym),dvec(:,ir))
+ end do
+ CALL ylm_wannier(dylm(1,2),l_w(jw),mr_w(jw),matmul(vaxis(:,:,jw),dvec2),32)
+ wws(jw,iw,isym)=sum(dylm(:,1)*dylm(:,2)*dwgt)*2d0*tpi ! for sym.op.(isym).
+ end do
+ end do
+ end do
+ deallocate(dylm,vaxis)
+ do isym=1,nsym
+ do iw=1,n_wannier
+ err=abs((sum(wws(:,iw,isym)**2)+sum(wws(iw,:,isym)**2))*.5d0-1d0)
+ if(err.gt.1d-3) then
+ write(stdout,"(a,i5,a,i5,a)") "compute_dmn: Symmetry operator (", isym, &
+ ") could not transform Wannier function (", iw, ")."
+ write(stdout,"(a,f15.7,a )") "compute_dmn: The error is ", err, "."
+ call errore("compute_dmn", "Error: missing Wannier functions, see the output.", 1)
+ end if
+ end do
+ end do
+
+ IF (wan_mode=='standalone') THEN
+ iun_dmn = find_free_unit()
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ IF (ionode) THEN
+ OPEN (unit=iun_dmn, file=trim(seedname)//".dmn",form='formatted')
+ WRITE (iun_dmn,*) header
+ WRITE (iun_dmn,"(4i9)") nbnd-nexband, nsym, nir, iknum
+ ENDIF
+ ENDIF
+
+ IF (ionode) THEN
+ WRITE (iun_dmn,*)
+ WRITE (iun_dmn,"(10i9)") ik2ir(1:iknum)
+ WRITE (iun_dmn,*)
+ WRITE (iun_dmn,"(10i9)") ir2ik(1:nir)
+ do ir=1,nir
+ WRITE (iun_dmn,*)
+ WRITE (iun_dmn,"(10i9)") iks2k(ir2ik(ir),:)
+ enddo
+ ENDIF
+ allocate(phs(n_wannier,n_wannier))
+ phs=(0d0,0d0)
+ WRITE(stdout,'(/)')
+ WRITE(stdout,'(a,i8)') ' DMN(d_matrix_wann): nir = ',nir
+ DO ir=1,nir
+ ik=ir2ik(ir)
+ WRITE (stdout,'(i8)',advance='no') ir
+ IF( MOD(ir,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ do isym=1,nsym
+ do iw=1,n_wannier
+ ip=iw2ip(iw)
+ jp=ips2p(ip,invs(isym))
+ jw=ip2iw(jp)
+ v1 = xk(:,iks2k(ik,isym)) - matmul(sr(:,:,isym),xk(:,ik))
+ v2 = matmul(v1, sr(:,:,isym))
+ phs(iw,iw)=exp(dcmplx(0d0,+sum(vps2t(:,jp,isym)*xk(:,ik))*tpi)) & !Phase of T.k with lattice vectors T of above.
+ *exp(dcmplx(0d0,+sum(tvec(:,isym)*v2)*tpi)) !Phase of t.G with translation vector t(isym).
+ end do
+ IF (ionode) then
+ WRITE (iun_dmn,*)
+ WRITE (iun_dmn,"(1p,(' (',e18.10,',',e18.10,')'))") matmul(phs,dcmplx(wws(:,:,isym),0d0))
+ end if
+ end do
+ end do
+ if(mod(nir,10) /= 0) WRITE(stdout,*)
+ WRITE(stdout,*) ' DMN(d_matrix_wann) calculated'
+ deallocate(phs)
+ !
+ ! USPP
+ !
+ !
+ IF(any_uspp) THEN
+ CALL init_us_1
+ CALL allocate_bec_type ( nkb, nbnd, becp )
+ IF (gamma_only) THEN
+ call errore("compute_dmn", "gamma-only mode not implemented", 1)
+ ELSE
+ ALLOCATE ( becp2(nkb,nbnd) )
+ ENDIF
+ ENDIF
+ !
+ ! qb is FT of Q(r)
+ !
+ nbt = nsym*nir!nnb * iknum
+ !
+ ALLOCATE( qg(nbt) )
+ ALLOCATE (dxk(3,nbt))
+ !
+ ind = 0
+ DO ir=1,nir
+ ik=ir2ik(ir)
+ DO isym=1,nsym!nnb
+ ind = ind + 1
+ ! ikp = kpb(ik,ib)
+ !
+ ! g_(:) = REAL( g_kpb(:,ik,ib) )
+ ! CALL cryst_to_cart (1, g_, bg, 1)
+ dxk(:,ind) = 0d0!xk(:,ikp) +g_(:) - xk(:,ik)
+ qg(ind) = dxk(1,ind)*dxk(1,ind)+dxk(2,ind)*dxk(2,ind)+dxk(3,ind)*dxk(3,ind)
+ ENDDO
+ ! write (stdout,'(i3,12f8.4)') ik, qg((ik-1)*nnb+1:ik*nnb)
+ ENDDO
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+
+ ALLOCATE( ylm(nbt,lmaxq*lmaxq), qgm(nbt) )
+ ALLOCATE( qb (nhm, nhm, ntyp, nbt) )
+ !
+ CALL ylmr2 (lmaxq*lmaxq, nbt, dxk, qg, ylm)
+ qg(:) = sqrt(qg(:)) * tpiba
+ !
+ DO nt = 1, ntyp
+ IF (upf(nt)%tvanp ) THEN
+ DO ih = 1, nh (nt)
+ DO jh = 1, nh (nt)
+ CALL qvan2 (nbt, ih, jh, nt, qg, qgm, ylm)
+ qb (ih, jh, nt, 1:nbt) = omega * qgm(1:nbt)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDDO
+ !
+ DEALLOCATE (qg, qgm, ylm )
+ !
+ ENDIF
+
+ WRITE(stdout,'(/)')
+ WRITE(stdout,'(a,i8)') ' DMN(d_matrix_band): nir = ',nir
+ !
+ ALLOCATE( Mkb(nbnd,nbnd) )
+ ALLOCATE( workg(npwx) )
+ !
+ ! Set up variables and stuff needed to rotate wavefunctions
+ nxxs = dffts%nr1x *dffts%nr2x *dffts%nr3x
+ ALLOCATE(psic_all(nxxs), temppsic_all(nxxs) )
+ !
+ ind = 0
+ DO ir=1,nir
+ ik=ir2ik(ir)
+ WRITE (stdout,'(i8)',advance='no') ir
+ IF( MOD(ir,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ ikevc = ik + ikstart - 1
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+ npw = ngk(ik)
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
+ ! below we compute the product of beta functions with |psi>
+ CALL calbec (npw, vkb, evc, becp)
+ ENDIF
+ !
+ !
+ DO isym=1,nsym
+ ind = ind + 1
+ ikp = iks2k(ik,isym)
+ ! read wfc at k+b
+ ikpevcq = ikp + ikstart - 1
+ ! if(noncolin) then
+ ! call davcio (evcq_nc, 2*nwordwfc, iunwfc, ikpevcq, -1 )
+ ! else
+ CALL davcio (evcq, 2*nwordwfc, iunwfc, ikpevcq, -1 )
+ ! end if
+ npwq = ngk(ikp)
+ do n=1,nbnd
+ do ip=1,npwq !applying translation vector t.
+ evcq(ip,n)=evcq(ip,n)*exp(dcmplx(0d0,+sum((matmul(g(:,igk_k(ip,ikp)),sr(:,:,isym))+xk(:,ik))*tvec(:,isym))*tpi))
+ end do
+ end do
+ ! compute the phase
+ phase(:) = (0.d0,0.d0)
+ ! missing phase G of above is given here and below.
+ IF(iks2g(ik,isym) >= 0) phase(dffts%nl(iks2g(ik,isym)))=(1d0,0d0)
+ CALL invfft ('Wave', phase, dffts)
+ do n=1,nbnd
+ if(excluded_band(n)) cycle
+ psic(:) = (0.d0, 0.d0)
+ psic(dffts%nl(igk_k(1:npwq,ikp))) = evcq(1:npwq,n)
+ ! go to real space
+ CALL invfft ('Wave', psic, dffts)
+#if defined(__MPI)
+ ! gather among all the CPUs
+ CALL gather_grid(dffts, psic, temppsic_all)
+ ! apply rotation
+ !psic_all(1:nxxs) = temppsic_all(rir(1:nxxs,isym))
+ psic_all(rir(1:nxxs,isym)) = temppsic_all(1:nxxs)
+ ! scatter back a piece to each CPU
+ CALL scatter_grid(dffts, psic_all, psic)
+#else
+ psic(rir(1:nxxs, isym)) = psic(1:nxxs)
+#endif
+ ! apply phase k -> k+G
+ psic(1:dffts%nnr) = psic(1:dffts%nnr) * phase(1:dffts%nnr)
+ ! go back to G space
+ CALL fwfft ('Wave', psic, dffts)
+ evcq(1:npw,n) = psic(dffts%nl (igk_k(1:npw,ik) ) )
+ end do
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
+ ! below we compute the product of beta functions with |psi>
+ IF (gamma_only) THEN
+ call errore("compute_dmn", "gamma-only mode not implemented", 1)
+ ELSE
+ CALL calbec ( npw, vkb, evcq, becp2 )
+ ENDIF
+ ENDIF
+ !
+ !
+ Mkb(:,:) = (0.0d0,0.0d0)
+ !
+ IF (any_uspp) THEN
+ ijkb0 = 0
+ DO nt = 1, ntyp
+ IF ( upf(nt)%tvanp ) THEN
+ DO na = 1, nat
+ !
+ arg = dot_product( dxk(:,ind), tau(:,na) ) * tpi
+ phase1 = cmplx( cos(arg), -sin(arg) ,kind=DP)
+ !
+ IF ( ityp(na) == nt ) THEN
+ DO jh = 1, nh(nt)
+ jkb = ijkb0 + jh
+ DO ih = 1, nh(nt)
+ ikb = ijkb0 + ih
+ !
+ DO m = 1,nbnd
+ IF (excluded_band(m)) CYCLE
+ IF (gamma_only) THEN
+ call errore("compute_dmn", "gamma-only mode not implemented", 1)
+ ELSE
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * qb(ih,jh,nt,ind) * &
+ conjg( becp%k(ikb,m) ) * becp2(jkb,n)
+ ENDDO
+ ENDIF
+ ENDDO ! m
+ ENDDO !ih
+ ENDDO !jh
+ ijkb0 = ijkb0 + nh(nt)
+ ENDIF !ityp
+ ENDDO !nat
+ ELSE !tvanp
+ DO na = 1, nat
+ IF ( ityp(na) == nt ) ijkb0 = ijkb0 + nh(nt)
+ ENDDO
+ ENDIF !tvanp
+ ENDDO !ntyp
+ ENDIF ! any_uspp
+ !
+ !
+ ! loops on bands
+ !
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE (iun_dmn,*)
+ ENDIF
+ !
+ DO m=1,nbnd
+ IF (excluded_band(m)) CYCLE
+ !
+ !
+ ! Mkb(m,n) = Mkb(m,n) + \sum_{ijI} qb_{ij}^I * e^-i(0*tau_I)
+ ! < beta_j,k2 | psi_n,k2 >
+ !
+ IF (gamma_only) THEN
+ call errore("compute_dmn", "gamma-only mode not implemented", 1)
+ ELSEIF(noncolin) THEN
+ call errore("compute_dmn", "Non-collinear not implemented", 1)
+ ELSE
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ mmn = zdotc (npw, evc(1,m),1,evcq(1,n),1)
+ CALL mp_sum(mmn, intra_pool_comm)
+ Mkb(m,n) = mmn + Mkb(m,n)
+ ENDDO
+ ENDIF
+ ENDDO ! m
+
+ ibnd_n = 0
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ ibnd_n = ibnd_n + 1
+ ibnd_m = 0
+ DO m=1,nbnd
+ IF (excluded_band(m)) CYCLE
+ ibnd_m = ibnd_m + 1
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE (iun_dmn,"(1p,(' (',e18.10,',',e18.10,')'))")dconjg(Mkb(n,m))
+ ELSEIF (wan_mode=='library') THEN
+ call errore("compute_dmn", "library mode not implemented", 1)
+ ELSE
+ CALL errore('compute_dmn',' value of wan_mode not recognised',1)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO !isym
+ ENDDO !ik
+
+ if(mod(nir,10) /= 0) WRITE(stdout,*)
+ WRITE(stdout,*) ' DMN(d_matrix_band) calculated'
+
+ IF (ionode .and. wan_mode=='standalone') CLOSE (iun_dmn)
+
+ DEALLOCATE (Mkb, dxk, phase)
+ DEALLOCATE(temppsic_all, psic_all)
+ DEALLOCATE(aux)
+ DEALLOCATE(evcq)
+
+ IF(any_uspp) THEN
+ DEALLOCATE ( qb)
+ CALL deallocate_bec_type (becp)
+ IF (gamma_only) THEN
+ CALL errore('compute_dmn','gamma-only not implemented',1)
+ ELSE
+ DEALLOCATE (becp2)
+ ENDIF
+ ENDIF
+ !
+ CALL stop_clock( 'compute_dmn' )
+
+ RETURN
+END SUBROUTINE compute_dmn
+!
+!-----------------------------------------------------------------------
+SUBROUTINE compute_mmn
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode
+ USE kinds, ONLY: DP
+ USE wvfct, ONLY : nbnd, npwx
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc, psic, psic_nc
+ USE fft_base, ONLY : dffts, dfftp
+ USE fft_interfaces, ONLY : fwfft, invfft
+ USE klist, ONLY : nkstot, xk, igk_k, ngk
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE cell_base, ONLY : omega, alat, tpiba, at, bg
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE constants, ONLY : tpi
+ USE uspp, ONLY : nkb, vkb
+ USE uspp_param, ONLY : upf, nh, lmaxq, nhm
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum
+ USE noncollin_module,ONLY : noncolin, npol
+ USE spin_orb, ONLY : lspinorb
+ USE gvecw, ONLY : gcutw
+ USE wannier
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
+ !
+ INTEGER :: npw, mmn_tot, ik, ikp, ipol, ib, npwq, i, m, n
+ INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
+ INTEGER :: ikevc, ikpevcq, s, counter
+ COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
+ becp2(:,:), Mkb(:,:), aux_nc(:,:), becp2_nc(:,:,:)
+ real(DP), ALLOCATABLE :: rbecp2(:,:)
+ COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:), qq_so(:,:,:,:)
+ real(DP), ALLOCATABLE :: qg(:), ylm(:,:), dxk(:,:)
+ COMPLEX(DP) :: mmn, zdotc, phase1
+ real(DP) :: arg, g_(3)
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp
+ INTEGER :: nn,inn,loop,loop2
+ LOGICAL :: nn_found
+ INTEGER :: istart,iend
+ INTEGER :: ibnd_n, ibnd_m
+
+
+ CALL start_clock( 'compute_mmn' )
+
+ any_uspp = any(upf(1:ntyp)%tvanp)
+
+ ALLOCATE( phase(dffts%nnr) )
+ ALLOCATE( evcq(npol*npwx,nbnd) )
+
+ IF(noncolin) THEN
+ ALLOCATE( aux_nc(npwx,npol) )
+ ELSE
+ ALLOCATE( aux(npwx) )
+ ENDIF
+
+ IF (gamma_only) ALLOCATE(aux2(npwx))
+
+ IF (wan_mode=='library') ALLOCATE(m_mat(num_bands,num_bands,nnb,iknum))
+
+ IF (wan_mode=='standalone') THEN
+ iun_mmn = find_free_unit()
+ IF (ionode) OPEN (unit=iun_mmn, file=trim(seedname)//".mmn",form='formatted')
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ IF (ionode) THEN
+ WRITE (iun_mmn,*) header
+ WRITE (iun_mmn,*) nbnd-nexband, iknum, nnb
+ ENDIF
+ ENDIF
+
+ !
+ ! USPP
+ !
+ !
+ IF(any_uspp) THEN
+ CALL init_us_1
+ CALL allocate_bec_type ( nkb, nbnd, becp )
+ IF (gamma_only) THEN
+ ALLOCATE ( rbecp2(nkb,nbnd))
+ else if (noncolin) then
+ ALLOCATE ( becp2_nc(nkb,2,nbnd) )
+ ELSE
+ ALLOCATE ( becp2(nkb,nbnd) )
+ ENDIF
+ !
+ ! qb is FT of Q(r)
+ !
+ nbt = nnb * iknum
+ !
+ ALLOCATE( qg(nbt) )
+ ALLOCATE (dxk(3,nbt))
+ !
+ ind = 0
+ DO ik=1,iknum
+ DO ib=1,nnb
+ ind = ind + 1
+ ikp = kpb(ik,ib)
+ !
+ g_(:) = REAL( g_kpb(:,ik,ib) )
+ CALL cryst_to_cart (1, g_, bg, 1)
+ dxk(:,ind) = xk(:,ikp) +g_(:) - xk(:,ik)
+ qg(ind) = dxk(1,ind)*dxk(1,ind)+dxk(2,ind)*dxk(2,ind)+dxk(3,ind)*dxk(3,ind)
+ ENDDO
+! write (stdout,'(i3,12f8.4)') ik, qg((ik-1)*nnb+1:ik*nnb)
+ ENDDO
+
+ ALLOCATE( ylm(nbt,lmaxq*lmaxq), qgm(nbt) )
+ ALLOCATE( qb (nhm, nhm, ntyp, nbt) )
+ ALLOCATE( qq_so (nhm, nhm, 4, ntyp) )
+ !
+ CALL ylmr2 (lmaxq*lmaxq, nbt, dxk, qg, ylm)
+ qg(:) = sqrt(qg(:)) * tpiba
+ !
+ DO nt = 1, ntyp
+ IF (upf(nt)%tvanp ) THEN
+ DO ih = 1, nh (nt)
+ DO jh = 1, nh (nt)
+ CALL qvan2 (nbt, ih, jh, nt, qg, qgm, ylm)
+ qb (ih, jh, nt, 1:nbt) = omega * qgm(1:nbt)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDDO
+ !
+ DEALLOCATE (qg, qgm, ylm )
+ !
+ ENDIF
+
+ WRITE(stdout,'(a,i8)') ' MMN: iknum = ',iknum
+ !
+ ALLOCATE( Mkb(nbnd,nbnd) )
+ !
+ ind = 0
+ DO ik=1,iknum
+ WRITE (stdout,'(i8)',advance='no') ik
+ IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ ikevc = ik + ikstart - 1
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+ npw = ngk(ik)
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
+ ! below we compute the product of beta functions with |psi>
+ CALL calbec (npw, vkb, evc, becp)
+ ENDIF
+ !
+ !
+ !do ib=1,nnb(ik)
+ DO ib=1,nnb
+ ind = ind + 1
+ ikp = kpb(ik,ib)
+! read wfc at k+b
+ ikpevcq = ikp + ikstart - 1
+! if(noncolin) then
+! call davcio (evcq_nc, 2*nwordwfc, iunwfc, ikpevcq, -1 )
+! else
+ CALL davcio (evcq, 2*nwordwfc, iunwfc, ikpevcq, -1 )
+! end if
+! compute the phase
+ IF (.not.zerophase(ik,ib)) THEN
+ phase(:) = (0.d0,0.d0)
+ IF ( ig_(ik,ib)>0) phase( dffts%nl(ig_(ik,ib)) ) = (1.d0,0.d0)
+ CALL invfft ('Wave', phase, dffts)
+ ENDIF
+ !
+ ! USPP
+ !
+ npwq = ngk(ikp)
+ IF(any_uspp) THEN
+ CALL init_us_2 (npwq, igk_k(1,ikp), xk(1,ikp), vkb)
+ ! below we compute the product of beta functions with |psi>
+ IF (gamma_only) THEN
+ CALL calbec ( npwq, vkb, evcq, rbecp2 )
+ else if (noncolin) then
+ CALL calbec ( npwq, vkb, evcq, becp2_nc )
+
+ if (lspinorb) then
+ qq_so = (0.0d0, 0.0d0)
+ call transform_qq_so(qb(:,:,:,ind), qq_so)
+ endif
+
+ ELSE
+ CALL calbec ( npwq, vkb, evcq, becp2 )
+ ENDIF
+ ENDIF
+ !
+ !
+ Mkb(:,:) = (0.0d0,0.0d0)
+ !
+ IF (any_uspp) THEN
+ ijkb0 = 0
+ DO nt = 1, ntyp
+ IF ( upf(nt)%tvanp ) THEN
+ DO na = 1, nat
+ !
+ arg = dot_product( dxk(:,ind), tau(:,na) ) * tpi
+ phase1 = cmplx( cos(arg), -sin(arg) ,kind=DP)
+ !
+ IF ( ityp(na) == nt ) THEN
+ DO jh = 1, nh(nt)
+ jkb = ijkb0 + jh
+ DO ih = 1, nh(nt)
+ ikb = ijkb0 + ih
+ !
+ DO m = 1,nbnd
+ IF (excluded_band(m)) CYCLE
+ IF (gamma_only) THEN
+ DO n=1,m ! Mkb(m,n) is symmetric in m and n for gamma_only case
+ IF (excluded_band(n)) CYCLE
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * qb(ih,jh,nt,ind) * &
+ becp%r(ikb,m) * rbecp2(jkb,n)
+ ENDDO
+ else if (noncolin) then
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ if (lspinorb) then
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * ( &
+ qq_so(ih,jh,1,nt) * conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 1, n) &
+ + qq_so(ih,jh,2,nt) * conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 2, n) &
+ + qq_so(ih,jh,3,nt) * conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 1, n) &
+ + qq_so(ih,jh,4,nt) * conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 2, n) &
+ )
+ else
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * qb(ih,jh,nt,ind) * &
+ (conjg( becp%nc(ikb, 1, m) ) * becp2_nc(jkb, 1, n) &
+ + conjg( becp%nc(ikb, 2, m) ) * becp2_nc(jkb, 2, n) )
+ endif
+ ENDDO
+ ELSE
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ Mkb(m,n) = Mkb(m,n) + &
+ phase1 * qb(ih,jh,nt,ind) * &
+ conjg( becp%k(ikb,m) ) * becp2(jkb,n)
+ ENDDO
+ ENDIF
+ ENDDO ! m
+ ENDDO !ih
+ ENDDO !jh
+ ijkb0 = ijkb0 + nh(nt)
+ ENDIF !ityp
+ ENDDO !nat
+ ELSE !tvanp
+ DO na = 1, nat
+ IF ( ityp(na) == nt ) ijkb0 = ijkb0 + nh(nt)
+ ENDDO
+ ENDIF !tvanp
+ ENDDO !ntyp
+ ENDIF ! any_uspp
+ !
+ !
+! loops on bands
+ !
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE (iun_mmn,'(7i5)') ik, ikp, (g_kpb(ipol,ik,ib), ipol=1,3)
+ ENDIF
+ !
+ DO m=1,nbnd
+ IF (excluded_band(m)) CYCLE
+ !
+ IF(noncolin) THEN
+ psic_nc(:,:) = (0.d0, 0.d0)
+ DO ipol=1,2!npol
+ istart=(ipol-1)*npwx+1
+ iend=istart+npw-1
+ psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol ) = evc(istart:iend, m)
+ IF (.not.zerophase(ik,ib)) THEN
+ CALL invfft ('Wave', psic_nc(:,ipol), dffts)
+ psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * &
+ phase(1:dffts%nnr)
+ CALL fwfft ('Wave', psic_nc(:,ipol), dffts)
+ ENDIF
+ aux_nc(1:npwq,ipol) = psic_nc(dffts%nl (igk_k(1:npwq,ikp)),ipol )
+ ENDDO
+ ELSE
+ psic(:) = (0.d0, 0.d0)
+ psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw, m)
+ IF(gamma_only) psic(dffts%nlm(igk_k(1:npw,ik) ) ) = conjg(evc (1:npw, m))
+ IF (.not.zerophase(ik,ib)) THEN
+ CALL invfft ('Wave', psic, dffts)
+ psic(1:dffts%nnr) = psic(1:dffts%nnr) * phase(1:dffts%nnr)
+ CALL fwfft ('Wave', psic, dffts)
+ ENDIF
+ aux(1:npwq) = psic(dffts%nl (igk_k(1:npwq,ikp) ) )
+ ENDIF
+ IF(gamma_only) THEN
+ IF (gstart==2) psic(dffts%nlm(1)) = (0.d0,0.d0)
+ aux2(1:npwq) = conjg(psic(dffts%nlm(igk_k(1:npwq,ikp) ) ) )
+ ENDIF
+ !
+ ! Mkb(m,n) = Mkb(m,n) + \sum_{ijI} qb_{ij}^I * e^-i(b*tau_I)
+ ! < beta_j,k2 | psi_n,k2 >
+ !
+ IF (gamma_only) THEN
+ DO n=1,m ! Mkb(m,n) is symmetric in m and n for gamma_only case
+ IF (excluded_band(n)) CYCLE
+ mmn = zdotc (npwq, aux,1,evcq(1,n),1) &
+ + conjg(zdotc(npwq,aux2,1,evcq(1,n),1))
+ CALL mp_sum(mmn, intra_pool_comm)
+ Mkb(m,n) = mmn + Mkb(m,n)
+ IF (m/=n) Mkb(n,m) = Mkb(m,n) ! fill other half of matrix by symmetry
+ ENDDO
+ ELSEIF(noncolin) THEN
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ mmn=(0.d0, 0.d0)
+! do ipol=1,2
+! mmn = mmn+zdotc (npwq, aux_nc(1,ipol),1,evcq_nc(1,ipol,n),1)
+ mmn = mmn + zdotc (npwq, aux_nc(1,1),1,evcq(1,n),1) &
+ + zdotc (npwq, aux_nc(1,2),1,evcq(npwx+1,n),1)
+! end do
+ CALL mp_sum(mmn, intra_pool_comm)
+ Mkb(m,n) = mmn + Mkb(m,n)
+ ENDDO
+ ELSE
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ mmn = zdotc (npwq, aux,1,evcq(1,n),1)
+ CALL mp_sum(mmn, intra_pool_comm)
+ Mkb(m,n) = mmn + Mkb(m,n)
+ ENDDO
+ ENDIF
+ ENDDO ! m
+
+ ibnd_n = 0
+ DO n=1,nbnd
+ IF (excluded_band(n)) CYCLE
+ ibnd_n = ibnd_n + 1
+ ibnd_m = 0
+ DO m=1,nbnd
+ IF (excluded_band(m)) CYCLE
+ ibnd_m = ibnd_m + 1
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE (iun_mmn,'(2f18.12)') Mkb(m,n)
+ ELSEIF (wan_mode=='library') THEN
+ m_mat(ibnd_m,ibnd_n,ib,ik)=Mkb(m,n)
+ ELSE
+ CALL errore('compute_mmn',' value of wan_mode not recognised',1)
+ ENDIF
+ ENDDO
+ ENDDO
+
+ ENDDO !ib
+ ENDDO !ik
+
+ IF (ionode .and. wan_mode=='standalone') CLOSE (iun_mmn)
+
+ IF (gamma_only) DEALLOCATE(aux2)
+ DEALLOCATE (Mkb, phase)
+ IF (any_uspp) DEALLOCATE (dxk)
+ IF(noncolin) THEN
+ DEALLOCATE(aux_nc)
+ ELSE
+ DEALLOCATE(aux)
+ ENDIF
+ DEALLOCATE(evcq)
+
+ IF(any_uspp) THEN
+ DEALLOCATE ( qb)
+ DEALLOCATE (qq_so)
+ CALL deallocate_bec_type (becp)
+ IF (gamma_only) THEN
+ DEALLOCATE (rbecp2)
+ else if (noncolin) then
+ deallocate (becp2_nc)
+ ELSE
+ DEALLOCATE (becp2)
+ ENDIF
+ ENDIF
+!
+ WRITE(stdout,'(/)')
+ WRITE(stdout,*) ' MMN calculated'
+
+ CALL stop_clock( 'compute_mmn' )
+
+ RETURN
+END SUBROUTINE compute_mmn
+
+!-----------------------------------------------------------------------
+SUBROUTINE compute_spin
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode
+ USE kinds, ONLY: DP
+ USE wvfct, ONLY : nbnd, npwx
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc, psic, psic_nc
+ USE fft_base, ONLY : dffts, dfftp
+ USE fft_interfaces, ONLY : fwfft, invfft
+ USE klist, ONLY : nkstot, xk, ngk, igk_k
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE cell_base, ONLY : alat, at, bg
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE constants, ONLY : tpi
+ USE uspp, ONLY : nkb, vkb
+ USE uspp_param, ONLY : upf, nh, lmaxq
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum
+ USE noncollin_module,ONLY : noncolin, npol
+ USE gvecw, ONLY : gcutw
+ USE wannier
+ ! begin change Lopez, Thonhauser, Souza
+ USE mp, ONLY : mp_barrier
+ USE scf, ONLY : vrs, vltot, v, kedtau
+ USE gvecs, ONLY : doublegrid
+ USE lsda_mod, ONLY : nspin
+ USE constants, ONLY : rytoev
+
+ USE uspp_param, ONLY : upf, nh, nhm
+ USE uspp, ONLY: qq_nt, nhtol,nhtoj, indv
+ USE spin_orb, ONLY : fcoef
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
+ !
+ INTEGER :: npw, mmn_tot, ik, ikp, ipol, ib, i, m, n
+ INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
+ INTEGER :: ikevc, ikpevcq, s, counter
+ COMPLEX(DP) :: mmn, zdotc, phase1
+ real(DP) :: arg, g_(3)
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp
+ INTEGER :: nn,inn,loop,loop2
+ LOGICAL :: nn_found
+ INTEGER :: istart,iend
+ COMPLEX(DP) :: sigma_x,sigma_y,sigma_z,cdum1,cdum2
+ complex(DP), allocatable :: spn(:,:), spn_aug(:,:)
+
+ integer :: np, is1, is2, kh, kkb
+ complex(dp) :: sigma_x_aug, sigma_y_aug, sigma_z_aug
+ COMPLEX(DP), ALLOCATABLE :: be_n(:,:), be_m(:,:)
+
+
+ any_uspp = any(upf(1:ntyp)%tvanp)
+
+ if (any_uspp) then
+ CALL init_us_1
+ CALL allocate_bec_type ( nkb, nbnd, becp )
+ ALLOCATE(be_n(nhm,2))
+ ALLOCATE(be_m(nhm,2))
+ endif
+
+
+ if (write_spn) allocate(spn(3,(num_bands*(num_bands+1))/2))
+ if (write_spn) allocate(spn_aug(3,(num_bands*(num_bands+1))/2))
+ spn_aug = (0.0d0, 0.0d0)
+!ivo
+! not sure this is really needed
+ if((write_spn.or.write_uhu.or.write_uIu).and.wan_mode=='library')&
+ call errore('pw2wannier90',&
+ 'write_spn, write_uhu, and write_uIu not meant to work library mode',1)
+!endivo
+
+ IF(write_spn.and.noncolin) THEN
+ IF (ionode) then
+ iun_spn = find_free_unit()
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ if(spn_formatted) then
+ OPEN (unit=iun_spn, file=trim(seedname)//".spn",form='formatted')
+ WRITE (iun_spn,*) header !ivo
+ WRITE (iun_spn,*) nbnd-nexband,iknum
+ else
+ OPEN (unit=iun_spn, file=trim(seedname)//".spn",form='unformatted')
+ WRITE (iun_spn) header !ivo
+ WRITE (iun_spn) nbnd-nexband,iknum
+ endif
+ ENDIF
+ ENDIF
+ !
+ WRITE(stdout,'(a,i8)') ' iknum = ',iknum
+
+ ind = 0
+ DO ik=1,iknum
+ WRITE (stdout,'(i8)') ik
+ ikevc = ik + ikstart - 1
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+ npw = ngk(ik)
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk(1,ik), vkb)
+ ! below we compute the product of beta functions with |psi>
+ CALL calbec (npw, vkb, evc, becp)
+ ENDIF
+
+
+ IF(write_spn.and.noncolin) THEN
+ counter=0
+ DO m=1,nbnd
+ if(excluded_band(m)) cycle !ivo
+ DO n=1,m
+ if(excluded_band(n)) cycle !ivo
+ cdum1=zdotc(npw,evc(1,n),1,evc(npwx+1,m),1)
+ call mp_sum(cdum1,intra_pool_comm)
+ cdum2=zdotc(npw,evc(npwx+1,n),1,evc(1,m),1)
+ call mp_sum(cdum2,intra_pool_comm)
+ sigma_x=cdum1+cdum2
+ sigma_y=cmplx_i*(cdum2-cdum1)
+ sigma_z=zdotc(npw,evc(1,n),1,evc(1,m),1)&
+ -zdotc(npw,evc(npwx+1,n),1,evc(npwx+1,m),1)
+ call mp_sum(sigma_z,intra_pool_comm)
+ counter=counter+1
+ spn(1,counter)=sigma_x
+ spn(2,counter)=sigma_y
+ spn(3,counter)=sigma_z
+
+ if (any_uspp) then
+ sigma_x_aug = (0.0d0, 0.0d0)
+ sigma_y_aug = (0.0d0, 0.0d0)
+ sigma_z_aug = (0.0d0, 0.0d0)
+ ijkb0 = 0
+
+ DO np = 1, ntyp
+ IF ( upf(np)%tvanp ) THEN
+ DO na = 1, nat
+ IF (ityp(na)==np) THEN
+ be_m = 0.d0
+ be_n = 0.d0
+ DO ih = 1, nh(np)
+ ikb = ijkb0 + ih
+ IF (upf(np)%has_so) THEN
+ DO kh = 1, nh(np)
+ IF ((nhtol(kh,np)==nhtol(ih,np)).and. &
+ (nhtoj(kh,np)==nhtoj(ih,np)).and. &
+ (indv(kh,np)==indv(ih,np))) THEN
+ kkb=ijkb0 + kh
+ DO is1=1,2
+ DO is2=1,2
+ be_n(ih,is1)=be_n(ih,is1)+ &
+ fcoef(ih,kh,is1,is2,np)* &
+ becp%nc(kkb,is2,n)
+
+ be_m(ih,is1)=be_m(ih,is1)+ &
+ fcoef(ih,kh,is1,is2,np)* &
+ becp%nc(kkb,is2,m)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDDO
+ ELSE
+ DO is1=1,2
+ be_n(ih, is1) = becp%nc(ikb, is1, n)
+ be_m(ih, is1) = becp%nc(ikb, is1, m)
+ ENDDO
+ ENDIF
+ ENDDO
+ DO ih = 1, nh(np)
+ DO jh = 1, nh(np)
+ sigma_x_aug = sigma_x_aug &
+ + qq_nt(ih,jh,np) * ( be_m(jh,2)*conjg(be_n(ih,1))+ be_m(jh,1)*conjg(be_n(ih,2)) )
+
+ sigma_y_aug = sigma_y_aug &
+ + qq_nt(ih,jh,np) * ( &
+ be_m(jh,1) * conjg(be_n(ih,2)) &
+ - be_m(jh,2) * conjg(be_n(ih,1)) &
+ ) * (0.0d0, 1.0d0)
+
+ sigma_z_aug = sigma_z_aug &
+ + qq_nt(ih,jh,np) * ( be_m(jh,1)*conjg(be_n(ih,1)) - be_m(jh,2)*conjg(be_n(ih,2)) )
+ ENDDO
+ ENDDO
+ ijkb0 = ijkb0 + nh(np)
+ ENDIF
+ ENDDO
+ ELSE
+ DO na = 1, nat
+ IF ( ityp(na) == np ) ijkb0 = ijkb0 + nh(np)
+ ENDDO
+ ENDIF
+ ENDDO
+ spn_aug(1, counter) = sigma_x_aug
+ spn_aug(2, counter) = sigma_y_aug
+ spn_aug(3, counter) = sigma_z_aug
+ endif
+ ENDDO
+ ENDDO
+ if(ionode) then ! root node for i/o
+ if(spn_formatted) then ! slow formatted way
+ counter=0
+ do m=1,num_bands
+ do n=1,m
+ counter=counter+1
+ do s=1,3
+ write(iun_spn,'(2es26.16)') spn(s,counter) + spn_aug(s,counter)
+ enddo
+ enddo
+ enddo
+ else ! fast unformatted way
+ write(iun_spn) ((spn(s,m) + spn_aug(s,m),s=1,3),m=1,((num_bands*(num_bands+1))/2))
+ endif
+ endif ! end of root activity
+
+
+ ENDIF
+
+ end DO
+
+ IF (ionode .and. write_spn .and. noncolin) CLOSE (iun_spn)
+
+ if(write_spn.and.noncolin) deallocate(spn, spn_aug)
+ if (any_uspp) then
+ deallocate(be_n, be_m)
+ call deallocate_bec_type(becp)
+ endif
+
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' SPIN calculated'
+
+ RETURN
+END SUBROUTINE compute_spin
+
+!-----------------------------------------------------------------------
+SUBROUTINE compute_orb
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode
+ USE kinds, ONLY: DP
+ USE wvfct, ONLY : nbnd, npwx, current_k
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc, psic, psic_nc
+ USE fft_base, ONLY : dffts, dfftp
+ USE fft_interfaces, ONLY : fwfft, invfft
+ USE klist, ONLY : nkstot, xk, ngk, igk_k
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE cell_base, ONLY : tpiba2, alat, at, bg
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE constants, ONLY : tpi
+ USE uspp, ONLY : nkb, vkb
+ USE uspp_param, ONLY : upf, nh, lmaxq
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum
+ USE noncollin_module,ONLY : noncolin, npol
+ USE gvecw, ONLY : gcutw
+ USE wannier
+ ! begin change Lopez, Thonhauser, Souza
+ USE mp, ONLY : mp_barrier
+ USE scf, ONLY : vrs, vltot, v, kedtau
+ USE gvecs, ONLY : doublegrid
+ USE lsda_mod, ONLY : nspin
+ USE constants, ONLY : rytoev
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ complex(DP), parameter :: cmplx_i=(0.0_DP,1.0_DP)
+ !
+ INTEGER :: mmn_tot, ik, ikp, ipol, ib, npw, i, m, n
+ INTEGER :: ikb, jkb, ih, jh, na, nt, ijkb0, ind, nbt
+ INTEGER :: ikevc, ikpevcq, s, counter
+ COMPLEX(DP), ALLOCATABLE :: phase(:), aux(:), aux2(:), evcq(:,:), &
+ becp2(:,:), Mkb(:,:), aux_nc(:,:)
+ real(DP), ALLOCATABLE :: rbecp2(:,:)
+ COMPLEX(DP), ALLOCATABLE :: qb(:,:,:,:), qgm(:)
+ real(DP), ALLOCATABLE :: qg(:), ylm(:,:), workg(:)
+ COMPLEX(DP) :: mmn, zdotc, phase1
+ real(DP) :: arg, g_(3)
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp
+ INTEGER :: nn,inn,loop,loop2
+ LOGICAL :: nn_found
+ INTEGER :: istart,iend
+ ! begin change Lopez, Thonhauser, Souza
+ COMPLEX(DP) :: sigma_x,sigma_y,sigma_z,cdum1,cdum2
+ integer :: npw_b1, npw_b2, i_b1, i_b2, ikp_b1, ikp_b2
+ integer, allocatable :: igk_b1(:), igk_b2(:)
+ complex(DP), allocatable :: evc_b1(:,:),evc_b2(:,:),evc_aux(:,:),H_evc(:,:)
+ complex(DP), allocatable :: uHu(:,:),uIu(:,:),spn(:,:)
+ ! end change Lopez, Thonhauser, Souza
+
+ any_uspp = any(upf(1:ntyp)%tvanp)
+
+ IF(any_uspp .and. noncolin) CALL errore('pw2wannier90',&
+ 'NCLS calculation not implimented with USP',1)
+
+ ALLOCATE( phase(dffts%nnr) )
+ ALLOCATE( evcq(npol*npwx,nbnd) )
+
+ IF(noncolin) THEN
+ ALLOCATE( aux_nc(npwx,npol) )
+ ELSE
+ ALLOCATE( aux(npwx) )
+ ENDIF
+
+ IF (gamma_only) ALLOCATE(aux2(npwx))
+
+ IF (wan_mode=='library') ALLOCATE(m_mat(num_bands,num_bands,nnb,iknum))
+
+ if (write_uHu) allocate(uhu(num_bands,num_bands))
+ if (write_uIu) allocate(uIu(num_bands,num_bands))
+
+
+!ivo
+! not sure this is really needed
+ if((write_uhu.or.write_uIu).and.wan_mode=='library')&
+ call errore('pw2wannier90',&
+ 'write_uhu, and write_uIu not meant to work library mode',1)
+!endivo
+
+
+ !
+ !
+ ! begin change Lopez, Thonhauser, Souza
+ !
+ !====================================================================
+ !
+ ! The following code was inserted by Timo Thonhauser, Ivo Souza, and
+ ! Graham Lopez in order to calculate the matrix elements
+ ! necessary for the Wannier interpolation
+ ! of the orbital magnetization
+ !
+ !====================================================================
+ !
+ !
+ !
+ if(write_uHu.or.write_uIu) then !ivo
+ !
+ if(gamma_only) call errore('pw2wannier90',&
+ 'write_uHu and write_uIu not yet implemented for gamma_only case',1) !ivo
+ if(any_uspp) call errore('pw2wannier90',&
+ 'write_uHu and write_uIu not yet implemented with USP',1) !ivo
+ !
+ !
+ allocate(igk_b1(npwx),igk_b2(npwx),evc_b1(npol*npwx,nbnd),&
+ evc_b2(npol*npwx,nbnd),&
+ evc_aux(npol*npwx,nbnd))
+ !
+ if(write_uHu) then
+ allocate(H_evc(npol*npwx,nbnd))
+ write(stdout,*)
+ write(stdout,*) ' -----------------'
+ write(stdout,*) ' *** Compute uHu '
+ write(stdout,*) ' -----------------'
+ write(stdout,*)
+ iun_uhu = find_free_unit()
+ if (ionode) then
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ if(uHu_formatted) then
+ open (unit=iun_uhu, file=TRIM(seedname)//".uHu",form='FORMATTED')
+ write (iun_uhu,*) header
+ write (iun_uhu,*) nbnd, iknum, nnb
+ else
+ open (unit=iun_uhu, file=TRIM(seedname)//".uHu",form='UNFORMATTED')
+ write (iun_uhu) header
+ write (iun_uhu) nbnd, iknum, nnb
+ endif
+ endif
+ endif
+ if(write_uIu) then
+ write(stdout,*)
+ write(stdout,*) ' -----------------'
+ write(stdout,*) ' *** Compute uIu '
+ write(stdout,*) ' -----------------'
+ write(stdout,*)
+ iun_uIu = find_free_unit()
+ if (ionode) then
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ if(uIu_formatted) then
+ open (unit=iun_uIu, file=TRIM(seedname)//".uIu",form='FORMATTED')
+ write (iun_uIu,*) header
+ write (iun_uIu,*) nbnd, iknum, nnb
+ else
+ open (unit=iun_uIu, file=TRIM(seedname)//".uIu",form='UNFORMATTED')
+ write (iun_uIu) header
+ write (iun_uIu) nbnd, iknum, nnb
+ endif
+ endif
+ endif
+
+ CALL set_vrs(vrs,vltot,v%of_r,kedtau,v%kin_r,dfftp%nnr,nspin,doublegrid)
+ call allocate_bec_type ( nkb, nbnd, becp )
+ ALLOCATE( workg(npwx) )
+
+ write(stdout,'(a,i8)') ' iknum = ',iknum
+ do ik = 1, iknum ! loop over k points
+ !
+ write (stdout,'(i8)') ik
+ !
+ npw = ngk(ik)
+ ! sort the wfc at k and set up stuff for h_psi
+ current_k=ik
+ CALL init_us_2(npw,igk_k(1,ik),xk(1,ik),vkb)
+ !
+ ! compute " H | u_n,k+b2 > "
+ !
+ do i_b2 = 1, nnb ! nnb = # of nearest neighbors
+ !
+ ! read wfc at k+b2
+ ikp_b2 = kpb(ik,i_b2) ! for kpoint 'ik', index of neighbor 'i_b2'
+ !
+! call davcio (evc_b2, 2*nwordwfc, iunwfc, ikp_b2, -1 ) !ivo
+ call davcio (evc_b2, 2*nwordwfc, iunwfc, ikp_b2+ikstart-1, -1 ) !ivo
+! call gk_sort (xk(1,ikp_b2), ngm, g, gcutw, npw_b2, igk_b2, workg)
+! ivo; igkq -> igk_k(:,ikp_b2), npw_b2 -> ngk(ikp_b2), replaced by PG
+ npw_b2=ngk(ikp_b2)
+ !
+ ! compute the phase
+ phase(:) = ( 0.0D0, 0.0D0 )
+ if (ig_(ik,i_b2)>0) phase( dffts%nl(ig_(ik,i_b2)) ) = ( 1.0D0, 0.0D0 )
+ call invfft('Wave', phase, dffts)
+ !
+ ! loop on bands
+ evc_aux = ( 0.0D0, 0.0D0 )
+ do n = 1, nbnd
+ !ivo replaced dummy m --> n everywhere on this do loop,
+ ! for consistency w/ band indices in comments
+ if (excluded_band(n)) cycle
+ if(noncolin) then
+ psic_nc = ( 0.0D0, 0.0D0 ) !ivo
+ do ipol = 1, 2
+! psic_nc = ( 0.0D0, 0.0D0 ) !ivo
+ istart=(ipol-1)*npwx+1
+ iend=istart+npw_b2-1 !ivo npw_b1 --> npw_b2
+ psic_nc(dffts%nl (igk_k(1:npw_b2,ikp_b2) ),ipol ) = &
+ evc_b2(istart:iend, n)
+ ! ivo igk_b1, npw_b1 --> igk_b2, npw_b2
+ ! multiply by phase in real space - '1' unless neighbor is in a bordering BZ
+ call invfft ('Wave', psic_nc(:,ipol), dffts)
+ psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * conjg(phase(1:dffts%nnr))
+ call fwfft ('Wave', psic_nc(:,ipol), dffts)
+ ! save the result
+ iend=istart+npw-1
+ evc_aux(istart:iend,n) = psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol )
+ end do
+ else ! this is modeled after the pre-existing code at 1162
+ psic = ( 0.0D0, 0.0D0 )
+ ! Graham, changed npw --> npw_b2 on RHS. Do you agree?!
+ psic(dffts%nl (igk_k(1:npw_b2,ikp_b2) ) ) = evc_b2(1:npw_b2, n)
+ call invfft ('Wave', psic, dffts)
+ psic(1:dffts%nnr) = psic(1:dffts%nnr) * conjg(phase(1:dffts%nnr))
+ call fwfft ('Wave', psic, dffts)
+ evc_aux(1:npw,n) = psic(dffts%nl (igk_k(1:npw,ik) ) )
+ end if
+ end do !n
+
+ if(write_uHu) then !ivo
+ !
+ ! calculate the kinetic energy at ik, used in h_psi
+ !
+ CALL g2_kin (ik)
+ !
+ CALL h_psi(npwx, npw, nbnd, evc_aux, H_evc)
+ !
+ endif
+ !
+ ! compute " < u_m,k+b1 | "
+ !
+ do i_b1 = 1, nnb
+ !
+ ! read wfc at k+b1 !ivo replaced k+b2 --> k+b1
+ ikp_b1 = kpb(ik,i_b1)
+! call davcio (evc_b1, 2*nwordwfc, iunwfc, ikp_b1, -1 ) !ivo
+ call davcio (evc_b1, 2*nwordwfc, iunwfc, ikp_b1+ikstart-1, -1 ) !ivo
+
+! call gk_sort (xk(1,ikp_b1), ngm, g, gcutw, npw_b2, igk_b2, workg) !ivo
+ call gk_sort (xk(1,ikp_b1), ngm, g, gcutw, npw_b1, igk_b1, workg) !ivo
+ !
+ ! compute the phase
+ phase(:) = ( 0.0D0, 0.0D0 )
+ if (ig_(ik,i_b1)>0) phase( dffts%nl(ig_(ik,i_b1)) ) = ( 1.0D0, 0.0D0 )
+ !call cft3s (phase, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
+ call invfft('Wave', phase, dffts)
+ !
+ ! loop on bands
+ do m = 1, nbnd
+ if (excluded_band(m)) cycle
+ if(noncolin) then
+ aux_nc = ( 0.0D0, 0.0D0 )
+ psic_nc = ( 0.0D0, 0.0D0 ) !ivo
+ do ipol = 1, 2
+! psic_nc = ( 0.0D0, 0.0D0 ) !ivo
+ istart=(ipol-1)*npwx+1
+ iend=istart+npw_b1-1 !ivo npw_b2 --> npw_b1
+ psic_nc(dffts%nl (igk_b1(1:npw_b1) ),ipol ) = evc_b1(istart:iend, m) !ivo igk_b2,npw_b2 --> igk_b1,npw_b1
+ ! multiply by phase in real space - '1' unless neighbor is in a different BZ
+ call invfft ('Wave', psic_nc(:,ipol), dffts)
+ !psic_nc(1:nrxxs,ipol) = psic_nc(1:nrxxs,ipol) * conjg(phase(1:nrxxs))
+ psic_nc(1:dffts%nnr,ipol) = psic_nc(1:dffts%nnr,ipol) * conjg(phase(1:dffts%nnr))
+ call fwfft ('Wave', psic_nc(:,ipol), dffts)
+ ! save the result
+ aux_nc(1:npw,ipol) = psic_nc(dffts%nl (igk_k(1:npw,ik) ),ipol )
+ end do
+ else ! this is modeled after the pre-existing code at 1162
+ aux = ( 0.0D0 )
+ psic = ( 0.0D0, 0.0D0 )
+ ! Graham, changed npw --> npw_b1 on RHS. Do you agree?!
+ psic(dffts%nl (igk_b1(1:npw_b1) ) ) = evc_b1(1:npw_b1, m) !ivo igk_b2 --> igk_b1
+ call invfft ('Wave', psic, dffts)
+ !psic(1:nrxxs) = psic(1:nrxxs) * conjg(phase(1:nrxxs))
+ psic(1:dffts%nnr) = psic(1:dffts%nnr) * conjg(phase(1:dffts%nnr))
+ call fwfft ('Wave', psic, dffts)
+ aux(1:npw) = psic(dffts%nl (igk_k(1:npw,ik) ) )
+ end if
+
+ !
+ !
+ if(write_uHu) then !ivo
+ do n = 1, nbnd ! loop over bands of already computed ket
+ if (excluded_band(n)) cycle
+ if(noncolin) then
+ mmn = zdotc (npw, aux_nc(1,1),1,H_evc(1,n),1) + &
+ zdotc (npw, aux_nc(1,2),1,H_evc(1+npwx,n),1)
+ else
+ mmn = zdotc (npw, aux,1,H_evc(1,n),1)
+ end if
+ mmn = mmn * rytoev ! because wannier90 works in eV
+ call mp_sum(mmn, intra_pool_comm)
+! if (ionode) write (iun_uhu) mmn
+ uHu(n,m)=mmn
+ !
+ end do !n
+ endif
+ if(write_uIu) then !ivo
+ do n = 1, nbnd ! loop over bands of already computed ket
+ if (excluded_band(n)) cycle
+ if(noncolin) then
+ mmn = zdotc (npw, aux_nc(1,1),1,evc_aux(1,n),1) + &
+ zdotc (npw, aux_nc(1,2),1,evc_aux(1+npwx,n),1)
+ else
+ mmn = zdotc (npw, aux,1,evc_aux(1,n),1)
+ end if
+ call mp_sum(mmn, intra_pool_comm)
+! if (ionode) write (iun_uIu) mmn
+ uIu(n,m)=mmn
+ !
+ end do !n
+ endif
+ !
+ end do ! m = 1, nbnd
+ if (ionode) then ! write the files out to disk
+ if(write_uhu) then
+ if(uHu_formatted) then ! slow bulky way for transferable files
+ do n=1,num_bands
+ do m=1,num_bands
+ write(iun_uHu,'(2ES20.10)') uHu(m,n)
+ enddo
+ enddo
+ else ! the fast way
+ write(iun_uHu) ((uHu(n,m),n=1,num_bands),m=1,num_bands)
+ endif
+ endif
+ if(write_uiu) then
+ if(uIu_formatted) then ! slow bulky way for transferable files
+ do n=1,num_bands
+ do m=1,num_bands
+ write(iun_uIu,'(2ES20.10)') uIu(m,n)
+ enddo
+ enddo
+ else ! the fast way
+ write(iun_uIu) ((uIu(n,m),n=1,num_bands),m=1,num_bands)
+ endif
+ endif
+ endif ! end of io
+ end do ! i_b1
+ end do ! i_b2
+ end do ! ik
+ DEALLOCATE (workg)
+ !
+ deallocate(igk_b1,igk_b2,evc_b1,evc_b2,evc_aux)
+ if(write_uHu) then
+ deallocate(H_evc)
+ deallocate(uHu)
+ end if
+ if(write_uIu) deallocate(uIu)
+ if (ionode.and.write_uHu) close (iun_uhu) !ivo
+ if (ionode.and.write_uIu) close (iun_uIu) !ivo
+ !
+ else
+ if(.not.write_uHu) then
+ write(stdout,*)
+ write(stdout,*) ' -------------------------------'
+ write(stdout,*) ' *** uHu matrix is not computed '
+ write(stdout,*) ' -------------------------------'
+ write(stdout,*)
+ endif
+ if(.not.write_uIu) then
+ write(stdout,*)
+ write(stdout,*) ' -------------------------------'
+ write(stdout,*) ' *** uIu matrix is not computed '
+ write(stdout,*) ' -------------------------------'
+ write(stdout,*)
+ endif
+ end if
+ !
+ !
+ !
+ !
+ !
+ !
+ !====================================================================
+ !
+ ! END_m_orbit
+ !
+ !====================================================================
+ !
+ ! end change Lopez, Thonhauser, Souza
+ !
+ !
+ !
+
+ IF (gamma_only) DEALLOCATE(aux2)
+ DEALLOCATE (phase)
+ IF(noncolin) THEN
+ DEALLOCATE(aux_nc)
+ ELSE
+ DEALLOCATE(aux)
+ ENDIF
+ DEALLOCATE(evcq)
+ if(write_spn.and.noncolin) deallocate(spn)
+
+ IF(any_uspp) THEN
+ DEALLOCATE ( qb)
+ CALL deallocate_bec_type (becp)
+ IF (gamma_only) THEN
+ DEALLOCATE (rbecp2)
+ ELSE
+ DEALLOCATE (becp2)
+ ENDIF
+ ENDIF
+!
+ WRITE(stdout,*)
+ WRITE(stdout,*) ' uHu calculated'
+
+ RETURN
+END SUBROUTINE compute_orb
+!
+!-----------------------------------------------------------------------
+SUBROUTINE compute_amn
+ !-----------------------------------------------------------------------
+ !
+ USE io_global, ONLY : stdout, ionode
+ USE kinds, ONLY : DP
+ USE klist, ONLY : nkstot, xk, ngk, igk_k
+ USE wvfct, ONLY : nbnd, npwx
+ USE control_flags, ONLY : gamma_only
+ USE wavefunctions, ONLY : evc
+ USE io_files, ONLY : nwordwfc, iunwfc
+ USE gvect, ONLY : g, ngm, gstart
+ USE uspp, ONLY : nkb, vkb
+ USE becmod, ONLY : bec_type, becp, calbec, &
+ allocate_bec_type, deallocate_bec_type
+ USE wannier
+ USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
+ USE uspp_param, ONLY : upf
+ USE mp_pools, ONLY : intra_pool_comm
+ USE mp, ONLY : mp_sum
+ USE noncollin_module,ONLY : noncolin, npol
+ USE gvecw, ONLY : gcutw
+ USE constants, ONLY : eps6
+
+ IMPLICIT NONE
+ !
+ INTEGER, EXTERNAL :: find_free_unit
+ !
+ COMPLEX(DP) :: amn, zdotc,amn_tmp,fac(2)
+ real(DP):: ddot
+ COMPLEX(DP), ALLOCATABLE :: sgf(:,:)
+ INTEGER :: ik, npw, ibnd, ibnd1, iw,i, ikevc, nt, ipol
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp, opnd, exst,spin_z_pos, spin_z_neg
+ INTEGER :: istart
+
+ !nocolin: we have half as many projections g(r) defined as wannier
+ ! functions. We project onto (1,0) (ie up spin) and then onto
+ ! (0,1) to obtain num_wann projections. jry
+
+
+ !call read_gf_definition.....> this is done at the beging
+
+ CALL start_clock( 'compute_amn' )
+
+ any_uspp =any (upf(1:ntyp)%tvanp)
+
+ IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum))
+
+ IF (wan_mode=='standalone') THEN
+ iun_amn = find_free_unit()
+ IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted')
+ ENDIF
+
+ WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum
+ !
+ IF (wan_mode=='standalone') THEN
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime
+ IF (ionode) THEN
+ WRITE (iun_amn,*) header
+ WRITE (iun_amn,*) nbnd-nexband, iknum, n_wannier
+ !WRITE (iun_amn,*) nbnd-nexband, iknum, n_proj
+ ENDIF
+ ENDIF
+ !
+ ALLOCATE( sgf(npwx,n_proj))
+ ALLOCATE( gf_spinor(2*npwx,n_proj))
+ ALLOCATE( sgf_spinor(2*npwx,n_proj))
+ !
+ IF (any_uspp) THEN
+ CALL allocate_bec_type ( nkb, n_wannier, becp)
+ CALL init_us_1
+ ENDIF
+ !
+
+ DO ik=1,iknum
+ WRITE (stdout,'(i8)',advance='no') ik
+ IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ ikevc = ik + ikstart - 1
+! if(noncolin) then
+! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 )
+! else
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+! end if
+ npw = ngk(ik)
+ CALL generate_guiding_functions(ik) ! they are called gf(npw,n_proj)
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ if(noncolin) then
+ sgf_spinor = (0.d0,0.d0)
+ call orient_gf_spinor(npw)
+ endif
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! USPP
+ !
+ IF(any_uspp) THEN
+ CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
+ ! below we compute the product of beta functions with trial func.
+ IF (gamma_only) THEN
+ CALL calbec ( npw, vkb, gf, becp, n_proj )
+ ELSE if (noncolin) then
+ CALL calbec ( npw, vkb, gf_spinor, becp, n_proj )
+ else
+ CALL calbec ( npw, vkb, gf, becp, n_proj )
+ ENDIF
+ ! and we use it for the product S|trial_func>
+ if (noncolin) then
+ CALL s_psi (npwx, npw, n_proj, gf_spinor, sgf_spinor)
+ else
+ CALL s_psi (npwx, npw, n_proj, gf, sgf)
+ endif
+
+ ELSE
+ !if (noncolin) then
+ ! sgf_spinor(:,:) = gf_spinor
+ !else
+ sgf(:,:) = gf(:,:)
+ !endif
+ ENDIF
+ !
+ noncolin_case : &
+ IF(noncolin) THEN
+ old_spinor_proj_case : &
+ IF(old_spinor_proj) THEN
+ ! we do the projection as g(r)*a(r) and g(r)*b(r)
+ DO ipol=1,npol
+ istart = (ipol-1)*npwx + 1
+ DO iw = 1,n_proj
+ ibnd1 = 0
+ DO ibnd = 1,nbnd
+ IF (excluded_band(ibnd)) CYCLE
+ amn=(0.0_dp,0.0_dp)
+ ! amn = zdotc(npw,evc_nc(1,ipol,ibnd),1,sgf(1,iw),1)
+ if (any_uspp) then
+ amn = zdotc(npw, evc(0,ibnd), 1, sgf_spinor(1, iw + (ipol-1)*n_proj), 1)
+ amn = amn + zdotc(npw, evc(npwx+1,ibnd), 1, sgf_spinor(npwx+1, iw + (ipol-1)*n_proj), 1)
+ else
+ amn = zdotc(npw,evc(istart,ibnd),1,sgf(1,iw),1)
+ endif
+ CALL mp_sum(amn, intra_pool_comm)
+ ibnd1=ibnd1+1
+ IF (wan_mode=='standalone') THEN
+ IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') ibnd1, iw+n_proj*(ipol-1), ik, amn
+ ELSEIF (wan_mode=='library') THEN
+ a_mat(ibnd1,iw+n_proj*(ipol-1),ik) = amn
+ ELSE
+ CALL errore('compute_amn',' value of wan_mode not recognised',1)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE old_spinor_proj_case
+ DO iw = 1,n_proj
+ spin_z_pos=.false.;spin_z_neg=.false.
+ ! detect if spin quantisation axis is along z
+ if((abs(spin_qaxis(1,iw)-0.0d0) nsp, tau
+ USE uspp_param, ONLY : upf
+
+ IMPLICIT NONE
+
+ INTEGER, EXTERNAL :: find_free_unit
+ COMPLEX(DP), ALLOCATABLE :: phase(:), nowfc1(:,:), nowfc(:,:), psi_gamma(:,:), &
+ qr_tau(:), cwork(:), cwork2(:), Umat(:,:), VTmat(:,:), Amat(:,:) ! vv: complex arrays for the SVD factorization
+ REAL(DP), ALLOCATABLE :: focc(:), rwork(:), rwork2(:), singval(:), rpos(:,:), cpos(:,:) ! vv: Real array for the QR factorization and SVD
+ INTEGER, ALLOCATABLE :: piv(:) ! vv: Pivot array in the QR factorization
+ COMPLEX(DP) :: tmp_cwork(2)
+ REAL(DP):: ddot, sumk, norm_psi, f_gamma
+ INTEGER :: ik, npw, ibnd, iw, ikevc, nrtot, ipt, info, lcwork, locibnd, &
+ jpt,kpt,lpt, ib, istart, gamma_idx, minmn, minmn2, maxmn2, numbands, nbtot
+ CHARACTER (len=9) :: cdate,ctime
+ CHARACTER (len=60) :: header
+ LOGICAL :: any_uspp, found_gamma
+
+#if defined(__MPI)
+ INTEGER :: nxxs
+ COMPLEX(DP),ALLOCATABLE :: psic_all(:)
+ nxxs = dffts%nr1x * dffts%nr2x * dffts%nr3x
+ ALLOCATE(psic_all(nxxs) )
+#endif
+
+ ! vv: Write info about SCDM in output
+ IF (TRIM(scdm_entanglement) == 'isolated') THEN
+ WRITE(stdout,'(1x,a,a/)') 'Case : ',trim(scdm_entanglement)
+ ELSEIF (TRIM(scdm_entanglement) == 'erfc' .OR. &
+ TRIM(scdm_entanglement) == 'gaussian') THEN
+ WRITE(stdout,'(1x,a,a)') 'Case : ',trim(scdm_entanglement)
+ WRITE(stdout,'(1x,a,f10.3,a/,1x,a,f10.3,a/)') 'mu = ', scdm_mu, ' eV', 'sigma =', scdm_sigma, ' eV'
+ ENDIF
+
+ CALL start_clock( 'compute_amn' )
+
+ any_uspp =any (upf(1:ntyp)%tvanp)
+
+ ! vv: Error for using SCDM with non-collinear spin calculations
+ IF (noncolin) THEN
+ call errore('pw2wannier90','The SCDM method is not compatible with non-collinear spin yet.',1)
+ ENDIF
+
+ ! vv: Error for using SCDM with Ultrasoft pseudopotentials
+ !IF (any_uspp) THEN
+ ! call errore('pw2wannier90','The SCDM method does not work with Ultrasoft pseudopotential yet.',1)
+ !ENDIF
+
+ ! vv: Error for using SCDM with gamma_only
+ IF (gamma_only) THEN
+ call errore('pw2wannier90','The SCDM method does not work with gamma_only calculations.',1)
+ ENDIF
+ ! vv: Allocate all the variables for the SCDM method:
+ ! 1)For the QR decomposition
+ ! 2)For the unk's on the real grid
+ ! 3)For the SVD
+ IF(TRIM(scdm_entanglement) == 'isolated') THEN
+ numbands=n_wannier
+ nbtot=n_wannier + nexband
+ ELSE
+ numbands=nbnd-nexband
+ nbtot=nbnd
+ ENDIF
+ nrtot = dffts%nr1*dffts%nr2*dffts%nr3
+ info = 0
+ minmn = MIN(numbands,nrtot)
+ ALLOCATE(qr_tau(2*minmn))
+ ALLOCATE(piv(nrtot))
+ piv(:) = 0
+ ALLOCATE(rwork(2*nrtot))
+ rwork(:) = 0.0_DP
+
+ ALLOCATE(kpt_latt(3,iknum))
+ ALLOCATE(nowfc1(n_wannier,numbands))
+ ALLOCATE(nowfc(n_wannier,numbands))
+ ALLOCATE(psi_gamma(nrtot,numbands))
+ ALLOCATE(focc(numbands))
+ minmn2 = MIN(numbands,n_wannier)
+ maxmn2 = MAX(numbands,n_wannier)
+ ALLOCATE(rwork2(5*minmn2))
+
+ ALLOCATE(rpos(nrtot,3))
+ ALLOCATE(cpos(n_wannier,3))
+ ALLOCATE(phase(n_wannier))
+ ALLOCATE(singval(n_wannier))
+ ALLOCATE(Umat(numbands,n_wannier))
+ ALLOCATE(VTmat(n_wannier,n_wannier))
+ ALLOCATE(Amat(numbands,n_wannier))
+
+ IF (wan_mode=='library') ALLOCATE(a_mat(num_bands,n_wannier,iknum))
+
+ IF (wan_mode=='standalone') THEN
+ iun_amn = find_free_unit()
+ IF (ionode) OPEN (unit=iun_amn, file=trim(seedname)//".amn",form='formatted')
+ ENDIF
+
+ WRITE(stdout,'(a,i8)') ' AMN: iknum = ',iknum
+ !
+ IF (wan_mode=='standalone') THEN
+ CALL date_and_tim( cdate, ctime )
+ header='Created on '//cdate//' at '//ctime//' with SCDM '
+ IF (ionode) THEN
+ WRITE (iun_amn,*) header
+ WRITE (iun_amn,'(3i8,xxx,2f10.6)') numbands, iknum, n_wannier, scdm_mu, scdm_sigma
+ ENDIF
+ ENDIF
+
+ !vv: Find Gamma-point index in the list of k-vectors
+ ik = 0
+ gamma_idx = 1
+ sumk = -1.0_DP
+ found_gamma = .false.
+ kpt_latt(:,1:iknum)=xk(:,1:iknum)
+ CALL cryst_to_cart(iknum,kpt_latt,at,-1)
+ DO WHILE(sumk/=0.0_DP .and. ik < iknum)
+ ik = ik + 1
+ sumk = ABS(kpt_latt(1,ik)**2 + kpt_latt(2,ik)**2 + kpt_latt(3,ik)**2)
+ IF (sumk==0.0_DP) THEN
+ found_gamma = .true.
+ gamma_idx = ik
+ ENDIF
+ END DO
+ IF (.not. found_gamma) call errore('compute_amn','No Gamma point found.',1)
+
+ f_gamma = 0.0_DP
+ ik = gamma_idx
+ locibnd = 0
+ DO ibnd=1,nbtot
+ IF(excluded_band(ibnd)) CYCLE
+ locibnd = locibnd + 1
+ ! check locibnd <= numbands
+ IF (locibnd > numbands) call errore('compute_amn','Something wrong with the number of bands. Check exclude_bands.')
+ IF(TRIM(scdm_entanglement) == 'isolated') THEN
+ f_gamma = 1.0_DP
+ ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN
+ f_gamma = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma)
+ ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN
+ f_gamma = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2))
+ ELSE
+ call errore('compute_amn','scdm_entanglement value not recognized.',1)
+ END IF
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ik, -1 )
+ npw = ngk(ik)
+ ! vv: Compute unk's on a real grid (the fft grid)
+ psic(:) = (0.D0,0.D0)
+ psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd)
+ CALL invfft ('Wave', psic, dffts)
+#if defined(__MPI)
+ CALL gather_grid(dffts,psic,psic_all)
+ ! vv: Gamma only
+ ! vv: Build Psi_k = Unk * focc
+ norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP))
+ psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi
+ psi_gamma(1:nrtot,locibnd) = psic_all(1:nrtot)
+ psi_gamma(1:nrtot,locibnd) = psi_gamma(1:nrtot,locibnd) * f_gamma
+#else
+ norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP))
+ psic(1:nrtot) = psic(1:nrtot)/ norm_psi
+ psi_gamma(1:nrtot,locibnd) = psic(1:nrtot)
+ psi_gamma(1:nrtot,locibnd) = psi_gamma(1:nrtot,locibnd) * f_gamma
+#endif
+ ENDDO
+
+ ! vv: Perform QR factorization with pivoting on Psi_Gamma
+ ! vv: Preliminary call to define optimal values for lwork and cwork size
+ CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,tmp_cwork,-1,rwork,info)
+ IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
+ lcwork = AINT(REAL(tmp_cwork(1)))
+ tmp_cwork(:) = (0.0_DP,0.0_DP)
+ piv(:) = 0
+ rwork(:) = 0.0_DP
+ ALLOCATE(cwork(lcwork))
+ cwork(:) = (0.0_DP,0.0_DP)
+#if defined(__MPI)
+ IF(ionode) THEN
+ CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info)
+ IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
+ ENDIF
+ CALL mp_bcast(piv,ionode_id,world_comm)
+#else
+ ! vv: Perform QR factorization with pivoting on Psi_Gamma
+ CALL ZGEQP3(numbands,nrtot,TRANSPOSE(CONJG(psi_gamma)),numbands,piv,qr_tau,cwork,lcwork,rwork,info)
+ IF(info/=0) call errore('compute_amn','Error in computing the QR factorization',1)
+#endif
+ DEALLOCATE(cwork)
+ tmp_cwork(:) = (0.0_DP,0.0_DP)
+
+ ! vv: Compute the points
+ lpt = 0
+ rpos(:,:) = 0.0_DP
+ cpos(:,:) = 0.0_DP
+ DO kpt = 0,dffts%nr3-1
+ DO jpt = 0,dffts%nr2-1
+ DO ipt = 0,dffts%nr1-1
+ lpt = lpt + 1
+ rpos(lpt,1) = REAL(ipt)/dffts%nr1
+ rpos(lpt,2) = REAL(jpt)/dffts%nr2
+ rpos(lpt,3) = REAL(kpt)/dffts%nr3
+ ENDDO
+ ENDDO
+ ENDDO
+ DO iw=1,n_wannier
+ cpos(iw,:) = rpos(piv(iw),:)
+ cpos(iw,:) = cpos(iw,:) - ANINT(cpos(iw,:))
+ ENDDO
+
+ DO ik=1,iknum
+ WRITE (stdout,'(i8)',advance='no') ik
+ IF( MOD(ik,10) == 0 ) WRITE (stdout,*)
+ FLUSH(stdout)
+ ikevc = ik + ikstart - 1
+! if(noncolin) then
+! call davcio (evc_nc, 2*nwordwfc, iunwfc, ikevc, -1 )
+! else
+! end if
+
+ ! vv: SCDM method for generating the Amn matrix
+ phase(:) = (0.0_DP,0.0_DP)
+ nowfc1(:,:) = (0.0_DP,0.0_DP)
+ nowfc(:,:) = (0.0_DP,0.0_DP)
+ Umat(:,:) = (0.0_DP,0.0_DP)
+ VTmat(:,:) = (0.0_DP,0.0_DP)
+ Amat(:,:) = (0.0_DP,0.0_DP)
+ singval(:) = 0.0_DP
+ rwork2(:) = 0.0_DP
+ locibnd = 0
+ ! vv: Generate the occupation numbers matrix according to scdm_entanglement
+ DO ibnd=1,nbtot
+ IF (excluded_band(ibnd)) CYCLE
+ locibnd = locibnd + 1
+ ! vv: Define the occupation numbers matrix according to scdm_entanglement
+ IF(TRIM(scdm_entanglement) == 'isolated') THEN
+ focc(locibnd) = 1.0_DP
+ ELSEIF (TRIM(scdm_entanglement) == 'erfc') THEN
+ focc(locibnd) = 0.5_DP*ERFC((et(ibnd,ik)*rytoev - scdm_mu)/scdm_sigma)
+ ELSEIF (TRIM(scdm_entanglement) == 'gaussian') THEN
+ focc(locibnd) = EXP(-1.0_DP*((et(ibnd,ik)*rytoev - scdm_mu)**2)/(scdm_sigma**2))
+ ELSE
+ call errore('compute_amn','scdm_entanglement value not recognized.',1)
+ END IF
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1 )
+ npw = ngk(ik)
+ psic(:) = (0.D0,0.D0)
+ psic(dffts%nl (igk_k (1:npw,ik) ) ) = evc (1:npw,ibnd)
+ CALL invfft ('Wave', psic, dffts)
+#if defined(__MPI)
+ CALL gather_grid(dffts,psic,psic_all)
+ norm_psi = sqrt(real(sum(psic_all(1:nrtot)*conjg(psic_all(1:nrtot))),kind=DP))
+ psic_all(1:nrtot) = psic_all(1:nrtot)/ norm_psi
+ DO iw = 1,n_wannier
+ phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
+ &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),&
+ &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
+ &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)))
+ nowfc(iw,locibnd) = phase(iw)*psic_all(piv(iw))*focc(locibnd)
+ ENDDO
+#else
+ norm_psi = sqrt(real(sum(psic(1:nrtot)*conjg(psic(1:nrtot))),kind=DP))
+ psic(1:nrtot) = psic(1:nrtot)/ norm_psi
+ DO iw = 1,n_wannier
+ phase(iw) = cmplx(COS(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
+ &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))), & !*ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)),&
+ &SIN(2.0_DP*pi*(cpos(iw,1)*kpt_latt(1,ik) + &
+ &cpos(iw,2)*kpt_latt(2,ik) + cpos(iw,3)*kpt_latt(3,ik))),kind=DP) !ddot(3,cpos(iw,:),1,kpt_latt(:,ik),1)))
+ nowfc(iw,locibnd) = phase(iw)*psic(piv(iw))*focc(locibnd)
+
+ ENDDO
+#endif
+ ENDDO
+
+ CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
+ &singval,Umat,numbands,VTmat,n_wannier,tmp_cwork,-1,rwork2,info)
+ lcwork = AINT(REAL(tmp_cwork(1)))
+ tmp_cwork(:) = (0.0_DP,0.0_DP)
+ ALLOCATE(cwork(lcwork))
+#if defined(__MPI)
+ IF(ionode) THEN
+ ! vv: SVD to generate orthogonal projections
+ CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
+ &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info)
+ IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1)
+ ENDIF
+ CALL mp_bcast(Umat,ionode_id,world_comm)
+ CALL mp_bcast(VTmat,ionode_id,world_comm)
+#else
+ ! vv: SVD to generate orthogonal projections
+ CALL ZGESVD('S','S',numbands,n_wannier,TRANSPOSE(CONJG(nowfc)),numbands,&
+ &singval,Umat,numbands,VTmat,n_wannier,cwork,lcwork,rwork2,info)
+ IF(info/=0) CALL errore('compute_amn','Error in computing the SVD of the PSI matrix in the SCDM method',1)
+#endif
+ DEALLOCATE(cwork)
+
+ Amat = MATMUL(Umat,VTmat)
+ DO iw = 1,n_wannier
+ locibnd = 0
+ DO ibnd = 1,nbtot
+ IF (excluded_band(ibnd)) CYCLE
+ locibnd = locibnd + 1
+ IF (ionode) WRITE(iun_amn,'(3i5,2f18.12)') locibnd, iw, ik, REAL(Amat(locibnd,iw)), AIMAG(Amat(locibnd,iw))
+ ENDDO
+ ENDDO
+ ENDDO ! k-points
+
+ ! vv: Deallocate all the variables for the SCDM method
+ DEALLOCATE(kpt_latt)
+ DEALLOCATE(psi_gamma)
+ DEALLOCATE(nowfc)
+ DEALLOCATE(nowfc1)
+ DEALLOCATE(focc)
+ DEALLOCATE(piv)
+ DEALLOCATE(qr_tau)
+ DEALLOCATE(rwork)
+ DEALLOCATE(rwork2)
+ DEALLOCATE(rpos)
+ DEALLOCATE(cpos)
+ DEALLOCATE(Umat)
+ DEALLOCATE(VTmat)
+ DEALLOCATE(Amat)
+ DEALLOCATE(singval)
+
+#if defined(__MPI)
+ DEALLOCATE( psic_all )
+#endif
+
+ IF (ionode .and. wan_mode=='standalone') CLOSE (iun_amn)
+ WRITE(stdout,'(/)')
+ WRITE(stdout,*) ' AMN calculated'
+ CALL stop_clock( 'compute_amn' )
+
+ RETURN
+END SUBROUTINE compute_amn_with_scdm
+
+subroutine orient_gf_spinor(npw)
+ use constants, only: eps6
+ use noncollin_module, only: npol
+ use wvfct, ONLY : npwx
+ use wannier
+
+ implicit none
+
+ integer :: npw, iw, ipol, istart, iw_spinor
+ logical :: spin_z_pos, spin_z_neg
+ complex(dp) :: fac(2)
+
+
+ gf_spinor = (0.0d0, 0.0d0)
+ if (old_spinor_proj) then
+ iw_spinor = 1
+ DO ipol=1,npol
+ istart = (ipol-1)*npwx + 1
+ DO iw = 1,n_proj
+ ! generate 2*nproj spinor functions, one for each spin channel
+ gf_spinor(istart:istart+npw-1, iw_spinor) = gf(1:npw, iw)
+ iw_spinor = iw_spinor + 1
+ enddo
+ enddo
+ else
+ DO iw = 1,n_proj
+ spin_z_pos=.false.;spin_z_neg=.false.
+ ! detect if spin quantisation axis is along z
+ if((abs(spin_qaxis(1,iw)-0.0d0).unkg file
+ !
+ iun_parity = find_free_unit()
+ IF (ionode) THEN
+ OPEN (unit=iun_parity, file=trim(seedname)//".unkg",form='formatted')
+ WRITE(stdout,*)"Finding the 32 unkg's per band required for parity signature."
+ ENDIF
+ !
+ ! g_abc(:,ipw) are the coordinates of the ipw-th G vector in b1, b2, b3 basis,
+ ! we compute them from g(:,ipw) by multiplying : transpose(at) with g(:,ipw)
+ !
+ ALLOCATE(g_abc(3,npw))
+ DO igv=1,npw
+ g_abc(:,igk_k(igv,kgamma))=matmul(transpose(at),g(:,igk_k(igv,kgamma)))
+ ENDDO
+ !
+ ! Count and identify the G vectors we will be extracting for each
+ ! cpu.
+ !
+ ig_idx=0
+ num_G = 0
+ DO igv=1,npw
+ ! 0-th Order
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! 1
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ ! 1st Order
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ ! 2nd Order
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! yz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! yz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! z^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ ! 3rd Order
+ IF ( (abs(g_abc(1,igv) - 3.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^3
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2y
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! x^2y
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! x^2z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! x^2z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! xy^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xyz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xyz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! xyz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) + 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! xyz
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! xz^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 2.d0 <= eps6) ) THEN ! xz^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 3.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 0.d0 <= eps6) ) THEN ! y^3
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 1.d0 <= eps6) ) THEN ! y^2z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 2.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 1.d0 <= eps6) ) THEN ! y^2z
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 2.d0 <= eps6) ) THEN ! yz^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and.&
+ (abs(g_abc(2,igv) - 1.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) + 2.d0 <= eps6) ) THEN ! yz^2
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ IF ( (abs(g_abc(1,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(2,igv) - 0.d0) <= eps6) .and. &
+ (abs(g_abc(3,igv)) - 3.d0 <= eps6) ) THEN ! z^3
+ num_G(mpime+1) = num_G(mpime+1) + 1
+ ig_idx(num_G(mpime+1))=igv
+ CYCLE
+ ENDIF
+ ENDDO
+ !
+ ! Sum laterally across cpus num_G, so it contains
+ ! the number of g_vectors on each node, and known to all cpus
+ !
+ CALL mp_sum(num_G, intra_pool_comm)
+
+ IF (ionode) WRITE(iun_parity,*) sum(num_G)
+ IF (sum(num_G) /= 32) CALL errore('write_parity', 'incorrect number of g-vectors extracted',1)
+ IF (ionode) THEN
+ WRITE(stdout,*)' ...done'
+ WRITE(stdout,*)'G-vector splitting:'
+ DO i=1,nproc
+ WRITE(stdout,*)' cpu: ',i-1,' number g-vectors: ',num_G(i)
+ ENDDO
+ WRITE(stdout,*)' Collecting g-vectors and writing to file'
+ ENDIF
+
+ !
+ ! Define needed intermediate arrays
+ !
+ ALLOCATE(evc_sub(32,nbnd,nproc))
+ ALLOCATE(evc_sub_gathered(32,nbnd))
+ ALLOCATE(g_abc_pre_gather(3,32,nproc))
+ !
+ ! Initialise
+ !
+ evc_sub=(0.d0,0.d0)
+ evc_sub_1D=(0.d0,0.d0)
+ evc_sub_gathered=(0.d0,0.d0)
+ g_abc_pre_gather=0
+ g_abc_1D=0
+ g_abc_gathered=0
+ !
+ ! Compute displacements needed for filling evc_sub
+ !
+ displ(1)=1
+ IF (nproc > 1) THEN
+ DO i=2,nproc
+ displ(i)=displ(i-1)+num_G(i-1)
+ ENDDO
+ ENDIF
+ !
+ ! Fill evc_sub with required fourier component from each cpu dependent evc
+ !
+ DO i=1,num_G(mpime+1)
+ evc_sub(i+displ(mpime+1)-1,:,mpime+1)=evc(ig_idx(i),:)
+ ENDDO
+ !
+ ! g_abc_pre_gather(:,ipw,icpu) are the coordinates of the ipw-th G vector in b1, b2, b3 basis
+ ! on icpu and stored sequencially, ready for a lateral mp_sum
+ !
+ DO igv=1,num_G(mpime+1)
+ g_abc_pre_gather(:,igv+displ(mpime+1)-1,mpime+1) = &
+ matmul(transpose(at),g(:,ig_idx(igk_k(igv,kgamma))))
+ ENDDO
+ !
+ ! Gather evc_sub and g_abc_pre_gather into common arrays to each cpu
+ !
+ DO ibnd=1,nbnd
+ evc_sub_1D=evc_sub(:,ibnd,mpime+1)
+ CALL mp_sum(evc_sub_1D, intra_pool_comm)
+ evc_sub_gathered(:,ibnd)=evc_sub_1D
+ ENDDO
+ !
+ DO i=1,3
+ g_abc_1D=g_abc_pre_gather(i,:,mpime+1)
+ CALL mp_sum(g_abc_1D, intra_pool_comm)
+ g_abc_gathered(i,:)=g_abc_1D
+ ENDDO
+ !
+ ! Write to file
+ !
+ DO ibnd=1,nbnd
+ DO igv=1,32
+ IF (ionode) WRITE(iun_parity,'(5i5,2f12.7)') ibnd, igv, nint(g_abc_gathered(1,igv)),&
+ nint(g_abc_gathered(2,igv)),&
+ nint(g_abc_gathered(3,igv)),&
+ real(evc_sub_gathered(igv,ibnd)),&
+ aimag(evc_sub_gathered(igv,ibnd))
+ ENDDO
+ ENDDO
+ WRITE(stdout,*)' ...done'
+ !
+ IF (ionode) CLOSE(unit=iun_parity)
+ !
+ DEALLOCATE(evc_sub)
+ DEALLOCATE(evc_sub_gathered)
+ DEALLOCATE(g_abc_pre_gather)
+
+ CALL stop_clock( 'write_parity' )
+
+END SUBROUTINE write_parity
+
+
+SUBROUTINE wan2sic
+
+ USE io_global, ONLY : stdout
+ USE kinds, ONLY : DP
+ USE io_files, ONLY : iunwfc, nwordwfc, nwordwann
+ USE gvect, ONLY : g, ngm
+ USE wavefunctions, ONLY : evc, psic
+ USE wvfct, ONLY : nbnd, npwx
+ USE gvecw, ONLY : gcutw
+ USE klist, ONLY : nkstot, xk, wk, ngk
+ USE wannier
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, nn, ik, ibnd, iw, ikevc, npw
+ COMPLEX(DP), ALLOCATABLE :: orbital(:,:), u_matrix(:,:,:)
+ INTEGER :: iunatsicwfc = 31 ! unit for sic wfc
+
+ OPEN (20, file = trim(seedname)//".dat" , form = 'formatted', status = 'unknown')
+ WRITE(stdout,*) ' wannier plot '
+
+ ALLOCATE ( u_matrix( n_wannier, n_wannier, nkstot) )
+ ALLOCATE ( orbital( npwx, n_wannier) )
+
+ !
+ DO i = 1, n_wannier
+ DO j = 1, n_wannier
+ DO ik = 1, nkstot
+ READ (20, * ) u_matrix(i,j,ik)
+ !do nn = 1, nnb(ik)
+ DO nn = 1, nnb
+ READ (20, * ) ! m_matrix (i,j,nkp,nn)
+ ENDDO
+ ENDDO !nkp
+ ENDDO !j
+ ENDDO !i
+ !
+ DO ik=1,iknum
+ ikevc = ik + ikstart - 1
+ CALL davcio (evc, 2*nwordwfc, iunwfc, ikevc, -1)
+ npw = ngk(ik)
+ WRITE(stdout,*) 'npw ',npw
+ DO iw=1,n_wannier
+ DO j=1,npw
+ orbital(j,iw) = (0.0d0,0.0d0)
+ DO ibnd=1,n_wannier
+ orbital(j,iw) = orbital(j,iw) + u_matrix(iw,ibnd,ik)*evc(j,ibnd)
+ WRITE(stdout,*) j, iw, ibnd, ik, orbital(j,iw), &
+ u_matrix(iw,ibnd,ik), evc(j,ibnd)
+ ENDDO !ibnd
+ ENDDO !j
+ ENDDO !wannier
+ CALL davcio (orbital, 2*nwordwann, iunatsicwfc, ikevc, +1)
+ ENDDO ! k-points
+
+ DEALLOCATE ( u_matrix)
+ WRITE(stdout,*) ' dealloc u '
+ DEALLOCATE ( orbital)
+ WRITE(stdout,*) ' dealloc orbital '
+ !
+END SUBROUTINE wan2sic
+
+SUBROUTINE ylm_expansion
+ USE io_global, ONLY : stdout
+ USE kinds, ONLY : DP
+ USE random_numbers, ONLY : randy
+ USE matrix_inversion
+ USE wannier
+ IMPLICIT NONE
+ ! local variables
+ INTEGER, PARAMETER :: lmax2=16
+ INTEGER :: lm, i, ir, iw, m
+ real(DP), ALLOCATABLE :: r(:,:), rr(:), rp(:,:), ylm_w(:), ylm(:,:), mly(:,:)
+ real(DP) :: u(3,3)
+
+ ALLOCATE (r(3,lmax2), rp(3,lmax2), rr(lmax2), ylm_w(lmax2))
+ ALLOCATE (ylm(lmax2,lmax2), mly(lmax2,lmax2) )
+
+ ! generate a set of nr=lmax2 random vectors
+ DO ir=1,lmax2
+ DO i=1,3
+ r(i,ir) = randy() -0.5d0
+ ENDDO
+ ENDDO
+ rr(:) = r(1,:)*r(1,:) + r(2,:)*r(2,:) + r(3,:)*r(3,:)
+ !- compute ylm(ir,lm)
+ CALL ylmr2(lmax2, lmax2, r, rr, ylm)
+ !- store the inverse of ylm(ir,lm) in mly(lm,ir)
+ CALL invmat(lmax2, ylm, mly)
+ !- check that r points are independent
+ CALL check_inverse(lmax2, ylm, mly)
+
+ DO iw=1, n_proj
+
+ !- define the u matrix that rotate the reference frame
+ CALL set_u_matrix (xaxis(:,iw),zaxis(:,iw),u)
+ !- find rotated r-vectors
+ rp(:,:) = matmul ( u(:,:) , r(:,:) )
+ !- set ylm funtion according to wannier90 (l,mr) indexing in the rotaterd points
+ CALL ylm_wannier(ylm_w,l_w(iw),mr_w(iw),rp,lmax2)
+
+ csph(:,iw) = matmul (mly(:,:), ylm_w(:))
+
+! write (stdout,*)
+! write (stdout,'(2i4,2(2x,3f6.3))') l_w(iw), mr_w(iw), xaxis(:,iw), zaxis(:,iw)
+! write (stdout,'(16i6)') (lm, lm=1,lmax2)
+! write (stdout,'(16f6.3)') (csph(lm,iw), lm=1,lmax2)
+
+ ENDDO
+ DEALLOCATE (r, rp, rr, ylm_w, ylm, mly )
+
+ RETURN
+END SUBROUTINE ylm_expansion
+
+SUBROUTINE check_inverse(lmax2, ylm, mly)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : eps8
+ IMPLICIT NONE
+ ! I/O variables
+ INTEGER :: lmax2
+ real(DP) :: ylm(lmax2,lmax2), mly(lmax2,lmax2)
+ ! local variables
+ real(DP), ALLOCATABLE :: uno(:,:)
+ real(DP) :: capel
+ INTEGER :: lm
+ !
+ ALLOCATE (uno(lmax2,lmax2) )
+ uno = matmul(mly, ylm)
+ capel = 0.d0
+ DO lm = 1, lmax2
+ uno(lm,lm) = uno(lm,lm) - 1.d0
+ ENDDO
+ capel = capel + sum ( abs(uno(1:lmax2,1:lmax2) ) )
+! write (stdout,*) "capel = ", capel
+ IF (capel > eps8) CALL errore('ylm_expansion', &
+ ' inversion failed: r(*,1:nr) are not all independent !!',1)
+ DEALLOCATE (uno)
+ RETURN
+END SUBROUTINE check_inverse
+
+SUBROUTINE set_u_matrix(x,z,u)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : eps6
+ IMPLICIT NONE
+ ! I/O variables
+ real(DP) :: x(3),z(3),u(3,3)
+ ! local variables
+ real(DP) :: xx, zz, y(3), coseno
+
+ xx = sqrt(x(1)*x(1) + x(2)*x(2) + x(3)*x(3))
+ IF (xx < eps6) CALL errore ('set_u_matrix',' |xaxis| < eps ',1)
+! x(:) = x(:)/xx
+ zz = sqrt(z(1)*z(1) + z(2)*z(2) + z(3)*z(3))
+ IF (zz < eps6) CALL errore ('set_u_matrix',' |zaxis| < eps ',1)
+! z(:) = z(:)/zz
+
+ coseno = (x(1)*z(1) + x(2)*z(2) + x(3)*z(3))/xx/zz
+ IF (abs(coseno) > eps6) CALL errore('set_u_matrix',' xaxis and zaxis are not orthogonal !',1)
+
+ y(1) = (z(2)*x(3) - x(2)*z(3))/xx/zz
+ y(2) = (z(3)*x(1) - x(3)*z(1))/xx/zz
+ y(3) = (z(1)*x(2) - x(1)*z(2))/xx/zz
+
+ u(1,:) = x(:)/xx
+ u(2,:) = y(:)
+ u(3,:) = z(:)/zz
+
+! write (stdout,'(3f10.7)') u(:,:)
+
+ RETURN
+
+END SUBROUTINE set_u_matrix
+
+SUBROUTINE ylm_wannier(ylm,l,mr,r,nr)
+!
+! this routine returns in ylm(r) the values at the nr points r(1:3,1:nr)
+! of the spherical harmonic identified by indices (l,mr)
+! in table 3.1 of the wannierf90 specification.
+!
+! No reference to the particular ylm ordering internal to Quantum ESPRESSO
+! is assumed.
+!
+! If ordering in wannier90 code is changed or extended this should be the
+! only place to be modified accordingly
+!
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi, fpi, eps8
+ IMPLICIT NONE
+! I/O variables
+!
+ INTEGER :: l, mr, nr
+ real(DP) :: ylm(nr), r(3,nr)
+!
+! local variables
+!
+ real(DP), EXTERNAL :: s, p_z,px,py, dz2, dxz, dyz, dx2my2, dxy
+ real(DP), EXTERNAL :: fz3, fxz2, fyz2, fzx2my2, fxyz, fxx2m3y2, fy3x2my2
+ real(DP) :: rr, cost, phi
+ INTEGER :: ir
+ real(DP) :: bs2, bs3, bs6, bs12
+ bs2 = 1.d0/sqrt(2.d0)
+ bs3=1.d0/sqrt(3.d0)
+ bs6 = 1.d0/sqrt(6.d0)
+ bs12 = 1.d0/sqrt(12.d0)
+!
+ IF (l > 3 .or. l < -5 ) CALL errore('ylm_wannier',' l out of range ', 1)
+ IF (l>=0) THEN
+ IF (mr < 1 .or. mr > 2*l+1) CALL errore('ylm_wannier','mr out of range' ,1)
+ ELSE
+ IF (mr < 1 .or. mr > abs(l)+1 ) CALL errore('ylm_wannier','mr out of range',1)
+ ENDIF
+
+ DO ir=1, nr
+ rr = sqrt( r(1,ir)*r(1,ir) + r(2,ir)*r(2,ir) + r(3,ir)*r(3,ir) )
+ IF (rr < eps8) CALL errore('ylm_wannier',' rr too small ',1)
+
+ cost = r(3,ir) / rr
+ !
+ ! beware the arc tan, it is defined modulo pi
+ !
+ IF (r(1,ir) > eps8) THEN
+ phi = atan( r(2,ir)/r(1,ir) )
+ ELSEIF (r(1,ir) < -eps8 ) THEN
+ phi = atan( r(2,ir)/r(1,ir) ) + pi
+ ELSE
+ phi = sign( pi/2.d0,r(2,ir) )
+ ENDIF
+
+
+ IF (l==0) THEN ! s orbital
+ ylm(ir) = s(cost,phi)
+ ENDIF
+ IF (l==1) THEN ! p orbitals
+ IF (mr==1) ylm(ir) = p_z(cost,phi)
+ IF (mr==2) ylm(ir) = px(cost,phi)
+ IF (mr==3) ylm(ir) = py(cost,phi)
+ ENDIF
+ IF (l==2) THEN ! d orbitals
+ IF (mr==1) ylm(ir) = dz2(cost,phi)
+ IF (mr==2) ylm(ir) = dxz(cost,phi)
+ IF (mr==3) ylm(ir) = dyz(cost,phi)
+ IF (mr==4) ylm(ir) = dx2my2(cost,phi)
+ IF (mr==5) ylm(ir) = dxy(cost,phi)
+ ENDIF
+ IF (l==3) THEN ! f orbitals
+ IF (mr==1) ylm(ir) = fz3(cost,phi)
+ IF (mr==2) ylm(ir) = fxz2(cost,phi)
+ IF (mr==3) ylm(ir) = fyz2(cost,phi)
+ IF (mr==4) ylm(ir) = fzx2my2(cost,phi)
+ IF (mr==5) ylm(ir) = fxyz(cost,phi)
+ IF (mr==6) ylm(ir) = fxx2m3y2(cost,phi)
+ IF (mr==7) ylm(ir) = fy3x2my2(cost,phi)
+ ENDIF
+ IF (l==-1) THEN ! sp hybrids
+ IF (mr==1) ylm(ir) = bs2 * ( s(cost,phi) + px(cost,phi) )
+ IF (mr==2) ylm(ir) = bs2 * ( s(cost,phi) - px(cost,phi) )
+ ENDIF
+ IF (l==-2) THEN ! sp2 hybrids
+ IF (mr==1) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)+bs2*py(cost,phi)
+ IF (mr==2) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)-bs2*py(cost,phi)
+ IF (mr==3) ylm(ir) = bs3*s(cost,phi) +2.d0*bs6*px(cost,phi)
+ ENDIF
+ IF (l==-3) THEN ! sp3 hybrids
+ IF (mr==1) ylm(ir) = 0.5d0*(s(cost,phi)+px(cost,phi)+py(cost,phi)+p_z(cost,phi))
+ IF (mr==2) ylm(ir) = 0.5d0*(s(cost,phi)+px(cost,phi)-py(cost,phi)-p_z(cost,phi))
+ IF (mr==3) ylm(ir) = 0.5d0*(s(cost,phi)-px(cost,phi)+py(cost,phi)-p_z(cost,phi))
+ IF (mr==4) ylm(ir) = 0.5d0*(s(cost,phi)-px(cost,phi)-py(cost,phi)+p_z(cost,phi))
+ ENDIF
+ IF (l==-4) THEN ! sp3d hybrids
+ IF (mr==1) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)+bs2*py(cost,phi)
+ IF (mr==2) ylm(ir) = bs3*s(cost,phi)-bs6*px(cost,phi)-bs2*py(cost,phi)
+ IF (mr==3) ylm(ir) = bs3*s(cost,phi) +2.d0*bs6*px(cost,phi)
+ IF (mr==4) ylm(ir) = bs2*p_z(cost,phi)+bs2*dz2(cost,phi)
+ IF (mr==5) ylm(ir) =-bs2*p_z(cost,phi)+bs2*dz2(cost,phi)
+ ENDIF
+ IF (l==-5) THEN ! sp3d2 hybrids
+ IF (mr==1) ylm(ir) = bs6*s(cost,phi)-bs2*px(cost,phi)-bs12*dz2(cost,phi)+.5d0*dx2my2(cost,phi)
+ IF (mr==2) ylm(ir) = bs6*s(cost,phi)+bs2*px(cost,phi)-bs12*dz2(cost,phi)+.5d0*dx2my2(cost,phi)
+ IF (mr==3) ylm(ir) = bs6*s(cost,phi)-bs2*py(cost,phi)-bs12*dz2(cost,phi)-.5d0*dx2my2(cost,phi)
+ IF (mr==4) ylm(ir) = bs6*s(cost,phi)+bs2*py(cost,phi)-bs12*dz2(cost,phi)-.5d0*dx2my2(cost,phi)
+ IF (mr==5) ylm(ir) = bs6*s(cost,phi)-bs2*p_z(cost,phi)+bs3*dz2(cost,phi)
+ IF (mr==6) ylm(ir) = bs6*s(cost,phi)+bs2*p_z(cost,phi)+bs3*dz2(cost,phi)
+ ENDIF
+
+ ENDDO
+
+ RETURN
+
+END SUBROUTINE ylm_wannier
+
+!======== l = 0 =====================================================================
+FUNCTION s(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) :: s, cost,phi
+ s = 1.d0/ sqrt(fpi)
+ RETURN
+END FUNCTION s
+!======== l = 1 =====================================================================
+FUNCTION p_z(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::p_z, cost,phi
+ p_z = sqrt(3.d0/fpi) * cost
+ RETURN
+END FUNCTION p_z
+FUNCTION px(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::px, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ px = sqrt(3.d0/fpi) * sint * cos(phi)
+ RETURN
+END FUNCTION px
+FUNCTION py(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::py, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ py = sqrt(3.d0/fpi) * sint * sin(phi)
+ RETURN
+END FUNCTION py
+!======== l = 2 =====================================================================
+FUNCTION dz2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dz2, cost, phi
+ dz2 = sqrt(1.25d0/fpi) * (3.d0* cost*cost-1.d0)
+ RETURN
+END FUNCTION dz2
+FUNCTION dxz(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dxz, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ dxz = sqrt(15.d0/fpi) * sint*cost * cos(phi)
+ RETURN
+END FUNCTION dxz
+FUNCTION dyz(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dyz, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ dyz = sqrt(15.d0/fpi) * sint*cost * sin(phi)
+ RETURN
+END FUNCTION dyz
+FUNCTION dx2my2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dx2my2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ dx2my2 = sqrt(3.75d0/fpi) * sint*sint * cos(2.d0*phi)
+ RETURN
+END FUNCTION dx2my2
+FUNCTION dxy(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : fpi
+ IMPLICIT NONE
+ real(DP) ::dxy, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ dxy = sqrt(3.75d0/fpi) * sint*sint * sin(2.d0*phi)
+ RETURN
+END FUNCTION dxy
+!======== l = 3 =====================================================================
+FUNCTION fz3(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fz3, cost, phi
+ fz3 = 0.25d0*sqrt(7.d0/pi) * ( 5.d0 * cost * cost - 3.d0 ) * cost
+ RETURN
+END FUNCTION fz3
+FUNCTION fxz2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fxz2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fxz2 = 0.25d0*sqrt(10.5d0/pi) * ( 5.d0 * cost * cost - 1.d0 ) * sint * cos(phi)
+ RETURN
+END FUNCTION fxz2
+FUNCTION fyz2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fyz2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fyz2 = 0.25d0*sqrt(10.5d0/pi) * ( 5.d0 * cost * cost - 1.d0 ) * sint * sin(phi)
+ RETURN
+END FUNCTION fyz2
+FUNCTION fzx2my2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fzx2my2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fzx2my2 = 0.25d0*sqrt(105d0/pi) * sint * sint * cost * cos(2.d0*phi)
+ RETURN
+END FUNCTION fzx2my2
+FUNCTION fxyz(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fxyz, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fxyz = 0.25d0*sqrt(105d0/pi) * sint * sint * cost * sin(2.d0*phi)
+ RETURN
+END FUNCTION fxyz
+FUNCTION fxx2m3y2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fxx2m3y2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fxx2m3y2 = 0.25d0*sqrt(17.5d0/pi) * sint * sint * sint * cos(3.d0*phi)
+ RETURN
+END FUNCTION fxx2m3y2
+FUNCTION fy3x2my2(cost,phi)
+ USE kinds, ONLY : DP
+ USE constants, ONLY : pi
+ IMPLICIT NONE
+ real(DP) ::fy3x2my2, cost, phi, sint
+ sint = sqrt(abs(1.d0 - cost*cost))
+ fy3x2my2 = 0.25d0*sqrt(17.5d0/pi) * sint * sint * sint * sin(3.d0*phi)
+ RETURN
+END FUNCTION fy3x2my2
+!
+!
+!-----------------------------------------------------------------------
+SUBROUTINE radialpart(ng, q, alfa, rvalue, lmax, radial)
+ !-----------------------------------------------------------------------
+ !
+ ! This routine computes a table with the radial Fourier transform
+ ! of the radial functions.
+ !
+ USE kinds, ONLY : dp
+ USE constants, ONLY : fpi
+ USE cell_base, ONLY : omega
+ !
+ IMPLICIT NONE
+ ! I/O
+ INTEGER :: ng, rvalue, lmax
+ real(DP) :: q(ng), alfa, radial(ng,0:lmax)
+ ! local variables
+ real(DP), PARAMETER :: xmin=-6.d0, dx=0.025d0, rmax=10.d0
+
+ real(DP) :: rad_int, pref, x
+ INTEGER :: l, lp1, ir, ig, mesh_r
+ real(DP), ALLOCATABLE :: bes(:), func_r(:), r(:), rij(:), aux(:)
+
+ mesh_r = nint ( ( log ( rmax ) - xmin ) / dx + 1 )
+ ALLOCATE ( bes(mesh_r), func_r(mesh_r), r(mesh_r), rij(mesh_r) )
+ ALLOCATE ( aux(mesh_r))
+ !
+ ! compute the radial mesh
+ !
+ DO ir = 1, mesh_r
+ x = xmin + dble (ir - 1) * dx
+ r (ir) = exp (x) / alfa
+ rij (ir) = dx * r (ir)
+ ENDDO
+ !
+ IF (rvalue==1) func_r(:) = 2.d0 * alfa**(3.d0/2.d0) * exp(-alfa*r(:))
+ IF (rvalue==2) func_r(:) = 1.d0/sqrt(8.d0) * alfa**(3.d0/2.d0) * &
+ (2.0d0 - alfa*r(:)) * exp(-alfa*r(:)*0.5d0)
+ IF (rvalue==3) func_r(:) = sqrt(4.d0/27.d0) * alfa**(3.0d0/2.0d0) * &
+ (1.d0 - 2.0d0/3.0d0*alfa*r(:) + 2.d0*(alfa*r(:))**2/27.d0) * &
+ exp(-alfa*r(:)/3.0d0)
+ pref = fpi/sqrt(omega)
+ !
+ DO l = 0, lmax
+ DO ig=1,ng
+ CALL sph_bes (mesh_r, r(1), q(ig), l, bes)
+ aux(:) = bes(:) * func_r(:) * r(:) * r(:)
+ ! second r factor added upo suggestion by YY Liang
+ CALL simpson (mesh_r, aux, rij, rad_int)
+ radial(ig,l) = rad_int * pref
+ ENDDO
+ ENDDO
+
+ DEALLOCATE (bes, func_r, r, rij, aux )
+ RETURN
+END SUBROUTINE radialpart
From 056e0a797a7bcd4a2084ed2e49add727ac86aaf8 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Fri, 1 Mar 2019 16:21:08 +0100
Subject: [PATCH 08/24] References for example WAN_example updated (expect the
"library" one)
---
.../WAN90_example/reference/diamond.lib.win | 4 +-
.../WAN90_example/reference/diamond.nscf.in | 8 +-
.../WAN90_example/reference/diamond.nscf.out | 436 ++++++++-------
.../reference/diamond.pw2wan.lib.in | 2 +-
.../reference/diamond.pw2wan.sa.in | 2 +-
.../reference/diamond.pw2wan.sa.out | 218 +++-----
.../WAN90_example/reference/diamond.sa.eig | 512 +++++++++---------
.../WAN90_example/reference/diamond.sa.nnkp | 10 +-
.../WAN90_example/reference/diamond.sa.win | 4 +-
.../WAN90_example/reference/diamond.sa.wout | 512 ++++++++++--------
.../WAN90_example/reference/diamond.scf.in | 8 +-
.../WAN90_example/reference/diamond.scf.out | 423 ++++++++-------
12 files changed, 1082 insertions(+), 1057 deletions(-)
diff --git a/PP/examples/WAN90_example/reference/diamond.lib.win b/PP/examples/WAN90_example/reference/diamond.lib.win
index ff52efe688..418f791ba2 100644
--- a/PP/examples/WAN90_example/reference/diamond.lib.win
+++ b/PP/examples/WAN90_example/reference/diamond.lib.win
@@ -2,8 +2,8 @@ num_wann = 4
num_iter = 20
begin atoms_frac
-C -0.12500 -0.1250 -0.125000
-C 0.12500 0.1250 0.125000
+C -0.2500 -0.250 -0.25000
+C 0.00000 0.0000 0.000000
end atoms_frac
begin projections
diff --git a/PP/examples/WAN90_example/reference/diamond.nscf.in b/PP/examples/WAN90_example/reference/diamond.nscf.in
index 052ebd7285..ee95b13daf 100644
--- a/PP/examples/WAN90_example/reference/diamond.nscf.in
+++ b/PP/examples/WAN90_example/reference/diamond.nscf.in
@@ -1,7 +1,7 @@
&control
calculation='nscf'
- pseudo_dir='/home/arash/PW-pseudo',
- outdir='/home/arash/tmp',
+ pseudo_dir='/home/giannozz/q-e-mio/pseudo',
+ outdir='/home/giannozz/q-e-mio/tempdir',
prefix='di'
/
&system
@@ -14,8 +14,8 @@
ATOMIC_SPECIES
C 12.0 C.pz-vbc.UPF
ATOMIC_POSITIONS {crystal}
-C -0.125 -0.125 -0.125
-C 0.125 0.125 0.125
+C -0.25 -0.25 -0.25
+C 0.0 0.0 0.0
K_POINTS {crystal}
64
0.0000 0.0000 0.0000 0.0156250
diff --git a/PP/examples/WAN90_example/reference/diamond.nscf.out b/PP/examples/WAN90_example/reference/diamond.nscf.out
index 766c9288de..ceacc17191 100644
--- a/PP/examples/WAN90_example/reference/diamond.nscf.out
+++ b/PP/examples/WAN90_example/reference/diamond.nscf.out
@@ -1,76 +1,88 @@
- Program PWSCF v.3.1.1 starts ...
- Today is 9Oct2006 at 15:37: 6
+ Program PWSCF v.6.4rc starts on 1Mar2019 at 15:58:49
- Parallel version (MPI)
+ This program is part of the open-source Quantum ESPRESSO suite
+ for quantum simulation of materials; please cite
+ "P. Giannozzi et al., J. Phys.:Condens. Matter 21 395502 (2009);
+ "P. Giannozzi et al., J. Phys.:Condens. Matter 29 465901 (2017);
+ URL http://www.quantum-espresso.org",
+ in publications or presentations arising from this work. More details at
+ http://www.quantum-espresso.org/quote
- Number of processors in use: 2
- R & G space division: proc/pool = 2
+ Parallel version (MPI), running on 1 processors
- Ultrasoft (Vanderbilt) Pseudopotentials
+ MPI processes distributed on 1 nodes
+ Waiting for input...
+ Reading input from standard input
- Current dimensions of program pwscf are:
+ Current dimensions of program PWSCF are:
+ Max number of different atomic species (ntypx) = 10
+ Max number of k-points (npk) = 40000
+ Max angular momentum in pseudopotentials (lmaxx) = 3
- ntypx = 10 npk = 40000 lmax = 3
- nchix = 6 ndmx = 2000 nbrx = 14 nqfx = 8
-
- looking for the optimal diagonalization algorithm ...
+ Atomic positions and unit cell read from directory:
+ /home/giannozz/q-e-mio/tempdir/di.save/
+
+ Subspace diagonalization in iterative solution of the eigenvalue problem:
a serial algorithm will be used
-
- Planes per process (thick) : nr3 = 18 npp = 9 ncplane = 324
- Proc/ planes cols G planes cols G columns G
- Pool (dense grid) (smooth grid) (wavefct grid)
- 1 9 99 957 9 99 957 42 230
- 2 9 100 960 9 100 960 43 229
- 0 18 199 1917 18 199 1917 85 459
+ G-vector sticks info
+ --------------------
+ sticks: dense smooth PW G-vecs: dense smooth PW
+ Sum 199 199 85 1917 1917 459
bravais-lattice index = 2
- lattice parameter (a_0) = 6.1000 a.u.
+ lattice parameter (alat) = 6.1000 a.u.
unit-cell volume = 56.7452 (a.u.)^3
number of atoms/cell = 2
number of atomic types = 1
+ number of electrons = 8.00
+ number of Kohn-Sham states= 4
kinetic-energy cutoff = 40.0000 Ry
charge density cutoff = 160.0000 Ry
- convergence threshold = 1.0E-11
- beta = 0.7000
- number of iterations used = 8 plain mixing
- Exchange-correlation = SLA PZ NOGX NOGC (1100)
+ Exchange-correlation = SLA PZ NOGX NOGC ( 1 1 0 0 0 0)
+
celldm(1)= 6.100000 celldm(2)= 0.000000 celldm(3)= 0.000000
celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000
- crystal axes: (cart. coord. in units of a_0)
- a(1) = ( -0.500000 0.000000 0.500000 )
- a(2) = ( 0.000000 0.500000 0.500000 )
- a(3) = ( -0.500000 0.500000 0.000000 )
+ crystal axes: (cart. coord. in units of alat)
+ a(1) = ( -0.500000 0.000000 0.500000 )
+ a(2) = ( 0.000000 0.500000 0.500000 )
+ a(3) = ( -0.500000 0.500000 0.000000 )
- reciprocal axes: (cart. coord. in units 2 pi/a_0)
+ reciprocal axes: (cart. coord. in units 2 pi/alat)
b(1) = ( -1.000000 -1.000000 1.000000 )
b(2) = ( 1.000000 1.000000 1.000000 )
b(3) = ( -1.000000 1.000000 -1.000000 )
- PSEUDO 1 is C zval = 4.0 lmax= 0 lloc= 0
- (in numerical form: 269 grid points, xmin = 0.00, dx = 0.0000)
+ PseudoPot. # 1 for C read from file:
+ /home/giannozz/q-e-mio/pseudo/C.pz-vbc.UPF
+ MD5 check sum: b3df27665907f6396c9b9f9dac2a9cb5
+ Pseudo is Norm-conserving, Zval = 4.0
+ Generated by new atomic code, or converted to UPF format
+ Using radial grid of 269 points, 1 beta functions with:
+ l(1) = 0
atomic species valence mass pseudopotential
C 4.00 12.00000 C ( 1.00)
- 48 Sym.Ops. (with inversion)
+ 48 Sym. Ops., with inversion, found (24 have fractional translation)
+
Cartesian axes
- site n. atom positions (a_0 units)
- 1 C tau( 1) = ( 0.1250000 -0.1250000 -0.1250000 )
- 2 C tau( 2) = ( -0.1250000 0.1250000 0.1250000 )
+ site n. atom positions (alat units)
+ 1 C tau( 1) = ( 0.2500000 -0.2500000 -0.2500000 )
+ 2 C tau( 2) = ( 0.0000000 0.0000000 0.0000000 )
- number of k points= 64
- cart. coord. in units 2pi/a_0
+ number of k points= 64
+ cart. coord. in units 2pi/alat
k( 1) = ( 0.0000000 0.0000000 0.0000000), wk = 0.0312500
k( 2) = ( 0.2500000 0.2500000 0.2500000), wk = 0.0312500
k( 3) = ( 0.5000000 0.5000000 0.5000000), wk = 0.0312500
@@ -136,320 +148,326 @@
k( 63) = ( -1.0000000 0.5000000 0.5000000), wk = 0.0312500
k( 64) = ( -0.7500000 0.7500000 0.7500000), wk = 0.0312500
- G cutoff = 150.8064 ( 1917 G-vectors) FFT grid: ( 18, 18, 18)
+ Dense grid: 1917 G-vectors FFT dimensions: ( 20, 20, 20)
- nbndx = 16 nbnd = 4 natomwfc = 8 npwx = 133
- nelec = 8.00 nkb = 2 ngl = 52
+ Estimated max dynamical RAM per process > 0.95 MB
The potential is recalculated from file :
- di.save/charge-density.xml
-
- Starting wfc are atomic
+ /home/giannozz/q-e-mio/tempdir/di.save/charge-density
- total cpu time spent up to now is 0.25 secs
+ Starting wfcs are 8 randomized atomic wfcs
Band Structure Calculation
Davidson diagonalization with overlap
- ethr = 1.25E-13, avg # of iterations = 11.2
- total cpu time spent up to now is 1.78 secs
+ ethr = 1.25E-13, avg # of iterations = 11.5
+
+ total cpu time spent up to now is 1.3 secs
End of band structure calculation
- k = 0.0000 0.0000 0.0000 band energies (ev):
+ k = 0.0000 0.0000 0.0000 ( 259 PWs) bands (ev):
- -6.4387 19.3980 19.3980 19.3980
+ -6.4386 19.3977 19.3977 19.3977
- k = 0.2500 0.2500 0.2500 band energies (ev):
+ k = 0.2500 0.2500 0.2500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
- k = 0.5000 0.5000 0.5000 band energies (ev):
+ k = 0.5000 0.5000 0.5000 ( 242 PWs) bands (ev):
- 1.3328 2.0781 15.8056 15.8056
+ 1.3328 2.0781 15.8054 15.8054
- k = 0.7500 0.7500 0.7500 band energies (ev):
+ k = 0.7500 0.7500 0.7500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
- k =-0.2500-0.2500 0.2500 band energies (ev):
+ k =-0.2500-0.2500 0.2500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
- k = 0.0000 0.0000 0.5000 band energies (ev):
+ k = 0.0000 0.0000 0.5000 ( 234 PWs) bands (ev):
- -3.6839 13.8639 13.8639 14.5739
+ -3.6839 13.8637 13.8637 14.5737
- k = 0.2500 0.2500 0.7500 band energies (ev):
+ k = 0.2500 0.2500 0.7500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k = 0.5000 0.5000 1.0000 band energies (ev):
+ k = 0.5000 0.5000 1.0000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.5000-0.5000 0.5000 band energies (ev):
+ k =-0.5000-0.5000 0.5000 ( 242 PWs) bands (ev):
- 1.3328 2.0781 15.8056 15.8056
+ 1.3328 2.0781 15.8054 15.8054
- k =-0.2500-0.2500 0.7500 band energies (ev):
+ k =-0.2500-0.2500 0.7500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k = 0.0000 0.0000 1.0000 band energies (ev):
+ k = 0.0000 0.0000 1.0000 ( 230 PWs) bands (ev):
- 4.2492 4.2492 11.0421 11.0421
+ 4.2491 4.2491 11.0419 11.0419
- k = 0.2500 0.2500 1.2500 band energies (ev):
+ k = 0.2500 0.2500 1.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.7500-0.7500 0.7500 band energies (ev):
+ k =-0.7500-0.7500 0.7500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
- k =-0.5000-0.5000 1.0000 band energies (ev):
+ k =-0.5000-0.5000 1.0000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.2500-0.2500 1.2500 band energies (ev):
+ k =-0.2500-0.2500 1.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k = 0.0000 0.0000 1.5000 band energies (ev):
+ k = 0.0000 0.0000 1.5000 ( 234 PWs) bands (ev):
- -3.6839 13.8639 13.8639 14.5739
+ -3.6839 13.8637 13.8637 14.5737
- k =-0.2500 0.2500-0.2500 band energies (ev):
+ k =-0.2500 0.2500-0.2500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
- k = 0.0000 0.5000 0.0000 band energies (ev):
+ k = 0.0000 0.5000 0.0000 ( 234 PWs) bands (ev):
- -3.6839 13.8639 13.8639 14.5739
+ -3.6839 13.8637 13.8637 14.5737
- k = 0.2500 0.7500 0.2500 band energies (ev):
+ k = 0.2500 0.7500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k = 0.5000 1.0000 0.5000 band energies (ev):
+ k = 0.5000 1.0000 0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.5000 0.0000 0.0000 band energies (ev):
+ k =-0.5000 0.0000 0.0000 ( 234 PWs) bands (ev):
- -3.6839 13.8639 13.8639 14.5739
+ -3.6839 13.8637 13.8637 14.5737
- k =-0.2500 0.2500 0.2500 band energies (ev):
+ k =-0.2500 0.2500 0.2500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
- k = 0.0000 0.5000 0.5000 band energies (ev):
+ k = 0.0000 0.5000 0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k = 0.2500 0.7500 0.7500 band energies (ev):
+ k = 0.2500 0.7500 0.7500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.7500-0.2500 0.2500 band energies (ev):
+ k =-0.7500-0.2500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.5000 0.0000 0.5000 band energies (ev):
+ k =-0.5000 0.0000 0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.2500 0.2500 0.7500 band energies (ev):
+ k =-0.2500 0.2500 0.7500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k = 0.0000 0.5000 1.0000 band energies (ev):
+ k = 0.0000 0.5000 1.0000 ( 252 PWs) bands (ev):
- 5.7054 5.7054 7.9453 7.9453
+ 5.7054 5.7054 7.9452 7.9452
- k =-1.0000-0.5000 0.5000 band energies (ev):
+ k =-1.0000-0.5000 0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.7500-0.2500 0.7500 band energies (ev):
+ k =-0.7500-0.2500 0.7500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.5000 0.0000 1.0000 band energies (ev):
+ k =-0.5000 0.0000 1.0000 ( 252 PWs) bands (ev):
- 5.7054 5.7054 7.9453 7.9453
+ 5.7054 5.7054 7.9452 7.9452
- k =-0.2500 0.2500 1.2500 band energies (ev):
+ k =-0.2500 0.2500 1.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.5000 0.5000-0.5000 band energies (ev):
+ k =-0.5000 0.5000-0.5000 ( 242 PWs) bands (ev):
- 1.3328 2.0781 15.8056 15.8056
+ 1.3328 2.0781 15.8054 15.8054
- k =-0.2500 0.7500-0.2500 band energies (ev):
+ k =-0.2500 0.7500-0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k = 0.0000 1.0000 0.0000 band energies (ev):
+ k = 0.0000 1.0000 0.0000 ( 230 PWs) bands (ev):
- 4.2492 4.2492 11.0421 11.0421
+ 4.2491 4.2491 11.0419 11.0419
- k = 0.2500 1.2500 0.2500 band energies (ev):
+ k = 0.2500 1.2500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.7500 0.2500-0.2500 band energies (ev):
+ k =-0.7500 0.2500-0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.5000 0.5000 0.0000 band energies (ev):
+ k =-0.5000 0.5000 0.0000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.2500 0.7500 0.2500 band energies (ev):
+ k =-0.2500 0.7500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k = 0.0000 1.0000 0.5000 band energies (ev):
+ k = 0.0000 1.0000 0.5000 ( 252 PWs) bands (ev):
- 5.7054 5.7054 7.9453 7.9453
+ 5.7054 5.7054 7.9452 7.9452
- k =-1.0000 0.0000 0.0000 band energies (ev):
+ k =-1.0000 0.0000 0.0000 ( 230 PWs) bands (ev):
- 4.2492 4.2492 11.0421 11.0421
+ 4.2491 4.2491 11.0419 11.0419
- k =-0.7500 0.2500 0.2500 band energies (ev):
+ k =-0.7500 0.2500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.5000 0.5000 0.5000 band energies (ev):
+ k =-0.5000 0.5000 0.5000 ( 242 PWs) bands (ev):
- 1.3328 2.0781 15.8056 15.8056
+ 1.3328 2.0781 15.8054 15.8054
- k =-0.2500 0.7500 0.7500 band energies (ev):
+ k =-0.2500 0.7500 0.7500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-1.2500-0.2500 0.2500 band energies (ev):
+ k =-1.2500-0.2500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-1.0000 0.0000 0.5000 band energies (ev):
+ k =-1.0000 0.0000 0.5000 ( 252 PWs) bands (ev):
- 5.7054 5.7054 7.9453 7.9453
+ 5.7054 5.7054 7.9452 7.9452
- k =-0.7500 0.2500 0.7500 band energies (ev):
+ k =-0.7500 0.2500 0.7500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.5000 0.5000 1.0000 band energies (ev):
+ k =-0.5000 0.5000 1.0000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.7500 0.7500-0.7500 band energies (ev):
+ k =-0.7500 0.7500-0.7500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
- k =-0.5000 1.0000-0.5000 band energies (ev):
+ k =-0.5000 1.0000-0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.2500 1.2500-0.2500 band energies (ev):
+ k =-0.2500 1.2500-0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k = 0.0000 1.5000 0.0000 band energies (ev):
+ k = 0.0000 1.5000 0.0000 ( 234 PWs) bands (ev):
- -3.6839 13.8639 13.8639 14.5739
+ -3.6839 13.8637 13.8637 14.5737
- k =-1.0000 0.5000-0.5000 band energies (ev):
+ k =-1.0000 0.5000-0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.7500 0.7500-0.2500 band energies (ev):
+ k =-0.7500 0.7500-0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.5000 1.0000 0.0000 band energies (ev):
+ k =-0.5000 1.0000 0.0000 ( 252 PWs) bands (ev):
- 5.7054 5.7054 7.9453 7.9453
+ 5.7054 5.7054 7.9452 7.9452
- k =-0.2500 1.2500 0.2500 band energies (ev):
+ k =-0.2500 1.2500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-1.2500 0.2500-0.2500 band energies (ev):
+ k =-1.2500 0.2500-0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-1.0000 0.5000 0.0000 band energies (ev):
+ k =-1.0000 0.5000 0.0000 ( 252 PWs) bands (ev):
- 5.7054 5.7054 7.9453 7.9453
+ 5.7054 5.7054 7.9452 7.9452
- k =-0.7500 0.7500 0.2500 band energies (ev):
+ k =-0.7500 0.7500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-0.5000 1.0000 0.5000 band energies (ev):
+ k =-0.5000 1.0000 0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-1.5000 0.0000 0.0000 band energies (ev):
+ k =-1.5000 0.0000 0.0000 ( 234 PWs) bands (ev):
- -3.6839 13.8639 13.8639 14.5739
+ -3.6839 13.8637 13.8637 14.5737
- k =-1.2500 0.2500 0.2500 band energies (ev):
+ k =-1.2500 0.2500 0.2500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
- k =-1.0000 0.5000 0.5000 band energies (ev):
+ k =-1.0000 0.5000 0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
- k =-0.7500 0.7500 0.7500 band energies (ev):
+ k =-0.7500 0.7500 0.7500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
- Writing output data file di.save
-
- PWSCF : 1.92s CPU time
+ highest occupied level (ev): 19.3977
- init_run : 0.24s CPU
- electrons : 1.53s CPU
-
- electrons : 1.53s CPU
- c_bands : 1.53s CPU
- sum_band : 0.06s CPU
- v_of_rho : 0.00s CPU
-
- c_bands : 1.53s CPU
- init_us_2 : 0.01s CPU ( 192 calls, 0.000 s avg)
- cegterg : 1.53s CPU ( 64 calls, 0.024 s avg)
-
- sum_band : 0.06s CPU
-
- wfcrot : 0.22s CPU ( 64 calls, 0.003 s avg)
- cegterg : 1.53s CPU ( 64 calls, 0.024 s avg)
- h_psi : 1.33s CPU ( 846 calls, 0.002 s avg)
- g_psi : 0.03s CPU ( 718 calls, 0.000 s avg)
- cdiaghg : 0.14s CPU ( 782 calls, 0.000 s avg)
- update : 0.02s CPU ( 718 calls, 0.000 s avg)
- last : 0.01s CPU ( 256 calls, 0.000 s avg)
-
- h_psi : 1.33s CPU ( 846 calls, 0.002 s avg)
- init : 0.01s CPU ( 846 calls, 0.000 s avg)
- firstfft : 0.58s CPU ( 3547 calls, 0.000 s avg)
- secondfft : 0.62s CPU ( 3547 calls, 0.000 s avg)
- add_vuspsi : 0.00s CPU ( 846 calls, 0.000 s avg)
+ Writing output data file di.save/
+ init_run : 0.02s CPU 0.02s WALL ( 1 calls)
+ electrons : 1.17s CPU 1.20s WALL ( 1 calls)
+
+ Called by init_run:
+ wfcinit : 0.00s CPU 0.00s WALL ( 1 calls)
+ potinit : 0.00s CPU 0.00s WALL ( 1 calls)
+ hinit0 : 0.02s CPU 0.02s WALL ( 1 calls)
+
+ Called by electrons:
+ c_bands : 1.17s CPU 1.20s WALL ( 1 calls)
+ v_of_rho : 0.00s CPU 0.00s WALL ( 1 calls)
+
+ Called by c_bands:
+ init_us_2 : 0.00s CPU 0.00s WALL ( 64 calls)
+ cegterg : 1.02s CPU 1.03s WALL ( 64 calls)
+
+ Called by sum_band:
+
+ Called by *egterg:
+ h_psi : 0.94s CPU 0.97s WALL ( 866 calls)
+ g_psi : 0.04s CPU 0.03s WALL ( 738 calls)
+ cdiaghg : 0.06s CPU 0.07s WALL ( 802 calls)
+
+ Called by h_psi:
+ h_psi:pot : 0.92s CPU 0.96s WALL ( 866 calls)
+ h_psi:calbec : 0.02s CPU 0.01s WALL ( 866 calls)
+ vloc_psi : 0.88s CPU 0.93s WALL ( 866 calls)
+ add_vuspsi : 0.01s CPU 0.01s WALL ( 866 calls)
+
General routines
- ccalbec : 0.06s CPU ( 846 calls, 0.000 s avg)
- cft3 : 0.01s CPU ( 3 calls, 0.003 s avg)
- cft3s : 1.21s CPU ( 7350 calls, 0.000 s avg)
- davcio : 0.01s CPU ( 256 calls, 0.000 s avg)
+ calbec : 0.02s CPU 0.01s WALL ( 866 calls)
+ fft : 0.00s CPU 0.00s WALL ( 3 calls)
+ fftw : 0.78s CPU 0.84s WALL ( 7172 calls)
+ davcio : 0.00s CPU 0.01s WALL ( 128 calls)
Parallel routines
- reduce : 0.20s CPU ( 3266 calls, 0.000 s avg)
- fft_scatter : 0.40s CPU ( 7353 calls, 0.000 s avg)
+
+ PWSCF : 1.31s CPU 1.36s WALL
+
+
+ This run was terminated on: 15:58:51 1Mar2019
+
+=------------------------------------------------------------------------------=
+ JOB DONE.
+=------------------------------------------------------------------------------=
diff --git a/PP/examples/WAN90_example/reference/diamond.pw2wan.lib.in b/PP/examples/WAN90_example/reference/diamond.pw2wan.lib.in
index 530ce4e4f8..a623c61aec 100644
--- a/PP/examples/WAN90_example/reference/diamond.pw2wan.lib.in
+++ b/PP/examples/WAN90_example/reference/diamond.pw2wan.lib.in
@@ -1,5 +1,5 @@
&inputpp
- outdir = '/home/arash/tmp/'
+ outdir = '/home/giannozz/q-e-mio/tempdir/'
prefix = 'di'
seedname = 'diamond.lib'
spin_component = 'none'
diff --git a/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.in b/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.in
index 4c52f0ed24..269ac53534 100644
--- a/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.in
+++ b/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.in
@@ -1,5 +1,5 @@
&inputpp
- outdir = '/home/arash/tmp/'
+ outdir = '/home/giannozz/q-e-mio/tempdir/'
prefix = 'di'
seedname = 'diamond.sa'
spin_component = 'none'
diff --git a/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.out b/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.out
index cd319bba8c..0dfc7633eb 100644
--- a/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.out
+++ b/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.out
@@ -1,25 +1,36 @@
- Program POST-PROC v.3.1.1 starts ...
- Today is 9Oct2006 at 15:37: 9
+ Program PW2WANNIER v.6.4rc starts on 1Mar2019 at 15:58:51
- Parallel version (MPI)
+ This program is part of the open-source Quantum ESPRESSO suite
+ for quantum simulation of materials; please cite
+ "P. Giannozzi et al., J. Phys.:Condens. Matter 21 395502 (2009);
+ "P. Giannozzi et al., J. Phys.:Condens. Matter 29 465901 (2017);
+ URL http://www.quantum-espresso.org",
+ in publications or presentations arising from this work. More details at
+ http://www.quantum-espresso.org/quote
- Number of processors in use: 2
- R & G space division: proc/pool = 2
+ Parallel version (MPI), running on 1 processors
+
+ MPI processes distributed on 1 nodes
Reading nscf_save data
- Planes per process (thick) : nr3 = 18 npp = 9 ncplane = 324
+ Reading data from directory:
+ /home/giannozz/q-e-mio/tempdir/di.save/
+ Message from routine pw_readschema_file:
+ failed retrieving input info from xml file, please check it
+
+ IMPORTANT: XC functional enforced from input :
+ Exchange-correlation = PZ ( 1 1 0 0 0 0)
+ Any further DFT definition will be discarded
+ Please, verify this is what you really want
+
- Proc/ planes cols G planes cols G columns G
- Pool (dense grid) (smooth grid) (wavefct grid)
- 1 9 99 957 9 99 957 42 230
- 2 9 100 960 9 100 960 43 229
- 0 18 199 1917 18 199 1917 85 459
+ G-vector sticks info
+ --------------------
+ sticks: dense smooth PW G-vecs: dense smooth PW
+ Sum 199 199 85 1917 1917 459
-
- nbndx = 4 nbnd = 4 natomwfc = 8 npwx = 133
- nelec = 8.00 nkb = 2 ngl = 52
Spin CASE ( default = unpolarized )
@@ -50,153 +61,40 @@
Opening pp-files
- ---------------
- *** Compute A
- ---------------
-
- AMN
- iknum = 64
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
+ --------------------------
+ *** Compute A projections
+ --------------------------
+ AMN: iknum = 64
+ 1 2 3 4 5 6 7 8 9 10
+ 11 12 13 14 15 16 17 18 19 20
+ 21 22 23 24 25 26 27 28 29 30
+ 31 32 33 34 35 36 37 38 39 40
+ 41 42 43 44 45 46 47 48 49 50
+ 51 52 53 54 55 56 57 58 59 60
+ 61 62 63 64
+
AMN calculated
---------------
*** Compute M
---------------
+ MMN: iknum = 64
+ 1 2 3 4 5 6 7 8 9 10
+ 11 12 13 14 15 16 17 18 19 20
+ 21 22 23 24 25 26 27 28 29 30
+ 31 32 33 34 35 36 37 38 39 40
+ 41 42 43 44 45 46 47 48 49 50
+ 51 52 53 54 55 56 57 58 59 60
+ 61 62 63 64
-MMN
- iknum = 64
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
-
MMN calculated
+ -----------------------------------
+ *** Orbital terms are not computed
+ -----------------------------------
+
----------------
*** Write bands
----------------
@@ -206,7 +104,25 @@ MMN
*** Plot info is not printed
-----------------------------
+ -----------------------------
+ *** Parity info is not printed
+ -----------------------------
+
------------
*** Stop pp
------------
+
+ init_pw2wan : 0.10s CPU 0.11s WALL ( 1 calls)
+ compute_amn : 2.55s CPU 2.55s WALL ( 1 calls)
+ compute_mmn : 0.25s CPU 0.27s WALL ( 1 calls)
+
+ PW2WANNIER : 2.91s CPU 2.94s WALL
+
+
+ This run was terminated on: 15:58:54 1Mar2019
+
+=------------------------------------------------------------------------------=
+ JOB DONE.
+=------------------------------------------------------------------------------=
+
diff --git a/PP/examples/WAN90_example/reference/diamond.sa.eig b/PP/examples/WAN90_example/reference/diamond.sa.eig
index 9585665f04..6e6f46942d 100644
--- a/PP/examples/WAN90_example/reference/diamond.sa.eig
+++ b/PP/examples/WAN90_example/reference/diamond.sa.eig
@@ -1,256 +1,256 @@
- 1 1 -6.438652252327
- 2 1 19.397969790637
- 3 1 19.397969790637
- 4 1 19.397969790637
- 1 2 -4.380016396969
- 2 2 11.172207556971
- 3 2 17.093266450345
- 4 2 17.093266450345
- 1 3 1.332848442002
- 2 3 2.078125696460
- 3 3 15.805580035570
- 4 3 15.805580035570
- 1 4 -4.380016396968
- 2 4 11.172207556971
- 3 4 17.093266450345
- 4 4 17.093266450345
- 1 5 -4.380016396969
- 2 5 11.172207556971
- 3 5 17.093266450345
- 4 5 17.093266450345
- 1 6 -3.683932502208
- 2 6 13.863868679720
- 3 6 13.863868679720
- 4 6 14.573879775104
- 1 7 0.992452023097
- 2 7 6.096400025548
- 3 7 10.923568079329
- 4 7 12.916098085933
- 1 8 -1.001903579304
- 2 8 8.971237876729
- 3 8 9.460135452653
- 4 8 15.403020804067
- 1 9 1.332848442001
- 2 9 2.078125696460
- 3 9 15.805580035570
- 4 9 15.805580035570
- 1 10 0.992452023097
- 2 10 6.096400025547
- 3 10 10.923568079329
- 4 10 12.916098085933
- 1 11 4.249159419138
- 2 11 4.249159419138
- 3 11 11.042056535307
- 4 11 11.042056535307
- 1 12 0.992452023097
- 2 12 6.096400025547
- 3 12 10.923568079329
- 4 12 12.916098085933
- 1 13 -4.380016396968
- 2 13 11.172207556971
- 3 13 17.093266450345
- 4 13 17.093266450345
- 1 14 -1.001903579304
- 2 14 8.971237876729
- 3 14 9.460135452653
- 4 14 15.403020804066
- 1 15 0.992452023097
- 2 15 6.096400025547
- 3 15 10.923568079329
- 4 15 12.916098085933
- 1 16 -3.683932502208
- 2 16 13.863868679720
- 3 16 13.863868679720
- 4 16 14.573879775104
- 1 17 -4.380016396968
- 2 17 11.172207556971
- 3 17 17.093266450345
- 4 17 17.093266450345
- 1 18 -3.683932502208
- 2 18 13.863868679720
- 3 18 13.863868679720
- 4 18 14.573879775104
- 1 19 0.992452023097
- 2 19 6.096400025547
- 3 19 10.923568079329
- 4 19 12.916098085933
- 1 20 -1.001903579304
- 2 20 8.971237876729
- 3 20 9.460135452653
- 4 20 15.403020804067
- 1 21 -3.683932502208
- 2 21 13.863868679720
- 3 21 13.863868679720
- 4 21 14.573879775104
- 1 22 -4.380016396968
- 2 22 11.172207556971
- 3 22 17.093266450345
- 4 22 17.093266450345
- 1 23 -1.001903579304
- 2 23 8.971237876729
- 3 23 9.460135452653
- 4 23 15.403020804066
- 1 24 0.992452023097
- 2 24 6.096400025547
- 3 24 10.923568079329
- 4 24 12.916098085933
- 1 25 0.992452023097
- 2 25 6.096400025547
- 3 25 10.923568079329
- 4 25 12.916098085933
- 1 26 -1.001903579304
- 2 26 8.971237876729
- 3 26 9.460135452653
- 4 26 15.403020804066
- 1 27 0.992452023097
- 2 27 6.096400025547
- 3 27 10.923568079329
- 4 27 12.916098085933
- 1 28 5.705448619229
- 2 28 5.705448619229
- 3 28 7.945291355847
- 4 28 7.945291355847
- 1 29 -1.001903579304
- 2 29 8.971237876729
- 3 29 9.460135452653
- 4 29 15.403020804066
- 1 30 0.992452023097
- 2 30 6.096400025548
- 3 30 10.923568079329
- 4 30 12.916098085933
- 1 31 5.705448619229
- 2 31 5.705448619229
- 3 31 7.945291355847
- 4 31 7.945291355847
- 1 32 0.992452023097
- 2 32 6.096400025547
- 3 32 10.923568079329
- 4 32 12.916098085933
- 1 33 1.332848442002
- 2 33 2.078125696459
- 3 33 15.805580035570
- 4 33 15.805580035570
- 1 34 0.992452023097
- 2 34 6.096400025547
- 3 34 10.923568079329
- 4 34 12.916098085933
- 1 35 4.249159419138
- 2 35 4.249159419138
- 3 35 11.042056535307
- 4 35 11.042056535307
- 1 36 0.992452023097
- 2 36 6.096400025547
- 3 36 10.923568079329
- 4 36 12.916098085933
- 1 37 0.992452023097
- 2 37 6.096400025547
- 3 37 10.923568079329
- 4 37 12.916098085933
- 1 38 -1.001903579304
- 2 38 8.971237876729
- 3 38 9.460135452653
- 4 38 15.403020804067
- 1 39 0.992452023097
- 2 39 6.096400025547
- 3 39 10.923568079329
- 4 39 12.916098085933
- 1 40 5.705448619229
- 2 40 5.705448619229
- 3 40 7.945291355847
- 4 40 7.945291355847
- 1 41 4.249159419138
- 2 41 4.249159419138
- 3 41 11.042056535307
- 4 41 11.042056535307
- 1 42 0.992452023097
- 2 42 6.096400025547
- 3 42 10.923568079329
- 4 42 12.916098085933
- 1 43 1.332848442001
- 2 43 2.078125696460
- 3 43 15.805580035570
- 4 43 15.805580035570
- 1 44 0.992452023097
- 2 44 6.096400025547
- 3 44 10.923568079329
- 4 44 12.916098085933
- 1 45 0.992452023097
- 2 45 6.096400025547
- 3 45 10.923568079329
- 4 45 12.916098085933
- 1 46 5.705448619229
- 2 46 5.705448619229
- 3 46 7.945291355847
- 4 46 7.945291355847
- 1 47 0.992452023097
- 2 47 6.096400025548
- 3 47 10.923568079329
- 4 47 12.916098085933
- 1 48 -1.001903579304
- 2 48 8.971237876729
- 3 48 9.460135452653
- 4 48 15.403020804066
- 1 49 -4.380016396968
- 2 49 11.172207556971
- 3 49 17.093266450345
- 4 49 17.093266450345
- 1 50 -1.001903579304
- 2 50 8.971237876729
- 3 50 9.460135452653
- 4 50 15.403020804067
- 1 51 0.992452023097
- 2 51 6.096400025548
- 3 51 10.923568079329
- 4 51 12.916098085933
- 1 52 -3.683932502208
- 2 52 13.863868679720
- 3 52 13.863868679720
- 4 52 14.573879775104
- 1 53 -1.001903579304
- 2 53 8.971237876729
- 3 53 9.460135452653
- 4 53 15.403020804066
- 1 54 0.992452023097
- 2 54 6.096400025548
- 3 54 10.923568079329
- 4 54 12.916098085933
- 1 55 5.705448619229
- 2 55 5.705448619229
- 3 55 7.945291355847
- 4 55 7.945291355847
- 1 56 0.992452023097
- 2 56 6.096400025547
- 3 56 10.923568079329
- 4 56 12.916098085933
- 1 57 0.992452023097
- 2 57 6.096400025547
- 3 57 10.923568079329
- 4 57 12.916098085933
- 1 58 5.705448619229
- 2 58 5.705448619229
- 3 58 7.945291355847
- 4 58 7.945291355847
- 1 59 0.992452023097
- 2 59 6.096400025547
- 3 59 10.923568079329
- 4 59 12.916098085933
- 1 60 -1.001903579304
- 2 60 8.971237876729
- 3 60 9.460135452653
- 4 60 15.403020804066
- 1 61 -3.683932502208
- 2 61 13.863868679720
- 3 61 13.863868679720
- 4 61 14.573879775104
- 1 62 0.992452023097
- 2 62 6.096400025547
- 3 62 10.923568079329
- 4 62 12.916098085933
- 1 63 -1.001903579304
- 2 63 8.971237876729
- 3 63 9.460135452653
- 4 63 15.403020804066
- 1 64 -4.380016396968
- 2 64 11.172207556971
- 3 64 17.093266450345
- 4 64 17.093266450345
+ 1 1 -6.438583264411
+ 2 1 19.397710424653
+ 3 1 19.397710424653
+ 4 1 19.397710424653
+ 1 2 -4.379970435035
+ 2 2 11.172069433429
+ 3 2 17.093036981117
+ 4 2 17.093036981117
+ 1 3 1.332842640814
+ 2 3 2.078083226485
+ 3 3 15.805365703112
+ 4 3 15.805365703112
+ 1 4 -4.379970435035
+ 2 4 11.172069433429
+ 3 4 17.093036981117
+ 4 4 17.093036981117
+ 1 5 -4.379970435035
+ 2 5 11.172069433429
+ 3 5 17.093036981117
+ 4 5 17.093036981117
+ 1 6 -3.683892994972
+ 2 6 13.863681772822
+ 3 6 13.863681772822
+ 4 6 14.573708048973
+ 1 7 0.992440267735
+ 2 7 6.096322710463
+ 3 7 10.923430710291
+ 4 7 12.915919837506
+ 1 8 -1.001894845988
+ 2 8 8.971130516365
+ 3 8 9.460011916381
+ 4 8 15.402810608905
+ 1 9 1.332842640814
+ 2 9 2.078083226485
+ 3 9 15.805365703112
+ 4 9 15.805365703112
+ 1 10 0.992440267735
+ 2 10 6.096322710463
+ 3 10 10.923430710291
+ 4 10 12.915919837507
+ 1 11 4.249112296946
+ 2 11 4.249112296946
+ 3 11 11.041900654573
+ 4 11 11.041900654573
+ 1 12 0.992440267735
+ 2 12 6.096322710463
+ 3 12 10.923430710291
+ 4 12 12.915919837506
+ 1 13 -4.379970435035
+ 2 13 11.172069433429
+ 3 13 17.093036981117
+ 4 13 17.093036981117
+ 1 14 -1.001894845988
+ 2 14 8.971130516365
+ 3 14 9.460011916381
+ 4 14 15.402810608906
+ 1 15 0.992440267735
+ 2 15 6.096322710463
+ 3 15 10.923430710291
+ 4 15 12.915919837506
+ 1 16 -3.683892994972
+ 2 16 13.863681772822
+ 3 16 13.863681772822
+ 4 16 14.573708048973
+ 1 17 -4.379970435035
+ 2 17 11.172069433429
+ 3 17 17.093036981117
+ 4 17 17.093036981117
+ 1 18 -3.683892994972
+ 2 18 13.863681772822
+ 3 18 13.863681772822
+ 4 18 14.573708048973
+ 1 19 0.992440267735
+ 2 19 6.096322710463
+ 3 19 10.923430710291
+ 4 19 12.915919837506
+ 1 20 -1.001894845988
+ 2 20 8.971130516365
+ 3 20 9.460011916381
+ 4 20 15.402810608905
+ 1 21 -3.683892994972
+ 2 21 13.863681772822
+ 3 21 13.863681772822
+ 4 21 14.573708048972
+ 1 22 -4.379970435035
+ 2 22 11.172069433429
+ 3 22 17.093036981117
+ 4 22 17.093036981117
+ 1 23 -1.001894845988
+ 2 23 8.971130516365
+ 3 23 9.460011916381
+ 4 23 15.402810608905
+ 1 24 0.992440267735
+ 2 24 6.096322710463
+ 3 24 10.923430710291
+ 4 24 12.915919837506
+ 1 25 0.992440267735
+ 2 25 6.096322710463
+ 3 25 10.923430710291
+ 4 25 12.915919837506
+ 1 26 -1.001894845988
+ 2 26 8.971130516365
+ 3 26 9.460011916381
+ 4 26 15.402810608905
+ 1 27 0.992440267735
+ 2 27 6.096322710463
+ 3 27 10.923430710291
+ 4 27 12.915919837506
+ 1 28 5.705390011134
+ 2 28 5.705390011134
+ 3 28 7.945174132517
+ 4 28 7.945174132517
+ 1 29 -1.001894845988
+ 2 29 8.971130516365
+ 3 29 9.460011916381
+ 4 29 15.402810608905
+ 1 30 0.992440267735
+ 2 30 6.096322710463
+ 3 30 10.923430710291
+ 4 30 12.915919837506
+ 1 31 5.705390011134
+ 2 31 5.705390011134
+ 3 31 7.945174132517
+ 4 31 7.945174132517
+ 1 32 0.992440267735
+ 2 32 6.096322710463
+ 3 32 10.923430710291
+ 4 32 12.915919837506
+ 1 33 1.332842640814
+ 2 33 2.078083226485
+ 3 33 15.805365703112
+ 4 33 15.805365703112
+ 1 34 0.992440267735
+ 2 34 6.096322710463
+ 3 34 10.923430710291
+ 4 34 12.915919837506
+ 1 35 4.249112296946
+ 2 35 4.249112296946
+ 3 35 11.041900654573
+ 4 35 11.041900654573
+ 1 36 0.992440267735
+ 2 36 6.096322710463
+ 3 36 10.923430710291
+ 4 36 12.915919837506
+ 1 37 0.992440267735
+ 2 37 6.096322710463
+ 3 37 10.923430710291
+ 4 37 12.915919837506
+ 1 38 -1.001894845988
+ 2 38 8.971130516365
+ 3 38 9.460011916381
+ 4 38 15.402810608906
+ 1 39 0.992440267735
+ 2 39 6.096322710463
+ 3 39 10.923430710291
+ 4 39 12.915919837506
+ 1 40 5.705390011134
+ 2 40 5.705390011134
+ 3 40 7.945174132517
+ 4 40 7.945174132517
+ 1 41 4.249112296946
+ 2 41 4.249112296946
+ 3 41 11.041900654573
+ 4 41 11.041900654573
+ 1 42 0.992440267735
+ 2 42 6.096322710463
+ 3 42 10.923430710291
+ 4 42 12.915919837506
+ 1 43 1.332842640814
+ 2 43 2.078083226485
+ 3 43 15.805365703113
+ 4 43 15.805365703113
+ 1 44 0.992440267735
+ 2 44 6.096322710463
+ 3 44 10.923430710291
+ 4 44 12.915919837506
+ 1 45 0.992440267735
+ 2 45 6.096322710463
+ 3 45 10.923430710291
+ 4 45 12.915919837506
+ 1 46 5.705390011134
+ 2 46 5.705390011134
+ 3 46 7.945174132517
+ 4 46 7.945174132517
+ 1 47 0.992440267735
+ 2 47 6.096322710463
+ 3 47 10.923430710291
+ 4 47 12.915919837506
+ 1 48 -1.001894845989
+ 2 48 8.971130516365
+ 3 48 9.460011916381
+ 4 48 15.402810608905
+ 1 49 -4.379970435035
+ 2 49 11.172069433429
+ 3 49 17.093036981117
+ 4 49 17.093036981118
+ 1 50 -1.001894845988
+ 2 50 8.971130516365
+ 3 50 9.460011916381
+ 4 50 15.402810608905
+ 1 51 0.992440267735
+ 2 51 6.096322710463
+ 3 51 10.923430710291
+ 4 51 12.915919837506
+ 1 52 -3.683892994972
+ 2 52 13.863681772822
+ 3 52 13.863681772822
+ 4 52 14.573708048973
+ 1 53 -1.001894845988
+ 2 53 8.971130516365
+ 3 53 9.460011916381
+ 4 53 15.402810608905
+ 1 54 0.992440267735
+ 2 54 6.096322710463
+ 3 54 10.923430710291
+ 4 54 12.915919837506
+ 1 55 5.705390011134
+ 2 55 5.705390011134
+ 3 55 7.945174132517
+ 4 55 7.945174132517
+ 1 56 0.992440267735
+ 2 56 6.096322710463
+ 3 56 10.923430710291
+ 4 56 12.915919837506
+ 1 57 0.992440267735
+ 2 57 6.096322710463
+ 3 57 10.923430710291
+ 4 57 12.915919837506
+ 1 58 5.705390011134
+ 2 58 5.705390011134
+ 3 58 7.945174132517
+ 4 58 7.945174132517
+ 1 59 0.992440267735
+ 2 59 6.096322710463
+ 3 59 10.923430710291
+ 4 59 12.915919837506
+ 1 60 -1.001894845988
+ 2 60 8.971130516365
+ 3 60 9.460011916381
+ 4 60 15.402810608906
+ 1 61 -3.683892994972
+ 2 61 13.863681772822
+ 3 61 13.863681772822
+ 4 61 14.573708048973
+ 1 62 0.992440267735
+ 2 62 6.096322710463
+ 3 62 10.923430710291
+ 4 62 12.915919837506
+ 1 63 -1.001894845988
+ 2 63 8.971130516365
+ 3 63 9.460011916381
+ 4 63 15.402810608905
+ 1 64 -4.379970435035
+ 2 64 11.172069433429
+ 3 64 17.093036981117
+ 4 64 17.093036981117
diff --git a/PP/examples/WAN90_example/reference/diamond.sa.nnkp b/PP/examples/WAN90_example/reference/diamond.sa.nnkp
index f71910036c..3015474a46 100644
--- a/PP/examples/WAN90_example/reference/diamond.sa.nnkp
+++ b/PP/examples/WAN90_example/reference/diamond.sa.nnkp
@@ -1,4 +1,4 @@
-File written on 9Oct2006 at 15:37:08
+File written on 1Mar2019 at 15:58:51
calc_only_A : F
@@ -85,13 +85,13 @@ end kpoints
begin projections
4
0.00000 0.00000 0.00000 0 1 1
- 0.000 0.000 1.000 1.000 0.000 0.000 1.00
+ 0.0000000 0.0000000 1.0000000 1.0000000 0.0000000 0.0000000 1.00
0.00000 0.00000 0.50000 0 1 1
- 0.000 0.000 1.000 1.000 0.000 0.000 1.00
+ 0.0000000 0.0000000 1.0000000 1.0000000 0.0000000 0.0000000 1.00
0.00000 0.50000 0.00000 0 1 1
- 0.000 0.000 1.000 1.000 0.000 0.000 1.00
+ 0.0000000 0.0000000 1.0000000 1.0000000 0.0000000 0.0000000 1.00
0.50000 0.00000 0.00000 0 1 1
- 0.000 0.000 1.000 1.000 0.000 0.000 1.00
+ 0.0000000 0.0000000 1.0000000 1.0000000 0.0000000 0.0000000 1.00
end projections
begin nnkpts
diff --git a/PP/examples/WAN90_example/reference/diamond.sa.win b/PP/examples/WAN90_example/reference/diamond.sa.win
index ff52efe688..418f791ba2 100644
--- a/PP/examples/WAN90_example/reference/diamond.sa.win
+++ b/PP/examples/WAN90_example/reference/diamond.sa.win
@@ -2,8 +2,8 @@ num_wann = 4
num_iter = 20
begin atoms_frac
-C -0.12500 -0.1250 -0.125000
-C 0.12500 0.1250 0.125000
+C -0.2500 -0.250 -0.25000
+C 0.00000 0.0000 0.000000
end atoms_frac
begin projections
diff --git a/PP/examples/WAN90_example/reference/diamond.sa.wout b/PP/examples/WAN90_example/reference/diamond.sa.wout
index 1e3817728e..3189739b6e 100644
--- a/PP/examples/WAN90_example/reference/diamond.sa.wout
+++ b/PP/examples/WAN90_example/reference/diamond.sa.wout
@@ -9,24 +9,33 @@
| Generalized Wannier Functions code |
| http://www.wannier.org |
| |
- | Authors: |
- | Arash A. Mostofi (MIT) |
- | Jonathan R. Yates (LBNL and UC Berkeley) |
| |
+ | Wannier90 Developer Group: |
+ | Giovanni Pizzi (EPFL) |
+ | Valerio Vitale (Cambridge) |
+ | David Vanderbilt (Rutgers University) |
+ | Nicola Marzari (EPFL) |
+ | Ivo Souza (Universidad del Pais Vasco) |
+ | Arash A. Mostofi (Imperial College London) |
+ | Jonathan R. Yates (University of Oxford) |
| |
- | Please cite |
+ | For the full list of Wannier90 3.x authors, |
+ | please check the code documentation and the |
+ | README on the GitHub page of the code |
| |
- | [ref] A. A. Mostofi, J. R. Yates, |
- | N. Marzari, I. Souza and D. Vanderbilt, |
- | http://www.wannier.org/ |
| |
- | in any publications arising from the use of |
- | this code. |
+ | Please cite |
| |
+ | [ref] "An updated version of Wannier90: |
+ | A Tool for Obtaining Maximally Localised |
+ | Wannier Functions", A. A. Mostofi, |
+ | J. R. Yates, G. Pizzi, Y. S. Lee, |
+ | I. Souza, D. Vanderbilt and N. Marzari, |
+ | Comput. Phys. Commun. 185, 2309 (2014) |
+ | http://dx.doi.org/10.1016/j.cpc.2014.05.003|
| |
- | Wannier90 is based on routines written by |
- | Nicola Marzari, Ivo Souza and David Vanderbilt. |
- | For the method please cite |
+ | in any publications arising from the use of |
+ | this code. For the method please cite |
| |
| [ref] "Maximally Localized Generalised Wannier |
| Functions for Composite Energy Bands" |
@@ -39,10 +48,11 @@
| Phys. Rev. B 65 035109 (2001) |
| |
| |
- | Copyright (c) 1997-2006 J. Yates, A. Mostofi, |
- | N. Marzari, I. Souza, D. Vanderbilt |
+ | Copyright (c) 1996-2019 |
+ | The Wannier90 Developer Group and |
+ | individual contributors |
| |
- | Release: 1.0.1 17th May 2006 |
+ | Release: 3.0.0 27th February 2019 |
| |
| This program is free software; you can |
| redistribute it and/or modify it under the terms |
@@ -62,9 +72,18 @@
| 675 Mass Ave, Cambridge, MA 02139, USA. |
| |
+---------------------------------------------------+
- | Execution started on 9Oct2006 at 15:37:14 |
+ | Execution started on 1Mar2019 at 15:58:54 |
+---------------------------------------------------+
+ ******************************************************************************
+ * -> Using CODATA 2006 constant values *
+ * (http://physics.nist.gov/cuu/Constants/index.html) *
+ * -> Using Bohr value from CODATA *
+ ******************************************************************************
+
+
+ Running in serial (with serial executable)
+
------
SYSTEM
------
@@ -84,10 +103,9 @@
*----------------------------------------------------------------------------*
| Site Fractional Coordinate Cartesian Coordinate (Ang) |
+----------------------------------------------------------------------------+
- | C 1 -0.12500 -0.12500 -0.12500 | 0.40350 -0.40350 -0.40350 |
- | C 2 0.12500 0.12500 0.12500 | -0.40350 0.40350 0.40350 |
+ | C 1 -0.25000 -0.25000 -0.25000 | 0.80700 -0.80700 -0.80700 |
+ | C 2 0.00000 0.00000 0.00000 | 0.00000 0.00000 0.00000 |
*----------------------------------------------------------------------------*
-
------------
K-POINT GRID
------------
@@ -97,21 +115,30 @@
*---------------------------------- MAIN ------------------------------------*
| Number of Wannier Functions : 4 |
+ | Number of Objective Wannier Functions : 4 |
| Number of input Bloch states : 4 |
| Output verbosity (1=low, 5=high) : 1 |
+ | Timing Level (1=low, 5=high) : 1 |
+ | Optimisation (0=memory, 3=speed) : 3 |
| Length Unit : Ang |
| Post-processing setup (write *.nnkp) : F |
+ | Using Gamma-only branch of algorithms : F |
*----------------------------------------------------------------------------*
*------------------------------- WANNIERISE ---------------------------------*
| Total number of iterations : 20 |
| Number of CG steps before reset : 5 |
| Trial step length for line search : 2.000 |
+ | Convergence tolerence : 0.100E-09 |
+ | Convergence window : -1 |
| Iterations between writing output : 1 |
| Iterations between backing up to disk : 100 |
| Write r^2_nm to file : F |
+ | Write xyz WF centres to file : F |
+ | Write on-site energies <0n|H|0n> to file : F |
| Use guiding centre to control phases : F |
+ | Use phases for initial projections : F |
*----------------------------------------------------------------------------*
- Time to read parameters 0.004 (sec)
+ Time to read parameters 0.008 (sec)
*---------------------------------- K-MESH ----------------------------------*
+----------------------------------------------------------------------------+
@@ -131,6 +158,30 @@
| 10 2.528546 32 |
| 11 2.752732 12 |
| 12 2.878876 48 |
+ | 13 2.919713 30 |
+ | 14 3.077648 24 |
+ | 15 3.190973 24 |
+ | 16 3.227864 24 |
+ | 17 3.371394 8 |
+ | 18 3.475154 48 |
+ | 19 3.509058 24 |
+ | 20 3.641522 48 |
+ | 21 3.737790 72 |
+ | 22 3.892951 6 |
+ | 23 3.983147 24 |
+ | 24 4.012762 48 |
+ | 25 4.129098 36 |
+ | 26 4.214243 56 |
+ | 27 4.242245 24 |
+ | 28 4.352451 24 |
+ | 29 4.433309 72 |
+ | 30 4.459935 48 |
+ | 31 4.564889 24 |
+ | 32 4.642048 48 |
+ | 33 4.767871 24 |
+ | 34 4.841796 72 |
+ | 35 4.866188 30 |
+ | 36 4.962558 72 |
+----------------------------------------------------------------------------+
| The b-vectors are chosen automatically |
| The following shells are used: 1 |
@@ -164,13 +215,21 @@
| 4 -0.486619 0.486619 0.486619 |
+----------------------------------------------------------------------------+
+ Time to get kmesh 0.108 (sec)
+ *============================================================================*
+ | MEMORY ESTIMATE |
+ | Maximum RAM allocated during each phase of the calculation |
+ *============================================================================*
+ | Wannierise: 0.42 Mb |
+ | plot_wannier: 0.42 Mb |
+ *----------------------------------------------------------------------------*
+
Starting a new Wannier90 calculation ...
- Time to get kmesh 0.048 (sec)
- Reading overlaps from diamond.sa.mmn : Created on 9Oct2006 at 15:37:12
+ Reading overlaps from diamond.sa.mmn : Created on 1Mar2019 at 15:58:54
- Reading projections from diamond.sa.amn : Created on 9Oct2006 at 15:37:10
+ Reading projections from diamond.sa.amn : Created on 1Mar2019 at 15:58:51
Time to read overlaps 0.012 (sec)
@@ -184,261 +243,264 @@
------------------------------------------------------------------------------
Initial State
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58061390
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58061390
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58061390
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58061390
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32245560
-
- 0 0.232E+01 0.0000000000 2.3224556019 0.07 <-- CONV
- O_D= 0.0000000 O_OD= 0.3678346 O_TOT= 2.3224556 <-- SPRD
+ WF centre and spread 1 ( -0.000151, 0.000151, 0.000151 ) 4.43516037
+ WF centre and spread 2 ( -0.549699, 0.549699, -0.292073 ) 1.31831922
+ WF centre and spread 3 ( 0.292073, 0.549699, 0.549699 ) 1.31831922
+ WF centre and spread 4 ( -0.549699, -0.292073, 0.549699 ) 1.31831920
+ Sum of centres and spreads ( -0.807475, 0.807475, 0.807475 ) 8.39011801
+
+ 0 0.839E+01 0.0000000000 8.3901180085 0.00 <-- CONV
+ O_D= 3.6651277 O_OD= 2.7703720 O_TOT= 8.3901180 <-- SPRD
------------------------------------------------------------------------------
Cycle: 1
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58023486
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58023486
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58023486
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58023486
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32093943
-
- 1 -0.152E-02 0.0234565935 2.3209394335 0.07 <-- CONV
- O_D= 0.0000000 O_OD= 0.3663184 O_TOT= 2.3209394 <-- SPRD
- Delta: O_D= -0.2661842E-23 O_OD= -0.1516168E-02 O_TOT= -0.1516168E-02 <-- DLTA
+ WF centre and spread 1 ( 0.204804, -0.204804, -0.204804 ) 3.53879720
+ WF centre and spread 2 ( -0.505450, 0.505450, -0.286677 ) 1.72955947
+ WF centre and spread 3 ( 0.286677, 0.505450, 0.505450 ) 1.72955951
+ WF centre and spread 4 ( -0.505450, -0.286677, 0.505450 ) 1.72955950
+ Sum of centres and spreads ( -0.519420, 0.519420, 0.519420 ) 8.72747568
+
+ 1 0.337E+00 1.6286961478 8.7274756849 0.00 <-- CONV
+ O_D= 3.0622729 O_OD= 3.7105845 O_TOT= 8.7274757 <-- SPRD
+ Delta: O_D= -0.6028547E+00 O_OD= 0.9402124E+00 O_TOT= 0.3373577E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 2
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022673
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022673
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022673
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022673
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090693
-
- 2 -0.325E-04 0.0039154226 2.3209069320 0.08 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662859 O_TOT= 2.3209069 <-- SPRD
- Delta: O_D= -0.2285730E-23 O_OD= -0.3250145E-04 O_TOT= -0.3250145E-04 <-- DLTA
+ WF centre and spread 1 ( 0.125259, -0.125259, -0.125259 ) 2.97567424
+ WF centre and spread 2 ( -0.511659, 0.511659, -0.286835 ) 1.69367428
+ WF centre and spread 3 ( 0.286835, 0.511659, 0.511659 ) 1.69367432
+ WF centre and spread 4 ( -0.511659, -0.286835, 0.511659 ) 1.69367432
+ Sum of centres and spreads ( -0.611223, 0.611223, 0.611223 ) 8.05669715
+
+ 2 -0.671E+00 3.5878922625 8.0566971521 0.01 <-- CONV
+ O_D= 2.4113429 O_OD= 3.6907359 O_TOT= 8.0566972 <-- SPRD
+ Delta: O_D= -0.6509300E+00 O_OD= -0.1984857E-01 O_TOT= -0.6707785E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 3
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 3 -0.614E-06 0.0005711221 2.3209063179 0.09 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= -0.1071897E-23 O_OD= -0.6141199E-06 O_TOT= -0.6141199E-06 <-- DLTA
+ WF centre and spread 1 ( 0.058760, -0.058760, -0.058760 ) 1.86375989
+ WF centre and spread 2 ( -0.551302, 0.551302, -0.299938 ) 1.64801302
+ WF centre and spread 3 ( 0.299938, 0.551303, 0.551302 ) 1.64801304
+ WF centre and spread 4 ( -0.551302, -0.299938, 0.551302 ) 1.64801303
+ Sum of centres and spreads ( -0.743908, 0.743908, 0.743908 ) 6.80779898
+
+ 3 -0.125E+01 1.5992894598 6.8077989832 0.01 <-- CONV
+ O_D= 1.3647697 O_OD= 3.4884109 O_TOT= 6.8077990 <-- SPRD
+ Delta: O_D= -0.1046573E+01 O_OD= -0.2023250E+00 O_TOT= -0.1248898E+01 <-- DLTA
------------------------------------------------------------------------------
Cycle: 4
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 4 -0.792E-10 0.0000061002 2.3209063178 0.09 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.1638306E-24 O_OD= -0.7916606E-10 O_TOT= -0.7916601E-10 <-- DLTA
+ WF centre and spread 1 ( 0.063754, -0.063754, -0.063754 ) 1.74767413
+ WF centre and spread 2 ( -0.543366, 0.543366, -0.275971 ) 1.49058354
+ WF centre and spread 3 ( 0.275971, 0.543366, 0.543366 ) 1.49058354
+ WF centre and spread 4 ( -0.543366, -0.275971, 0.543366 ) 1.49058354
+ Sum of centres and spreads ( -0.747007, 0.747007, 0.747007 ) 6.21942474
+
+ 4 -0.588E+00 0.7347832611 6.2194247416 0.02 <-- CONV
+ O_D= 1.0866932 O_OD= 3.1781132 O_TOT= 6.2194247 <-- SPRD
+ Delta: O_D= -0.2780765E+00 O_OD= -0.3102977E+00 O_TOT= -0.5883742E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 5
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 5 0.000E+00 0.0000004301 2.3209063178 0.10 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.085402, -0.085402, -0.085402 ) 1.87107143
+ WF centre and spread 2 ( -0.520567, 0.520567, -0.269210 ) 1.33949225
+ WF centre and spread 3 ( 0.269210, 0.520567, 0.520567 ) 1.33949225
+ WF centre and spread 4 ( -0.520567, -0.269210, 0.520567 ) 1.33949224
+ Sum of centres and spreads ( -0.686523, 0.686523, 0.686523 ) 5.88954818
+
+ 5 -0.330E+00 0.4298895898 5.8895481776 0.02 <-- CONV
+ O_D= 0.9387607 O_OD= 2.9961692 O_TOT= 5.8895482 <-- SPRD
+ Delta: O_D= -0.1479325E+00 O_OD= -0.1819440E+00 O_TOT= -0.3298766E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 6
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 6 0.000E+00 0.0000004196 2.3209063178 0.10 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.130427, -0.130427, -0.130427 ) 1.83680888
+ WF centre and spread 2 ( -0.496691, 0.496691, -0.273805 ) 1.31361327
+ WF centre and spread 3 ( 0.273805, 0.496691, 0.496691 ) 1.31361326
+ WF centre and spread 4 ( -0.496691, -0.273805, 0.496691 ) 1.31361327
+ Sum of centres and spreads ( -0.589149, 0.589149, 0.589149 ) 5.77764868
+
+ 6 -0.112E+00 0.3614540976 5.7776486794 0.03 <-- CONV
+ O_D= 0.8890137 O_OD= 2.9340167 O_TOT= 5.7776487 <-- SPRD
+ Delta: O_D= -0.4974698E-01 O_OD= -0.6215252E-01 O_TOT= -0.1118995E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 7
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 7 -0.342E-13 0.0000003999 2.3209063178 0.11 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= -0.2269263E-24 O_OD= -0.3413936E-13 O_TOT= -0.3419487E-13 <-- DLTA
+ WF centre and spread 1 ( 0.162783, -0.162783, -0.162783 ) 1.85304365
+ WF centre and spread 2 ( -0.475537, 0.475537, -0.273770 ) 1.27321074
+ WF centre and spread 3 ( 0.273770, 0.475537, 0.475537 ) 1.27321072
+ WF centre and spread 4 ( -0.475537, -0.273770, 0.475537 ) 1.27321072
+ Sum of centres and spreads ( -0.514520, 0.514520, 0.514520 ) 5.67267583
+
+ 7 -0.105E+00 0.4639479956 5.6726758321 0.03 <-- CONV
+ O_D= 0.8385598 O_OD= 2.8794977 O_TOT= 5.6726758 <-- SPRD
+ Delta: O_D= -0.5045390E-01 O_OD= -0.5451895E-01 O_TOT= -0.1049728E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 8
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 8 0.000E+00 0.0000003815 2.3209063178 0.11 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.136909, -0.136909, -0.136909 ) 1.71825077
+ WF centre and spread 2 ( -0.482533, 0.482533, -0.267977 ) 1.24182755
+ WF centre and spread 3 ( 0.267977, 0.482533, 0.482533 ) 1.24182754
+ WF centre and spread 4 ( -0.482533, -0.267977, 0.482533 ) 1.24182755
+ Sum of centres and spreads ( -0.560181, 0.560181, 0.560181 ) 5.44373340
+
+ 8 -0.229E+00 0.5502964520 5.4437334035 0.04 <-- CONV
+ O_D= 0.6962162 O_OD= 2.7928989 O_TOT= 5.4437334 <-- SPRD
+ Delta: O_D= -0.1423435E+00 O_OD= -0.8659888E-01 O_TOT= -0.2289424E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 9
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 9 -0.236E-12 0.0000003644 2.3209063178 0.12 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= -0.5124537E-24 O_OD= -0.2364775E-12 O_TOT= -0.2362555E-12 <-- DLTA
+ WF centre and spread 1 ( 0.174401, -0.174401, -0.174401 ) 1.49970435
+ WF centre and spread 2 ( -0.473319, 0.473319, -0.286759 ) 1.23997873
+ WF centre and spread 3 ( 0.286759, 0.473319, 0.473319 ) 1.23997871
+ WF centre and spread 4 ( -0.473319, -0.286759, 0.473319 ) 1.23997872
+ Sum of centres and spreads ( -0.485478, 0.485478, 0.485478 ) 5.21964051
+
+ 9 -0.224E+00 0.3181948033 5.2196405116 0.04 <-- CONV
+ O_D= 0.5790535 O_OD= 2.6859687 O_TOT= 5.2196405 <-- SPRD
+ Delta: O_D= -0.1171627E+00 O_OD= -0.1069302E+00 O_TOT= -0.2240929E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 10
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 10 0.000E+00 0.0000002034 2.3209063178 0.12 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.309907, -0.309907, -0.309907 ) 1.49162691
+ WF centre and spread 2 ( -0.431164, 0.431164, -0.341246 ) 1.19158999
+ WF centre and spread 3 ( 0.341246, 0.431164, 0.431164 ) 1.19159000
+ WF centre and spread 4 ( -0.431164, -0.341246, 0.431164 ) 1.19159001
+ Sum of centres and spreads ( -0.211176, 0.211176, 0.211176 ) 5.06639692
+
+ 10 -0.153E+00 0.2587277742 5.0663969183 0.04 <-- CONV
+ O_D= 0.5259375 O_OD= 2.5858411 O_TOT= 5.0663969 <-- SPRD
+ Delta: O_D= -0.5311601E-01 O_OD= -0.1001276E+00 O_TOT= -0.1532436E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 11
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 11 -0.333E-13 0.0000001918 2.3209063178 0.13 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.1278015E-25 O_OD= -0.3336220E-13 O_TOT= -0.3330669E-13 <-- DLTA
+ WF centre and spread 1 ( 0.288267, -0.288267, -0.288267 ) 1.24350909
+ WF centre and spread 2 ( -0.437700, 0.437700, -0.340626 ) 1.17075909
+ WF centre and spread 3 ( 0.340626, 0.437700, 0.437700 ) 1.17075907
+ WF centre and spread 4 ( -0.437700, -0.340626, 0.437700 ) 1.17075909
+ Sum of centres and spreads ( -0.246506, 0.246506, 0.246506 ) 4.75578634
+
+ 11 -0.311E+00 0.5334748389 4.7557863416 0.05 <-- CONV
+ O_D= 0.3021356 O_OD= 2.4990324 O_TOT= 4.7557863 <-- SPRD
+ Delta: O_D= -0.2238019E+00 O_OD= -0.8680871E-01 O_TOT= -0.3106106E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 12
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 12 -0.173E-13 0.0000001556 2.3209063178 0.14 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= -0.1414977E-25 O_OD= -0.1759703E-13 O_TOT= -0.1731948E-13 <-- DLTA
+ WF centre and spread 1 ( 0.318047, -0.318047, -0.318047 ) 1.21055499
+ WF centre and spread 2 ( -0.427877, 0.427876, -0.343608 ) 1.13786031
+ WF centre and spread 3 ( 0.343608, 0.427877, 0.427877 ) 1.13786025
+ WF centre and spread 4 ( -0.427877, -0.343608, 0.427877 ) 1.13786007
+ Sum of centres and spreads ( -0.194098, 0.194098, 0.194098 ) 4.62413563
+
+ 12 -0.132E+00 0.2435771163 4.6241356312 0.05 <-- CONV
+ O_D= 0.2890406 O_OD= 2.3804767 O_TOT= 4.6241356 <-- SPRD
+ Delta: O_D= -0.1309505E-01 O_OD= -0.1185557E+00 O_TOT= -0.1316507E+00 <-- DLTA
------------------------------------------------------------------------------
Cycle: 13
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 13 0.000E+00 0.0000001314 2.3209063178 0.14 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.338205, -0.338205, -0.338205 ) 1.25135596
+ WF centre and spread 2 ( -0.429362, 0.429362, -0.352371 ) 1.10363125
+ WF centre and spread 3 ( 0.352371, 0.429362, 0.429362 ) 1.10363121
+ WF centre and spread 4 ( -0.429362, -0.352371, 0.429362 ) 1.10363119
+ Sum of centres and spreads ( -0.168148, 0.168148, 0.168148 ) 4.56224960
+
+ 13 -0.619E-01 0.2029485499 4.5622496006 0.06 <-- CONV
+ O_D= 0.2400217 O_OD= 2.3676095 O_TOT= 4.5622496 <-- SPRD
+ Delta: O_D= -0.4901885E-01 O_OD= -0.1286718E-01 O_TOT= -0.6188603E-01 <-- DLTA
------------------------------------------------------------------------------
Cycle: 14
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 14 0.000E+00 0.0000001286 2.3209063178 0.14 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.380912, -0.380912, -0.380912 ) 1.24630085
+ WF centre and spread 2 ( -0.414140, 0.414140, -0.379223 ) 1.07849486
+ WF centre and spread 3 ( 0.379223, 0.414140, 0.414140 ) 1.07849480
+ WF centre and spread 4 ( -0.414140, -0.379223, 0.414140 ) 1.07849467
+ Sum of centres and spreads ( -0.068145, 0.068145, 0.068145 ) 4.48178517
+
+ 14 -0.805E-01 0.1643815809 4.4817851693 0.06 <-- CONV
+ O_D= 0.2021295 O_OD= 2.3250373 O_TOT= 4.4817852 <-- SPRD
+ Delta: O_D= -0.3789220E-01 O_OD= -0.4257223E-01 O_TOT= -0.8046443E-01 <-- DLTA
------------------------------------------------------------------------------
Cycle: 15
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 15 0.000E+00 0.0000001233 2.3209063178 0.15 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.406611, -0.406611, -0.406611 ) 1.24055171
+ WF centre and spread 2 ( -0.411705, 0.411705, -0.389129 ) 1.06476068
+ WF centre and spread 3 ( 0.389129, 0.411705, 0.411705 ) 1.06476065
+ WF centre and spread 4 ( -0.411705, -0.389129, 0.411705 ) 1.06475678
+ Sum of centres and spreads ( -0.027670, 0.027670, 0.027670 ) 4.43482981
+
+ 15 -0.470E-01 0.2011151169 4.4348298079 0.07 <-- CONV
+ O_D= 0.2040303 O_OD= 2.2761812 O_TOT= 4.4348298 <-- SPRD
+ Delta: O_D= 0.1900721E-02 O_OD= -0.4885608E-01 O_TOT= -0.4695536E-01 <-- DLTA
------------------------------------------------------------------------------
Cycle: 16
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 16 -0.235E-13 0.0000001158 2.3209063178 0.16 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= -0.2696537E-25 O_OD= -0.2353673E-13 O_TOT= -0.2353673E-13 <-- DLTA
+ WF centre and spread 1 ( 0.414371, -0.414372, -0.414371 ) 1.22426072
+ WF centre and spread 2 ( -0.413663, 0.413662, -0.390877 ) 1.06262005
+ WF centre and spread 3 ( 0.390877, 0.413662, 0.413662 ) 1.06264009
+ WF centre and spread 4 ( -0.413685, -0.390867, 0.413685 ) 1.06187777
+ Sum of centres and spreads ( -0.022100, 0.022084, 0.022099 ) 4.41139863
+
+ 16 -0.234E-01 0.1230443506 4.4113986307 0.07 <-- CONV
+ O_D= 0.2024957 O_OD= 2.2542846 O_TOT= 4.4113986 <-- SPRD
+ Delta: O_D= -0.1534555E-02 O_OD= -0.2189662E-01 O_TOT= -0.2343118E-01 <-- DLTA
------------------------------------------------------------------------------
Cycle: 17
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 17 -0.311E-14 0.0000000702 2.3209063178 0.16 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.4067529E-26 O_OD= -0.3108624E-14 O_TOT= -0.3108624E-14 <-- DLTA
+ WF centre and spread 1 ( 0.414436, -0.414446, -0.414436 ) 1.22242845
+ WF centre and spread 2 ( -0.411868, 0.411883, -0.391923 ) 1.06127217
+ WF centre and spread 3 ( 0.391923, 0.411883, 0.411868 ) 1.06128336
+ WF centre and spread 4 ( -0.411866, -0.391930, 0.411867 ) 1.06087259
+ Sum of centres and spreads ( -0.017375, 0.017391, 0.017375 ) 4.40585657
+
+ 17 -0.554E-02 0.1921501541 4.4058565729 0.08 <-- CONV
+ O_D= 0.1978022 O_OD= 2.2534361 O_TOT= 4.4058566 <-- SPRD
+ Delta: O_D= -0.4693543E-02 O_OD= -0.8485151E-03 O_TOT= -0.5542058E-02 <-- DLTA
------------------------------------------------------------------------------
Cycle: 18
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 18 0.133E-14 0.0000000623 2.3209063178 0.17 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.8779410E-27 O_OD= 0.1276756E-14 O_TOT= 0.1332268E-14 <-- DLTA
+ WF centre and spread 1 ( 0.414710, -0.414765, -0.414712 ) 1.21372786
+ WF centre and spread 2 ( -0.404122, 0.404196, -0.396562 ) 1.06068076
+ WF centre and spread 3 ( 0.396561, 0.404199, 0.404127 ) 1.06067460
+ WF centre and spread 4 ( -0.404022, -0.396605, 0.404024 ) 1.06091035
+ Sum of centres and spreads ( 0.003127, -0.002975, -0.003123 ) 4.39599357
+
+ 18 -0.986E-02 0.1521433736 4.3959935728 0.08 <-- CONV
+ O_D= 0.1895808 O_OD= 2.2517944 O_TOT= 4.3959936 <-- SPRD
+ Delta: O_D= -0.8221356E-02 O_OD= -0.1641644E-02 O_TOT= -0.9863000E-02 <-- DLTA
------------------------------------------------------------------------------
Cycle: 19
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 19 0.000E+00 0.0000000574 2.3209063178 0.17 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.414733, -0.414930, -0.414738 ) 1.17757009
+ WF centre and spread 2 ( -0.408536, 0.408225, -0.398238 ) 1.06828191
+ WF centre and spread 3 ( 0.398235, 0.408202, 0.408503 ) 1.06850438
+ WF centre and spread 4 ( -0.409031, -0.398097, 0.409022 ) 1.06933375
+ Sum of centres and spreads ( -0.004598, 0.003399, 0.004549 ) 4.38369014
+
+ 19 -0.123E-01 0.0818448235 4.3836901361 0.09 <-- CONV
+ O_D= 0.1854015 O_OD= 2.2436703 O_TOT= 4.3836901 <-- SPRD
+ Delta: O_D= -0.4179282E-02 O_OD= -0.8124155E-02 O_TOT= -0.1230344E-01 <-- DLTA
------------------------------------------------------------------------------
Cycle: 20
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- 20 0.000E+00 0.0000000562 2.3209063178 0.18 <-- CONV
- O_D= 0.0000000 O_OD= 0.3662853 O_TOT= 2.3209063 <-- SPRD
- Delta: O_D= 0.0000000E+00 O_OD= 0.0000000E+00 O_TOT= 0.0000000E+00 <-- DLTA
+ WF centre and spread 1 ( 0.414831, -0.415013, -0.414837 ) 1.17685030
+ WF centre and spread 2 ( -0.408031, 0.407817, -0.397915 ) 1.06787005
+ WF centre and spread 3 ( 0.397919, 0.407806, 0.408017 ) 1.06786000
+ WF centre and spread 4 ( -0.408443, -0.397788, 0.408441 ) 1.06838311
+ Sum of centres and spreads ( -0.003724, 0.002822, 0.003706 ) 4.38096346
+
+ 20 -0.273E-02 0.2039493351 4.3809634608 0.09 <-- CONV
+ O_D= 0.1830117 O_OD= 2.2433335 O_TOT= 4.3809635 <-- SPRD
+ Delta: O_D= -0.2389858E-02 O_OD= -0.3368169E-03 O_TOT= -0.2726675E-02 <-- DLTA
------------------------------------------------------------------------------
Final State
- WF centre and spread 1 ( 0.000000, 0.000000, 0.000000 ) 0.58022658
- WF centre and spread 2 ( -0.806995, 0.806995, 0.000000 ) 0.58022658
- WF centre and spread 3 ( 0.000000, 0.806995, 0.806995 ) 0.58022658
- WF centre and spread 4 ( -0.806995, 0.000000, 0.806995 ) 0.58022658
- Sum of centres and spreads ( -1.613990, 1.613990, 1.613990 ) 2.32090632
-
- Spreads (Ang^2) Omega I = 1.954621046
- ================ Omega D = 0.000000000
- Omega OD = 0.366285272
- Final Spread (Ang^2) Omega Total = 2.320906318
+ WF centre and spread 1 ( 0.414831, -0.415013, -0.414837 ) 1.17685030
+ WF centre and spread 2 ( -0.408031, 0.407817, -0.397915 ) 1.06787005
+ WF centre and spread 3 ( 0.397919, 0.407806, 0.408017 ) 1.06786000
+ WF centre and spread 4 ( -0.408443, -0.397788, 0.408441 ) 1.06838311
+ Sum of centres and spreads ( -0.003724, 0.002822, 0.003706 ) 4.38096346
+
+ Spreads (Ang^2) Omega I = 1.954618313
+ ================ Omega D = 0.183011671
+ Omega OD = 2.243333477
+ Final Spread (Ang^2) Omega Total = 4.380963461
------------------------------------------------------------------------------
- Time for wannierise 0.112 (sec)
+ Time for wannierise 0.088 (sec)
Writing checkpoint file diamond.sa.chk... done
- Total Execution Time 0.176 (sec)
+ Time for plotting 0.000 (sec)
+ Total Execution Time 0.220 (sec)
*===========================================================================*
| TIMING INFORMATION |
*===========================================================================*
| Tag Ncalls Time (s)|
|---------------------------------------------------------------------------|
- |kmesh: get : 1 0.048|
+ |kmesh: get : 1 0.108|
+ |overlap: allocate : 1 0.000|
|overlap: read : 1 0.012|
- |wann: main : 1 0.112|
+ |wann: main : 1 0.088|
+ |plot: main : 1 0.000|
*---------------------------------------------------------------------------*
All done: wannier90 exiting
diff --git a/PP/examples/WAN90_example/reference/diamond.scf.in b/PP/examples/WAN90_example/reference/diamond.scf.in
index 83940d1e08..b9e1381de3 100644
--- a/PP/examples/WAN90_example/reference/diamond.scf.in
+++ b/PP/examples/WAN90_example/reference/diamond.scf.in
@@ -2,8 +2,8 @@
calculation = 'scf'
restart_mode='from_scratch',
prefix='di',
- pseudo_dir='/home/arash/PW-pseudo',
- outdir='/home/arash/tmp'
+ pseudo_dir='/home/giannozz/q-e-mio/pseudo',
+ outdir='/home/giannozz/q-e-mio/tempdir'
/
&system
ibrav= 2, celldm(1) =6.1, nat= 2, ntyp= 1,
@@ -18,7 +18,7 @@
ATOMIC_SPECIES
C 12.0 C.pz-vbc.UPF
ATOMIC_POSITIONS {crystal}
-C -0.125 -0.125 -0.125
-C 0.125 0.125 0.125
+C -0.25 -0.25 -0.25
+C 0.0 0.0 0.0
K_POINTS {automatic}
12 12 12 0 0 0
diff --git a/PP/examples/WAN90_example/reference/diamond.scf.out b/PP/examples/WAN90_example/reference/diamond.scf.out
index f32a42ee97..c4c60f70b9 100644
--- a/PP/examples/WAN90_example/reference/diamond.scf.out
+++ b/PP/examples/WAN90_example/reference/diamond.scf.out
@@ -1,76 +1,87 @@
- Program PWSCF v.3.1.1 starts ...
- Today is 9Oct2006 at 15:37: 0
+ Program PWSCF v.6.4rc starts on 1Mar2019 at 15:58:46
- Parallel version (MPI)
+ This program is part of the open-source Quantum ESPRESSO suite
+ for quantum simulation of materials; please cite
+ "P. Giannozzi et al., J. Phys.:Condens. Matter 21 395502 (2009);
+ "P. Giannozzi et al., J. Phys.:Condens. Matter 29 465901 (2017);
+ URL http://www.quantum-espresso.org",
+ in publications or presentations arising from this work. More details at
+ http://www.quantum-espresso.org/quote
- Number of processors in use: 2
- R & G space division: proc/pool = 2
+ Parallel version (MPI), running on 1 processors
- Ultrasoft (Vanderbilt) Pseudopotentials
+ MPI processes distributed on 1 nodes
+ Waiting for input...
+ Reading input from standard input
- Current dimensions of program pwscf are:
-
- ntypx = 10 npk = 40000 lmax = 3
- nchix = 6 ndmx = 2000 nbrx = 14 nqfx = 8
-
- looking for the optimal diagonalization algorithm ...
+ Current dimensions of program PWSCF are:
+ Max number of different atomic species (ntypx) = 10
+ Max number of k-points (npk) = 40000
+ Max angular momentum in pseudopotentials (lmaxx) = 3
+ Subspace diagonalization in iterative solution of the eigenvalue problem:
a serial algorithm will be used
-
- Planes per process (thick) : nr3 = 18 npp = 9 ncplane = 324
- Proc/ planes cols G planes cols G columns G
- Pool (dense grid) (smooth grid) (wavefct grid)
- 1 9 99 957 9 99 957 37 206
- 2 9 100 960 9 100 960 36 205
- 0 18 199 1917 18 199 1917 73 411
+ G-vector sticks info
+ --------------------
+ sticks: dense smooth PW G-vecs: dense smooth PW
+ Sum 199 199 73 1917 1917 411
bravais-lattice index = 2
- lattice parameter (a_0) = 6.1000 a.u.
+ lattice parameter (alat) = 6.1000 a.u.
unit-cell volume = 56.7452 (a.u.)^3
number of atoms/cell = 2
number of atomic types = 1
+ number of electrons = 8.00
+ number of Kohn-Sham states= 4
kinetic-energy cutoff = 40.0000 Ry
charge density cutoff = 160.0000 Ry
convergence threshold = 1.0E-13
- beta = 0.7000
+ mixing beta = 0.7000
number of iterations used = 8 plain mixing
- Exchange-correlation = SLA PZ NOGX NOGC (1100)
+ Exchange-correlation = SLA PZ NOGX NOGC ( 1 1 0 0 0 0)
+
celldm(1)= 6.100000 celldm(2)= 0.000000 celldm(3)= 0.000000
celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000
- crystal axes: (cart. coord. in units of a_0)
- a(1) = ( -0.500000 0.000000 0.500000 )
- a(2) = ( 0.000000 0.500000 0.500000 )
- a(3) = ( -0.500000 0.500000 0.000000 )
+ crystal axes: (cart. coord. in units of alat)
+ a(1) = ( -0.500000 0.000000 0.500000 )
+ a(2) = ( 0.000000 0.500000 0.500000 )
+ a(3) = ( -0.500000 0.500000 0.000000 )
- reciprocal axes: (cart. coord. in units 2 pi/a_0)
+ reciprocal axes: (cart. coord. in units 2 pi/alat)
b(1) = ( -1.000000 -1.000000 1.000000 )
b(2) = ( 1.000000 1.000000 1.000000 )
b(3) = ( -1.000000 1.000000 -1.000000 )
- PSEUDO 1 is C zval = 4.0 lmax= 0 lloc= 0
- (in numerical form: 269 grid points, xmin = 0.00, dx = 0.0000)
+ PseudoPot. # 1 for C read from file:
+ /home/giannozz/q-e-mio/pseudo/C.pz-vbc.UPF
+ MD5 check sum: b3df27665907f6396c9b9f9dac2a9cb5
+ Pseudo is Norm-conserving, Zval = 4.0
+ Generated by new atomic code, or converted to UPF format
+ Using radial grid of 269 points, 1 beta functions with:
+ l(1) = 0
atomic species valence mass pseudopotential
C 4.00 12.00000 C ( 1.00)
- 48 Sym.Ops. (with inversion)
+ 48 Sym. Ops., with inversion, found (24 have fractional translation)
+
Cartesian axes
- site n. atom positions (a_0 units)
- 1 C tau( 1) = ( 0.1250000 -0.1250000 -0.1250000 )
- 2 C tau( 2) = ( -0.1250000 0.1250000 0.1250000 )
+ site n. atom positions (alat units)
+ 1 C tau( 1) = ( 0.2500000 -0.2500000 -0.2500000 )
+ 2 C tau( 2) = ( 0.0000000 0.0000000 0.0000000 )
- number of k points= 72
- cart. coord. in units 2pi/a_0
+ number of k points= 72
+ cart. coord. in units 2pi/alat
k( 1) = ( 0.0000000 0.0000000 0.0000000), wk = 0.0011574
k( 2) = ( -0.0833333 0.0833333 -0.0833333), wk = 0.0092593
k( 3) = ( -0.1666667 0.1666667 -0.1666667), wk = 0.0092593
@@ -144,438 +155,456 @@
k( 71) = ( -0.3333333 -1.0000000 0.0000000), wk = 0.0138889
k( 72) = ( -0.5000000 -1.0000000 0.0000000), wk = 0.0069444
- G cutoff = 150.8064 ( 1917 G-vectors) FFT grid: ( 18, 18, 18)
+ Dense grid: 1917 G-vectors FFT dimensions: ( 20, 20, 20)
- nbndx = 16 nbnd = 4 natomwfc = 8 npwx = 128
- nelec = 8.00 nkb = 2 ngl = 52
+ Estimated max dynamical RAM per process > 2.57 MB
Initial potential from superposition of free atoms
starting charge 7.99994, renormalised to 8.00000
- Starting wfc are atomic
+ Starting wfcs are 8 randomized atomic wfcs
- total cpu time spent up to now is 0.26 secs
+ total cpu time spent up to now is 0.3 secs
Self-consistent Calculation
- iteration # 1 ecut= 40.00 ryd beta=0.70
+ iteration # 1 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
ethr = 1.00E-02, avg # of iterations = 2.0
- total cpu time spent up to now is 0.74 secs
+ total cpu time spent up to now is 0.6 secs
- total energy = -22.56222778 ryd
- estimated scf accuracy < 0.21680062 ryd
+ total energy = -22.56221267 Ry
+ Harris-Foulkes estimate = -22.68088990 Ry
+ estimated scf accuracy < 0.21686343 Ry
- iteration # 2 ecut= 40.00 ryd beta=0.70
+ iteration # 2 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
ethr = 2.71E-03, avg # of iterations = 1.9
- total cpu time spent up to now is 1.10 secs
+ total cpu time spent up to now is 0.9 secs
- total energy = -22.58044894 ryd
- estimated scf accuracy < 0.00299479 ryd
+ total energy = -22.58046634 Ry
+ Harris-Foulkes estimate = -22.58154139 Ry
+ estimated scf accuracy < 0.00299122 Ry
- iteration # 3 ecut= 40.00 ryd beta=0.70
+ iteration # 3 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
ethr = 3.74E-05, avg # of iterations = 2.2
- total cpu time spent up to now is 1.53 secs
+ total cpu time spent up to now is 1.2 secs
- total energy = -22.58126747 ryd
- estimated scf accuracy < 0.00007543 ryd
+ total energy = -22.58128830 Ry
+ Harris-Foulkes estimate = -22.58130274 Ry
+ estimated scf accuracy < 0.00007580 Ry
- iteration # 4 ecut= 40.00 ryd beta=0.70
+ iteration # 4 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
- ethr = 9.43E-07, avg # of iterations = 2.1
+ ethr = 9.47E-07, avg # of iterations = 2.1
- total cpu time spent up to now is 1.97 secs
+ total cpu time spent up to now is 1.5 secs
- total energy = -22.58128481 ryd
- estimated scf accuracy < 0.00000553 ryd
+ total energy = -22.58130603 Ry
+ Harris-Foulkes estimate = -22.58130945 Ry
+ estimated scf accuracy < 0.00000569 Ry
- iteration # 5 ecut= 40.00 ryd beta=0.70
+ iteration # 5 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
- ethr = 6.91E-08, avg # of iterations = 2.1
+ ethr = 7.12E-08, avg # of iterations = 2.1
- total cpu time spent up to now is 2.40 secs
+ total cpu time spent up to now is 1.8 secs
- total energy = -22.58128612 ryd
- estimated scf accuracy < 0.00000006 ryd
+ total energy = -22.58130737 Ry
+ Harris-Foulkes estimate = -22.58130740 Ry
+ estimated scf accuracy < 0.00000006 Ry
- iteration # 6 ecut= 40.00 ryd beta=0.70
+ iteration # 6 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
- ethr = 7.28E-10, avg # of iterations = 2.4
+ ethr = 7.39E-10, avg # of iterations = 2.5
- total cpu time spent up to now is 2.88 secs
+ total cpu time spent up to now is 2.2 secs
- total energy = -22.58128615 ryd
- estimated scf accuracy < 4.8E-10 ryd
+ total energy = -22.58130740 Ry
+ Harris-Foulkes estimate = -22.58130740 Ry
+ estimated scf accuracy < 4.5E-10 Ry
- iteration # 7 ecut= 40.00 ryd beta=0.70
+ iteration # 7 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
- ethr = 6.06E-12, avg # of iterations = 2.7
+ ethr = 5.64E-12, avg # of iterations = 2.9
- total cpu time spent up to now is 3.38 secs
+ total cpu time spent up to now is 2.5 secs
- total energy = -22.58128615 ryd
- estimated scf accuracy < 2.5E-12 ryd
+ total energy = -22.58130740 Ry
+ Harris-Foulkes estimate = -22.58130740 Ry
+ estimated scf accuracy < 2.8E-12 Ry
- iteration # 8 ecut= 40.00 ryd beta=0.70
+ iteration # 8 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
- ethr = 3.07E-14, avg # of iterations = 2.7
+ ethr = 1.00E-13, avg # of iterations = 2.0
- total cpu time spent up to now is 3.87 secs
+ total cpu time spent up to now is 2.8 secs
- total energy = -22.58128615 ryd
- estimated scf accuracy < 2.4E-12 ryd
+ total energy = -22.58130740 Ry
+ Harris-Foulkes estimate = -22.58130740 Ry
+ estimated scf accuracy < 2.6E-12 Ry
- iteration # 9 ecut= 40.00 ryd beta=0.70
+ iteration # 9 ecut= 40.00 Ry beta= 0.70
Davidson diagonalization with overlap
- ethr = 3.03E-14, avg # of iterations = 2.0
+ ethr = 1.00E-13, avg # of iterations = 1.0
- total cpu time spent up to now is 4.28 secs
+ total cpu time spent up to now is 3.0 secs
End of self-consistent calculation
k = 0.0000 0.0000 0.0000 ( 259 PWs) bands (ev):
- -6.4387 19.3980 19.3980 19.3980
+ -6.4386 19.3977 19.3977 19.3977
k =-0.0833 0.0833-0.0833 ( 259 PWs) bands (ev):
- -6.2059 17.7916 18.9461 18.9461
+ -6.2059 17.7913 18.9458 18.9458
k =-0.1667 0.1667-0.1667 ( 250 PWs) bands (ev):
- -5.5239 14.7237 18.0303 18.0303
+ -5.5239 14.7235 18.0301 18.0301
k =-0.2500 0.2500-0.2500 ( 247 PWs) bands (ev):
- -4.3800 11.1722 17.0933 17.0933
+ -4.3800 11.1721 17.0930 17.0930
k =-0.3333 0.3333-0.3333 ( 256 PWs) bands (ev):
- -2.7985 7.7336 16.3402 16.3402
+ -2.7984 7.7335 16.3400 16.3400
k =-0.4167 0.4167-0.4167 ( 241 PWs) bands (ev):
- -0.7720 4.5802 15.9606 15.9606
+ -0.7720 4.5802 15.9604 15.9604
k = 0.5000-0.5000 0.5000 ( 242 PWs) bands (ev):
- 1.3328 2.0781 15.8056 15.8056
+ 1.3328 2.0781 15.8054 15.8054
k = 0.0000 0.1667 0.0000 ( 258 PWs) bands (ev):
- -6.1283 18.0990 18.0990 18.7944
+ -6.1283 18.0988 18.0988 18.7941
k =-0.0833 0.2500-0.0833 ( 251 PWs) bands (ev):
- -5.5975 15.7396 17.0413 18.3592
+ -5.5975 15.7394 17.0410 18.3590
k =-0.1667 0.3333-0.1667 ( 245 PWs) bands (ev):
- -4.6090 12.4481 16.1205 17.4878
+ -4.6090 12.4479 16.1202 17.4875
k =-0.2500 0.4167-0.2500 ( 244 PWs) bands (ev):
- -3.1690 9.0041 15.4986 16.4994
+ -3.1689 9.0040 15.4984 16.4992
k =-0.3333 0.5000-0.3333 ( 239 PWs) bands (ev):
- -1.2861 5.7738 15.2328 15.6431
+ -1.2860 5.7737 15.2326 15.6429
k = 0.5833-0.4167 0.5833 ( 244 PWs) bands (ev):
- 0.9585 2.8834 15.0126 15.2937
+ 0.9584 2.8834 15.0124 15.2935
k = 0.5000-0.3333 0.5000 ( 245 PWs) bands (ev):
- 0.1816 3.7906 14.7068 15.6943
+ 0.1816 3.7905 14.7066 15.6941
k = 0.4167-0.2500 0.4167 ( 246 PWs) bands (ev):
- -1.9665 6.8253 14.7676 16.3532
+ -1.9665 6.8252 14.7674 16.3529
k = 0.3333-0.1667 0.3333 ( 247 PWs) bands (ev):
- -3.7043 10.1448 15.1597 17.2929
+ -3.7043 10.1446 15.1595 17.2927
k = 0.2500-0.0833 0.2500 ( 247 PWs) bands (ev):
- -4.9871 13.6195 15.8712 18.2866
+ -4.9871 13.6193 15.8710 18.2864
k = 0.1667 0.0000 0.1667 ( 249 PWs) bands (ev):
- -5.8228 16.6872 16.9968 19.0144
+ -5.8227 16.6870 16.9965 19.0141
k = 0.0000 0.3333 0.0000 ( 246 PWs) bands (ev):
- -5.2143 15.8760 15.8760 17.1836
+ -5.2142 15.8758 15.8758 17.1834
k =-0.0833 0.4167-0.0833 ( 241 PWs) bands (ev):
- -4.3759 13.5805 14.9103 16.3827
+ -4.3759 13.5804 14.9101 16.3825
k =-0.1667 0.5000-0.1667 ( 243 PWs) bands (ev):
- -3.0921 10.4482 14.2608 15.3274
+ -3.0921 10.4481 14.2606 15.3272
k =-0.2500 0.5833-0.2500 ( 242 PWs) bands (ev):
- -1.3652 7.2880 13.9795 14.1724
+ -1.3652 7.2879 13.9793 14.1723
k = 0.6667-0.3333 0.6667 ( 241 PWs) bands (ev):
- 0.7661 4.3402 13.1961 14.1422
+ 0.7661 4.3402 13.1960 14.1420
k = 0.5833-0.2500 0.5833 ( 244 PWs) bands (ev):
- 1.5045 3.4799 12.5245 14.6603
+ 1.5045 3.4798 12.5243 14.6601
k = 0.5000-0.1667 0.5000 ( 244 PWs) bands (ev):
- -0.7053 6.3114 12.2247 15.4885
+ -0.7052 6.3113 12.2246 15.4883
k = 0.4167-0.0833 0.4167 ( 247 PWs) bands (ev):
- -2.5725 9.4562 12.3240 16.5607
+ -2.5724 9.4561 12.3238 16.5605
k = 0.3333 0.0000 0.3333 ( 243 PWs) bands (ev):
- -3.9981 12.5454 13.0501 17.6367
+ -3.9980 12.5452 13.0499 17.6365
k = 0.0000 0.5000 0.0000 ( 234 PWs) bands (ev):
- -3.6839 13.8639 13.8639 14.5739
+ -3.6839 13.8637 13.8637 14.5737
k =-0.0833 0.5833-0.0833 ( 241 PWs) bands (ev):
- -2.5558 11.7000 13.1068 13.5221
+ -2.5558 11.6998 13.1066 13.5220
k =-0.1667 0.6667-0.1667 ( 241 PWs) bands (ev):
- -0.9844 8.9159 12.2025 12.7922
+ -0.9844 8.9158 12.2024 12.7920
k = 0.7500-0.2500 0.7500 ( 242 PWs) bands (ev):
- 0.9925 6.0964 10.9236 12.9161
+ 0.9924 6.0963 10.9234 12.9159
k = 0.6667-0.1667 0.6667 ( 243 PWs) bands (ev):
- 2.8810 3.9356 9.9587 13.4075
+ 2.8809 3.9356 9.9586 13.4073
k = 0.5833-0.0833 0.5833 ( 242 PWs) bands (ev):
- 0.9624 6.2286 9.3906 14.2912
+ 0.9624 6.2285 9.3905 14.2910
k = 0.5000 0.0000 0.5000 ( 248 PWs) bands (ev):
- -1.0019 8.9712 9.4601 15.4030
+ -1.0019 8.9711 9.4600 15.4028
k = 0.0000 0.6667 0.0000 ( 238 PWs) bands (ev):
- -1.5725 11.2642 12.2895 12.2895
+ -1.5724 11.2641 12.2893 12.2893
k =-0.0833 0.7500-0.0833 ( 238 PWs) bands (ev):
- -0.1604 9.4051 11.0975 11.8596
+ -0.1604 9.4050 11.0973 11.8594
k = 0.8333-0.1667 0.8333 ( 237 PWs) bands (ev):
- 1.6593 7.5041 9.1634 11.9042
+ 1.6593 7.5040 9.1633 11.9040
k = 0.7500-0.0833 0.7500 ( 240 PWs) bands (ev):
- 3.7207 5.4924 7.6076 12.3195
+ 3.7206 5.4923 7.6075 12.3193
k = 0.6667 0.0000 0.6667 ( 236 PWs) bands (ev):
- 2.9492 6.3653 6.9214 13.1569
+ 2.9492 6.3652 6.9213 13.1568
k = 0.0000 0.8333 0.0000 ( 242 PWs) bands (ev):
- 1.0916 7.7036 11.3169 11.3169
+ 1.0916 7.7036 11.3168 11.3168
k = 0.9167-0.0833 0.9167 ( 236 PWs) bands (ev):
- 2.7524 6.0454 10.2548 11.2543
+ 2.7524 6.0454 10.2547 11.2542
k = 0.8333 0.0000 0.8333 ( 236 PWs) bands (ev):
- 4.6516 4.7804 8.2699 11.5694
+ 4.6516 4.7804 8.2698 11.5692
k = 0.0000-1.0000 0.0000 ( 230 PWs) bands (ev):
- 4.2492 4.2492 11.0421 11.0421
+ 4.2491 4.2491 11.0419 11.0419
k =-0.1667 0.3333 0.0000 ( 246 PWs) bands (ev):
- -4.9093 14.5284 14.9188 17.8183
+ -4.9092 14.5282 14.9187 17.8181
k =-0.2500 0.4167-0.0833 ( 242 PWs) bands (ev):
- -3.7718 11.4980 13.9890 16.9330
+ -3.7717 11.4979 13.9888 16.9328
k =-0.3333 0.5000-0.1667 ( 241 PWs) bands (ev):
- -2.1915 8.2128 13.5508 15.8527
+ -2.1915 8.2127 13.5506 15.8525
k = 0.5833-0.4167 0.7500 ( 245 PWs) bands (ev):
- -0.1834 5.1215 13.4385 14.9220
+ -0.1834 5.1214 13.4383 14.9218
k = 0.5000-0.3333 0.6667 ( 248 PWs) bands (ev):
- 1.8514 2.7077 13.5088 14.4976
+ 1.8514 2.7077 13.5086 14.4974
k =-0.1667 0.5000 0.0000 ( 240 PWs) bands (ev):
- -3.3863 12.5120 12.9789 15.4172
+ -3.3863 12.5118 12.9787 15.4170
k =-0.2500 0.5833-0.0833 ( 242 PWs) bands (ev):
- -1.9597 9.7407 12.2598 14.2906
+ -1.9597 9.7406 12.2597 14.2905
k = 0.6667-0.3333 0.8333 ( 242 PWs) bands (ev):
- -0.1078 6.7622 11.9531 13.2951
+ -0.1078 6.7621 11.9530 13.2949
k = 0.5833-0.2500 0.7500 ( 244 PWs) bands (ev):
- 2.0675 4.0376 11.4911 13.0996
+ 2.0675 4.0376 11.4910 13.0994
k = 0.5000-0.1667 0.6667 ( 242 PWs) bands (ev):
- 1.3220 4.9225 10.9875 13.7104
+ 1.3219 4.9224 10.9874 13.7102
k = 0.4167-0.0833 0.5833 ( 243 PWs) bands (ev):
- -0.7751 7.8113 10.7866 14.7292
+ -0.7751 7.8112 10.7865 14.7290
k = 0.3333 0.0000 0.5000 ( 245 PWs) bands (ev):
- -2.4890 10.6785 11.2079 15.9035
+ -2.4890 10.6783 11.2077 15.9033
k =-0.1667 0.6667 0.0000 ( 233 PWs) bands (ev):
- -1.2730 10.6158 11.5108 12.5541
+ -1.2730 10.6157 11.5106 12.5540
k = 0.7500-0.2500 0.9167 ( 241 PWs) bands (ev):
- 0.4166 8.3786 10.4116 11.7076
+ 0.4166 8.3785 10.4115 11.7075
k = 0.6667-0.1667 0.8333 ( 241 PWs) bands (ev):
- 2.4737 5.8638 9.2553 11.7926
+ 2.4736 5.8637 9.2552 11.7925
k = 0.5833-0.0833 0.7500 ( 240 PWs) bands (ev):
- 3.1150 5.2146 8.3789 12.4525
+ 3.1150 5.2145 8.3788 12.4523
k = 0.5000 0.0000 0.6667 ( 240 PWs) bands (ev):
- 1.0411 7.6226 8.1361 13.4967
+ 1.0411 7.6225 8.1360 13.4965
k = 0.8333-0.1667 1.0000 ( 238 PWs) bands (ev):
- 1.3752 7.8172 10.5785 10.7901
+ 1.3752 7.8171 10.5784 10.7900
k = 0.7500-0.0833 0.9167 ( 237 PWs) bands (ev):
- 3.2820 6.3579 8.5917 10.8368
+ 3.2820 6.3578 8.5915 10.8367
k = 0.6667 0.0000 0.8333 ( 236 PWs) bands (ev):
- 4.7275 5.5416 6.7823 11.4553
+ 4.7274 5.5415 6.7822 11.4552
k =-0.1667-1.0000 0.0000 ( 240 PWs) bands (ev):
- 4.4828 4.4828 10.2998 10.2998
+ 4.4828 4.4828 10.2997 10.2997
k = 0.6667-0.3333 1.0000 ( 241 PWs) bands (ev):
- -0.4002 9.1556 9.7984 13.0400
+ -0.4002 9.1555 9.7982 13.0398
k = 0.5833-0.2500 0.9167 ( 241 PWs) bands (ev):
- 1.5518 6.6605 9.5598 11.8615
+ 1.5518 6.6604 9.5597 11.8614
k = 0.5000-0.1667 0.8333 ( 244 PWs) bands (ev):
- 3.3921 4.5257 9.6735 11.3128
+ 3.3920 4.5256 9.6734 11.3127
k = 0.6667-0.1667 1.0000 ( 249 PWs) bands (ev):
- 2.2043 7.6799 8.9571 10.0738
+ 2.2043 7.6798 8.9570 10.0736
k = 0.5833-0.0833 0.9167 ( 242 PWs) bands (ev):
- 4.2151 6.0118 7.9294 9.7768
+ 4.2150 6.0118 7.9293 9.7767
k = 0.5000 0.0000 0.8333 ( 245 PWs) bands (ev):
- 3.5098 6.6578 7.4201 10.5578
+ 3.5098 6.6577 7.4200 10.5576
k =-0.3333-1.0000 0.0000 ( 244 PWs) bands (ev):
- 5.1547 5.1547 8.8552 8.8552
+ 5.1547 5.1547 8.8551 8.8551
k =-0.5000-1.0000 0.0000 ( 252 PWs) bands (ev):
- 5.7054 5.7054 7.9453 7.9453
+ 5.7054 5.7054 7.9452 7.9452
-! total energy = -22.58128615 ryd
- estimated scf accuracy < 9.3E-15 ryd
+ highest occupied level (ev): 19.3977
- band energy sum = 4.91039910 ryd
- one-electron contribution = 11.69117932 ryd
- hartree contribution = 1.57036312 ryd
- xc contribution = -7.58421585 ryd
- ewald contribution = -28.25861274 ryd
+! total energy = -22.58130740 Ry
+ Harris-Foulkes estimate = -22.58130740 Ry
+ estimated scf accuracy < 8.3E-15 Ry
- convergence has been achieved
+ The total energy is the sum of the following terms:
- Writing output data file di.save
-
- PWSCF : 4.38s CPU time
+ one-electron contribution = 11.69117718 Ry
+ hartree contribution = 1.57036679 Ry
+ xc contribution = -7.58423863 Ry
+ ewald contribution = -28.25861274 Ry
- init_run : 0.26s CPU
- electrons : 4.02s CPU
-
- electrons : 4.02s CPU
- c_bands : 3.49s CPU ( 9 calls, 0.388 s avg)
- sum_band : 0.48s CPU ( 9 calls, 0.053 s avg)
- v_of_rho : 0.02s CPU ( 10 calls, 0.002 s avg)
- mix_rho : 0.01s CPU ( 9 calls, 0.001 s avg)
-
- c_bands : 3.49s CPU ( 9 calls, 0.388 s avg)
- init_us_2 : 0.02s CPU ( 1368 calls, 0.000 s avg)
- cegterg : 3.47s CPU ( 648 calls, 0.005 s avg)
-
- sum_band : 0.48s CPU ( 9 calls, 0.053 s avg)
-
- wfcrot : 0.24s CPU ( 72 calls, 0.003 s avg)
- cegterg : 3.47s CPU ( 648 calls, 0.005 s avg)
- h_psi : 2.99s CPU ( 2164 calls, 0.001 s avg)
- g_psi : 0.04s CPU ( 1444 calls, 0.000 s avg)
- cdiaghg : 0.24s CPU ( 2092 calls, 0.000 s avg)
- update : 0.04s CPU ( 1444 calls, 0.000 s avg)
- last : 0.00s CPU ( 648 calls, 0.000 s avg)
-
- h_psi : 2.99s CPU ( 2164 calls, 0.001 s avg)
- init : 0.02s CPU ( 2164 calls, 0.000 s avg)
- firstfft : 1.32s CPU ( 8012 calls, 0.000 s avg)
- secondfft : 1.44s CPU ( 8012 calls, 0.000 s avg)
- add_vuspsi : 0.01s CPU ( 2164 calls, 0.000 s avg)
+ convergence has been achieved in 9 iterations
+
+ Writing output data file di.save/
+ init_run : 0.20s CPU 0.25s WALL ( 1 calls)
+ electrons : 2.68s CPU 2.75s WALL ( 1 calls)
+
+ Called by init_run:
+ wfcinit : 0.18s CPU 0.21s WALL ( 1 calls)
+ potinit : 0.00s CPU 0.00s WALL ( 1 calls)
+ hinit0 : 0.02s CPU 0.04s WALL ( 1 calls)
+
+ Called by electrons:
+ c_bands : 2.26s CPU 2.33s WALL ( 9 calls)
+ sum_band : 0.40s CPU 0.40s WALL ( 9 calls)
+ v_of_rho : 0.01s CPU 0.01s WALL ( 10 calls)
+ mix_rho : 0.01s CPU 0.01s WALL ( 9 calls)
+
+ Called by c_bands:
+ init_us_2 : 0.05s CPU 0.03s WALL ( 1368 calls)
+ cegterg : 2.22s CPU 2.29s WALL ( 648 calls)
+
+ Called by sum_band:
+
+ Called by *egterg:
+ h_psi : 2.04s CPU 2.10s WALL ( 2067 calls)
+ g_psi : 0.05s CPU 0.05s WALL ( 1347 calls)
+ cdiaghg : 0.14s CPU 0.14s WALL ( 1995 calls)
+
+ Called by h_psi:
+ h_psi:pot : 2.02s CPU 2.09s WALL ( 2067 calls)
+ h_psi:calbec : 0.02s CPU 0.05s WALL ( 2067 calls)
+ vloc_psi : 1.98s CPU 2.01s WALL ( 2067 calls)
+ add_vuspsi : 0.01s CPU 0.02s WALL ( 2067 calls)
+
General routines
- ccalbec : 0.12s CPU ( 2164 calls, 0.000 s avg)
- cft3 : 0.01s CPU ( 40 calls, 0.000 s avg)
- cft3s : 3.14s CPU ( 18616 calls, 0.000 s avg)
- davcio : 0.02s CPU ( 2016 calls, 0.000 s avg)
+ calbec : 0.02s CPU 0.04s WALL ( 2067 calls)
+ fft : 0.00s CPU 0.02s WALL ( 29 calls)
+ ffts : 0.00s CPU 0.00s WALL ( 9 calls)
+ fftw : 2.04s CPU 2.11s WALL ( 17996 calls)
Parallel routines
- reduce : 0.39s CPU ( 8123 calls, 0.000 s avg)
- fft_scatter : 1.26s CPU ( 18656 calls, 0.000 s avg)
+
+ PWSCF : 2.92s CPU 3.08s WALL
+
+
+ This run was terminated on: 15:58:49 1Mar2019
+
+=------------------------------------------------------------------------------=
+ JOB DONE.
+=------------------------------------------------------------------------------=
From aba7e8fb01479216a4f3379c1346a60f280a0df0 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Fri, 1 Mar 2019 16:24:13 +0100
Subject: [PATCH 09/24] TS vdW should work also for atomic symbols in LSDA
style, e.g. Fe1, Fe2 ...
---
Modules/tsvdw.f90 | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Modules/tsvdw.f90 b/Modules/tsvdw.f90
index efcbeee7b7..62a4af134f 100644
--- a/Modules/tsvdw.f90
+++ b/Modules/tsvdw.f90
@@ -549,7 +549,7 @@ SUBROUTINE tsvdw_initialize()
!
! Populate reference free atom quantities...
!
- CALL GetVdWParam(atm(is),C6AAfree(is),dpfree(is),R0free(is))
+ CALL GetVdWParam(upf(is)%psd,C6AAfree(is),dpfree(is),R0free(is))
!
WRITE(stdout,'(5X,"The free atom static dipole polarizability is ",F13.6," bohr^3.")') dpfree(is)
WRITE(stdout,'(5X,"The free atom homonuclear C6 coefficient is ",F13.6," Hartree bohr^6.")') C6AAfree(is)
@@ -2444,7 +2444,7 @@ SUBROUTINE GetVdWParam(atom,C6,alpha,R0)
!
! I/O variables
!
- CHARACTER(LEN=3) :: atom
+ CHARACTER(LEN=2) :: atom
REAL(DP) :: C6,alpha,R0
!
SELECT CASE (atom)
From 2e09e4e26c72efd86701c1fecf95cf49a629a040 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Fri, 1 Mar 2019 16:29:23 +0100
Subject: [PATCH 10/24] *.in files should not be in reference/ directory
---
.../WAN90_example/reference/diamond.nscf.in | 84 -------------------
.../reference/diamond.pw2wan.lib.in | 10 ---
.../reference/diamond.pw2wan.sa.in | 10 ---
.../WAN90_example/reference/diamond.scf.in | 24 ------
4 files changed, 128 deletions(-)
delete mode 100644 PP/examples/WAN90_example/reference/diamond.nscf.in
delete mode 100644 PP/examples/WAN90_example/reference/diamond.pw2wan.lib.in
delete mode 100644 PP/examples/WAN90_example/reference/diamond.pw2wan.sa.in
delete mode 100644 PP/examples/WAN90_example/reference/diamond.scf.in
diff --git a/PP/examples/WAN90_example/reference/diamond.nscf.in b/PP/examples/WAN90_example/reference/diamond.nscf.in
deleted file mode 100644
index ee95b13daf..0000000000
--- a/PP/examples/WAN90_example/reference/diamond.nscf.in
+++ /dev/null
@@ -1,84 +0,0 @@
- &control
- calculation='nscf'
- pseudo_dir='/home/giannozz/q-e-mio/pseudo',
- outdir='/home/giannozz/q-e-mio/tempdir',
- prefix='di'
- /
- &system
- ibrav= 2, celldm(1) =6.1, nat= 2, ntyp= 1,
- ecutwfc =40.0, nbnd = 4,
- /
- &electrons
- conv_thr = 1.0d-11
- /
-ATOMIC_SPECIES
- C 12.0 C.pz-vbc.UPF
-ATOMIC_POSITIONS {crystal}
-C -0.25 -0.25 -0.25
-C 0.0 0.0 0.0
-K_POINTS {crystal}
- 64
-0.0000 0.0000 0.0000 0.0156250
-0.0000 0.2500 0.0000 0.0156250
-0.0000 0.5000 0.0000 0.0156250
-0.0000 0.7500 0.0000 0.0156250
-0.2500 0.0000 0.0000 0.0156250
-0.2500 0.2500 0.0000 0.0156250
-0.2500 0.5000 0.0000 0.0156250
-0.2500 0.7500 0.0000 0.0156250
-0.5000 0.0000 0.0000 0.0156250
-0.5000 0.2500 0.0000 0.0156250
-0.5000 0.5000 0.0000 0.0156250
-0.5000 0.7500 0.0000 0.0156250
-0.7500 0.0000 0.0000 0.0156250
-0.7500 0.2500 0.0000 0.0156250
-0.7500 0.5000 0.0000 0.0156250
-0.7500 0.7500 0.0000 0.0156250
-0.0000 0.0000 0.2500 0.0156250
-0.0000 0.2500 0.2500 0.0156250
-0.0000 0.5000 0.2500 0.0156250
-0.0000 0.7500 0.2500 0.0156250
-0.2500 0.0000 0.2500 0.0156250
-0.2500 0.2500 0.2500 0.0156250
-0.2500 0.5000 0.2500 0.0156250
-0.2500 0.7500 0.2500 0.0156250
-0.5000 0.0000 0.2500 0.0156250
-0.5000 0.2500 0.2500 0.0156250
-0.5000 0.5000 0.2500 0.0156250
-0.5000 0.7500 0.2500 0.0156250
-0.7500 0.0000 0.2500 0.0156250
-0.7500 0.2500 0.2500 0.0156250
-0.7500 0.5000 0.2500 0.0156250
-0.7500 0.7500 0.2500 0.0156250
-0.0000 0.0000 0.5000 0.0156250
-0.0000 0.2500 0.5000 0.0156250
-0.0000 0.5000 0.5000 0.0156250
-0.0000 0.7500 0.5000 0.0156250
-0.2500 0.0000 0.5000 0.0156250
-0.2500 0.2500 0.5000 0.0156250
-0.2500 0.5000 0.5000 0.0156250
-0.2500 0.7500 0.5000 0.0156250
-0.5000 0.0000 0.5000 0.0156250
-0.5000 0.2500 0.5000 0.0156250
-0.5000 0.5000 0.5000 0.0156250
-0.5000 0.7500 0.5000 0.0156250
-0.7500 0.0000 0.5000 0.0156250
-0.7500 0.2500 0.5000 0.0156250
-0.7500 0.5000 0.5000 0.0156250
-0.7500 0.7500 0.5000 0.0156250
-0.0000 0.0000 0.7500 0.0156250
-0.0000 0.2500 0.7500 0.0156250
-0.0000 0.5000 0.7500 0.0156250
-0.0000 0.7500 0.7500 0.0156250
-0.2500 0.0000 0.7500 0.0156250
-0.2500 0.2500 0.7500 0.0156250
-0.2500 0.5000 0.7500 0.0156250
-0.2500 0.7500 0.7500 0.0156250
-0.5000 0.0000 0.7500 0.0156250
-0.5000 0.2500 0.7500 0.0156250
-0.5000 0.5000 0.7500 0.0156250
-0.5000 0.7500 0.7500 0.0156250
-0.7500 0.0000 0.7500 0.0156250
-0.7500 0.2500 0.7500 0.0156250
-0.7500 0.5000 0.7500 0.0156250
-0.7500 0.7500 0.7500 0.0156250
diff --git a/PP/examples/WAN90_example/reference/diamond.pw2wan.lib.in b/PP/examples/WAN90_example/reference/diamond.pw2wan.lib.in
deleted file mode 100644
index a623c61aec..0000000000
--- a/PP/examples/WAN90_example/reference/diamond.pw2wan.lib.in
+++ /dev/null
@@ -1,10 +0,0 @@
-&inputpp
- outdir = '/home/giannozz/q-e-mio/tempdir/'
- prefix = 'di'
- seedname = 'diamond.lib'
- spin_component = 'none'
- write_mmn = .true.
- write_amn = .true.
- write_unk = .false.
- wan_mode = 'library'
-/
diff --git a/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.in b/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.in
deleted file mode 100644
index 269ac53534..0000000000
--- a/PP/examples/WAN90_example/reference/diamond.pw2wan.sa.in
+++ /dev/null
@@ -1,10 +0,0 @@
-&inputpp
- outdir = '/home/giannozz/q-e-mio/tempdir/'
- prefix = 'di'
- seedname = 'diamond.sa'
- spin_component = 'none'
- write_mmn = .true.
- write_amn = .true.
- write_unk = .false.
- wan_mode = 'standalone'
-/
diff --git a/PP/examples/WAN90_example/reference/diamond.scf.in b/PP/examples/WAN90_example/reference/diamond.scf.in
deleted file mode 100644
index b9e1381de3..0000000000
--- a/PP/examples/WAN90_example/reference/diamond.scf.in
+++ /dev/null
@@ -1,24 +0,0 @@
- &control
- calculation = 'scf'
- restart_mode='from_scratch',
- prefix='di',
- pseudo_dir='/home/giannozz/q-e-mio/pseudo',
- outdir='/home/giannozz/q-e-mio/tempdir'
- /
- &system
- ibrav= 2, celldm(1) =6.1, nat= 2, ntyp= 1,
- ecutwfc =40.0,
- /
- &electrons
- diagonalization='david'
- mixing_mode = 'plain'
- mixing_beta = 0.7
- conv_thr = 1.0d-13
- /
-ATOMIC_SPECIES
- C 12.0 C.pz-vbc.UPF
-ATOMIC_POSITIONS {crystal}
-C -0.25 -0.25 -0.25
-C 0.0 0.0 0.0
-K_POINTS {automatic}
- 12 12 12 0 0 0
From 6834a502ef069b46a5efae56ad4c5bd53fd1a8e9 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Fri, 1 Mar 2019 17:42:56 +0100
Subject: [PATCH 11/24] [Skip-CI] Obsolete version 'svn' replaced by 'git';
various .PHONY of questionable usefulness, referring to no longer existing
procedure devised for svn, removed
---
CPV/Doc/Makefile | 2 +-
EPW/Makefile | 1 -
FFTXlib/Makefile | 8 --------
KS_Solvers/CG/Makefile | 8 --------
KS_Solvers/Davidson/Makefile | 8 --------
KS_Solvers/Davidson_RCI/Makefile | 8 --------
KS_Solvers/PPCG/Makefile | 8 --------
NEB/Doc/Makefile | 2 +-
PHonon/Doc/Makefile | 2 +-
PP/Doc/Makefile | 2 +-
PW/Doc/Makefile | 2 +-
PWCOND/Doc/Makefile | 2 +-
UtilXlib/Makefile | 8 --------
UtilXlib/tests/Makefile | 8 --------
atomic/Doc/Makefile | 2 +-
15 files changed, 7 insertions(+), 64 deletions(-)
diff --git a/CPV/Doc/Makefile b/CPV/Doc/Makefile
index b44c40588f..15c0141c71 100644
--- a/CPV/Doc/Makefile
+++ b/CPV/Doc/Makefile
@@ -1,4 +1,4 @@
-VERSION = svn
+VERSION = git
HELPDOC = ../../dev-tools/helpdoc -version $(VERSION)
LATEX = pdflatex
LATEX2HTML = latex2html
diff --git a/EPW/Makefile b/EPW/Makefile
index d81f15a28d..63e59e31b3 100644
--- a/EPW/Makefile
+++ b/EPW/Makefile
@@ -21,7 +21,6 @@ release:
rm -rf examples/*/epw/out/* examples/*/epw/tmp/* \
examples/*/phonons/out/* examples/*/phonons/tmp/* \
examples/*/phonons/save/* ; \
- rm -rf .svn */.svn */*/*.svn */*/*/*.svn */*/*/*/*.svn
cd .. ; tar cfz EPW/EPW-release.tgz EPW-release ; \
rm -rf EPW-release ; cd EPW
diff --git a/FFTXlib/Makefile b/FFTXlib/Makefile
index 5b35d23db5..e4532d313c 100644
--- a/FFTXlib/Makefile
+++ b/FFTXlib/Makefile
@@ -49,12 +49,4 @@ TEST0: test0.o libqefft.a
clean :
- /bin/rm -f *.o *.a *.d *.i *~ *_tmp.f90 *.mod *.L
-# .PHONY forces execution of a rule irrespective of the presence of an
-# updated file with the same name of the rule. In this way, the script
-# that generates version.f90 always runs, updating the version if you
-# execute "svn update". The update_version script takes care of not
-# changing the file if the svn version did not change
-
-.PHONY: all clean
-
include make.depend
diff --git a/KS_Solvers/CG/Makefile b/KS_Solvers/CG/Makefile
index 1859d73ff9..0f736040fd 100644
--- a/KS_Solvers/CG/Makefile
+++ b/KS_Solvers/CG/Makefile
@@ -22,12 +22,4 @@ libcg.a: $(CG)
clean :
- /bin/rm -f *.o *.a *.d *.i *~ *_tmp.f90 *.mod *.L *.x
-# .PHONY forces execution of a rule irrespective of the presence of an
-# updated file with the same name of the rule. In this way, the script
-# that generates version.f90 always runs, updating the version if you
-# execute "svn update". The update_version script takes care of not
-# changing the file if the svn version did not change
-
-.PHONY: all clean
-
include make.depend
diff --git a/KS_Solvers/Davidson/Makefile b/KS_Solvers/Davidson/Makefile
index 73ace639b5..4c72e2ec80 100644
--- a/KS_Solvers/Davidson/Makefile
+++ b/KS_Solvers/Davidson/Makefile
@@ -20,12 +20,4 @@ libdavid.a: $(DAVID)
clean :
- /bin/rm -f *.o *.a *.d *.i *~ *_tmp.f90 *.mod *.L *.x
-# .PHONY forces execution of a rule irrespective of the presence of an
-# updated file with the same name of the rule. In this way, the script
-# that generates version.f90 always runs, updating the version if you
-# execute "svn update". The update_version script takes care of not
-# changing the file if the svn version did not change
-
-.PHONY: all clean
-
include make.depend
diff --git a/KS_Solvers/Davidson_RCI/Makefile b/KS_Solvers/Davidson_RCI/Makefile
index 787b93b037..e594e2d4c7 100644
--- a/KS_Solvers/Davidson_RCI/Makefile
+++ b/KS_Solvers/Davidson_RCI/Makefile
@@ -18,12 +18,4 @@ libdavid_rci.a: $(DAVID_RCI)
clean :
- /bin/rm -f *.o *.a *.d *.i *~ *_tmp.f90 *.mod *.L *.x
-# .PHONY forces execution of a rule irrespective of the presence of an
-# updated file with the same name of the rule. In this way, the script
-# that generates version.f90 always runs, updating the version if you
-# execute "svn update". The update_version script takes care of not
-# changing the file if the svn version did not change
-
-.PHONY: all clean
-
include make.depend
diff --git a/KS_Solvers/PPCG/Makefile b/KS_Solvers/PPCG/Makefile
index d1109d3ad2..7665fe1418 100644
--- a/KS_Solvers/PPCG/Makefile
+++ b/KS_Solvers/PPCG/Makefile
@@ -20,12 +20,4 @@ libppcg.a: $(PPCG)
clean :
- /bin/rm -f *.o *.a *.d *.i *~ *_tmp.f90 *.mod *.L *.x
-# .PHONY forces execution of a rule irrespective of the presence of an
-# updated file with the same name of the rule. In this way, the script
-# that generates version.f90 always runs, updating the version if you
-# execute "svn update". The update_version script takes care of not
-# changing the file if the svn version did not change
-
-.PHONY: all clean
-
include make.depend
diff --git a/NEB/Doc/Makefile b/NEB/Doc/Makefile
index a9f34518f4..838922fe56 100644
--- a/NEB/Doc/Makefile
+++ b/NEB/Doc/Makefile
@@ -1,4 +1,4 @@
-VERSION = svn
+VERSION = git
HELPDOC = ../../dev-tools/helpdoc -version $(VERSION)
LATEX = pdflatex
LATEX2HTML = latex2html
diff --git a/PHonon/Doc/Makefile b/PHonon/Doc/Makefile
index 2ad84840bb..ce01e8a278 100644
--- a/PHonon/Doc/Makefile
+++ b/PHonon/Doc/Makefile
@@ -1,4 +1,4 @@
-VERSION = svn
+VERSION = git
HELPDOC = ../../dev-tools/helpdoc -version $(VERSION)
LATEX = pdflatex
diff --git a/PP/Doc/Makefile b/PP/Doc/Makefile
index 747d851f6c..2696b667fe 100644
--- a/PP/Doc/Makefile
+++ b/PP/Doc/Makefile
@@ -1,4 +1,4 @@
-VERSION = svn
+VERSION = git
HELPDOC = ../../dev-tools/helpdoc -version $(VERSION)
LATEX = pdflatex
LATEX2HTML = latex2html
diff --git a/PW/Doc/Makefile b/PW/Doc/Makefile
index 64d1aaa368..0e1299f73a 100644
--- a/PW/Doc/Makefile
+++ b/PW/Doc/Makefile
@@ -1,4 +1,4 @@
-VERSION = svn
+VERSION = git
HELPDOC = ../../dev-tools/helpdoc -version $(VERSION)
LATEX = pdflatex
LATEX2HTML = latex2html
diff --git a/PWCOND/Doc/Makefile b/PWCOND/Doc/Makefile
index ee198eb327..ff62711473 100644
--- a/PWCOND/Doc/Makefile
+++ b/PWCOND/Doc/Makefile
@@ -1,4 +1,4 @@
-VERSION = svn
+VERSION = git
HELPDOC = ../../dev-tools/helpdoc -version $(VERSION)
doc: all
diff --git a/UtilXlib/Makefile b/UtilXlib/Makefile
index 09fb815c78..d2daed7108 100644
--- a/UtilXlib/Makefile
+++ b/UtilXlib/Makefile
@@ -31,12 +31,4 @@ libutil.a: $(UTIL)
clean :
- /bin/rm -f *.o *.a *.d *.i *~ *_tmp.f90 *.mod *.L *.x
-# .PHONY forces execution of a rule irrespective of the presence of an
-# updated file with the same name of the rule. In this way, the script
-# that generates version.f90 always runs, updating the version if you
-# execute "svn update". The update_version script takes care of not
-# changing the file if the svn version did not change
-
-.PHONY: all clean
-
include make.depend
diff --git a/UtilXlib/tests/Makefile b/UtilXlib/tests/Makefile
index d0422d9e93..e8e8e26d88 100644
--- a/UtilXlib/tests/Makefile
+++ b/UtilXlib/tests/Makefile
@@ -61,11 +61,3 @@ common: tester.o mp_world.o utils.o
clean :
- /bin/rm -f *.o *.a *.d *.i *~ *_tmp.f90 *.mod *.L *.x rnd_seed_*
-# .PHONY forces execution of a rule irrespective of the presence of an
-# updated file with the same name of the rule. In this way, the script
-# that generates version.f90 always runs, updating the version if you
-# execute "svn update". The update_version script takes care of not
-# changing the file if the svn version did not change
-
-.PHONY: all clean
-
diff --git a/atomic/Doc/Makefile b/atomic/Doc/Makefile
index 881a01160e..302ed42fcb 100644
--- a/atomic/Doc/Makefile
+++ b/atomic/Doc/Makefile
@@ -1,4 +1,4 @@
-VERSION = svn
+VERSION = git
HELPDOC = ../../dev-tools/helpdoc -version $(VERSION)
LATEX = pdflatex
LATEX2HTML = latex2html
From 8a3b936bc8f99f9a9c95dd03a2f9b8edb2f55ba1 Mon Sep 17 00:00:00 2001
From: Paolo Giannozzi
Date: Fri, 1 Mar 2019 17:47:47 +0100
Subject: [PATCH 12/24] [Skip-CI] Makefile sets correct version number in
documentation; obsolete stuff removed
---
Makefile | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/Makefile b/Makefile
index 0522f5872a..8a40ce78f5 100644
--- a/Makefile
+++ b/Makefile
@@ -324,8 +324,7 @@ veryclean : clean
- @(cd install ; $(MAKE) -f plugins_makefile veryclean)
- @(cd install ; $(MAKE) -f extlibs_makefile veryclean)
- rm -rf install/patch-plumed
- - cd install ; rm -f config.log configure.msg config.status \
- CPV/version.h ChangeLog* intel.pcl */intel.pcl
+ - cd install ; rm -f config.log configure.msg config.status
- rm -rf include/configure.h install/make_wannier90.inc
- cd install ; rm -fr autom4te.cache
- cd install; ./clean.sh ; cd -
@@ -378,10 +377,10 @@ tar-qe-modes :
# "latex2html" and "convert" (from Image-Magick) are needed.
doc :
if test -d Doc ; then \
- ( cd Doc ; $(MAKE) TLDEPS= all ) ; fi
+ ( cd Doc ; $(MAKE) VERSION=6.4 TLDEPS= all ) ; fi
for dir in */Doc; do \
( if test -f $$dir/Makefile ; then \
- ( cd $$dir; $(MAKE) TLDEPS= all ) ; fi ) ; done
+ ( cd $$dir; $(MAKE) VERSION=6.4 TLDEPS= all ) ; fi ) ; done
doc_clean :
if test -d Doc ; then \
From 7a8a7ffe097606155d0f7685333eedbf705a7128 Mon Sep 17 00:00:00 2001
From: Tone Kokalj
Date: Fri, 1 Mar 2019 17:52:53 +0100
Subject: [PATCH 13/24] Updating/synchronizing PWgui to version 6.4
---
GUI/PWgui/INSTALL | 2 +-
GUI/PWgui/INSTALL.repository | 25 +
GUI/PWgui/INSTALL.svn | 28 -
GUI/PWgui/Makefile | 2 +-
GUI/PWgui/VERSION | 2 +-
GUI/PWgui/doc/pwdocs/Makefile | 6 +-
GUI/PWgui/images/pwgui-logo.gif | Bin 260963 -> 264557 bytes
GUI/PWgui/images/pwgui-logo.xcf.bz2 | Bin 2094120 -> 2100117 bytes
GUI/PWgui/make.usage | 4 +-
GUI/PWgui/modules/dos/dos-event.tcl | 13 +
GUI/PWgui/modules/dos/dos-help.tcl | 52 +
GUI/PWgui/modules/dos/dos.tcl | 47 +-
GUI/PWgui/modules/ph/ph-help.tcl | 30 +-
GUI/PWgui/modules/ph/ph.tcl | 11 +-
GUI/PWgui/modules/pp/pp-help.tcl | 17 +-
GUI/PWgui/modules/pp/pp.tcl | 4 +-
GUI/PWgui/modules/pw/commands.tcl | 1 +
GUI/PWgui/modules/pw/pw-event.tcl | 15 +-
GUI/PWgui/modules/pw/pw-help.tcl | 258 ++-
GUI/PWgui/modules/pw/pw.tcl | 3151 ++++++++++++++-------------
GUI/PWgui/pwgui | 3 +-
GUI/PWgui/pwgui.tcl | 10 +-
22 files changed, 2003 insertions(+), 1678 deletions(-)
create mode 100644 GUI/PWgui/INSTALL.repository
delete mode 100644 GUI/PWgui/INSTALL.svn
create mode 100644 GUI/PWgui/modules/dos/dos-event.tcl
diff --git a/GUI/PWgui/INSTALL b/GUI/PWgui/INSTALL
index b8192b762c..66883f54cf 100644
--- a/GUI/PWgui/INSTALL
+++ b/GUI/PWgui/INSTALL
@@ -12,7 +12,7 @@ The PWgui package comes in two flavors:
(ii) SOURCE PACKAGE
-N.B.: for the usage of SVN version of PWgui see file INSTALL.svn
+N.B.: for the usage of repository version of PWgui see file INSTALL.repository
________________________________________________________________________
diff --git a/GUI/PWgui/INSTALL.repository b/GUI/PWgui/INSTALL.repository
new file mode 100644
index 0000000000..7b43bca815
--- /dev/null
+++ b/GUI/PWgui/INSTALL.repository
@@ -0,0 +1,25 @@
+
+ ==============================================================================
+ * * * INSTALLATION instructions for PWgui as obtained * * *
+ * * * from the QE repository * * *
+ ==============================================================================
+
+This INSTALL.repository file is located in GUI/PWgui/ directory. To
+make the PWgui functional do the following:
+
+Either:
+ * from the QE root directory call: make gui
+Or:
+ * or from the this directory (i.e. GUI/PWgui) call: make init
+
+ * to run the PWgui program, type from this directory: ./pwgui
+
+BEWARE:
+
+To run the "pwgui" you will need the required Tcl-related software.
+See the INSTALL file, for the software-requirements of the PWgui
+source-package.
+
+
+--
+Anton Kokalj (tone.kokalj@ijs.si), Fri Mar 01 2019
diff --git a/GUI/PWgui/INSTALL.svn b/GUI/PWgui/INSTALL.svn
deleted file mode 100644
index aec23a09bf..0000000000
--- a/GUI/PWgui/INSTALL.svn
+++ /dev/null
@@ -1,28 +0,0 @@
-
- ==============================================================================
- * * * INSTALLATION instructions for PWgui as obtained * * *
- * * * from the QE SVN repository * * *
- ==============================================================================
-
-This INSTALL.svn file is located in GUI/PWgui/ directory. To "install"
-the PWgui do the following:
-
- (i) from GUI/PWgui/ directory call: make svninit
- ^^^^^^^^^^^^
- (ii) define the PWGUI environmental variable (optional for versions >= 4.0),
-
- (iii) add $PWGUI to your path, and
-
- (iv) to launch the PWgui program, type: pwgui
-
-BEWARE:
-
-To run the "pwgui" you will need the required Tcl-related software.
-See the INSTALL file, for the software-requirements of the PWgui
-source-package.
-
-
-
-
---
-Anton Kokalj (tone.kokalj@ijs.si), Wed Jun 08 2011
diff --git a/GUI/PWgui/Makefile b/GUI/PWgui/Makefile
index f69d4fae9d..debff34f59 100644
--- a/GUI/PWgui/Makefile
+++ b/GUI/PWgui/Makefile
@@ -79,7 +79,7 @@ distclean: veryclean
-cd lib/; rm -f *
cd $(PWGUI_VFS); $(MAKE) distclean
-svninit:
+init:
-cd doc/pwdocs; $(MAKE)
-if test ! -d lib; then mkdir lib; fi
-cd lib/; rm -f Guib-*;
diff --git a/GUI/PWgui/VERSION b/GUI/PWgui/VERSION
index c064af48ab..c596943a9f 100644
--- a/GUI/PWgui/VERSION
+++ b/GUI/PWgui/VERSION
@@ -1 +1 @@
-svn
+6.4
diff --git a/GUI/PWgui/doc/pwdocs/Makefile b/GUI/PWgui/doc/pwdocs/Makefile
index 56c0b9b538..3d3309bc2d 100644
--- a/GUI/PWgui/doc/pwdocs/Makefile
+++ b/GUI/PWgui/doc/pwdocs/Makefile
@@ -44,13 +44,9 @@ make_user_guide: links
rm -rf user_guide/
cp -a $(QE_DOC_DIR)/user_guide .
cd user_guide/; \
- for file in *.png; do \
- convert $$file $${file%.png}.gif; \
- rm -f $$file; \
- done; \
for file in *.html; do \
cp $$file /tmp/$$file; \
- cat /tmp/$$file | sed 's/\.png/\.gif/g' - | sed 's/ / /g' - > $$file; \
+ cat /tmp/$$file | sed 's/ / /g' - > $$file; \
rm -f /tmp/$$file; \
done
diff --git a/GUI/PWgui/images/pwgui-logo.gif b/GUI/PWgui/images/pwgui-logo.gif
index 560cfa12816b6ce1cb1003f7816f08fd4496103f..6cfd5fd58df39757a3d625175ff29962268d29e0 100644
GIT binary patch
literal 264557
zcmV(^K-IrTNk%w1VZ8&y0_Xn#0S5~T1`GxZ1`i1b7z+&w6A%d#86*q~A`BA_6bTs+
z8aE0L9u*iA84xrN5epj{4;v5*9S#y27zQ34BNh`J85%Cqy0V>EM_bqV=X6VEgFX?3mHioA4NJJMMfe;L3}L}g(?;)
zMJs7BGbctfVl*_2ECo72MJ`1|cQqAQJU1vzFM}{JBTP+rHY9;I11(J{Q9(H;O-OJ%
z793R@cQ-JLGAlzzKt@S4b3Z31R8%oiQ7lwXG*mYqT^l7=QA$uPY(+OMSvWjXQZrXc
zn>!#!QB*QpG@v{aYDq$iLnA6(STS2yIa*h>IU9{e8M!+RwK_F1V_lg_6^=_aE@fjT
zZ6z*hE~G?3tVjttXgoY*VNYZvSzkp^U}B3@COv9NZd_9~Y-c=fIz4MzU13{#Sy57F
zOO{w0g<4CVRV*ibB&AmlVrWBIb0R!;Z$fxPac(F~bZ|p_Kgm`o-BcCVTolP-4zy=6
zy=V!!Xd6d_d_9gYONvV|mnf`oGr(^E&tqUrkwjUHUwndGVvC2Zd?vYhC~K43fB4n6C
zph1Zc4OWb}aHB$m93^fn@epLg6B19Vj7XBCiI*>3$ec;DCXSjeZpy^LQzuTD9XjOP
z*|Vt8pEO}AUCNYc%MvkRB3;3B1=XfOvo?LXp{v)gUAcM{`?Z2uvn0Bnt#ER~+6o&m
zRFI3IuHCzM^XlEp*RF-Wc;^BhOt`LvzlHB2PR!VEW5bIdH#VC%a%9PTFYBFa*6rDo
zW>3J~VBsxT(qK)TKE3s2)()+$E?t4tg;ba>TkBq0o2b#FJ6#CvU6g3=^`pkH_v*=Jrs13lG}QZ>CM;e=UT5L8Y*1?Lk`$PIx9Yh!KD)M_VyB~WQ^+11%$dhzI&W_fXj*^h+@mf4UHkl)Yt^1p?W)no=^Vrdn87!6cgr$+fuEi%QW}+lj52_>!G5
z$!QZ$!67%CaW@qw+yxd=Xy}DW;pQNG4KDcIfz}y#kfQ>Acae7EP1j#|5CKTtcjY-0
zsz{)!)ZRppG8hp`^tF`Gef|P=XOe&aaYyT{?Cu1jTp3$C{mLui$=y5Z>(R3(u6~W#~!NeREjRD>Z<^%*Bzt4MmKAx=;0dc%nB;VTt?dY$0`N@NJL(B
z`;}Lcc?;euYjaN<9a65+^~~wbRku2+O2WQmgAIFTSlfhrc4%9O*YakSoLiZ=+(S<-
zm-e-B*Uj;R74JrZ{)l+OBre_~=C%|`e|v?2KzAXII0<*Dt8bN*Ddyy1nnix@yMNtF
zd6HQwhQa3fg8q5t?>a^$<%nsXy63F7j-}}Q+8deWKTdwxS^F9mx#b5PZZ6_>4P@X3
zgyTK9wQ)ymE!|4(op;8=#n=&y
zw6TsCnPbl6NJv2fGLVTpq#haB$VnzLkAdu?AL*#cPEL|kYP4f0H~B|W%2AE~BPAZY
zlRoDi#EXQS9xNA<0}?cmg*MP45UWVVD}K!d4J=_3K{&x&7IA|lG~g14$jl-7aECgS
zVKi~5!)f9WhdyMW3v~%aVxG{ONd%w(O^8Ge788IN)SweVNWgP`Q-KUTCIZ=M#BYkw
ze#V4+_n*`J#0B!kBbUIL<5ESSJ+gVTx?z5RL=;bq^a6^gukS7++Xb@H)
zL^DNZ-X0Dz$jK9KZd
zK@>^Hq8gQ`75OAmLrGK&SW=A`fTJWwc}O|dg*r}EWFb|#NK<s+;v
ze_UlCvpP!eTve+}edDM46W62Gm9C;ZB^n7ryU{@gbvxauk0|%0t}G{}2r-@srpVG>
zTJeemROvzeNkW09pri}6pb(`;5+SajvAx8oM5Q@Hi%KzwC`D*F8=BeH=0JlAb^a}D
zxj4Ysx)!AVMB!^g+S&}d$00_mTd2TzSccRmedf_m`4H5~`UFdQ%^{CRh}*Q{4k$s{
z36QGFmlooAMX|2wzzVX$wyIENS}plXjlyK0rqPE$P4k@^TXnvYFsPKcf{G2;gf^)N
zg+zV>3j-K17Xq8bz-zIK0&-NB1$!v~5H?GMz2v34#ART8Es|h_q$49eE_Wafv4}@Z
zVh}Heb{H0zgD()l|Ylnrh{;Lv{T<9{Y
zm0^U=a$`l`t+k3fOAD2le|8}AxW`rVv2WAJL+JOu*Nh>VPyAdq9zL)6RmIiwP?;5EJu0!bvBbF%b2v)T
z<_qo+7H%Jd?!^xdfP|M#>|#6E*v9TsuX{~kU;lVw;nfP8NJhTtfO3yBOKKX;wO3oM
zn!Ty{idYstqX5(GD`_EgrNyj}O+os)=Gn*>mDXO8aJtQKyK|%dkjrPK!3rYCg)hpX
zEOJ^&+RtAEBY~phUhBwwXKfB{b)Q1Kn47QABCiO~1D!srDa6p{36{r~8)kBm%K`(A
zy3_~k^wIdoSLHJK*0`GFr^(eKc4U>{A|xD`c==3SnfifuO>fSa1>VPw`?1$DV|An3
zOFgYIVyLaI1fy$rI?^$<0}pP$huEjvo>F5F-)+n=UP%=Ox46f>u5k-qU95|ov7vtV
z2cKoab02mEL_d0X%X`;RUwhQS@|y7eL{T5vj&(i>$DtC{y09u&(;em(r%(O&TXOno
zqUtO9R5}IAwK&XX<=#xSig>OHmdTms5b8qTzSEx>aT)$}zN~RXB?cihbPrNAR>D+j
zu;yBHb%v3mx4*vCA1>4ERy~&yZoLj$we((9e1ZsH*T46BGZlRQ_gxQhedp(ViiQ%@
z(PVS=5pfnLGa(dR1{+=xfKs;>Z1-Xa_I4D;0Cv}T==N+Fuz@Z{c_P?XE+%*#_IDK4
zf`y?uiHB`XB4SxWgNo-b(S~7n*EpA_f+@H=LWn!_hAtf#gmm{}b2o1lwsvlZfvZ<0
zLBTeO@)B`&9T0dMMXm(;(WHUg=eUUJ-myICWy!7E*R|@6mr9H-89NJxoS@hE{W0
z!)Ma*MHm5TAa@d5s5D=Ah5e&jlT}*=6;KRCO#Z5sMBQXdTeL+ba76v2Pyf_U2ayAh
z7(uU8OO>cn$FgfXo;7&LN-u|shEg@_(bot{))VHP+vm=01!{`BtrG1OhqI>NWfYNv_KAo
zlN8iJC}dkanUuzah?Ce*>m*RhG+FB8kjvCeLG%+oBtAd{Oju-0IGIZYG*1eoL_!Hc
zWqCkLq>83h6SY=qhSgmbfOf+J7PSZ#adQv`awhDxBdL>9UqXOel2iABQ)h8vq7!^R
zbyFBHfHt*Z(pFY?QCFfQj#Kq1rZiQmG?`k3R+4l|(kND81y@WZYeuC>VuhJcb(*bK
z7rlcc#Ym7hb%TicBW~ds(xy{?MLG6JShopSqtknAIG1}PJ*!cd5T|fnftRBu6>U-z
z7Uhs;DL^`jKogWjX9-XBq(CA5q(w`_O)PX;Q#2Dn@Do^YlW_Gw-gqDCQ5pz+qg&S9gUg#iU
z1ZQBhG*R|65AixXmx~|B0LNBu_I4Ig
zR~HB-Z1KipHs++lCM5pzHjg+uU{H6X_x2UAX`>2vCiw;%-!nMv<31?I9Mc086Ka0-
z1xuKUCm|xDXX7T`Qhyi;iVylWHq(Apvt*~*eVJOJ96@x=ML#-+5(>IX+i6u-50f0E3V>Np@ZhL
ze0HKPvtH>{XO`9|-1n`{>KaOMvsn
zu>p6mKJO;zcMt1@5xg=Y=Jgj<5Om(TDCV5LC
zohsSMre+4{#aTuZg
z{>!#%8@~ICzkoZg_M5+dtGyU($XGir*+ZH8}(|hge!a$3Bm~3JrVpor;)P3+oZe;!&D5sNLZx1_J57)bh^32NenMO{JS_t
z!}7+2E!Gz{)qAXKi@jWcW
z%HypWoHloPeV^>fZ-N{ER*H97K6E@~4&$K3w|{%a$m42!vC6;xJhlU^$UGMSL=;cf
zsn87Vl?+Xm@#N4Al$I#foxyZO+*y?jBt!*;pW8W34$VOpt^h_~y(i-(bF6}};^jJQ`QL%_IXlI-SIfjAx
z)K0z3Hgy=i8GPMEE(39!bV&lg{5Ke}STkKqEip_s@Q7d?L@&`q1(8a_S$k1)WTask
zxH&oq5;dh{g|-9|PP8|wxL++HOd76VU
z+AI~@y0p;?&7Rb`PpTNvr>)SC2;1c}+zlFJR7ECPO3<=GTZ2F}~o*@(=YMGi$-{@1s*oK^M(Np>6Mn$
z8N;Vz?SiPNlcZE)Im7oETM{NTj_e0<7|NNmDgoi@_3Nz5q`F@2&@7iVnzxjysqG7A
ztV-%{{OW;2H&?-^=U%Ep>&O8O@1icWqul9tOFr0gw!%U@NBdGj3pi|S>XPp7*i*`1
zOVbkH$fUj-cH#oyd|op#&ko)(58pPQ%>wpAOn-a4ZKX3kQ#C9}~o(zEWo
zdTIM3a(794oJy-7I^}lkF%K7NmKvll54n|%3BQ2GEeYH>!JEC@*$7Gc>m~@{>B%x@frWWCQJ&5jJ|MF3+CmlI4C|&!e+{qsKTGTH3;8KeCg{%V*qXw3(_C=K
zfJVg;O12-3#7bHNw243RldNavpsk{d{2&_YdWEY2p1RD*&-!
zLx~L}1RmUQLZQME3`;b0_)y|RiWMoEz-Xc(2@()Xa0D4rNu4GoF?6HTq8L}W!0O_r)~Xq^
zy14ok>{lFRaRm9g!iEhKYu&mv`c!Vkj1#+N3~=}EL#ajQUd*}n<_fiJO^8LDSaH_F
zSP3s?i?i<3niOH0koouM$ju?8TK>*#Hz(Jk9fTsx*uiv0!5Bd=jY%TKiI*T**1nzF
zc1n`6d51j7G3MVBGZnr(dfeo4g({cF4v9g!$%4X_j=U`$LkjKOyL*>TLc8?r;KPrP
zjzQ$kgFW59?^&S&288k}Y_Kn1pnZfG?!$Ml0-x9uNF?nz8c)3hxyw#L2gzHIJnwYl
ztRaw0LXR`%oMY}erd*m0sfQwZN;sNCx~(_gcB3st5PxIwH>IEpjWxEka$z-$P}9pR
zj12oQDa>G-sY1;*8|pKnvBaQUEU~uMBJ8HtCUdIBxcK6$$D#so;Vm=I
zL^DmdCbA(+iPVHsO2uqQ{tT@k(87w&D#d#1v$r0CE2=OtvJN`XhU92S5n&RpO^R~J
z0Zk!x3AbsmjP4QIB1l3q`LDMq-e6ysFYD3Y*-AK}nH&s&=DF@qv6*>b%VI9Fv2>0EVJq!3nh1qQLBlN>GK
z%uw$vGqpV*-qcJ>B{h>$NG)p9x{geY%E%dMx-O&3h*}F}QdM?q;;;047_vRDG_x=@
zYjQMaICtimtpM)+q|}B<-O_Z@ASOk+Xd#YX8fl@ChI(ilHVwkes@DqoEvYkJnrg4V
z27A+}DIL4)r=KQU2uO2K8`83+emicoRZGh`qPZ
zUhKNRcN%>0+dkgyw9yuN?y=Q3I&Am*cDm=SuO?bkx9CQjY5jq=yZx);4qUHb4Rv
z@Jy_ElL7wIbf>8?kbVj*otj>!yGju-Yp}D}-!7%W1%hpF+JgcE&s2iLg=B3l5}xSR
z^}E2408$)zA?G|dx)gd&Rx0#evN)&1+8n1`=%SqqZ)YYFx=>*!02m5i0S^lur}uA
zBso|}5nYJ8HKCDqQ?z4nXtP5(u8WYLtDy>K*g_$~@P?pUVG2_eL`Md$gCPWA-oOSY
z#^o+|6Rgw)u|`1KT?~}FgW#D&D8f{(%rG=-Wh@nFg1p!SFn$@-UjD+RTlOV17Ew}7
zxc($2*Bt30#uVmtj>1dKB*!GCBH2`aWEi%r-&T0aMQyv!#%1
zt!h>KlF+`iHN}K_b3(21Crb`gu5=EoiS$gTH!qY&3t1$OFIwRV7KE&bezcs!f}@Lo
zr7U=%be=5QrWSA6nwM2`n#Jsl!c?M?T>=#}ZbGI}lS<571`|vr>Pt48T2x&&RjI
zB7WMmrOTPkUa4qUjapPaKjdpn;lIfPbteJmgmyPcM{3Xs2r<4Zk?s(fwMqU{o=
zX2&S6UfQ)TLpiH)nzNx>Ch)3D64a868QtwZ)h?9z>P&=r-SF-uNq7A&QSu@r^oI9H
zUUlzA(h8b_#P>*<;Vv+XnKHNva*V@a%4_8EqIGVorXf{qt-kp#+M;Wlv?VBS!y}%A
zDmReD3FB%F8%GCgI9(0?=eZ)8S9wZ!Mfu!LdLq0V2uVmht+k^>m-Qe+~UhZ_*fbS@oYJ3Q;>pFHuCggG@(M){I=7-M6C#aZ8?|F%-6mn
zT5El|{AJO6iOf&wN>VlufPrYY%}XjKd4Z`Jfy`OXzl=zo<=dG8JwzbAn$ejX>t(vG
z70gSytul2Qn-RGaBFTbsWf|;JB%^A^8%|e_jqF*_`cIDD8+jYy*B(nk9z%Af!zPzJfsC)>;I`XmZ3=#g+OBVlcdYq!?^&0l=K}s2q%#)LvqvT(X1ch>
zsbVIycIOi3E$ewGYnCO}M7gyLdJ0*1^fl*w*`8N&%0K>llaJc{{LZ|@`~C1jFudc+w{^qu{qG*H
ze#beUcDG@SX9uS{&+fi6xb-OjfGLPmyOeLGgo_~co=dm84OcTZmLS<0&iqZap%a+|
z%=0gice6h!lL(TMzmwWO092;O>WweTG34s73_CTNLNJ%|tzz>vT!A!sNvUE{tx?Og
zaq*~8vovXYqK;Z331lslnyg*9G>#g!6x6JGvNlRHwGUIW!ooDjf}+@BG8O5l6st
zTbGsaHFLVOl8C|Ch`<9Awaw})Dhfd`@*~^Rs4pf?(vxj`YZn1jTNsx>Oe?W(m%!X@dg-!SaABYJPxE3kPl|Rd?
zhG2z}#L1lONRk0Yo%G3%LwTS$oESU
zb9;!5EXv^|&X6R_vLwbQ7>R?pmW5)Dn=Hg+^>#Msl=Ir*z95^DwnMfj_X&3$@S~xHfb$MGkz4P~$L?Fen1O7stF1
z;NX>btVGA^5ZpQv%B)OZA*1>ul6*S}Zdr)x$c##4&UVuxj?goZ_(RyN4x|t(`06SG
zxlP-o3oxvVpa4YLME(tlv0$(>EQ{cnGv?Xj3?~)8o_!?4*cRsM9+gQ++r}X1lF{I?NW~A`bB}5jDbMSx0g^
z)PsRFNWDRFgwHjqMsE_%vFy+P)Q5TqP_$e|1g*3P6|uiUf{6HH!-MV@+I|7KKE!Vj5SVLei&lE`o5oG#Nj6%^En+
z2QU3kKZR3H{^i$v)z|(+hgNt3iUXy!VTF7B*EjvoddP;5qtk>X(}m53vbhF??N5mH
zPfy)E(tAGYaXsP_0*{qF!!fp@XuY3Zn>&Do>h#Iu4A>{&IgbrKl%15>&MTcVmzie1o&aGYB;p`$^+Z0EuQVnSaNI@JKw32c)&%9~!J9D&o??8CdKBOk6);Dg&cfh*XqBiIZ=xCml9Ix#y15*0qt69~!^
zxTvMUh_iCdh%Awes(6BoMTczA;T=|0bTHl11>(~cULGdmBG%!P^x@4_-i2)iia`F?
zP4Lfn$l)IT;UKnR;ho|gJ_d^5-ONQ|AGYE!#$qDgV(~g&eURcEKFKN$V%*K*CO)b~
zBasH&LM!uD4`J3vjly7gLp|1&B#hKJ`pQd{HYCtg)
zTI2ju&s|+WeS!t8OJtb^Zg2*aUbUXMZ;5DNg5=9Oyy&1AT^Pd2VAVMoDz;=7t_k_G6SiWQw2`L7S$0D%R5TRzm;nP4lqUmFL8-w`wJ?s9?h`c2y*=hji55wKC{Xm6r`Fn8MZ2Ry(+iP
z=Dq&wu83=Eb_{5qYrKeN7`BSXXbg-Hi!AYx8m?ij_=9Y~T$uLfG(H9ihp!p_Y5HPSX8df4_>@rgFeo9gmslkR8KOXtSl{LSth=4O`sgCh8Yg63{8
zmTd42N8`d54_rVl8-5~UrZfYGqhE0$s+1LbCtp^qF-FVo9qXV5eYLP>#A)sR+;Q9FUMVvM-
z^op-`u`?caS9i*}pSmO1zr&ysemmkl;d1{z#KrkhQnzmteh;%OJ-Z19?{
z`Jb^z2O|>n9kzcq)hn=PNY_M9I6Zx7;c>e4b^K%y1&dY|0AM?{i2Rk^N(JMa0KRv{^
zJkjf0#Xnn(n-n|XX=e9g=S5qZHCwL7YVZC_q&>dT0qXfo`CJ=Hw
z_-CQMkP#agf
zvS;<8wcD5O-K->F`72zwUq6u~v$Z-=HY&QcY}+!7cPwvSqfq-|?hH2URmWtnQmtAV
zs*QPu5wC6d_Sis-QIkg9dGn%9r!$Xg49XN{&6+7=65q%Yp>Kpwk27y><0bLr&Zn!i
z$lL_>?8XVYC^&HY^X}rsn;36?Ja&XGR-A9|{yqHhI9%YEU;n;+{QBdg$KKsU04`+L
z0e0;1N1uKPDp;QjYPCk$LnIk^pnxW?vCwwg@ixEra59;2yOETDU?0E0~*|ffIH&u6W?eTc3j>$ruqu6E+*)
zx!U=#;k^-B_U!(;EW#MDYj7Qttga?xgK%X(+Gs0G^&T46F;7sOq-?ZNoaYHe-WX+*
zoI=T}syv};rH!5%^<<|o$4mm3n9&7TT`4>fV~20WwMl1j?pZ0GP6~QwpK}HcCo7^N
zmRLw_W?U&cqe9&?I<4eF8
z1y*Jv&O@2ox}-8svC4WPvzx1wVnqBOUxVZ(%KnC;bkL<*yoePnUL`sC*xl+fu1hwv7ucH?2$m5^$Sjz<;
zVaV@#=0P1E19?9B0}YAv2Q;P;MLxR2^Jo>BwIIp|Fwa57Rm0V|!Pv^d3}P#kp2L?%_2z3A_2Q_5suE=WERsthCl^W`sf*9v7iayHf6
zlJ!2tvYMFEZMHH&Bs=y;!?^^8#QSF7%IUYi>9C#d>|q%Hv#%`L&OOnB;<=*eg3rZg
zi~GqI5bZfFDh8pT1}!KQ5}MG1GE|`sMJN>Xc
zj?58_u6tb&gm6$B2tf!eHHb@FDuj-n6fT>PX-sjd)19`o9#GQSWiVI_&k|(fgb*Z5pYHww#)ZY?Uti26xagFNIsJ_$&25o6Z4?chT=^bfNy;&953M8-(nt
zgr+q`#}aUw(%j1QwnAtl#9o72uO8m
z;kC*Z#k5VXi5)CewUU*yHnwpJ{*Vp0(Dkm1Jw_{@Kv>WEwa7QdENBV~76e*Nfl@ni
zHclJOQcYwNHx5f?v3g`1)7ZmEO{+`~dl=NFmN74$?OIoy<};U7tg&VDaw+`bogVe5
zVU4Sti)&%y!g$UzJ}z{1dQg=X)wv8c^ng1uQbc2Pz8Q72des}=^zygT@*S^v&pXlj
zQu@&k&8Q2~RiG7Ypo~b29f|TeqAQLEz!3W4^{sHaV&h54aEXC_$8z8Xk0mXkxh6z4
z7JqnwQ#_hHWh!UQXfUgvpZLur@o^8Al*-=Sa)Kq0F~7oB9?e1?
z9c#-RM-&UEy1kj~b@FXwkqq{&G}2DRt%#gNpCZyz{hv`6C|gN1PqjvEts9!UTe8k#
zs*~t0Yn6JSRoqrSlPGmmGi#vmakYo?RqLyx&RXL-{^BMiQ%5^e1n9-W2(jl5%(`o5
zV<0*3Ci0k_C^H*lGmrK-rKj_mhr3EJf8+?^t?xzdO;sj?`MK8}?wp)VG*yz*ru4mX
zyJh?jtypYHfc%FTpqopvT;=OuroX6c0A#Ejxa|cl@PUi@QDr{H?(0W_+OzU$YQq{j
zHUYAuM+b#A$(UJ^PehwPcRg1xwW(2({$j)PYg0bwI3*ny6I^1BzYP
zVMqt?P#H~~d7xdSz)rJBjywg?*n!R;$X!kTWy95N01CRq24sYR8Jh|A9mVvT>nO}i
zv>%b2RqzHyW50ZP*79vIplolsMr)ZPi0A^2&KltD_HOcTKI+bTUlhD}_VDW4+=jhx(x
zE`1vzITBh}TgjMTHXX?`ts&OvUBz
z9gC0}08AYaDGM=5ow8Km(p^XdcHsWxXrNoDoz{`jK-HSG+yM!?AlsoJc9`M@$e^*I
z101Q74PwM5G=$z!TsC-*l*mvl
zA|GS9iqVYWD;fam0;)>|n#=zYBdXDp1k%&zXdQ+qU@bOXHO3k|sSCBdixnN9
zstpt>n!qqV$1frg;)G=^qW*^wg=MWlsvAGTwV_>Ex#tB7Z`@kSKpO*n1S
z_fcX_V8@Zbpb3TBOV*~}VB!qvXN!bfO+bf$rr)tFoqu4U7+J`$ut?@qPJ3WT?HEyo
z%GzI^+SN%;>-Ae)dxqQzOEN!NodCh+)3E98`tPS`~dl~r!JRf>@ng#}lK373=P
znT+LBaIw@9Fj?BvLy~UUQ^}TaeVL5a*q8DYSc%qUZ5Efg)RC#xW-*mp(J5H))nN6+
za_}ivX_i3*>RK5@FB#(6ltf!WnRZ4D#uREw*qM#x)|N%-W3Ab5si(;u;!RyCm&IwD
z#gvp1)tZ79aCPa3Iarp0s#T5Fa+Q^Ai5PGp1aO%uh|!s?3Kx-bM4TO3rLn|-(I~MN
zD@J8kbQ#3{NL`4r4r{X-lnbzE5VXg%p2tAAi+Y%cK@>!*;hGmw1dr}ZwRXpG)S8VR
zq7T@BvoHrZ{wQ3W1a%C=IcBGJwn;|>YDYX1YsjON_A66OYFv31o%SnL428kwDWDF-
zo&xNo8fu;ngc^zpV*M2G0ai+|m7Yo}z)ESs9t2!zR>yvFG_{HHRiS)l#JpC<0=)KI-8RQ~Y%6@ktAT{;6^*Mk_TPmZ$9Pn$wXg)assu(@gtmHzdmKczaL3@fM-afJ
zR(9oBLgk9YXu@#jFHTE~tlEfdz+if-yJkZSv{T-F)Ee<8e`Z7sfCPJPCpyey^kf8~
z>}yFJUM1RWQ$`>6#1NTU&7+8f9WLKCO&dE(+X`)>?@}Tl_R8IuqVpo<^bQ;vVkAj=
zqmxv?22_CecCYtxZ}@tzwc#GfbfoWnBx6+o28gftmZ3LhgI$HvNQ}}486i?iZxqtR
zMKUMlC*M1ruOo
zx?t`}!C?1~85~ZxffO-n=Pdx}az~+-cn>dY=0uzb;cH9cq
zV|1ioDQd6X#M~37;2EM23Z9`UZY1}D@A%d+2GDUGlkW+HZ=OVKbgFL*3;!nK8xWq%YNP`o5#YWw4OrRF<#}BMVz5OEZGy{tB?LGY(*i
z>X0u_rRGLV4eRnRpJFV(NDu2*zI0;_2eU4>>yg669XRGXwa5ybE8QK#-z40V`cYDb
zQzfgAB?B;$l$OK}ZyLoz@%H0AR^slu-^}T+A&;UN12aL#F&q!HLBsDGw{f0`F9TG-
zLqjwJMD+Mhv>;bB9!J>#pWHFj@kCp6_)_!<_<)Akn@RszD>!mSB((MxG(b~w?ICpS
z)vm4dUShlsT@@x1kFsMSuq6^DJUemANN|F-vaAS6-@Q;Z$8s=-u6CH>3rX`alCU&q
zM^(QBR8ut!vWQDdCS3EY`A7`#&F$WF?iw{ruORl8z#YKCHC)4vN$mSv!zMIV
zwQ01XMoMGg=l{xe&c(C0DJZWpkBS99=<7GYXkE^cXe~Cbr`d)ev9*lH|C{K0BUtc<4(Vlc)X3`I&%x9&*929j;Za_q)F?AoI3z
zI{-yMy1#5k1lxwkhDOW;ITFXDf>U-Fg_P^33{kl{Aur*?#6r9D8S}&@Ty1v85Y3n#
zzTsOdWVX05iGJpWc37sA;t0=egiLTa2-l#x&h5ZjZ2~b+E7*XJeK;s@*4b)pz`8Av
zx2@M6N8BDc!3O!m9xRLFxW7Vr-CjDTvxIiYW$gIIhBGdQ8^n_5xw;;%K9xGR-tBQv
zxN~4Db4Ul?Iykk;dV(W3M&SU18^ESLD~;MfgzuNKF53RJDjGvw!-dlwV_Da9c(WRT
zbG(XqfPrgnN!LLv0StPQw3yvO^z*Slon`@Pp&M;eAeWIJ{J`yIS{yc2xE
z8$4wryr^7*usDZHAVlH}OK4_Cw-=OgmqN?
zixw2K^19U@gs>x8)?=5lI+qQ+7q8RkLm5D~kp9u^)DteE+OKowFvD<%qQkLAV_f(^
zQt$l>1#PZn%~5BE8jAeTn&3ALKFx<>ar{bA17xFsd!ZPg+^xkNMh$0=3IlDz6Oi?E!B8z+~Nx~^H{P4s_kXbY$;r+m
zg9ix`JScF53l|+$^pmKMVm*r&FC3nh!2-yNIKY3M{BZ4G+{StDiU%Dw|CJQx75ZOvon0pg2Ou2iROQL9@+n
z6soD|;!#Ycj?Sv?H0DaPNiVqO(h8l9vhnDcW2(#s9hATdYp$N+0nR2HHDYVZY+CX1
z%Qe|-Q>AQ5xa%&NTImO?Ht}5ZNWe;1s4;`Gu~V@;2?dj}%dqQFB-SjeN+}j`ylp%l
zv18OyMk^Z)JsGb%Y6HV~TI$8YPT0+-5Iqy~x#nV84z)yIT@}{pU}CP%S^JEtNn9n{
zF4yF8Ese${7o9Y;U`75?&%|YAWbZu_IxxsShU~NOM3Ann5W@$fEs??)L2QLKo
z+Z7D(ub~S6vsT*;;cf53Q*Z3-HUkMn=ss@`L?0FI7@{j_6Rx&8
z)2vOl?9%6-E3()oIZxOi%@u)8y0dIJrSZc@lU5p?O;W>^#^Xq`4C@m7&8jz-j=6f)
zOUWj0u%?FSR;puv<<8f-S3oxHUVD9bSi#fI?_h%s
z+Lm3125eB=ZT=6uw!Qq;9XH;B%iY`|6F4`w;BU_@h{9~!4c&7K8Jrj3ukU4@z{&yC
zmX(RW&Jj%u*BgC4_@3aBVz3{^Pd!JKqPVjhcf{$jCns{7nxcNP@Ak=;M6p
zD@okwHMbYtjfPGkVcweLJl6>BRyJH*52+JG9hTsLH;fNM4pzKj880Nv63~B4v^v^J
zabKe={@uFVCAxTNNQ+y{+=W7StqBEzjAbGD1O(L11GU*%(JTw$XL>o7*ww
z7)Lj*v5k9NBN>}B74oP?Iik^wWEx(M;K0Z;7HLJw6UruRa7G~r!3H)E
zLf3j?8?%(LlchA}DN7jyRN4Rz^SH|P09d6~l#!FDT;G=FMx{G=vXg&sS(UEzhhA#Q
zN>{4VmdFRYZ1B>PwJc?t&UYo3A+uhdS%NAvNk$i(l8hgU<}`5`B)S#FlsQ0U4$!$u
zRBp1A&g|qS-N}mWDYF&Kd?zP`@CR62;~HA>M@RSx3t^hmlujYR2`6X}b()flrraj}
zDKmLWciI4*1bxCQ-*k*!y3Qs_F_32N4y2wNhwT+2%qaxwhN2S8?s6=(@BKgS2p-PphegrBS4G;tz
zT$PbL?J88e*+AIgk*hm}0&QX#DMN0;s7>{%8C#*eP<97KE`hUf@TFv{*^yMb6qPGj
z!V{jb2`q(EoY`pXLLE{{fy4l{cW4=CQ8iAfMCUXIJ<2If@X}7^z$SI7qzwM+Dcer6
zLS%C3hsHMXgx!{)X1*ms^#<3cPR2H*D_Cerh+6_1(1t9x5hf}-O306HqNjD$q)BV)
zOwy{8wDVDpaK+wZLw5>l_0N*7gqgr!F|1
z@vzk&_3%!^<|0rX7d9fwm5y}?BCki6r?Xa2v5N!of$%~sVt6$Kd0MGokaDzy3=af)
zVA`0v^nFy;>urY>tv%{63}+ffnb4~X3hq0l!NHCKSo3{dk1D*n(IKl_<5f4+>L
zL`WF3y&0pwIpPsvAyx;zh>Y)Y&=ujsDbpwlyE8K44I$RV#Wk@&{9zE3cihF*fl-U9
z_9E(1M>;BQ&ea(!TH^ToO{KRT{%Q(x+Iog7UJ>JsZ=Jtp
zS?Q@O>+$-X|!>9e@fyB+xj&0~B&)LK&Y)DP>mgr632)&FZmW|m~&IFDD?$&Gf0L}Nv<^*^T$Tqyk)wB=xQUz@kg6F``-~KP`)Q;>XuOKeX>KdYPI4Axx1Q9tz
z5w)$>por=cP{S?<$S&vTf~@=uhlz$ITHOAQ04I;=+>l)sP!UDP2Jr6`4MYNS>lk7S
zi-KSY;9zA~VV^GV_|i)6+^72rM4NQ&K!U&px~-aW%m~p)+>XR7A}jF}?++NsQ7Ga!
z9Dr{)z)Xb9k3OQs
z;0EHS?5sA-ORAu%4s&mz#E~3@OB~gSAWTsqve6R7(bd$CinI!i;^h~K@r<_0j2=WL
zZIT#`5cO(Ol6+Ancaj)a;1}1$CjNO5C|4&4EGHVAQ3|h>BUUk2RA0nz}yJ%9%)KgA*Tv2dOSjn)@R?$
zZAw}J!h(R3La8I};HfyWrwVV7;%-C;3?06)V$RExXbPU->ApM(9hK?7k_y4phzVtA
z2@La$PR$_h(GGt@xa^5CRdY32vo-%|mYaPdxQ
zn?#BnF;j+66P4T%AFZjtPHhEB^CMrhq~L3~7D}G*DtEl`f<#H0j7dxAhcAP|VM>VS
zge@A+(~MT&<$UZTSSr16bd^LBwpc0=TX7o?qAR0r5E&6(R?i`jF!hjdvjS^FCUioN
z?kCGMD-py^i85Zg(g;^_AWm`+q39~VMJgi^b@ne3=X7(lsnrnCT#OPvbrM1twKsop
z0UdGGE)D4v0vI3ub1hP$Q1Apq`ZG(eWD{Zl0yXT>9PrVC5yz%P?5Z(T*v%lGpvv&E
zVss=zOu!jMW$;!_bV>wQ3C=V6O~{(XAg1sgE9M8o?=d_x?u2GZpTgf_)HIpKV@TAL
zuH{BKjz5T_Q+NfTi~<&5b1{i0Y5Z&>Lgi7*iX1!7Q_QrfIV*Jh`8c+~)7O#mtH{*H)KV#In9A~@ph
zVkZ(1h4m6W&C)VwiSp%hbTC6G5&ov=>X>d6RTeAb4@FG$+DI??BM!nwB9vBjaUhIQly+9>pr}JEZ=RU-MScwei&aKP1PGlXTIEbK
zcndom(^&0|e{
zN)GP;JJhyn#UxQct?Q@-6Fo6v16Au#B{n#TEGx1;saXToH{7B6ox7BCYkmydt
z0hbQwh|Skd)^dGK{_bx>OdtT7a_+nm1`Tm$nT*_Ymo2FzON!}ac2T&)UutWe3
z>*z1jz%Ij#S8r;78KOO(G&;F>y*6Q=`MIC_
z`40g45ANU&;2^LX>Zev}v|>t~Ds!RW33`PwXjAF0sFayx)!T-mlv;H#&4QcIC?S-R
zu%I&tB3aI638+lz8Zs4Zao=gfsi%6lcqW!JXqIZ~o`hft
z;ORU2h^XI*r%4K_>%s=4l!fw@N9mfZHwl>GaTC}{rpLOa7mATk>7EJ9yN2>4hf=>7
znx(c8IkVBF`r5CBtDznGu@zdSJi5R}8nH*KvIV=deG)9wa~;c*!1CG1jsc>WQ?N4o
zzc}eRRokIQ$_A2mE|bd!Zl`)%p{H%&_T~~r&5@!>(xXZ8pozPTZaOxv3Z_(=Yy}3g
zZNQPMHaYhio~D|ej=O4~;5cV`lM*SYnfo`OKsBqnE{r+_s{8%~C^M;rK&q#@y`@@w
zSMV5~8VPo~qTmS$&^rfW6|BM0wcdy|5p28nx|Glf32fkAr}PQ%$(%OHoa~!2@tXT0
zTcTPTp;wzGJsX=WTck&dvRBH!U^_J#+qsX^o>pnZN4mAS%BD1%mNc8NR6N7YvpU;I
z2=r)*E%xAqwS`$VQ%#$i(*_THj${Qw4{uqA7viE|Ea9L3}5dz~wL6l8G65^24E^*MjPabkOAm+)D2vz`>AC1CRa@|*`)qJ&F
z)Q6aKm8EABr-;@$as}3MT-XmUR*Ko>0Wa}V0l5#~4wVmY0D~P6bKLFV)zpFb>xx$j
zfp#cLf}&k0G*$q{RCOpmMbpg!g&N~HzCGNL=pMV=RMTdAw@-KGcGQo;&AS*oF!+T4
z{-Zd()92SFK0Q^AV$m0Ulsg%eA)e6xoRj(Ipg1{^;rIzid6MJge^cNO1`fwKB3Nx5
za2r0(Paq@9E71==&yQl^(adg8p4NeU6Hz#F{=&%o%;RsWc{P^9S7s082O}mB?KqZ0
z*OUG`iauEIMr{a!hm8CaQLR)(P1%|T+31-j5atO%5!OEE0P|&b2*PD&5Z0>L|G=)a
zeS<_eHppd|aSRp;b6Aauh}6D$A)-8KbEYZg&C34-P#hg^OMU}ZXhhOSYXVp4k;RUu
z{0VMo10sTZPc&b-S!{(mQ3jrCgnEB9xoC)EFl2tt0(g=!V3QR+1r7@11%35bKLs=%
zc5Z_N0DY2c{{&ud%6GZV;8!?sJvRKjf{P+J-Dcq79N|ZQ6TB5yWF>-z{>zM>gbXCi
z|IJxl`X(hjoP?Gi6tb9?=vn*OR0E=}}0W*DyGA?p-$}=!U)Pt3KOFckGTm?hiKE
zlJ5Sc?f%SOB`0@w-!$C-BAdQ}`sx`xh!9~sbjMb#FahzQ!-o(nMx2N-q6voUdIb}@JQ!~wx)s;_`RmtDAG&ORO86|X!KaB$2V1^W7!%!}em8T*
z%ht;0hN)D8R;_B{YEX+S;vIdtkf%tCRhQx%_*G`MV^XdDEMelUT%YI&8a*18#N53;
zPrR*5@T|M;BV;LWdqwI8lcVeYk>%6q*R)h#ra{mB&%YuII@*O`0)#wA`m
zSr(mKC!pq?VUFo3X#O^vYz7)gP|M#_7^z2AVk+e-`yxr%(n4*yef_j)g3--06qq
zfOft$9<~C?#nlSh`s5I^B2lQ`c^NjFUWq9c38au9qR4KFB&mpFy*JW(FTF3q=t2Nc
z{0nfv0uM}Z!3FCGtf0q05yZejJPdKf5>Gs_4HQRgL&gsaAw&=wUkviYe-y=IOa`F?
zrc+R5%yP>%WWy4aUa@3Xt~)*9a?Td7pmWa|-(hlVYCT+{&l#hGYr;M5bd1qXXPoDC
zjS7)5)h=7j{&5aMFv2o3L_PIE;4m@!7r!|1?akZ3v+xhQ
z9EANKPxSCgVINg9E2Yk5CSX}BNCu^vNoFlZa|rz$h!Gp;M`y=~$;{HCst59{XPa0~
zn1ZGLmSg+@crAFWgbM!oa(}q
zTd8r4xB4Kc&RCB$uJIZq>{;y!7`zSIpmr^DApIWrv|(v5V<4)dA$6xmmO(I)9oi$&
z91=18L5z3!n`DugcQN@zY+oRA-zKAnJ?=?Nd^ixFDF+sSeW`MltZXGKZ3Lrzxxjpa
zJBGb(iOU$NC`G*Nr3pHKAqqW7O+~5MLXPnSadl?{cQD8azXBOywZ%U2A=ic4GnM`o
zWW$0%14~%W1(FzS&W#E|$DCS`75OOUOxrSn3IDeyWbLJeZ_Gvv`ckN$G)7UDp~|A9
z2A1qx<~OWr6=-6U0up@Y1fn@jXck(jAClk+O+=j!5OW$)rC>IUJHZ_)ia{*8sy6<-
z3_c6wmz3HDOazfhp5(~JnBMA{a(Zb@`*932No$$(Q72Z&LY1Blt63|^=0g;O9*1Ca
zDj3obdhWAM|DX$~>r_lus%4d{o~uj}d5}}(Rgqqb^XfTS-eN+VZVxbrBA7StAkIs74{eSCQhCq7IGBnQCGU)7CQ;|Nap(Az|@B
zfR@#*q*e&3)m*_J%*oAe!bB#m*z8qmQl&uYCL3!xs$vv0pLJ&IPVYpWJm*5sJrM_=
zyq(TK8>7QUtx7hKlGLa&8XHMPic|>&4b5mu*_&bJhX@6Y4?vnKhK#hIzzNQ)4l}FM
z_(ULKDu~JSk+SrvcfBm_(o5N!6Lj7wsulT;f`SU$o|dGiOoi-8$dy^2QZtxNJr=bJ
zWYwu=MW6XqaAq@fA`@>}gVrBKM$$p{SeXbPPPJv^KXzm{A4--%O_$x(UIw
zdIu7ZO>8Tu#~P}BeQF_%__V(ZB2b0E`KUu7l%_N-*Joz=XNNOEcbBPs4
z7ydDhHtfnBcR1NNp0Tr68Dkj7*u^Ox!3b~=fD~(63Dn+pjJe%n7_9h3(U!4{Re6m^
zNB73ho^g(oeWPW&wZk(~@{-l!gKo{sv(AL)6^*;2
zpRj@_`~l2mY>95h`~+i#m01NEOPcq@t!iy2w~dN3UtZ-ab+2i-k|s`|`|M{e0(#J*
znN5v#3usPBG&FwcWw|nkzWwBh(9c^;M00u2i@wdIr
z;%%oG+hQoZ;mMF-Wq^~hIvaE(5|kb|auE(#5rpJ?
zc+^PCH+vrPe7Q$qHqtXS!ZH&$dkknV6c|{%!+H;+O6#+N?BhQ0<9P%FdH^$nG+2Y7
zCwk$-c{;dlnYV+S2ZWL*ghNP#+O~L$*LaSHgodXC0l;`qhy{g*1yKlvQ}~2eh=oZ=
zc?wg6U1)@g=XgDMd1(-a+hzrbSB8S8g#G}7c>zNPuQypq;V2F>N>E^LY9faXAxRvF
zNg>lR7&AMqvk9!VaKP7Tp2kL}BNKD779(Uky)!&I(>p>yeJGR-Wn(s(_&Kg)1M~N0
zOJFoub2U}dee4%qcNTt?LpZHNIg_I`S|d8}$2Y9-T(zV&Sp$oHV>OOuil^8LR3kZK
z1Uj2IimlT!uER06p%$#gjLqnb&j^hRCp2LJjm@|T#8XN4lYy|adc$LV6j*ybLo}F_
zjq`Im&NE4^*CEgYGSX8$pma*{czIR;1y-O0hHZFWa)FSbf5R#z=HVu5#VaCL`xXinJx2b=^k$i{+1K{I$b86mlM2
zcVrL|1Fay907MY*ReU{pe8=!84wfX9c!~vtff6WkKk)=`0#Dzx7vl9Qeex5hQHq?l
za(yvrlEx`AcPNmOP#N`dq!9!CR!bu_mzP0N<>f?&NiENHJx!~dW^-BYq3^-6=EK;1aNphJMjl;mv*%VV8IrjBQX|Ou>$L7
zUJTc70kkyDhG&8MKmT
znBhaCl2CY7DvMSsFyn7b2BHz=7Y{0!pb{26p-;E9PA2DDC*UpKq9|uF5p!_|+vJu<
zDOLuWbs!;iX4YRt3R_HdUrRN0>11%J_F$(uA;0vVhn1SDshalUb~6H-cL$SODp%Es
zcP+`1(x#o!32y#@rvxytoNEf4Fp!+u){!2$Z5=t1aH^cmxo(gboz&KCBM_Zxx}7g#
zZCwg&y6L4aVg>41GLuoBIc6gyih4}5cJu;FzH}}h0Zd)C1h8-oCbTq+NQeq&mCP8K
zt?&oDAzMURA9m7f8dm}dYKh>4CVa685Q;h`hjLM6q28Ar$3Yz1btx?u8-d1A40Qqr
zG@jsxDTrYfy*OG=bXze13!FNwcW|S(g{|5W7oX*{!K6xx
zu3csknc8Y!bsAQxdfj-suAent|l;XZB&(4`IxOhv_;zrn}D>N@CTb-ou-k^G<@B+@$+{v7rlkv$=9YJN)t%t!vgDbsummG;z?V+Mp7?5eyfnE{
zHgM?i2lKE-XVDyMVXC|VwOHY}O^T!mrXSc;5mozU8P`riDiM0!0UkkYG1QPx0tyouZ
z?!l@_s;Wwwu2B0Rrx~R1iD8qASY(Au_ZmyA>2@-Vy&xuHpBuU)HfVXMrXq|kuyU*)0PqHD4!#Yj{`=MjEkE1MSKH8
ze}k-cd67_
zlrxGtt&sD6?`@GL$5CHrP&;cFA!RxVG+{F>OkYo&zUF`nO4eihm?a=oK
zGd%f3@z}~X3l#%1gYQT_7ejgs!!YpkFiQZwdket~@kl9RG`N>D8mKeO>@&fufKJ1S
zsCCPY0*X1K%etH~pNu-!2s%1l$}_|XXA!%OVgN$eBSrR33}1ds7J
zgWe3z|Kf$_4AJNu*n|DfUcAs;9L7>O&xt*e4*A4aDA17&&;bCEm2KHr5T}?ug%Z2j
z9SM<0+>r$B8pBJ(Yl@R0ySk|DcV}vMEJm{!&2Dn{Zj05UE&e*gxKwN%n06Bp$PikU
zdI%!fR85VGz96x_0-CN%CDZ2A3IH;-FX~g3d=qZDCcxnx@R1n8K^12$EZpTAXRD!b
zIk%h9Dwfd-hA3Q;M!+j|)6pftGkO^m=i5z$4o{$~RW&W!!eC6gt64l5_?5m5Hg)Q|
zR1k6!MkQ903$K@pcEon2G<>gGYMvUFud!s|+}Xo1nVo3rZLH0@d|KK>tgv1P+C%W!
znLV+ajoF@k*_J&7l-=SnF5@w7;w!%5aVpwt65>0)oM;NiH7m!h0Bv_QWc73mOMt_;
zjk6As9D=MT$0Sy;^${iWZHcx)TX@ANY|?{zzlVTDGn(Oo6gLB!XK@o)@EIxX7)AMvpo{+%5G4!Kmt
zxLxMH^!Z=fyS)xExfHU!@q)Sb^5C6|y*^gqv3YkY>yjVN;XID&1sL_gxPI$1j_Wg?<6)t(yG!D!zNQmxy*!cOb+wZ|2Ng1VRx`5cn@%EN
zo;0deS(cu&W(Vn!zG~^=xJl-HElO%Xg`{A1zxaFIZb4=3apsOP9Kg|Cb}nfGoZYq2
zw&yKc|HkIDVix2?e@&*O)Q;7HV&DG}RlMf@7Ky7*j7t@XZny5rp`#cK~MBRPxLu&^HcciJ2CSmKH^UgyDi^^uWjTniSk`Ko#6>xa<~b1
z1?m&NV=i1Iyj*d>l7~uLBH4}-SwR6)(e`ft_DM~FL5UJ}&pY+(@^Vsj=0Z{bXf9p;h{@_mq(wvwNEqu^IL2d~h58T1fDp%>4-na4DIr+U;6a2+;?>iq
zuiit55aXdkm(7X{j52U+UN01z0`SaJWUqgoxB~o0dub;n(6lKn&n9XLkYdK-T
z`r~88PoP1C4kc>B=o5x1RW6Mevz5`ICS15!ag8KNlMU-FTpDp=wkIV@7!~_->{t_G
z)vhhE38m7mTPto7OP1|jy#6Ontlg`3ZwbGF)#?Qt_{1M{O}R4tx=FCu$7-{cJPB9g
z*KDouvfYHWvgNK5kJU{}+URN2P*<4viTdYMszF=5jk_|l>eNJa@8->$wNThoL%QG?
z9Ck?L$v?}c(JRH`IcA9<
z;*>K8C`QV%vaOoJ@vA#*uwkkdZ1~B~KM6I|&{nbnO{K3|IrLFNbFe{DKPjEm(n>AW
z3(`n!IN?%HTS?4HrYJfl2TVb&)Xyh8(~40Yk9mSqL#>+f)gna`bSghzn={U-f>`0#
zUvUV+SYl^GY0r2vd#%i8sluU5GN+|hI5dL;3br_vYi^?_ISLm_jc|aX$$~aQQabE{
z6r(yI-Tjfg8GWqrUVQV_w?!29Ya_)8=~&~#4gck@LkkI3_(Bd5E?7l?CA=bl1@rSS
zMT{f#S4EEgSKP0pW!ID|8$9$i`DB!7)DD(4jWlmP_0q#m3F}x+DzvW#S{EVbWH_if
zDHUBb$A=o4@@S-!R$A$7Ho4X~YpHETd(5w6M%5EmivD1$Zn}-KlWjI@I_8hl{7kL1ps8fG
zqG!oA&hn0kQ!Z#+<7x_>W5j;i%+Z6(JnE=5PhGg=dUoCQpPkzop?9$`s5*kUv%THw
z*wYTZd4sn%W#WrJxnqy8O4`EbgoR{q_KvJhSr%!eR*gmB4=p=YqW7vKlWTY)
zn7cgR#bSgYeVwvBH##N_O}W1zm}h@C8k&)?`Au-{&k5sHf)fmKK!QvX79kUv1l{>g
zc*YYYupn1PKH@=;z=BlmRN)G{Ru9nmKn8ugSv6&Xlbj^&`FfLZ|#f1)g7;tZl7
zVPsF8V+A{b%#Jy#NYi|P9DK&np7q2CM+n(Lrz+KTj%Vh+ZRS3VJf%_f)XKBUSp3!1Bv>4uO
zhc~M}_Dyz1&`eNVw@sW!Y&<_SpdWmmtc{-7rFA4
zX@y>b(%K#|z^Jn9L(h@Tb6O&mihijKrW}gq*_y}!#VD@Wmc7j76l;%_)J$!eRr}7Z
zz=Fc`oi7a7{O0*0W~8!REkLueI6UN8M7vcjZ7Iw(7V6k@y>*E{{ehgz^@du}9oq^*
zDw8>b_YXsv3VDmE6_?sXj5uHpQ+r0z`E8KGqb9X}1(atz02;@F=511Xj1^e0+0AU;
zZ++o>Yh2&j!n+RTT(g(rFK_wR!M*~Q^W){XdicZrS+f3R>4P8qG&$P3?2n3rNo;G=
zHQVTm@$$UAJWt@bysV~kp^w(RWGqZWlbA%uW@IoC_h%AxVE2Bw$(V|GfIP=z7gtXGl7YhAVb3){J!r+P9N_=?e4O@2|
z{+*$9x4Z6}=X}5bK(GvPDD=zYmxMflL7|m-wi&DkEY$5G7qMvZ{NdNX*I@fg{JRb=
z3P)z|tay40Uigy`yV!?>Z-LxG`L`&3Dwh9z=rjKolAwO|n?Le!csJq`=l)i%!FPot
zPw*Pwcx-c}qdO-9`Xhok#3{b4X8A(?zPQCaR!Cb+uW9usK?i%L5TR
zI2Qqgf&t9A1q?tZAp=O;ZkYrYd4
zIpzz(;u}8U+n9T45zAw@77@NHoITlNk%4(VFRX(^xR8O<5P}m!4}rXg@wU>d5DZZf
z40%Hk5rDW8wqpAaW4k3haEUZx440w_KQuoIA}UyD13DD5T2eMdd=DsVsYYQB4qT8d
z;6Oasx@5Srm8gi28@b^VIk1~QPo%%%13Rw+u%X+h?vuEQ@C1TG16G{7EtABIlfV(=
z!-KlBWB5e*`;4aZLtdl_n*h6P&_j;{qh5?H32GKeyn<09hy_yupW?Jd`U4o6iNBex
z3)G65&@@J!bi+)1A7
z$(tyuwY$UY*{t&LNcd3`z!8XVdY}LBMj5)JV^}$@8$NXO#AHYYhr~);3#ZxS^
ziMR%l`$0z_NSS;^Pnbq(Y`;Fd3FUIg%D@bt)U;!$OS`m7V8ljWoJ*hN#bfZs|8N2<
zC^d{ACxdXX*HHpkfT8}bEV*-Ym65TKI)|LUdC<$E
z;!D%q$)eISfN>hRv=VZ?JI6g4CGp}08aT?4}60QHR&ys>DN%S&2__A(H$oacUT)fI_
z=&tSi%GCOt*p$t&yg{=Jwt$p_2($@!tVPMh&4&OT4QvGx-3b#tQCP4|b_+(^T2B{!
z(aOv->CrF$5&oxAyHOllT!OIXO#`8$P#^v4)wQzt;R
z9Hr44{>?KY%~o+O&|_<*QmYszK-7$5Odj<^x@?6Mt;}xyR(8!s&J9Rd+}fsM5=T;;WI
zsxVQ7I+4w!kwu8I;#50b5RAM6xT{V-l}YYw$wF*Yp%f5Jo!LmO0Gnk=Lp{ssl+H_q
z+0GN%EC>*lwbLPpp)k5jSN$aDpriw8vj!T1`}!>Nv@cwPuvx=35x`im#Z_JXGC7E#
zR|!_sdeDaohiYhBw>1X1{lwSgM6a{bgPp&fKu<7%g)yDbe?``=13zq?yRZdYuNt-f
zT%)x&yV1YuMu7vkLlsviur+=E!!Px!9MKJVr0w7
zS%-3{V0pOU3eMmP9*1#=1`qyV5DsAw=3o*o;SLtzXvhT>&V}WpKJXLRft>z3UDckC
zy&nr>kGyJJSlqfqa6+*|LLd%eAznfs7P-g;IBv|&y-Lo~vS9^QU`VY;f*iQ&TfP;}
z1r&}36E@*2?qUxf2MyNX3zmm4F5?UaVKc5^4>pG7!(G0MVfNM86jR_KaHX&^;Ql0F
zQ@RfU24Fu9J|5m*L0-7WgS`8--!{a&g&D*66}UF20D{9iM`pt`JYN;jyBd7lh5NU^
z6TX1?V?S;-^hu9RJ*#Z0p8mvRRrUn36Dk5bP1B?auS}e4K;tytU@sQoGUnnCUg1@k
zzUsTdFBoQ4`~o95<|Ozs=Y3u%##mME&tId=BL=)8mcAjrW^5*6AO0S=8dOvG#N$}K
zRangrW?p75OM)agW;FPMVjgBks6I*fPkhQ8rEeveaDwoQGJW&`ELqmbe2V2#NAB>yndVz
zi^VnyyK9l9(U29Zuzg;*{!SxcYu0>c*<6LQKI>{I2DA3WuZB(9^}1wLRtt?`x6T5%
zHUhYIUfAvd6hMJm-CC~QZCah$rEZ|6rrxAR>g_EpqbBO>rP}0v0iRA;0`48bG!Jtc
z)laf%|CB5Wk!hH=)CrMJmM+BbBveP$YgbfB0rMz-jjJ4#Jok(AjLLl1B&)pe;b
z!?d5CZf^bdY3s!%TV=D{et~c^thjus>ZLDQ1=}pp&{kl~Q8^}oAV@cua0+(=vb@26
z4QsP5>(DOkv<7HNSk}&lUCu7?^geO!&d}u**u7i+?Z91a7Z2R8gYgT$LDrseu%q!A
zf8m5v@#XDq6c2JQD{;>D!Ll@R4F7DJBnNBWWpY{oc0h^0_wWz@YA1yC7amwv^frQ25q@lg
zJ0Bl*i?cWt`E}&}8CZZEIAjmP(|*lWScO@yb#eFG
zSBLd-hjk)fO)rbo5ccWHemd!uQ$JMf^g_Iw_yX$*iwgHa~AU2o^5t7
zTxK?PSf%Y8qmpLXAbW3ll;5&}EZDwT^{?n#EERX3uXS8R!q>coxvfxVALM&%I390y
zW$$*{o!ug~(%E(TC};W_x52!-c|opmB9sK$J;9*=d9e>|+m%1%i+W@=XnUkoT}Ans
zXZg#fd3H}|u_bwwr)}64a=M3JY!Z2p{rLXn1S_vP2>QOSlI1mwWhI8E_=x|uD}Zq<;o!}u?%sE&B-yfNOSU
z=H+`=QeDES2m?;+Z*jlI`X1Md91mT#WUE#Y&a4^ntyO$6VVV^hQ!ZPkO)rc07;ejDg&;ERP
zbK=Rr7w^72SM=Y!&!bPTzP9#gr%j8F5Bl@q&6_VL&aXeQ;lqa|-L=<#;|ZuAU3F2_
zQ&Mj^)Ye05sr4X)6G9l){#Rp-6ww-MWQA2#1vLegh)*^3;Xz4#0aO7FviQ(ICNAXQ
zg*I*Ul8rZVRO3rJ;>Z$@J>Hm6MHDeuBti)x=}1$j0OpI6#y}aRlu$b9OJ2T6S>-8J
zR+$W!SQcYUHH-P<7;BPIR!n|>=|$XSZ+ga8G`ZBXnm(=76VGI63P+xF<&*;*po0Rs
z455b(x=eJ-Fxsf1?Nw(?U#r~mS6@-)GNq)%ZF;GupMnZ1aK?;EYN)583S~5^u9~W=
znsT}vteE=M*`=#OI-R49E{Z6kh9W9xpwjKN9f5t#$rqfL?bT_40p@4SEw4fuW|zKr
z$>k|qJ{hHzcX65is*{PG(o~WO9aJQPLr#~-V{!3C
z22*5k!!I9{q$i#vnaZ{|tr%OCzG_&O9$O_HS6?KWPop-jjXEw*sn(3=fqn$R;TC@G>W!o~_w%l{mUANtLx4p{EdgD#4
z+J86ws;67~HKo~vXWA^=-G=Hj;7%_c`O!ZYjqT8A_xz=kIdh(h%rql;(93cdjK@T!
zUvaS$AZz}7vBW8j>~Y8+!_;x?8{=;A$+=5RBfAhajK@w1BRomz4-cGtQCA2saK0C1
z0sZO1KXiP-)VCXbMnC+(d&awaAAXOs-%fkU6{`;Z5E!doy8C#{?8%onYhFK=j2ly>
zF+D#XH2+SABY*-Npa6q5kH$>xOktzUHMHixQ+>lsV9V2MU^BP=VNh+Tava*k^s~N!
zFoYr;AqoBVI8t2kHq`NkK%C#o-eKkyw+jz>M~wLy3g!-)2{2(jjMQ6o8e9u<>!1@3Y0i6&Dc
z8~!PFqc(moiR???#fT_}nQ2aGI8dA{^alqh_`-irzz`^vp;`n~YH-6ZwGv
zFoH%jHuIa}Od~YQ$vbjNY>M8r7sb#SO(ULcjyG}N9p&ewTsAF+fy1OGXW2^{euHX>
zL=yu=iO&q)Lz0jY+t_C5(1$`agQ)bMDjjLc654Wq6OAZGJL=JoI!&K{tKlyH{z*WG
zLUKy^T;<<%c#4^ku5?{IB285XO?TGBUEQ0QJI(3Sc8>F#;S}dZh9Ce3<%ccC7geijRh^*Ws%;QTB0SNQ0Feh!@)#>wejK&V;=dK
zD_!eq*LVyRPkKTJU(qp-x60$MWtD4O3rp5~kV$HHV(2jh3)sg(HnNhPEM+Te*~_+d
zt-dn%?OKaNGVz#jJxQAics#?Oj7O<}+Yhmqb+uPdJv863XZlW=b
z-Gnx?!^#DvZqXD^5M(G<&8k+L>)eP)kEu6_9(A2+U8gG5CRAw46#}6C6Om~13RDTgu#%t9i+!}x2Hp6yJXkyFs7{;#l9wNR6YD;Y56QelA=t(h)TkPT&
zmvzJ<&c}#1tlrM7~%~M1z_;BS+Faek0SG{zf*?F<}c!
zrZskoT46Vx>2;vGwjEBaV=8$JQ^PvenyyBs9|sL+=n~dw`$n!e9S&d9@Nv9Gn+*qP
z(qk_gq{;>$vYYM8pcPw?B_*J*O&zphH!apbyLJC+E$eTCJKW+PcL2w&Ys|Tj(o*_l
zEhDW;NHdypk^3196HSf)GJ13N6g0p4?dLuh1PyXv(4FgSaDm8~U2t}@INAKuH9LG`
z=Z5nqF;>gQ*sfvjr~Ze#=TIj%wKYvht2;aETIc1>
z3CYPq0&VMJAA7koO;TVFaO!GbJKNjtcBtPlkdf|Rv};K7yTcsjiat4)l7@0@@jZxv
zuF`RH_HmCFeB*dV_`oh+@geLK@)5@!#Mvl<%VS;yxMTQq1x9dzyv)z^tDodbZ~9_Z
zDKW?G_uozK_mnG5=6Rnz?P-7anIn6XndbJ-uF+|rPdGAPD|%y)j&uZmm@>yWhST5f
zd~yGJm#~h0xdk|VfSR4`+TT9+yYKz2XCM1$FR9s|Z~pVI{o1ou;jN)jYe6FW_Oh=%
z{cUgWrS)BDtrvX1znY3Gk>2SE;OhmEFWk(Z{wbcot&8(89PVTu=CzRsKwRWa%mZ5B
z1zsLdq0z-vgt|C_5PhI0AA=+7AFI^wjZJ*2?
z8y9}x7jmB$_L3NGAJ$!8AxU2lR^b}HUCZX#&`kWm-~v*_!Zn=4VBjWZUdD8f1iBf;
zWME8a9w}4dRnlvJ$KIY*va%3{rpUmMO2+H6ulBBw@q9aH`+*FH2
z?vg%Q-}`A0sN{zsTG?AvL=TLU#+2eHLLg7&WB?>VPzvQx5+zYaRq`YOM7+pc;02`6
zhJqv{BdjHotfhT;
zMlb=&I$&j8S|vZ=WnSv#Uh1V?`sH5&W>#j{K3s$EE#EaFW)dnU&|Ty5N#Qk6rH)DF
zWKw2jTIOX+W?)`rK4_+9&Q)g$rft=whK*)ba%N|qCTRX;Y6d1|y5?)bW^7ufjL~Lo
z%9w1@m1^qdRq|zT?xkj~1EBm7abd=0uw|00rCO$CzbMIAIz?eril2;wSRIyV+U1T>
zmTg2OZM2897*~RD8AK#O<4I3Znx}aN0E(z*P#VE`3gyMY*?1;_5zr@nx`=#z)m@NE
za1aW0Y}Sy0manK5VE)$CJnTbj4GNUqg}D$!bEZpHF~wM(OIjXhD`v*BtR%Ccns0Jw
zhw>$Fe&}7+rGW6UUSjm~J7f@xv>
zsFm&mKY-|O-ld1Csc$wZzJ(ME!ii?oS6fnO&5UJFY}Jc2sOJ!*rF%d6ftP8vlVD=O8P$
z#2((g96PYX>^W<+O6#;ztFyXXw8mUB)>|WrAFK_jsX1df?U+dw9ykbWy27TdI~s}JJgwLUA#R_n@6Yu;IF%-tRS
z8DPO0o)8%;!5-If5k$ijMZ#$uSAAfso