1! --- 2! Copyright (C) 1996-2016 The SIESTA group 3! This file is distributed under the terms of the 4! GNU General Public License: see COPYING in the top directory 5! or http://www.gnu.org/copyleft/gpl.txt . 6! See Docs/Contributors.txt for a list of contributors. 7! --- 8MODULE Kpoint_pdos 9! 10! Contains data structures and routines to deal with the kpoint-grid 11! for the projected density of states calculation. 12! Modelled on the equivalent module for the SCF calculation. 13! 14 USE precision, only : dp 15 16 implicit none 17 18 private 19 20 logical, public, save :: pdos_kgrid_first_time = .true. 21 logical, public, save :: gamma_pdos 22 integer, public, save :: maxk_pdos ! 23 integer, public, save :: nkpnt_pdos ! Total number of k-points 24 real(dp) :: eff_kgrid_cutoff ! Effective kgrid_cutoff 25 26 real(dp), pointer, public, save :: kweight_pdos(:) 27 real(dp), pointer, public, save :: kpoints_pdos(:,:) 28 29 integer, dimension(3,3), save :: kscell = 0 30 real(dp), dimension(3), save :: kdispl = 0.0_dp 31 32 logical, save :: user_requested_mp = .false. 33 logical, save :: user_requested_cutoff = .false. 34 35 logical, save :: time_reversal_symmetry = .true. 36 logical, save :: firm_displ = .false. 37 38 public :: setup_kpoint_pdos 39 40 CONTAINS 41 42 subroutine setup_Kpoint_pdos( ucell, different_pdos_grid ) 43 USE parallel, only : Node 44 USE fdf, only : fdf_defined, fdf_get 45 USE m_find_kgrid, only : find_kgrid 46 use m_spin, only: TrSym 47 48 implicit none 49 real(dp), intent(in) :: ucell(3,3) 50 logical, intent(out) :: different_pdos_grid 51 52 logical :: spiral 53 if (pdos_kgrid_first_time) then 54 nullify(kweight_pdos,kpoints_pdos) 55 spiral = fdf_defined('SpinSpiral') 56 ! Allow the user to control the use of time-reversal-symmetry 57 ! By default, it is on, except for "spin-spiral" calculations 58 ! and/or non-collinear calculations 59 time_reversal_symmetry = fdf_get( & 60 "TimeReversalSymmetryForKpoints", & 61 (.not. spiral) .and. TrSym) 62 63 call setup_pdos_kscell(ucell, firm_displ) 64 65 pdos_kgrid_first_time = .false. 66 67 else 68 if ( user_requested_mp ) then 69 ! no need to set up the kscell again 70 else 71 ! This was wrong in the old code 72 call setup_pdos_kscell(ucell, firm_displ) 73 endif 74 endif 75 76 if (user_requested_mp.or.user_requested_cutoff) then 77 different_pdos_grid = .true. 78 else 79 different_pdos_grid = .false. 80 endif 81 82! If the grid hasn't been explicit specified then just set dummy values 83 if (different_pdos_grid) then 84 call find_kgrid(ucell,kscell,kdispl,firm_displ, & 85 time_reversal_symmetry, & 86 nkpnt_pdos,kpoints_pdos,kweight_pdos,eff_kgrid_cutoff) 87 88 maxk_pdos = nkpnt_pdos 89 gamma_pdos = (nkpnt_pdos == 1 .and. dot_product(kpoints_pdos(:,1),kpoints_pdos(:,1)) < 1.0e-20_dp) 90 91 if (Node .eq. 0) call siesta_write_k_points_pdos() 92 else 93 nkpnt_pdos = 0 94 maxk_pdos = nkpnt_pdos 95 gamma_pdos = .true. 96 endif 97 98 end subroutine setup_Kpoint_pdos 99 100!-------------------------------------------------------------------- 101 subroutine setup_pdos_kscell( cell, firm_displ ) 102 103! ***************** INPUT ********************************************** 104! real*8 cell(3,3) : Unit cell vectors in real space cell(ixyz,ivec) 105! ***************** OUTPUT ********************************************* 106! logical firm_displ : User-specified displacements (firm)? 107 108! The relevant fdf labels are PDOS.kgrid_cutoff and PDOS.kgrid_Monkhorst_Pack. 109! If both are present, PDOS.kgrid_Monkhorst_Pack has priority. If neither is 110! present, the cutoff default is zero, producing only the gamma point. 111! Examples of fdf data specifications: 112! PDOS.kgrid_cutoff 50. Bohr 113! %block PDOS.kgrid_Monkhorst_Pack # Defines kscell and kdispl 114! 4 0 0 0.50 # (kscell(i,1),i=1,3), kdispl(1) 115! 0 4 0 0.50 # (kscell(i,2),i=1,3), kdispl(2) 116! 0 0 4 0.50 # (kscell(i,3),i=1,3), kdispl(3) 117! %endblock PDOS.kgrid_Monkhorst_Pack 118! ********************************************************************** 119 120! Modules 121 122 use precision, only : dp 123 use m_minvec, only : minvec 124 use sys, only : die 125 use fdf 126 127 implicit none 128 129! Passed variables 130 real(dp), intent(in) :: cell(3,3) 131 logical, intent(out) :: firm_displ 132 133! Internal variables 134 integer i, j, factor(3,3), expansion_factor 135 136 real(dp) scmin(3,3), vmod, cutoff 137 real(dp) ctransf(3,3) 138 logical mp_input 139 140 real(dp), parameter :: defcut = 0.0_dp 141 integer, dimension(3,3), parameter :: unit_matrix = & 142 reshape ((/1,0,0,0,1,0,0,0,1/), (/3,3/)) 143 144 type(block_fdf) :: bfdf 145 type(parsed_line), pointer :: pline 146 147 mp_input = fdf_block('PDOS.kgrid_Monkhorst_Pack',bfdf) 148 if ( mp_input ) then 149 user_requested_mp = .true. 150 do i= 1, 3 151 if (.not. fdf_bline(bfdf,pline)) & 152 call die('setup_pdos_kscell: ERROR in ' // & 153 'PDOS.kgrid_Monkhorst_Pack block') 154 kscell(1,i) = fdf_bintegers(pline,1) 155 kscell(2,i) = fdf_bintegers(pline,2) 156 kscell(3,i) = fdf_bintegers(pline,3) 157 if ( fdf_bnvalues(pline) > 3 ) then 158 kdispl(i) = mod(fdf_bvalues(pline,4), 1._dp) 159 else 160 kdispl(i) = 0._dp 161 end if 162 enddo 163 call fdf_bclose(bfdf) 164 firm_displ = .true. 165 166 else 167 168 cutoff = fdf_physical('PDOS.kgrid_cutoff',defcut,'Bohr') 169 if (cutoff /= defcut) then 170 !! write(6,"(a,f10.5)") "PDOS Kgrid cutoff input: ", cutoff 171 user_requested_cutoff = .true. 172 endif 173 174 kdispl(1:3) = 0.0_dp ! Might be changed later 175 firm_displ = .false. ! In future we might add new options 176 ! for user-specified displacements 177 178 ! Find equivalent rounded unit-cell 179 call minvec( cell, scmin, ctransf ) 180 181 expansion_factor = 1 182 do j = 1,3 183 factor(j,1:3) = 0 184 vmod = sqrt(dot_product(scmin(1:3,j),scmin(1:3,j))) 185 factor(j,j) = int(2.0_dp*cutoff/vmod) + 1 186 expansion_factor = expansion_factor * factor(j,j) 187 enddo 188 ! Generate actual supercell skeleton 189 kscell = matmul(ctransf, factor) 190 ! Avoid confusing permutations 191 if (expansion_factor == 1) then 192 kscell = unit_matrix 193 endif 194 endif 195 196 end subroutine setup_pdos_kscell 197 198 subroutine siesta_write_k_points_pdos() 199 200 USE siesta_options, only: writek 201 USE units, only: Ang 202 203 implicit none 204 205 integer :: ik, ix, i 206 207 if ( writek ) then 208 write(6,'(/,a)') 'siesta: k-point coordinates (Bohr**-1) and weights for PDOS:' 209 write(6,'(a,i4,3f12.6,3x,f12.6)') & 210 ('siesta: ', ik, (kpoints_pdos(ix,ik),ix=1,3), kweight_pdos(ik), ik=1,nkpnt_pdos) 211 endif 212 213 write(6,'(/a,i6)') 'siesta: PDOS.k-grid: Number of k-points =', nkpnt_pdos 214 write(6,'(a,f10.3,a)') 'siesta: PDOS.k-grid: Cutoff (effective) =', eff_kgrid_cutoff/Ang, ' Ang' 215 write(6,'(a)') 'siesta: PDOS.k-grid: Supercell and displacements' 216 write(6,'(a,3i4,3x,f8.3)') 'siesta: PDOS.k-grid: ', (kscell(i,1),i=1,3), kdispl(1) 217 write(6,'(a,3i4,3x,f8.3)') 'siesta: PDOS.k-grid: ', (kscell(i,2),i=1,3), kdispl(2) 218 write(6,'(a,3i4,3x,f8.3)') 'siesta: PDOS.k-grid: ', (kscell(i,3),i=1,3), kdispl(3) 219 220 end subroutine siesta_write_k_points_pdos 221 222END MODULE Kpoint_pdos 223