Branch data Line data Source code
1 : : !!****m* ABINIT/m_ebands
2 : : !! NAME
3 : : !! m_ebands
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains utilities to analyze and retrieve information from the ebands_t.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2008-2026 ABINIT group (MG, MJV, BXu)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! TODO
15 : : !! 1) Remove npwarr, istwfk.
16 : : !! 2) Use 3d arrays for ebands%nband
17 : : !! 3) Solve issue with Hdr dependency
18 : : !!
19 : : !! SOURCE
20 : :
21 : : #if defined HAVE_CONFIG_H
22 : : #include "config.h"
23 : : #endif
24 : :
25 : : #include "abi_common.h"
26 : :
27 : : module m_ebands
28 : :
29 : : use defs_basis
30 : : use m_errors
31 : : use m_abicore
32 : : use m_xmpi
33 : : use m_htetra
34 : : use m_nctk
35 : : use netcdf
36 : : use m_hdr
37 : : use m_krank
38 : : use m_skw
39 : : use m_kpts
40 : : use m_sort
41 : : use m_dtset
42 : : use m_yaml
43 : :
44 : : use defs_datatypes, only : ebands_base_t
45 : : use m_copy, only : alloc_copy
46 : : use m_io_tools, only : file_exists, open_file
47 : : use m_time, only : cwtime, cwtime_report
48 : : use m_fstrings, only : tolower, itoa, sjoin, ftoa, ltoa, ktoa, strcat, basename, replace
49 : : use m_numeric_tools, only : arth, imin_loc, imax_loc, bisect, stats_t, stats_eval, simpson, simpson_int, wrap2_zero_one, &
50 : : isdiagmat, get_diag, interpol3d_0d, interpol3d_indices, linspace
51 : : use m_special_funcs, only : gaussian
52 : : use m_geometry, only : normv
53 : : use m_cgtools, only : set_istwfk
54 : : use m_pptools, only : printbxsf
55 : : use m_occ, only : getnel, newocc, occ_fd
56 : : use m_nesting, only : mknesting
57 : : use m_crystal, only : crystal_t
58 : : use m_bz_mesh, only : isamek, kpath_t, littlegroup_t, kmesh_t
59 : : use m_fftcore, only : get_kg
60 : :
61 : : implicit none
62 : :
63 : : private
64 : : !!***
65 : :
66 : : ! Helper functions
67 : : public :: pack_eneocc ! Helper function for reshaping (energies|occupancies|derivate of occupancies).
68 : : public :: get_eneocc_vect ! Reshape (ene|occ|docdde) returning a matrix instead of a vector.
69 : : public :: put_eneocc_vect ! Put (ene|occ|doccde) in vectorial form into the data type doing a reshape.
70 : : public :: unpack_eneocc ! Helper function for reshaping (energies|occupancies|derivate of occupancies).
71 : :
72 : : !----------------------------------------------------------------------
73 : :
74 : : !!****t* m_ebands/ebands_t
75 : : !! NAME
76 : : !! ebands_t
77 : : !!
78 : : !! FUNCTION
79 : : !! Electron energies and occupations
80 : : !!
81 : : !! SOURCE
82 : :
83 : : type, extends(ebands_base_t), public :: ebands_t
84 : :
85 : : contains
86 : :
87 : : procedure :: init => ebands_init
88 : : ! Main creation method.
89 : :
90 : : procedure :: free => ebands_free
91 : : ! Destruction method.
92 : :
93 : : procedure :: from_hdr => ebands_from_hdr
94 : : ! Init object from the abinit header.
95 : :
96 : : procedure :: from_dtset => ebands_from_dtset
97 : : ! Init object from the abinit dataset.
98 : :
99 : : procedure :: copy => ebands_copy ! Copy of the ebands_t.
100 : : procedure :: move_alloc => ebands_move_alloc ! Transfer allocation.
101 : : procedure :: print => ebands_print ! Printout basic info on the data type.
102 : : procedure :: get_bandenergy => ebands_get_bandenergy ! Returns the band energy of the system.
103 : : procedure :: get_valence_idx => ebands_get_valence_idx ! Gives the index of the (valence|bands at E_f).
104 : : procedure :: get_bands_from_erange => ebands_get_bands_from_erange ! Return the indices of the mix and max band within an energy window.
105 : : procedure :: vcbm_range_from_gaps => ebands_vcbm_range_from_gaps ! Find band and energy range for states close to the CBM/VBM given input energies.
106 : : procedure :: apply_scissors => ebands_apply_scissors ! Apply scissors operator (no k-dependency).
107 : : procedure :: read_qpdata => ebands_read_qpdata ! Read quasi-particle energies from file, update %eig and %fermi_energy
108 : : procedure :: get_occupied => ebands_get_occupied ! Returns band indices after which occupations are less than an input value.
109 : : procedure :: enclose_degbands => ebands_enclose_degbands ! Adjust band indices such that all degenerate states are treated.
110 : : procedure :: get_bands_e0 => ebands_get_bands_e0 ! Find min/max band indices crossing energy e0
111 : : procedure :: get_erange => ebands_get_erange ! Compute the minimum and maximum energy enclosing a list of states.
112 : : procedure :: nelect_per_spin => ebands_nelect_per_spin ! Returns number of electrons per spin channel
113 : : procedure :: get_minmax => ebands_get_minmax ! Returns min and Max value of (eig|occ|doccde).
114 : : procedure :: has_metal_scheme => ebands_has_metal_scheme ! .True. if metallic occupation scheme is used.
115 : : procedure :: write_bxsf => ebands_write_bxsf ! Write 3D energies for Fermi surface visualization (XSF format)
116 : : procedure :: update_occ => ebands_update_occ ! Update the occupation numbers.
117 : : procedure :: set_scheme => ebands_set_scheme ! Set the occupation scheme.
118 : : procedure :: set_fermie => ebands_set_fermie ! Change the fermi level (assume metallic scheme).
119 : : procedure :: set_extrael => ebands_set_extrael ! Add extrael to initial number of electrons to simulate e/h doping. (assume metallic scheme).
120 : : procedure :: get_muT_with_fd => ebands_get_muT_with_fd ! Change the number of electrons (assume metallic scheme).
121 : : procedure :: calc_nelect => ebands_calc_nelect ! Compute nelect from Fermi level and Temperature.
122 : : procedure :: report_gap => ebands_report_gap ! Print info on the fundamental and direct gap.
123 : : procedure :: ncwrite => ebands_ncwrite ! Write object to NETCDF file (use ncid)
124 : : procedure :: ncwrite_path => ebands_ncwrite_path ! Dump the object into NETCDF file (use filepath)
125 : : procedure :: write_nesting => ebands_write_nesting ! Calculate the nesting function and output data to file.
126 : : procedure :: expandk => ebands_expandk ! Build a new ebands_t in the full BZ.
127 : : procedure :: downsample => ebands_downsample ! Build a new ebands_t with a downsampled IBZ.
128 : : procedure :: chop => ebands_chop ! Build a new ebands_t with selected nbands.
129 : : procedure :: get_edos => ebands_get_edos ! Compute e-DOS from band structure.
130 : : procedure :: get_jdos => ebands_get_jdos ! Compute electron joint-DOS from band structure.
131 : : procedure :: get_edos_matrix_elements => ebands_get_edos_matrix_elements ! Compute e-DOS and other DOS-like quantities involving ! vectorial or tensorial matrix elements.
132 : : procedure :: interp_kmesh => ebands_interp_kmesh ! Use SWK to interpolate energies on a k-mesh.
133 : : procedure :: interp_kpath => ebands_interp_kpath ! Interpolate energies on a k-path.
134 : : procedure :: interpolate_kpath => ebands_interpolate_kpath
135 : : procedure :: prtbltztrp => ebands_prtbltztrp ! Output files for BoltzTraP code.
136 : : procedure :: write => ebands_write ! Driver routine to write bands in different txt formats.
137 : : procedure :: get_carriers => ebands_get_carriers ! Compute carrier concentration from input Fermi level and list of Temperatures.
138 : : procedure :: get_gaps => ebands_get_gaps ! Build the gaps object from a bandstructure.
139 : : procedure :: print_gaps => ebands_print_gaps ! Helper function to print gaps directly from ebands.
140 : : procedure :: write_xmgrace => ebands_write_xmgrace
141 : : procedure :: write_gnuplot => ebands_write_gnuplot
142 : : procedure :: sort => ebands_sort
143 : : procedure :: has_enough_bands_for_ef => ebands_has_enough_bands_for_ef ! Check if nband is "large enough" to compute the Fermi level Ef(T).
144 : :
145 : : end type ebands_t
146 : : !!***
147 : :
148 : : public :: ebands_prtbltztrp_tau_out ! Output files for BoltzTraP code,
149 : :
150 : : !----------------------------------------------------------------------
151 : :
152 : : !!****t* m_ebands/edos_t
153 : : !! NAME
154 : : !! edos_t
155 : : !!
156 : : !! FUNCTION
157 : : !! Store the electronic DOS
158 : : !!
159 : : !! SOURCE
160 : :
161 : : type,public :: edos_t
162 : :
163 : : integer :: nsppol = -1
164 : : ! Number of spins.
165 : :
166 : : integer :: nspinor = -1
167 : : ! Number of spinors
168 : :
169 : : integer :: nkibz = -1
170 : : ! Number of k-points in the IBZ.
171 : :
172 : : integer :: nw = -1
173 : : ! Number of points in the frequency mesh.
174 : :
175 : : integer :: ief = 0
176 : : ! Rightmost Index of the energy mesh such as IDOS[mesh[ief]] < nelect.
177 : : ! 0 if Fermi level could not be computed
178 : : ! Note the value of gef stored in edos_t is computed by performing
179 : : ! a linear interpolation between ief and ief + 1
180 : :
181 : : integer :: ihf = 0
182 : : ! Like ief (see above)
183 : : ! But for fermi level of thermalized holes in valence bands
184 : : ! For occopt 9 purposes
185 : :
186 : : integer :: intmeth = 0
187 : : ! 1 for gaussian, 2 tetra
188 : :
189 : : real(dp) :: broad = zero
190 : : ! Gaussian broadening
191 : :
192 : : real(dp) :: step = -one
193 : : ! Step of the mesh
194 : :
195 : : real(dp) :: nelect = zero
196 : : ! Number of electrons taken from ebands.
197 : :
198 : : real(dp),allocatable :: mesh(:)
199 : : ! mesh(nw)
200 : :
201 : : real(dp),allocatable :: dos(:,:)
202 : : ! dos(nw, 0:nsppol)
203 : : ! Total DOS, spin up and spin down component.
204 : :
205 : : real(dp),allocatable :: idos(:,:)
206 : : ! idos(nw, 0:nsppol)
207 : : ! Integrated DOS: (total, spin up, spin down) component.
208 : :
209 : : real(dp),allocatable :: gef(:)
210 : : ! gef(0:nsppol)
211 : : ! DOS at the Fermi level. Total, spin up, spin down
212 : :
213 : : real(dp),allocatable :: ghf(:)
214 : : ! ghf(0:nsppol)
215 : : ! DOS at the Fermi level of thermalized holes. Total, spin up, spin down
216 : :
217 : : contains
218 : :
219 : : procedure :: free => edos_free
220 : : ! Free memory
221 : :
222 : : procedure :: write => edos_write
223 : : ! Write results to file (formatted mode)
224 : :
225 : : procedure :: print => edos_print
226 : : ! Print eDOS info to Fortran unit.
227 : :
228 : : procedure :: ncwrite => edos_ncwrite
229 : : ! Write eDOS to netcdf file.
230 : :
231 : : procedure :: get_carriers => edos_get_carriers
232 : : ! Compute number of holes (nh) and electrons (ne) per unit cell from a given
233 : : ! list of `ntemp` temperatures `kTmesh` and chemical potentials `mu_e`.
234 : :
235 : : end type edos_t
236 : : !!***
237 : :
238 : : !!****t* m_ebands/jdos_t
239 : : !! NAME
240 : : !! jdos_t
241 : : !!
242 : : !! FUNCTION
243 : : !! Store the electron joint DOS
244 : : !!
245 : : !! SOURCE
246 : :
247 : : type,public :: jdos_t
248 : :
249 : : integer :: nsppol
250 : : ! Number of spins.
251 : :
252 : : integer :: nkibz
253 : : ! Number of k-points in the IBZ.
254 : :
255 : : integer :: nw
256 : : ! Number of points in the frequency mesh.
257 : :
258 : : integer :: intmeth
259 : : ! 1 for gaussian, 2 tetra
260 : :
261 : : real(dp) :: broad = zero
262 : : ! Gaussian broadening
263 : :
264 : : real(dp) :: step
265 : : ! Step of the mesh
266 : :
267 : : real(dp),allocatable :: mesh(:)
268 : : ! mesh(nw)
269 : :
270 : : real(dp),allocatable :: values(:,:)
271 : : ! dos(nw,0:nsppol)
272 : : ! Total jDOS, spin up and spin down component.
273 : :
274 : : contains
275 : :
276 : : procedure :: free => jdos_free
277 : : ! Free memory
278 : :
279 : : !procedure :: write => jdos_write
280 : : ! Write results to file (formatted mode)
281 : :
282 : : !procedure :: print => jdos_print
283 : : ! Print jDOS info to Fortran unit.
284 : :
285 : : procedure :: ncwrite => jdos_ncwrite
286 : : ! Write jDOS to netcdf file.
287 : :
288 : : end type jdos_t
289 : : !!***
290 : :
291 : : !----------------------------------------------------------------------
292 : :
293 : : !!****t* m_ebands/gaps_t
294 : : !! NAME
295 : : !! gaps_t
296 : : !!
297 : : !! FUNCTION
298 : : !! Structure with information on the fundamental and direct gaps returned by ebands_report_gap.
299 : : !!
300 : : !! SOURCE
301 : :
302 : : type,public :: gaps_t
303 : :
304 : : integer :: nsppol
305 : : ! Number of spins.
306 : :
307 : : integer,allocatable :: fo_kpos(:,:)
308 : : ! fo_kpos(3,nsppol)
309 : : ! fo_kpos(1:2,spin) ==> Indices of the k-points where the homo, lumo states are located (for each spin).
310 : : ! fo_kpos(3,spin) ==> the index of k-point where the direct gap is located (for each spin).
311 : : ! NB: f stands for fundamental, o for "optical" gap.
312 : :
313 : : real(dp) :: fermie
314 : : ! Fermi energy taken from ebands.
315 : :
316 : : real(dp) :: nelect
317 : : ! Number of electrons taken from ebands.
318 : :
319 : : integer,allocatable :: ierr(:)
320 : : ! ierr(nsppol)
321 : : ! 0 if the gap has been computed.
322 : : ! 1 if the system (or spin-channel) is metallic.
323 : : ! 2 if gaps were not computed (because there are only valence bands).
324 : :
325 : : real(dp),allocatable :: fo_values(:,:)
326 : : ! fo_values(2,nsppol)
327 : : ! Fundamental and direct gaps (in Hartree) for each spin.
328 : :
329 : : real(dp),allocatable :: vb_max(:), cb_min(:)
330 : : ! vb_max(nsppol)
331 : : ! valence band max and conduction band min for each spin in Ha.
332 : : ! Only for Semiconductors, set to (+, -) huge(one) for metals.
333 : :
334 : : real(dp),allocatable :: optical_kpoints(:,:)
335 : : ! (3, nsppol)
336 : : ! kpoint of optical gap for each spin
337 : :
338 : : real(dp),allocatable :: fund_kpoints(:,:, :)
339 : : ! (3, 2, nsppol)
340 : : ! kpoint of the fundamental gap for (val, cond) and each spin
341 : :
342 : : character(len=500),allocatable :: errmsg_spin(:)
343 : : ! errmsg_spin(nsppol)
344 : : ! String with human-readable error message if ierr(spin) != 0.
345 : :
346 : : contains
347 : :
348 : : procedure :: free => gaps_free
349 : : ! Free memory
350 : :
351 : : procedure :: print => gaps_print
352 : : ! Print info on the gaps
353 : :
354 : : end type gaps_t
355 : : !!***
356 : :
357 : : !!****t* m_ebands/klinterp_t
358 : : !! NAME
359 : : !! klinterp_t
360 : : !!
361 : : !! FUNCTION
362 : : !! Linear interpolation of eigenvalue-like quantities (scalars with the same symmetry as the KS eigenvalues)
363 : : !! Used, for instance, to interpolate electron or phonon lifetimes.
364 : : !!
365 : : !! SOURCE
366 : :
367 : : type,public :: klinterp_t
368 : :
369 : : integer :: bsize, nsppol, ndat
370 : : ! Max number of bands, number of independent spin polarization, size of "extra" dimension.
371 : :
372 : : integer :: nkx, nky, nkz
373 : : ! Number of divisions of the grid enclosing the first unit cell
374 : :
375 : : real(dp),allocatable :: data_uk_bsd(:,:,:,:,:,:)
376 : : ! (nkx*nky*nkz, mband, nsppol, ndat)
377 : :
378 : : contains
379 : :
380 : : procedure :: free => klinterp_free
381 : : ! Free dynamic memory
382 : :
383 : : procedure :: eval_bsd => klinterp_eval_bsd
384 : : ! Interpolate values at an arbitrary k-point.
385 : :
386 : : end type klinterp_t
387 : : !!***
388 : :
389 : : public :: klinterp_new ! Build interpolator.
390 : :
391 : : !----------------------------------------------------------------------
392 : :
393 : : CONTAINS !=====================================================================================
394 : :
395 : : !----------------------------------------------------------------------
396 : :
397 : : !!****f* m_ebands/ebands_print_gaps
398 : : !! NAME
399 : : !! ebands_print_gaps
400 : : !!
401 : : !! FUNCTION
402 : : !! Helper function to print gaps directly from ebands.
403 : : !!
404 : : !! INPUTS
405 : : !! ebands<ebands_t>=Info on the band structure, the smearing technique and the physical temperature used.
406 : : !! units=Unit numbers
407 : : !!
408 : : !! OUTPUT
409 : : !!
410 : : !! SOURCE
411 : :
412 [ # # ]: 0 : subroutine ebands_print_gaps(ebands, units, header)
413 : :
414 : : !Arguments ------------------------------------
415 : : class(ebands_t),intent(in) :: ebands
416 : : integer,intent(in) :: units(:)
417 : : character(len=*),optional,intent(in) :: header
418 : :
419 : : !Local variables-------------------------------
420 : : integer :: ierr, spin
421 : : type(gaps_t) :: gaps
422 : : !character(len=500) :: msg
423 : : ! *********************************************************************
424 : :
425 : : !if (unit == dev_null) return
426 : 0 : gaps = ebands_get_gaps(ebands, ierr)
427 [ # # ]: 0 : if (ierr /= 0) then
428 [ # # ]: 0 : do spin=1, ebands%nsppol
429 [ # # ]: 0 : call wrtout(units, trim(gaps%errmsg_spin(spin)))
430 : : end do
431 : : end if
432 : :
433 [ # # ]: 0 : if (present(header)) then
434 : 0 : call gaps%print(units, header=header)
435 : : else
436 : 0 : call gaps%print(units)
437 : : end if
438 : 0 : call gaps%free()
439 : :
440 [ # # # # : 0 : end subroutine ebands_print_gaps
# # # # #
# # # # #
# # ]
441 : : !!***
442 : :
443 : : !----------------------------------------------------------------------
444 : :
445 : : !!****f* m_ebands/ebands_get_gaps
446 : : !! NAME
447 : : !! ebands_get_gaps
448 : : !!
449 : : !! FUNCTION
450 : : !! Returns a gaps_t object with info on the fundamental and direct gap.
451 : : !!
452 : : !! INPUTS
453 : : !! ebands<ebands_t>=Info on the band structure, the smearing technique and the physical temperature used.
454 : : !!
455 : : !! OUTPUT
456 : : !! ierr=Return code (!=0 signals failure)
457 : : !! gaps<gaps_t>=object with info on the gaps (caller is responsible for freeing the object).
458 : : !!
459 : : !! SOURCE
460 : :
461 : 298 : type(gaps_t) function ebands_get_gaps(ebands, ierr) result(gaps)
462 : :
463 : : !Arguments ------------------------------------
464 : : !scalars
465 : : class(ebands_t),target,intent(in) :: ebands
466 : : integer,intent(out) :: ierr
467 : :
468 : : !Local variables-------------------------------
469 : : !scalars
470 : : integer,parameter :: occopt3 = 3, prtvol0 = 0
471 : : real(dp),parameter :: spinmagntarget_ = -99.99_dp
472 : : real(dp) :: tsmear
473 : 298 : type(ebands_t) :: tmp_ebands
474 : : !character(len=500) :: msg
475 : : ! *********************************************************************
476 : :
477 : 298 : call get_gaps_(ebands, gaps, ierr)
478 : :
479 [ + + ]: 298 : if (ierr /= 0) then
480 : : ! get_gaps_ will fail if we have a real metal/semimetal
481 : : ! but it's also possible to have a false negative if the input ebands represents a:
482 : : !
483 : : ! 1) highly degenerate doped semiconductor with the Fermi level in the bands.
484 : : ! 2) Small gap semiconductor at relatively high T.
485 : : !
486 : : ! Here I try to compute the gaps of an intrinsic semiconductor at low T with Fermi-Dirac.
487 : : ! This might still fail though and the caller should handle that.
488 : 16 : call gaps%free()
489 : 16 : call ebands%copy(tmp_ebands)
490 : 16 : tsmear = 0.01_dp * eV_Ha
491 : 16 : call tmp_ebands%set_scheme(occopt3, tsmear, spinmagntarget_, prtvol0, update_occ=.False.)
492 : : ! Remove extrael to go back to intrinsic system
493 [ + + ]: 16 : if (ebands%extrael /= zero) tmp_ebands%nelect = ebands%nelect - ebands%extrael
494 : : !if (ebands%cellcharge /= zero) tmp_ebands%nelect = ebands%nelect + ebands%cellcharge
495 : 16 : call tmp_ebands%update_occ(spinmagntarget_)
496 : :
497 : : ! Try to compute gaps the again with new Fermi level at FD T = tsmear computed from update_occ.
498 : : ! Return ierr
499 : 16 : call get_gaps_(tmp_ebands, gaps, ierr)
500 : 16 : call tmp_ebands%free()
501 : : end if
502 : :
503 [ - + - + : 596 : end function ebands_get_gaps
- + - + -
+ - + - +
- + - + -
+ - + ]
504 : : !!***
505 : :
506 : : !----------------------------------------------------------------------
507 : :
508 : : !!****f* m_ebands/get_gaps_
509 : : !! NAME
510 : : !! get_gaps_
511 : : !!
512 : : !! FUNCTION
513 : : !! Private function that returns a gaps_t object with info on the fundamental and direct gap.
514 : : !!
515 : : !! INPUTS
516 : : !! ebands<ebands_t>=Info on the band structure, the smearing technique and the physical temperature used.
517 : : !!
518 : : !! OUTPUT
519 : : !! ierr=Return code (!=0 signals failure)
520 : : !! gaps<gaps_t>=object with info on the gaps (caller is responsible for freeing the object).
521 : : !!
522 : : !! SOURCE
523 : :
524 [ - + - + : 314 : subroutine get_gaps_(ebands, gaps, ierr)
- + - + -
+ - + -
+ ]
525 : :
526 : : !Arguments ------------------------------------
527 : : !scalars
528 : : class(ebands_t),target,intent(in) :: ebands
529 : : type(gaps_t),intent(out) :: gaps
530 : : integer,intent(out) :: ierr
531 : :
532 : : !Local variables-------------------------------
533 : : !scalars
534 : : integer :: ikibz,nband_k,spin,nsppol,ikopt,ivk,ick,ivb,icb
535 : : real(dp),parameter :: tol_fermi = tol6
536 : : real(dp) :: fun_gap, opt_gap
537 : : logical :: ismetal
538 : : !arrays
539 : 628 : integer :: val_idx(ebands%nkpt, ebands%nsppol)
540 [ - + ]: 314 : real(dp) :: top_valence(ebands%nkpt), bot_conduct(ebands%nkpt)
541 : : ! *********************************************************************
542 : :
543 : 314 : call gaps%free()
544 : 314 : nsppol = ebands%nsppol
545 : :
546 : : ! Initialize gaps_t
547 : 314 : gaps%nsppol = nsppol
548 : 314 : gaps%nelect = ebands%nelect
549 [ - + + - : 942 : ABI_MALLOC(gaps%fo_kpos, (3, nsppol))
+ - + - -
+ - + -
+ ]
550 [ - + + - : 942 : ABI_MALLOC(gaps%ierr, (nsppol))
+ - + - -
+ - + -
+ ]
551 [ - + + - : 942 : ABI_MALLOC(gaps%fo_values, (2, nsppol))
+ - + - -
+ - + -
+ ]
552 [ - + + - : 942 : ABI_MALLOC(gaps%vb_max, (nsppol))
+ - + - -
+ - + -
+ ]
553 [ - + + - : 628 : ABI_MALLOC(gaps%cb_min, (nsppol))
- + - + -
+ ]
554 [ - + + - : 942 : ABI_MALLOC(gaps%errmsg_spin, (nsppol))
+ - + - -
+ - + -
+ ]
555 : :
556 [ - + + - : 942 : ABI_MALLOC(gaps%fund_kpoints, (3, 2, nsppol))
+ - + - -
+ - + -
+ ]
557 [ - + + - : 942 : ABI_MALLOC(gaps%optical_kpoints, (3, nsppol))
+ - + - -
+ - + -
+ ]
558 [ + + + + : 3176 : gaps%fund_kpoints = huge(one)
+ + ]
559 [ + + + + ]: 1586 : gaps%optical_kpoints = huge(one)
560 : :
561 [ + + + + ]: 1586 : gaps%fo_kpos = 0
562 [ + + ]: 632 : gaps%ierr = 0
563 [ + + + + ]: 1268 : gaps%fo_values = zero
564 [ + + + + ]: 950 : gaps%vb_max = huge(one); gaps%cb_min = -huge(one)
565 [ + + ]: 632 : gaps%errmsg_spin(:) = ""
566 : 314 : gaps%fermie = ebands%fermie
567 : :
568 : : ! Compute "valence index" using efermi
569 : 314 : val_idx(:,:) = ebands_get_valence_idx(ebands, tol_fermi=tol_fermi)
570 : :
571 : : spin_loop: &
572 [ + + ]: 632 : do spin=1,nsppol
573 : :
574 : : ! No output if system is metallic
575 [ + + + + ]: 9723 : ismetal = ANY(val_idx(:,spin) /= val_idx(1,spin))
576 [ + + ]: 318 : if (ismetal) then
577 : 28 : gaps%ierr(spin) = 1
578 : 28 : write(gaps%errmsg_spin(spin), "(a,i0)")" Detected metallic system for spin channel: ", spin
579 : 28 : cycle
580 : : endif
581 : :
582 : 290 : ivb = val_idx(1, spin)
583 : 290 : icb = ivb + 1
584 : :
585 [ + + ]: 9619 : do ikibz=1,ebands%nkpt
586 : 9331 : nband_k = ebands%nband(ikibz + (spin-1)*ebands%nkpt)
587 : 9331 : top_valence(ikibz) = ebands%eig(ivb, ikibz, spin)
588 [ + + ]: 9331 : if (icb > nband_k) then
589 : 2 : gaps%ierr(spin) = 2
590 : 2 : gaps%errmsg_spin(spin) = "Not enough states to calculate the band gap."
591 : 2 : cycle spin_loop
592 : : end if
593 : 9617 : bot_conduct(ikibz) = ebands%eig(icb, ikibz, spin)
594 : : end do
595 : :
596 : : ! Minimum of the direct Gaps
597 [ + - + + ]: 9617 : ikopt = imin_loc(bot_conduct - top_valence)
598 : 288 : opt_gap = bot_conduct(ikopt) - top_valence(ikopt)
599 : :
600 : : ! Fundamental Gap
601 : 288 : ick = imin_loc(bot_conduct)
602 : 288 : ivk = imax_loc(top_valence)
603 : :
604 : 288 : gaps%vb_max(spin) = ebands%eig(ivb, ivk, spin)
605 : 288 : gaps%cb_min(spin) = ebands%eig(icb, ick, spin)
606 : 288 : fun_gap = ebands%eig(icb, ick, spin) - ebands%eig(ivb, ivk, spin)
607 [ + + ]: 864 : gaps%fo_values(:, spin) = [fun_gap, opt_gap]
608 [ + + ]: 1152 : gaps%fo_kpos(:, spin) = [ivk, ick, ikopt]
609 : :
610 [ + + ]: 1152 : gaps%optical_kpoints(:, spin) = ebands%kptns(:, ikopt)
611 [ + + ]: 1152 : gaps%fund_kpoints(:, 1, spin) = ebands%kptns(:, ivk)
612 [ + + ]: 1466 : gaps%fund_kpoints(:, 2, spin) = ebands%kptns(:, ick)
613 : : end do spin_loop
614 : :
615 [ + + ]: 632 : ierr = maxval(gaps%ierr)
616 : :
617 [ + + ]: 314 : if (ierr /= 0) then
618 : : ! Set VBM and CBM to fermie if metal.
619 [ + + ]: 60 : do spin=1,nsppol
620 [ + - ]: 60 : if (gaps%ierr(spin) /= 0) then
621 : 30 : gaps%vb_max(spin) = ebands%fermie
622 : 30 : gaps%cb_min(spin) = ebands%fermie
623 : : end if
624 : : end do
625 : : end if
626 : :
627 : 314 : end subroutine get_gaps_
628 : : !!***
629 : :
630 : : !----------------------------------------------------------------------
631 : :
632 : : !!****f* m_ebands/gaps_free
633 : : !! NAME
634 : : !! gaps_free
635 : : !!
636 : : !! FUNCTION
637 : : !! Free the memory allocated in gaps_t
638 : : !!
639 : : !! SOURCE
640 : :
641 : 630 : subroutine gaps_free(gaps)
642 : :
643 : : !Arguments ------------------------------------
644 : : class(gaps_t),intent(inout) :: gaps
645 : : ! *********************************************************************
646 : :
647 : : !integer
648 [ + + ]: 630 : ABI_SFREE(gaps%fo_kpos)
649 [ + + ]: 630 : ABI_SFREE(gaps%ierr)
650 : :
651 : : !real
652 [ + + ]: 630 : ABI_SFREE(gaps%fo_values)
653 [ + + ]: 630 : ABI_SFREE(gaps%vb_max)
654 [ + + ]: 630 : ABI_SFREE(gaps%cb_min)
655 [ + + ]: 630 : ABI_SFREE(gaps%optical_kpoints)
656 [ + + ]: 630 : ABI_SFREE(gaps%fund_kpoints)
657 : :
658 : : !chars
659 [ + + ]: 630 : ABI_SFREE(gaps%errmsg_spin)
660 : :
661 : 630 : end subroutine gaps_free
662 : : !!***
663 : :
664 : : !----------------------------------------------------------------------
665 : :
666 : : !!****f* m_ebands/gaps_print
667 : : !! NAME
668 : : !! gaps_print
669 : : !!
670 : : !! FUNCTION
671 : : !! Print info on the fundamental and direct gap.
672 : : !!
673 : : !! INPUTS
674 : : !! units=Unit numbers
675 : : !! [header]=Optional title.
676 : : !! [kTmesh]=List of temperatures. If present activates output of (T, mu_e, band_edges)
677 : : !! [mu_e]=List of Fermi levels for each T.
678 : : !!
679 : : !! OUTPUT
680 : : !! Only writing.
681 : : !!
682 : : !! SOURCE
683 : :
684 [ + + + - : 298 : subroutine gaps_print(gaps, units, header, kTmesh, mu_e)
- + + + +
- - + ]
685 : :
686 : : !Arguments ------------------------------------
687 : : !scalars
688 : : class(gaps_t),intent(in) :: gaps
689 : : integer,intent(in) :: units(:)
690 : : character(len=*),intent(in),optional :: header
691 : : real(dp),optional,intent(in) :: kTmesh(:), mu_e(:)
692 : :
693 : : !Local variables-------------------------------
694 : : !scalars
695 : : integer :: spin, ikopt, ivk, ick, itemp, ntemp
696 : : real(dp) :: fun_gap, opt_gap, csi_c, csi_v
697 : : character(len=500) :: msg
698 : : ! *********************************************************************
699 : :
700 [ + + ]: 600 : do spin=1,gaps%nsppol
701 [ + + ]: 302 : if (spin == 1) then
702 : 298 : msg = ch10
703 [ + + + - : 298 : if (present(header)) msg = ch10//' === '//trim(adjustl(header))//' === '
+ - ]
704 : 298 : call wrtout(units, msg)
705 : : end if
706 : :
707 [ + + ]: 302 : if (gaps%ierr(spin) /= 0) then
708 : 14 : call wrtout(units, gaps%errmsg_spin(spin))
709 : : continue
710 : : end if
711 : :
712 : : ! Get minimum of the direct Gap.
713 : 302 : fun_gap = gaps%fo_values(1, spin)
714 : 302 : opt_gap = gaps%fo_values(2, spin)
715 : :
716 [ + + + + : 1166 : if (any(gaps%fo_kpos(:,spin) == 0)) then
+ + ]
717 : 14 : call wrtout(units, sjoin(" Cannot detect gap for spin: ", itoa(spin)))
718 : 14 : cycle
719 : : end if
720 : :
721 : 288 : ivk = gaps%fo_kpos(1, spin)
722 : 288 : ick = gaps%fo_kpos(2, spin)
723 : 288 : ikopt = gaps%fo_kpos(3, spin)
724 : :
725 : : ! >>>> For spin 2
726 : : !Direct band gap semiconductor.
727 : : !Fundamental gap: 4.48 (eV)
728 : : ! VBM: 4.47 (eV) at k: [ 0.0000E+00, 0.0000E+00, 0.0000E+00]
729 : : ! CBM: 8.96 (eV) at k: [ 0.0000E+00, 0.0000E+00, 0.0000E+00]
730 : : !Optical gap: 4.48 (eV) at k:[ 0.0000E+00, 0.0000E+00, 0.0000E+00]
731 : :
732 [ + + ]: 288 : if (gaps%nsppol == 2) call wrtout(units, sjoin(' >>>> For spin ', itoa(spin)))
733 [ + + ]: 288 : if (ivk == ick) call wrtout(units, " Direct band gap semiconductor")
734 [ + + ]: 288 : if (ivk /= ick) call wrtout(units, " Indirect band gap semiconductor")
735 : 288 : write(msg, "(a,f9.3,a )")" Fundamental gap: ", fun_gap * Ha_eV, " (eV)"
736 : 288 : call wrtout(units, msg)
737 [ + - ]: 288 : write(msg, "(a,f9.3,2a)")" VBM: ", gaps%vb_max(spin) * Ha_eV, " (eV) at k: ", trim(ktoa(gaps%fund_kpoints(:,1,spin)))
738 : 288 : call wrtout(units, msg)
739 [ + - ]: 288 : write(msg, "(a,f9.3,2a)")" CBM: ", gaps%cb_min(spin) * Ha_eV, " (eV) at k: ", trim(ktoa(gaps%fund_kpoints(:,2,spin)))
740 : 288 : call wrtout(units, msg)
741 [ + - ]: 288 : write(msg, "(a,f9.3,2a)")" Direct gap: ", opt_gap * Ha_eV," (eV) at k: ", trim(ktoa(gaps%optical_kpoints(:,spin)))
742 : 288 : call wrtout(units, msg)
743 : : !write(msg, "((2(a, f9.3)))")" Fermi level:", gaps%fermie * Ha_eV, " (eV) with nelect:", gaps%nelect
744 : : !call wrtout(units, msg)
745 : :
746 [ + + + - : 882 : if (present(mu_e) .and. present(kTmesh) .and. all(gaps%ierr == 0)) then
+ + + - ]
747 : 63 : ntemp = size(mu_e)
748 : 63 : call wrtout(units, " Position of CBM/VBM with respect to the Fermi level:", pre_newlines=1)
749 : 63 : call wrtout(units, " Notations: mu_e = Fermi level, D_v = (mu_e - VBM), D_c = (CBM - mu_e)")
750 : 63 : call wrtout(units, " T(K) kT (eV) mu_e (eV) D_v (eV) D_c (eV)", pre_newlines=1)
751 [ + + ]: 306 : do itemp=1,ntemp
752 : 243 : csi_c = gaps%cb_min(spin) - mu_e(itemp)
753 : 243 : csi_v = -gaps%vb_max(spin) + mu_e(itemp)
754 : : write(msg, "(f6.1, 1x, 4(f9.3, 1x))") &
755 : 243 : kTmesh(itemp) / kb_HaK, kTmesh(itemp) * Ha_eV, mu_e(itemp) * Ha_eV, csi_v * Ha_eV, csi_c * Ha_eV
756 : 306 : call wrtout(units, msg)
757 : : end do
758 : 63 : call wrtout(units, "")
759 : : end if
760 : :
761 : : end do ! spin
762 : :
763 [ + + + + : 1450 : if (any(gaps%fo_kpos == 0)) then
+ + + + ]
764 : 14 : write(msg, "((2(a, f9.3)))") " Fermi level:", gaps%fermie * Ha_eV, " (eV) with nelect:", gaps%nelect
765 : 14 : call wrtout(units, msg)
766 : : end if
767 : :
768 : 298 : call wrtout(units, "")
769 : :
770 [ - + ]: 298 : end subroutine gaps_print
771 : : !!***
772 : :
773 : : !----------------------------------------------------------------------
774 : :
775 : : !!****f* m_ebands/ebands_init
776 : : !! NAME
777 : : !! ebands_init
778 : : !!
779 : : !! FUNCTION
780 : : !! This subroutine initializes the ebands_t structured datatype
781 : : !!
782 : : !! INPUTS
783 : : !! bantot=total number of bands (=sum(nband(:))
784 : : !! doccde(bantot)=derivative of the occupation numbers with respect to the energy (Ha)
785 : : !! eig(bantot)=eigenvalues (hartree)
786 : : !! istwfk(nkpt)=parameter that describes the storage of wfs.
787 : : !! ivalence = index of the valence band separating thermalized excited holes
788 : : !! from excited thermalized excited electrons
789 : : !! kptns(3,nkpt)=k points in terms of recip primitive translations
790 : : !! nband(nkpt*nsppol)=number of bands
791 : : !! nelect=Number of electrons.
792 : : !! ne_qFD, nh_qFD= number of electrons (holes resp.) excited in the bands above band
793 : : !! index ivalence + 1 (below ivalence resp.)
794 : : !! nkpt=number of k points
795 : : !! npwarr(nkpt)=number of planewaves at each k point
796 : : !! nsppol=1 for unpolarized, 2 for spin-polarized
797 : : !! nspinor=Number of spinor components
798 : : !! occopt=Occupation options (see input variable)
799 : : !! occ(bantot)=occupation numbers
800 : : !! tphysel=Physical temperature (input variable)
801 : : !! tsmear=Temperature of smearing.
802 : : !! wtk(nkpt)=weight assigned to each k point
803 : : !! cellcharge=Additional charge added to the unit cell (input variable).
804 : : !! kptopt=Option for k-point generation (see input variable)
805 : : !! kptrlatt_orig=Original value of kptrlatt given in input
806 : : !! nshiftk_orig=Original number of shifts given in input
807 : : !! shiftk_orig(3,nshiftk_orig)=Original set of shifts given in input
808 : : !! kptrlatt=Value of kptrlatt after inkpts
809 : : !! nshiftk=Number of shifts after inkpts
810 : : !! shiftk(3,nshiftk)=Set of shifts after inkpts.
811 : : !!
812 : : !! OUTPUT
813 : : !! ebands<ebands_t>=the ebands_t datatype
814 : : !!
815 : : !! SOURCE
816 : :
817 : 36226 : subroutine ebands_init(ebands, bantot, nelect, ne_qFD, nh_qFD, ivalence, doccde, eig, istwfk, kptns, &
818 : 36226 : nband, nkpt, npwarr, nsppol, nspinor, tphysel, tsmear, occopt, occ, wtk, &
819 [ + - ]: 36226 : cellcharge, kptopt, kptrlatt_orig, nshiftk_orig, shiftk_orig, kptrlatt, nshiftk, shiftk)
820 : :
821 : : !Arguments ------------------------------------
822 : : !scalars
823 : : class(ebands_t),intent(out) :: ebands
824 : : integer,intent(in) :: bantot,nkpt,nsppol,nspinor,occopt,ivalence
825 : : real(dp),intent(in) :: nelect,ne_qFD,nh_qFD,tphysel,tsmear
826 : : !arrays
827 : : integer,intent(in) :: istwfk(nkpt),nband(nkpt*nsppol),npwarr(nkpt)
828 : : real(dp),intent(in) :: doccde(bantot),eig(bantot),kptns(3,nkpt),occ(bantot)
829 : : real(dp),intent(in) :: wtk(nkpt)
830 : : integer,intent(in) :: kptopt, nshiftk_orig, nshiftk
831 : : real(dp),intent(in) :: cellcharge
832 : : integer,intent(in) :: kptrlatt_orig(3,3),kptrlatt(3,3)
833 : : real(dp),intent(in) :: shiftk_orig(3,nshiftk_orig),shiftk(3,nshiftk)
834 : : ! *************************************************************************
835 : :
836 : : ! Copy the scalars
837 : : ! MG TODO here there is a inconsistency in the way occ are treated in the header
838 : : ! (only the states used, bantot. are saved, and the way occ. and energies
839 : : ! are passed to routines (mband,nkpt,nsppol). It might happen that bantot<mband*nktp*nsppol
840 : : ! this should not lead to problems since arrays are passed by reference
841 : : ! anyway the treatment of these arrays have to be rationalized
842 : 36226 : ebands%bantot = bantot
843 [ + + ]: 808312 : ebands%mband = MAXVAL(nband(1:nkpt*nsppol))
844 : 36226 : ebands%nkpt = nkpt
845 : 36226 : ebands%nspinor= nspinor
846 : 36226 : ebands%nsppol = nsppol
847 : 36226 : ebands%occopt = occopt
848 : :
849 : 36226 : ebands%entropy= zero
850 : 36226 : ebands%fermie = zero
851 : 36226 : ebands%fermih = zero
852 : 36226 : ebands%ivalence =ivalence
853 : 36226 : ebands%nelect = nelect
854 : 36226 : ebands%ne_qFD =ne_qFD
855 : 36226 : ebands%nh_qFD =nh_qFD
856 : 36226 : ebands%tphysel= tphysel
857 : 36226 : ebands%tsmear = tsmear
858 : :
859 : : ! Allocate the components
860 [ - + + - : 108678 : ABI_MALLOC(ebands%nband, (nkpt*nsppol))
+ - + - -
+ - + -
+ ]
861 [ - + + - : 108678 : ABI_MALLOC(ebands%istwfk, (nkpt))
+ - + - -
+ - + -
+ ]
862 [ - + + - : 72452 : ABI_MALLOC(ebands%npwarr, (nkpt))
- + - + -
+ ]
863 [ - + + - : 108678 : ABI_MALLOC(ebands%kptns, (3, nkpt))
+ - + - -
+ - + -
+ ]
864 : :
865 : : ! Copy the arrays
866 [ + + ]: 808312 : ebands%nband(1:nkpt*nsppol) = nband(1:nkpt*nsppol)
867 [ + + ]: 793321 : ebands%istwfk(1:nkpt) = istwfk(1:nkpt)
868 [ + + ]: 793321 : ebands%npwarr(1:nkpt) = npwarr(1:nkpt)
869 [ + + + + ]: 3064606 : ebands%kptns(1:3,1:nkpt) = kptns(1:3,1:nkpt)
870 : :
871 : : ! In ebands, energies and occupations are stored in a matrix (mband,nkpt,nsppol).
872 : : ! put_eneocc_vect is used to reshape the values stored in vectorial form.
873 [ - + + - : 181130 : ABI_MALLOC(ebands%eig , (ebands%mband, nkpt, nsppol))
- + + - -
+ + - + -
+ - - + -
+ - + ]
874 [ - + + - : 144904 : ABI_MALLOC(ebands%occ , (ebands%mband, nkpt, nsppol))
- + + - -
+ + - - +
- + - + ]
875 [ - + + - : 144904 : ABI_MALLOC(ebands%doccde, (ebands%mband, nkpt, nsppol))
- + + - -
+ + - - +
- + - + ]
876 : :
877 : 36226 : call put_eneocc_vect(ebands,'eig', eig )
878 : 36226 : call put_eneocc_vect(ebands,'occ', occ )
879 : 36226 : call put_eneocc_vect(ebands,'doccde',doccde)
880 : :
881 [ - + + - : 108678 : ABI_MALLOC(ebands%wtk, (nkpt))
+ - + - -
+ - + -
+ ]
882 [ + + ]: 793321 : ebands%wtk(1:nkpt) = wtk(1:nkpt)
883 : :
884 : 36226 : ebands%kptopt = kptopt
885 : 36226 : ebands%nshiftk_orig = nshiftk_orig
886 : 36226 : ebands%nshiftk = nshiftk
887 : 36226 : ebands%cellcharge = cellcharge
888 [ + + + + ]: 470938 : ebands%kptrlatt_orig = kptrlatt_orig
889 [ + + + + ]: 470938 : ebands%kptrlatt = kptrlatt
890 : :
891 [ - + ]: 36226 : call alloc_copy(shiftk_orig, ebands%shiftk_orig)
892 [ - + ]: 36226 : call alloc_copy(shiftk, ebands%shiftk)
893 : :
894 : 36226 : end subroutine ebands_init
895 : : !!***
896 : :
897 : : !----------------------------------------------------------------------
898 : :
899 : : !!****f* m_ebands/ebands_from_hdr
900 : : !! NAME
901 : : !! ebands_from_hdr
902 : : !!
903 : : !! FUNCTION
904 : : !! This subroutine initializes the ebands_t datatype from the abinit header by
905 : : !! calling the main creation method.
906 : : !!
907 : : !! INPUTS
908 : : !! Hdr<hdr_type>=Abinit header.
909 : : !! mband=Maximum number of bands.
910 : : !! ene3d(mband,Hdr%nkpt,Hdr%nsppol)=Energies.
911 : : !! [nelect]=Number of electrons per unit cell.
912 : : !! Optional argument that can be used for performing a ridid shift of the fermi level.
913 : : !! in the case of metallic occupancies.
914 : : !! If not specified, nelect will be initialized from Hdr.
915 : : !!
916 : : !! SOURCE
917 : :
918 : 3227 : subroutine ebands_from_hdr(ebands, hdr, mband, ene3d, nelect)
919 : :
920 : : !Arguments ------------------------------------
921 : : !scalars
922 : : class(ebands_t),intent(out) :: ebands
923 : : integer,intent(in) :: mband
924 : : type(hdr_type),intent(in) :: hdr
925 : : real(dp),optional,intent(in) :: nelect
926 : : !arrays
927 : : real(dp),intent(in) :: ene3d(mband,hdr%nkpt,hdr%nsppol)
928 : :
929 : : !Local variables-------------------------------
930 : : !scalars
931 : : real(dp) :: my_nelect
932 : : !arrays
933 [ + - ]: 3227 : real(dp),allocatable :: ugly_doccde(:),ugly_ene(:)
934 : : ! *************************************************************************
935 : :
936 [ + + ]: 3227 : my_nelect = hdr%nelect; if (present(nelect)) my_nelect = nelect
937 : :
938 : : ! Have to use ugly 1d vectors to call ebands_init
939 [ - + + - : 484027 : ABI_CALLOC(ugly_doccde, (hdr%bantot))
+ - + - -
+ - + +
+ ]
940 [ - + + - : 6454 : ABI_MALLOC(ugly_ene, (hdr%bantot))
- + - + ]
941 : :
942 : 3227 : call pack_eneocc(hdr%nkpt, hdr%nsppol, mband, hdr%nband, hdr%bantot, ene3d, ugly_ene)
943 : :
944 : : call ebands%init(hdr%bantot, my_nelect, hdr%ne_qFD, hdr%nh_qFD, hdr%ivalence, &
945 : : ugly_doccde, ugly_ene, hdr%istwfk, hdr%kptns, hdr%nband, hdr%nkpt, &
946 : : hdr%npwarr, hdr%nsppol, hdr%nspinor, hdr%tphysel, hdr%tsmear, hdr%occopt, hdr%occ, hdr%wtk, &
947 : 3227 : hdr%cellcharge, hdr%kptopt, hdr%kptrlatt_orig, hdr%nshiftk_orig, hdr%shiftk_orig, hdr%kptrlatt, hdr%nshiftk, hdr%shiftk)
948 : :
949 : : ! Copy the fermi level reported in the header
950 : 3227 : ebands%fermie = hdr%fermie
951 : 3227 : ebands%fermih = hdr%fermih
952 : :
953 [ - + ]: 3227 : ABI_FREE(ugly_doccde)
954 [ - + ]: 3227 : ABI_FREE(ugly_ene)
955 : :
956 : 3227 : end subroutine ebands_from_hdr
957 : : !!***
958 : :
959 : : !----------------------------------------------------------------------
960 : :
961 : : !!****f* m_ebands/ebands_from_dtset
962 : : !! NAME
963 : : !! ebands_from_dtset
964 : : !!
965 : : !! FUNCTION
966 : : !! Build and return a new ebands_t datatype. Dimensions are taken from the abinit dataset.
967 : : !!
968 : : !! INPUTS
969 : : !! dtset<dataset_type>=Abinit dataset
970 : : !! npwarr(dtset%nkpt)=Number of G-vectors for each k-point.
971 : : !! [nband]= If present, use these values instead of dtset%nband
972 : : !!
973 : : !! OUTPUT
974 : : !! ebands<ebands_t>=The ebands_t datatype completely initialized.
975 : : !! The Fermi level and the entropy are set to zero.
976 : : !!
977 : : !! SOURCE
978 : :
979 : 6465 : subroutine ebands_from_dtset(new, dtset, npwarr, nband)
980 : :
981 : : !Arguments ------------------------------------
982 : : !scalars
983 : : class(ebands_t),intent(out) :: new
984 : : type(dataset_type),target,intent(in) :: dtset
985 : : integer,target,optional,intent(in) :: nband(dtset%nkpt * dtset%nsppol)
986 : : !arrays
987 : : integer,intent(in) :: npwarr(dtset%nkpt)
988 : :
989 : : !Local variables-------------------------------
990 : : !scalars
991 : : integer :: bantot
992 : : !arrays
993 : 6465 : real(dp),allocatable :: ugly_doccde(:), ugly_ene(:), ugly_occ(:)
994 : 6465 : integer,pointer :: nband__(:)
995 : : ! *************************************************************************
996 : :
997 [ - + ]: 6465 : nband__ => dtset%nband; if (present(nband)) nband__ => nband
998 : :
999 : : ! Have to use ugly 1d vectors to call ebands_init
1000 [ + + ]: 190189 : bantot = sum(nband__)
1001 [ - + + - : 825015 : ABI_CALLOC(ugly_doccde, (bantot))
+ - + - -
+ - + +
+ ]
1002 [ - + + - : 825015 : ABI_CALLOC(ugly_ene, (bantot))
- + + - +
+ ]
1003 [ - + + - : 825015 : ABI_CALLOC(ugly_occ, (bantot))
- + + - +
+ ]
1004 : :
1005 : : call new%init(bantot, dtset%nelect, dtset%ne_qFD, dtset%nh_qFD, dtset%ivalence, ugly_doccde, ugly_ene, &
1006 : : dtset%istwfk, dtset%kptns, nband__, dtset%nkpt, &
1007 : : npwarr, dtset%nsppol, dtset%nspinor, dtset%tphysel, dtset%tsmear, dtset%occopt, ugly_occ, dtset%wtk,&
1008 : : dtset%cellcharge(1), dtset%kptopt, dtset%kptrlatt_orig, dtset%nshiftk_orig, dtset%shiftk_orig, &
1009 [ - + ]: 6465 : dtset%kptrlatt, dtset%nshiftk, dtset%shiftk)
1010 : :
1011 : : !new%extrael = dtset%eph_extrael
1012 : :
1013 [ - + ]: 6465 : ABI_FREE(ugly_doccde)
1014 [ - + ]: 6465 : ABI_FREE(ugly_ene)
1015 [ - + ]: 6465 : ABI_FREE(ugly_occ)
1016 : :
1017 [ - + + - ]: 6465 : end subroutine ebands_from_dtset
1018 : : !!***
1019 : :
1020 : : !----------------------------------------------------------------------
1021 : :
1022 : : !!****f* m_ebands/ebands_free
1023 : : !! NAME
1024 : : !! ebands_free
1025 : : !!
1026 : : !! FUNCTION
1027 : : !! Deallocates the components of the ebands_t structured datatype
1028 : : !!
1029 : : !! SOURCE
1030 : :
1031 : 37949 : subroutine ebands_free(ebands)
1032 : :
1033 : : !Arguments ------------------------------------
1034 : : class(ebands_t),intent(inout) :: ebands
1035 : : ! *************************************************************************
1036 : :
1037 [ + + ]: 37949 : ABI_SFREE(ebands%istwfk)
1038 [ + + ]: 37949 : ABI_SFREE(ebands%nband)
1039 [ + + ]: 37949 : ABI_SFREE(ebands%npwarr)
1040 [ + + ]: 37949 : ABI_SFREE(ebands%kptns)
1041 [ + + ]: 37949 : ABI_SFREE(ebands%eig)
1042 [ + + ]: 37949 : ABI_SFREE(ebands%linewidth)
1043 [ + + ]: 37949 : ABI_SFREE(ebands%occ)
1044 [ + + ]: 37949 : ABI_SFREE(ebands%doccde)
1045 [ + + ]: 37949 : ABI_SFREE(ebands%wtk)
1046 [ + + ]: 37949 : ABI_SFREE(ebands%shiftk_orig)
1047 [ + + ]: 37949 : ABI_SFREE(ebands%shiftk)
1048 : :
1049 : 37949 : end subroutine ebands_free
1050 : : !!***
1051 : :
1052 : : !----------------------------------------------------------------------
1053 : :
1054 : : !!****f* m_ebands/ebands_copy
1055 : : !! NAME
1056 : : !! ebands_copy
1057 : : !!
1058 : : !! FUNCTION
1059 : : !! This subroutine performs a deep copy of an ebands_t datatype.
1060 : : !!
1061 : : !! INPUTS
1062 : : !! ibands<ebands_t>=The data type to be copied.
1063 : : !!
1064 : : !! OUTPUT
1065 : : !! obands<ebands_t>=The copy.
1066 : : !!
1067 : : !! SOURCE
1068 : :
1069 [ + - ]: 701 : subroutine ebands_copy(ibands, obands)
1070 : :
1071 : : !Arguments ------------------------------------
1072 : : !scalars
1073 : : class(ebands_t),intent(in) :: ibands
1074 : : class(ebands_t),intent(out) :: obands
1075 : : ! *********************************************************************
1076 : :
1077 : 701 : call obands%free()
1078 : :
1079 : : ! Copy scalars
1080 : 701 : obands%bantot = ibands%bantot
1081 : 701 : obands%ivalence = ibands%ivalence
1082 : 701 : obands%mband = ibands%mband
1083 : 701 : obands%nkpt = ibands%nkpt
1084 : 701 : obands%nspinor = ibands%nspinor
1085 : 701 : obands%nsppol = ibands%nsppol
1086 : 701 : obands%occopt = ibands%occopt
1087 : 701 : obands%kptopt = ibands%kptopt
1088 : 701 : obands%nshiftk_orig = ibands%nshiftk_orig
1089 : 701 : obands%nshiftk = ibands%nshiftk
1090 : :
1091 : 701 : obands%cellcharge = ibands%cellcharge
1092 : 701 : obands%extrael = ibands%extrael
1093 : 701 : obands%entropy = ibands%entropy
1094 : 701 : obands%fermie = ibands%fermie
1095 : 701 : obands%fermih = ibands%fermih
1096 : 701 : obands%nelect = ibands%nelect
1097 : 701 : obands%ne_qFD = ibands%ne_qFD
1098 : 701 : obands%nh_qFD = ibands%nh_qFD
1099 : 701 : obands%tphysel = ibands%tphysel
1100 : 701 : obands%tsmear = ibands%tsmear
1101 : :
1102 [ + + + + ]: 9113 : obands%kptrlatt_orig = ibands%kptrlatt_orig
1103 [ + + + + ]: 9113 : obands%kptrlatt = ibands%kptrlatt
1104 : :
1105 : : ! Copy allocatable arrays
1106 : : ! integer
1107 [ - + ]: 701 : call alloc_copy(ibands%istwfk, obands%istwfk)
1108 [ - + ]: 701 : call alloc_copy(ibands%nband , obands%nband )
1109 [ - + ]: 701 : call alloc_copy(ibands%npwarr, obands%npwarr)
1110 : :
1111 : : ! real
1112 [ - + ]: 701 : call alloc_copy(ibands%kptns , obands%kptns )
1113 [ - + ]: 701 : call alloc_copy(ibands%eig , obands%eig )
1114 [ - + ]: 701 : call alloc_copy(ibands%occ , obands%occ )
1115 [ - + ]: 701 : call alloc_copy(ibands%doccde, obands%doccde)
1116 [ - + ]: 701 : call alloc_copy(ibands%wtk , obands%wtk )
1117 [ - + ]: 701 : call alloc_copy(ibands%shiftk_orig, obands%shiftk_orig)
1118 [ - + ]: 701 : call alloc_copy(ibands%shiftk, obands%shiftk)
1119 : :
1120 [ - + - - ]: 701 : if (allocated(ibands%linewidth)) call alloc_copy(ibands%linewidth, obands%linewidth)
1121 : :
1122 : 701 : end subroutine ebands_copy
1123 : : !!***
1124 : :
1125 : : !----------------------------------------------------------------------
1126 : :
1127 : : !!****f* m_ebands/ebands_move_alloc
1128 : : !! NAME
1129 : : !! ebands_move_alloc
1130 : : !!
1131 : : !! FUNCTION
1132 : : !! Transfer allocate from `from_ebands` to `to_ebands`.
1133 : : !! `from_ebands` is destroyed when the routine returns.
1134 : : !!
1135 : : !! SOURCE
1136 : :
1137 : 1 : subroutine ebands_move_alloc(from_ebands, to_ebands)
1138 : :
1139 : : !Arguments ------------------------------------
1140 : : class(ebands_t),intent(inout) :: from_ebands
1141 : : class(ebands_t),intent(inout) :: to_ebands
1142 : : ! *********************************************************************
1143 : :
1144 : 1 : call to_ebands%free()
1145 : 1 : call from_ebands%copy(to_ebands)
1146 : 1 : call from_ebands%free()
1147 : :
1148 : 1 : end subroutine ebands_move_alloc
1149 : : !!***
1150 : :
1151 : : !----------------------------------------------------------------------
1152 : :
1153 : : !!****f* m_ebands/ebands_print
1154 : : !! NAME
1155 : : !! ebands_print
1156 : : !!
1157 : : !! FUNCTION
1158 : : !! Print the content of the object.
1159 : : !!
1160 : : !! INPUTS
1161 : : !! units=Unit numbers
1162 : : !! [header]=title for info
1163 : : !! [prtvol]=Verbosity level (default: 0)
1164 : : !!
1165 : : !! OUTPUT
1166 : : !! Only writing
1167 : : !!
1168 : : !! SOURCE
1169 : :
1170 : 294 : subroutine ebands_print(ebands, units, header, prtvol)
1171 : :
1172 : : !Arguments ------------------------------------
1173 : : class(ebands_t),intent(in) :: ebands
1174 : : integer,intent(in) :: units(:)
1175 : : integer,optional,intent(in) :: prtvol
1176 : : character(len=*),optional,intent(in) :: header
1177 : :
1178 : : !Local variables-------------------------------
1179 : : integer :: spin, ikpt, my_prtvol, ii
1180 : : character(len=500) :: msg
1181 : : ! *************************************************************************
1182 : :
1183 [ + - ]: 147 : my_prtvol = 0; if (present(prtvol)) my_prtvol = prtvol
1184 : :
1185 : 147 : msg = ' ==== Info on the ebands_t ==== '
1186 [ + - + - : 147 : if (present(header)) msg=' ==== '//trim(adjustl(header))//' ==== '
+ - ]
1187 : 147 : call wrtout(units, msg)
1188 : :
1189 : : write(msg,'(6(a,i0,a))')&
1190 : 147 : ' Number of spinorial components ...... ',ebands%nspinor,ch10,&
1191 : 147 : ' Number of spin polarizations ........ ',ebands%nsppol,ch10,&
1192 : 147 : ' Number of k-points in the IBZ ....... ',ebands%nkpt,ch10,&
1193 : 147 : ' kptopt .............................. ',ebands%kptopt,ch10,&
1194 : 147 : ' Maximum number of bands ............. ',ebands%mband,ch10,&
1195 : 294 : ' Occupation option ................... ',ebands%occopt,ch10
1196 : 147 : call wrtout(units, msg)
1197 : :
1198 [ + - ]: 147 : write(msg,"(2a)")" kptrlatt .............. ",trim(ltoa(reshape(ebands%kptrlatt, [9])))
1199 : 147 : call wrtout(units, msg)
1200 [ + + + - ]: 294 : write(msg,"(2a)")" shiftk ................ ",trim(ltoa(reshape(ebands%shiftk, [3 * ebands%nshiftk])))
1201 : 147 : call wrtout(units, msg)
1202 : :
1203 : : write(msg,'(3(a,f14.2,a),4(a,f14.6,a))')&
1204 : 147 : ' Number of valence electrons ......... ',ebands%nelect,ch10,&
1205 : 147 : ' Extra cell charge (from GS run)...... ',ebands%cellcharge,ch10,&
1206 : 147 : ' Extra electrons (after GS run)....... ',ebands%extrael,ch10,&
1207 : 147 : ' Fermi level ........................ ',ebands%fermie,ch10,&
1208 : 147 : ' Entropy ............................. ',ebands%entropy,ch10,&
1209 : 147 : ' Tsmear value ........................ ',ebands%tsmear,ch10,&
1210 : 294 : ' Tphysel value ....................... ',ebands%tphysel,ch10
1211 : 147 : call wrtout(units, msg)
1212 : :
1213 [ - + ]: 147 : if (my_prtvol > 10) then
1214 [ # # ]: 0 : if (ebands%nsppol == 1)then
1215 : 0 : call wrtout(units, sjoin(' New occ. numbers for occopt= ', itoa(ebands%occopt),' , spin-unpolarized case.'))
1216 : : end if
1217 : :
1218 [ # # ]: 0 : do spin=1,ebands%nsppol
1219 [ # # ]: 0 : if (ebands%nsppol == 2) then
1220 : 0 : write(msg,'(a,i9,a,i0)')' New occ. numbers for occopt= ',ebands%occopt,', spin ',spin
1221 : 0 : call wrtout(units, msg)
1222 : : end if
1223 : :
1224 [ # # ]: 0 : do ikpt=1,ebands%nkpt
1225 : 0 : write(msg,'(2a,i4,3a,f6.3,2a)')ch10,&
1226 [ # # ]: 0 : ' k-point number ',ikpt,') ',trim(ktoa(ebands%kptns(:,ikpt))),'; weight: ',ebands%wtk(ikpt), ch10, &
1227 : 0 : " eig (Ha), eig (eV), occ, doccde"
1228 : 0 : call wrtout(units, msg)
1229 [ # # ]: 0 : do ii=1,ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1230 : 0 : write(msg,'(4(f7.3,1x))')ebands%eig(ii,ikpt,spin), ebands%eig(ii,ikpt,spin) * Ha_eV, &
1231 : 0 : ebands%occ(ii,ikpt,spin), ebands%doccde(ii,ikpt,spin)
1232 : 0 : call wrtout(units, msg)
1233 : : end do
1234 : : end do !ikpt
1235 : :
1236 : : end do !spin
1237 : :
1238 : : end if !my_prtvol
1239 : :
1240 [ - + ]: 147 : end subroutine ebands_print
1241 : : !!***
1242 : :
1243 : : !----------------------------------------------------------------------
1244 : :
1245 : : !!****f* m_ebands/unpack_eneocc
1246 : : !! NAME
1247 : : !! unpack_eneocc
1248 : : !!
1249 : : !! FUNCTION
1250 : : !! Helper function to do a reshape of (energies|occupancies|derivate of occupancies)
1251 : : !! initially stored in a vector. Return a 3D array index by (band,ikpt,spin)
1252 : : !!
1253 : : !! INPUTS
1254 : : !! nkpt=number of k-points
1255 : : !! nsppol=number of spin polarizations
1256 : : !! mband=Max number of bands over k-points (just to dimension the output)
1257 : : !! nbands(nkpt*nsppol)=Number of bands at eack k and spin
1258 : : !! vect(:)=The input values to reshape
1259 : : !! [val]=Optional value used to initialize the array.
1260 : : !!
1261 : : !! OUTPUT
1262 : : !! array3d(mband,nkpt,nsppol)=Arrays containing the values of vect.
1263 : : !! Note that the first dimension is usually larger than the
1264 : : !! number of bands really used for a particular k-point and spin.
1265 : : !!
1266 : : !! SOURCE
1267 : :
1268 [ - + ]: 120290 : subroutine unpack_eneocc(nkpt,nsppol,mband,nband,vect,array3d,val)
1269 : :
1270 : : !Arguments ------------------------------------
1271 : : !scalars
1272 : : integer,intent(in) :: nkpt,nsppol,mband
1273 : : real(dp),optional,intent(in) :: val
1274 : : !arrays
1275 : : integer,intent(in) :: nband(nkpt*nsppol)
1276 : : real(dp),intent(in) :: vect(:)
1277 : : real(dp),intent(out) :: array3d(mband,nkpt,nsppol)
1278 : :
1279 : : !Local variables-------------------------------
1280 : : integer :: spin,ikpt,band,idx
1281 : : ! *************************************************************************
1282 : :
1283 [ + + ]: 120290 : if (present(val)) then
1284 [ + + + + : 20476262 : array3d = val
+ + ]
1285 : : else
1286 [ + + + + : 810000 : array3d = huge(one)
+ + ]
1287 : : end if
1288 : :
1289 : : idx=0
1290 : : ! elements in vect are packed in the first positions.
1291 [ + + ]: 250786 : do spin=1,nsppol
1292 [ + + ]: 3049480 : do ikpt=1,nkpt
1293 [ + + ]: 21162766 : do band=1,nband(ikpt + (spin-1)*nkpt)
1294 : 18233576 : idx = idx + 1
1295 : 21032270 : array3d(band, ikpt, spin) = vect(idx)
1296 : : end do
1297 : : end do
1298 : : end do
1299 : :
1300 : 120290 : end subroutine unpack_eneocc
1301 : : !!***
1302 : :
1303 : : !----------------------------------------------------------------------
1304 : :
1305 : : !!****f* m_ebands/pack_eneocc
1306 : : !! NAME
1307 : : !! pack_eneocc
1308 : : !!
1309 : : !! FUNCTION
1310 : : !! Helper function to do a reshape of (energies|occupancies|derivate of occupancies)
1311 : : !! initially stored in a 3D arrays returning a vector.
1312 : : !!
1313 : : !! INPUTS
1314 : : !! nkpt=number of k-points
1315 : : !! nsppol=number of spin polarizations
1316 : : !! mband=Max number of bands over k-points (just to dimension the output)
1317 : : !! nbands(nkpt*nsppol)=Number of bands at eack k and spin
1318 : : !! bantot=Total number of bands
1319 : : !! array3d(mband,nkpt,nsppol)=Arrays containing the values to reshape.
1320 : : !!
1321 : : !! OUTPUT
1322 : : !! vect(bantot)=The input values stored in vector mode. Only the values really
1323 : : !! considered at each k-point and spin are copied.
1324 : : !!
1325 : : !! SOURCE
1326 : :
1327 : 3705 : subroutine pack_eneocc(nkpt, nsppol, mband, nband, bantot, array3d, vect)
1328 : :
1329 : : !Arguments ------------------------------------
1330 : : !scalars
1331 : : integer,intent(in) :: nkpt,nsppol,mband,bantot
1332 : : !arrays
1333 : : integer,intent(in) :: nband(nkpt*nsppol)
1334 : : real(dp),intent(in) :: array3d(mband,nkpt,nsppol)
1335 : : real(dp),intent(out) :: vect(bantot)
1336 : :
1337 : : !Local variables-------------------------------
1338 : : integer :: spin,ikpt,band,idx
1339 : : ! *************************************************************************
1340 : :
1341 [ + + ]: 1055496 : vect(:)=zero
1342 : : idx=0
1343 [ + + ]: 7730 : do spin=1,nsppol
1344 [ + + ]: 116177 : do ikpt=1,nkpt
1345 [ + + ]: 1164263 : do band=1,nband(ikpt+(spin-1)*nkpt)
1346 : 1051791 : idx=idx+1
1347 : 1160238 : vect(idx)=array3d(band,ikpt,spin)
1348 : : end do
1349 : : end do
1350 : : end do
1351 : :
1352 : 3705 : end subroutine pack_eneocc
1353 : : !!***
1354 : :
1355 : : !----------------------------------------------------------------------
1356 : :
1357 : : !!****f* m_ebands/get_eneocc_vect
1358 : : !! NAME
1359 : : !! get_eneocc_vect
1360 : : !!
1361 : : !! FUNCTION
1362 : : !! Retrieve energies or occupations from a ebands_t structure accessing by name.
1363 : : !! Results are reported in a vector to facilitate the interface with other abinit routines.
1364 : : !!
1365 : : !! INPUTS
1366 : : !! ebands<ebands_t>The type containing the data.
1367 : : !! arr_name=The name of the quantity to retrieve. Allowed values are
1368 : : !! == "eig" == For the eigenvalues.
1369 : : !! == "occ" == For the occupation numbers.
1370 : : !! == "doccde" == For the derivative of the occupancies wrt the energy.
1371 : : !!
1372 : : !! OUTPUT
1373 : : !! vect(ebands%bantot)=The values required.
1374 : : !!
1375 : : !! SOURCE
1376 : :
1377 : 445 : subroutine get_eneocc_vect(ebands, arr_name, vect)
1378 : :
1379 : : !Arguments ------------------------------------
1380 : : !scalars
1381 : : class(ebands_t),intent(in) :: ebands
1382 : : character(len=*),intent(in) :: arr_name
1383 : : real(dp),intent(out) :: vect(ebands%bantot)
1384 : :
1385 : : !Local variables-------------------------------
1386 : : integer :: nkpt,nsppol,mband,bantot
1387 : : ! *************************************************************************
1388 : :
1389 : 445 : mband = ebands%mband; bantot = ebands%bantot; nkpt = ebands%nkpt; nsppol = ebands%nsppol
1390 : :
1391 : 97 : select case (arr_name)
1392 : : case ('occ')
1393 : 97 : call pack_eneocc(nkpt, nsppol, mband, ebands%nband, bantot, ebands%occ, vect)
1394 : : case ('eig')
1395 : 348 : call pack_eneocc(nkpt,nsppol,mband,ebands%nband,bantot,ebands%eig, vect)
1396 : : case ('doccde')
1397 : 0 : call pack_eneocc(nkpt,nsppol,mband,ebands%nband,bantot,ebands%doccde,vect)
1398 : : case default
1399 [ + + - - ]: 445 : ABI_BUG(sjoin('Wrong arr_name:', arr_name))
1400 : : end select
1401 : :
1402 : 445 : end subroutine get_eneocc_vect
1403 : : !!***
1404 : :
1405 : : !----------------------------------------------------------------------
1406 : :
1407 : : !!****f* m_ebands/put_eneocc_vect
1408 : : !! NAME
1409 : : !! put_eneocc_vect
1410 : : !!
1411 : : !! FUNCTION
1412 : : !! Update the energies or the occupations stored in a ebands_t structure.
1413 : : !! The input values are stored in a vector according to the abinit convention
1414 : : !! In the data type, on the contrary, we use 3D arrays (mband,nkpt,nsspol)
1415 : : !! which are much easier to use inside loops.
1416 : : !!
1417 : : !! INPUTS
1418 : : !! vect(ebands%bantot)=The new values to be stored in the structure.
1419 : : !! arr_name=The name of the quantity to be saved (CASE insensitive).
1420 : : !! Allowed values are
1421 : : !! == "eig" == For the eigenvalues.
1422 : : !! == "occ" == For the occupation numbers.
1423 : : !! == "doccde" == For the derivative of the occupancies wrt the energy.
1424 : : !!
1425 : : !! OUTPUT
1426 : : !! See SIDE EFFECTS
1427 : : !!
1428 : : !! SIDE EFFECTS
1429 : : !! ebands<ebands_t>=The object with updated values depending on the value of arr_name
1430 : : !!
1431 : : !! SOURCE
1432 : :
1433 [ - + ]: 114093 : subroutine put_eneocc_vect(ebands, arr_name, vect)
1434 : :
1435 : : !Arguments ------------------------------------
1436 : : !scalars
1437 : : class(ebands_t),intent(inout) :: ebands
1438 : : character(len=*),intent(in) :: arr_name
1439 : : real(dp),intent(in) :: vect(:)
1440 : :
1441 : : !Local variables-------------------------------
1442 : : integer :: nkpt,nsppol,mband,bantot
1443 : : real(dp) :: val
1444 : : ! *************************************************************************
1445 : :
1446 : 114093 : mband = ebands%mband; bantot = ebands%bantot; nkpt= ebands%nkpt; nsppol = ebands%nsppol
1447 : :
1448 : 264760 : select case (tolower(arr_name))
1449 : : case ('occ')
1450 : 36574 : call unpack_eneocc(nkpt,nsppol,mband,ebands%nband,vect,ebands%occ, val=zero)
1451 : : case ('eig')
1452 : : ! DFPT routines call ebands_init with the wrong bantot. Using maxval(vect) causes SEGFAULT
1453 : : ! so I have to recompute the correct bantot here
1454 : : !ABI_CHECK(sum(ebands%nband) == ebands%bantot, "bantot and nband are inconsistent")
1455 [ + + + - : 7789490 : val = maxval(vect(1:sum(ebands%nband)))
- + - - +
+ ]
1456 : 40945 : call unpack_eneocc(nkpt,nsppol,mband,ebands%nband,vect,ebands%eig, val=val)
1457 : : case ('doccde')
1458 : 36574 : call unpack_eneocc(nkpt,nsppol,mband,ebands%nband,vect,ebands%doccde, val=zero)
1459 : : case default
1460 [ + + + - ]: 114093 : ABI_BUG(sjoin('Wrong arr_name= ', arr_name))
1461 : : end select
1462 : :
1463 : 114093 : end subroutine put_eneocc_vect
1464 : : !!***
1465 : :
1466 : : !----------------------------------------------------------------------
1467 : :
1468 : : !!****f* m_ebands/ebands_get_bandenergy
1469 : : !! NAME
1470 : : !! ebands_get_bandenergy
1471 : : !!
1472 : : !! FUNCTION
1473 : : !! Return the band energy (weighted sum of occupied eigenvalues)
1474 : : !!
1475 : : !! INPUTS
1476 : : !!
1477 : : !! OUTPUT
1478 : : !!
1479 : : !! NOTES
1480 : : !! TODO Likely this expression is not accurate since it is not variatonal
1481 : : !! One should use
1482 : : !! band_energy = \int e N(e) de for e<Ef , where N(e) is the e-DOS
1483 : : !!
1484 : : !! SOURCE
1485 : :
1486 : 76 : pure real(dp) function ebands_get_bandenergy(ebands) result(band_energy)
1487 : :
1488 : : !Arguments ------------------------------------
1489 : : !scalars
1490 : : class(ebands_t),intent(in) :: ebands
1491 : :
1492 : : !Local variables-------------------------------
1493 : : integer :: spin,ikibz,nband_k
1494 : : real(dp) :: wtk
1495 : : ! *********************************************************************
1496 : :
1497 : 76 : band_energy=zero
1498 [ + + ]: 154 : do spin=1,ebands%nsppol
1499 [ + + ]: 607 : do ikibz=1,ebands%nkpt
1500 : 453 : wtk=ebands%wtk(ikibz)
1501 : 453 : nband_k=ebands%nband(ikibz+(spin-1)*ebands%nkpt)
1502 [ + + ]: 5787 : band_energy = band_energy + wtk*SUM( ebands%eig(1:nband_k,ikibz,spin)*ebands%occ(1:nband_k,ikibz,spin) )
1503 : : end do
1504 : : end do
1505 : :
1506 : 76 : end function ebands_get_bandenergy
1507 : : !!***
1508 : :
1509 : : !!****f* m_ebands/ebands_get_valence_idx
1510 : : !! NAME
1511 : : !! ebands_get_valence_idx
1512 : : !!
1513 : : !! FUNCTION
1514 : : !! For each k-point and spin polarisation, report:
1515 : : !!
1516 : : !! 1) the index of the valence in case of semiconductors at T = 0
1517 : : !! 2) (band_k - 1) where band_k is the first band whose energy is > Fermi energy + told_fermi
1518 : : !!
1519 : : !! using the value of the Fermi level.
1520 : : !!
1521 : : !! INPUTS
1522 : : !! ebands<ebands_t>=The object describing the band structure.
1523 : : !! tol_fermi[optional]
1524 : : !!
1525 : : !! OUTPUT
1526 : : !!
1527 : : !! SOURCE
1528 : :
1529 [ - + ]: 7345 : pure function ebands_get_valence_idx(ebands, tol_fermi) result(val_idx)
1530 : :
1531 : : !Arguments ------------------------------------
1532 : : !scalars
1533 : : class(ebands_t),intent(in) :: ebands
1534 : : real(dp),optional,intent(in) :: tol_fermi
1535 : : !arrays
1536 : : integer :: val_idx(ebands%nkpt,ebands%nsppol)
1537 : :
1538 : : !Local variables-------------------------------
1539 : : integer :: band,ikpt,spin,idx,nband_k
1540 : : real(dp) :: tol_
1541 : : ! *************************************************************************
1542 : :
1543 [ + + ]: 7345 : tol_ = tol6; if (present(tol_fermi)) tol_ = tol_fermi
1544 : :
1545 [ + + ]: 15264 : do spin=1,ebands%nsppol
1546 [ + + ]: 108498 : do ikpt=1,ebands%nkpt
1547 [ + + ]: 101153 : if (ebands%occopt == 9) then
1548 : 10 : val_idx(ikpt,spin) = ebands%ivalence
1549 : : else
1550 : 93224 : nband_k = ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1551 : 93224 : idx = 0
1552 [ + + ]: 427487 : do band=1,nband_k
1553 [ + + ]: 427487 : if (ebands%eig(band,ikpt,spin) > ebands%fermie + abs(tol_)) then
1554 : : idx = band; exit
1555 : : end if
1556 : : end do
1557 : 93224 : val_idx(ikpt,spin) = idx - 1
1558 [ + + ]: 93224 : if (idx == 1) val_idx(ikpt, spin) = idx
1559 [ + + ]: 93224 : if (idx == 0) val_idx(ikpt, spin) = nband_k
1560 : : end if
1561 : : end do
1562 : : end do
1563 : :
1564 : 7345 : end function ebands_get_valence_idx
1565 : : !!***
1566 : :
1567 : : !!****f* m_ebands/ebands_get_bands_from_erange
1568 : : !! NAME
1569 : : !! ebands_get_bands_from_erange
1570 : : !!
1571 : : !! FUNCTION
1572 : : !! Return the indices of the min and max band index within an energy window.
1573 : : !!
1574 : : !! INPUTS
1575 : : !! elow, ehigh: Min and max energy
1576 : : !!
1577 : : !! OUTPUT
1578 : : !! bstart, bstop: Min and max band index. Initialized to bstart = huge(1); bstop = -huge(1)
1579 : : !!
1580 : : !! SOURCE
1581 : :
1582 : 25 : pure subroutine ebands_get_bands_from_erange(ebands, elow, ehigh, bstart, bstop)
1583 : :
1584 : : !Arguments ------------------------------------
1585 : : !scalars
1586 : : class(ebands_t),intent(in) :: ebands
1587 : : real(dp),intent(in) :: elow, ehigh
1588 : : integer,intent(out) :: bstart, bstop
1589 : :
1590 : : !Local variables-------------------------------
1591 : : integer :: band, ik, spin
1592 : : ! *************************************************************************
1593 : :
1594 : 25 : bstart = huge(1); bstop = -huge(1)
1595 [ + + ]: 50 : do spin=1,ebands%nsppol
1596 [ + + ]: 3648 : do ik=1,ebands%nkpt
1597 [ + + ]: 35069 : do band=1,ebands%nband(ik + (spin - 1) * ebands%nkpt)
1598 [ + + + + ]: 35044 : if (ebands%eig(band, ik , spin) >= elow .and. ebands%eig(band, ik , spin) <= ehigh) then
1599 : 767 : bstart = min(bstart, band)
1600 : 767 : bstop = max(bstop, band)
1601 : : end if
1602 : : end do
1603 : : end do
1604 : : end do
1605 : :
1606 : 25 : end subroutine ebands_get_bands_from_erange
1607 : : !!***
1608 : :
1609 : : !!****f* m_ebands/ebands_vcbm_range_from_gaps
1610 : : !! NAME
1611 : : !! ebands_vcbm_range_from_gaps
1612 : : !!
1613 : : !! FUNCTION
1614 : : !! Find band and energy range for states close to the CBM/VBM given input energies in ebands and gaps.
1615 : : !! Return exit status and error message in msg.
1616 : : !!
1617 : : !! INPUTS
1618 : : !! gaps<gaps_t>=Object with info on the gaps.
1619 : : !! erange(2)=Energy range for holes and electrons. Only those states whose relative position
1620 : : !! wrt to the VBM/CBM is <= than erange are included. Note that relative positions are always
1621 : : !! positive (even for holes). Use a negative value to exclude either holes or electrons.
1622 : : !!
1623 : : !! OUTPUT
1624 : : !! e_lowhigh(2)=min and Max energy.
1625 : : !! band_lowhigh=min and Max band index.
1626 : : !! [ks_range]: For each spin and k-point, the min and max band index included in the output set.
1627 : : !! if (ik, spin) is not included then ib_work(1, ik, spin) > ib_work(2, ik, spin) = -huge(1)
1628 : : !!
1629 : : !! SOURCE
1630 : :
1631 : 0 : integer function ebands_vcbm_range_from_gaps(ebands, gaps, erange, e_lowhigh, band_lowhigh, ks_range, msg) result(ierr)
1632 : :
1633 : : !Arguments ------------------------------------
1634 : : !scalars
1635 : : class(ebands_t),intent(in) :: ebands
1636 : : class(gaps_t),intent(in) :: gaps
1637 : : real(dp),intent(in) :: erange(2)
1638 : : real(dp),intent(out) :: e_lowhigh(2)
1639 : : integer,intent(out) :: band_lowhigh(2)
1640 : : integer,optional,intent(out) :: ks_range(2, ebands%nkpt, ebands%nsppol)
1641 : : character(len=*),intent(out) :: msg
1642 : :
1643 : : !Local variables-------------------------------
1644 : : integer :: band, ik, spin, band_low, band_high
1645 : : real(dp) :: cmin, vmax, ee, elow, ehigh
1646 : 0 : integer,allocatable :: ib_work(:,:,:)
1647 : : ! *************************************************************************
1648 : :
1649 [ # # # # : 0 : ABI_MALLOC(ib_work, (2, ebands%nkpt, ebands%nsppol))
# # # # #
# # # # #
# # ]
1650 : 0 : elow = huge(one); ehigh = -huge(one)
1651 : 0 : band_low = huge(1); band_high = -huge(1)
1652 : :
1653 : 0 : ierr = 1
1654 [ # # ]: 0 : do spin=1,ebands%nsppol
1655 : : ! Get cmb and vbm with some tolerance
1656 : 0 : vmax = gaps%vb_max(spin) + tol2 * eV_Ha
1657 : 0 : cmin = gaps%cb_min(spin) - tol2 * eV_Ha
1658 [ # # ]: 0 : do ik=1,ebands%nkpt
1659 : 0 : ib_work(1, ik, spin) = huge(1)
1660 : 0 : ib_work(2, ik, spin) = -huge(1)
1661 [ # # ]: 0 : do band=1,ebands%nband(ik+(spin-1)*ebands%nkpt)
1662 : 0 : ee = ebands%eig(band, ik, spin)
1663 [ # # ]: 0 : if (erange(1) > zero) then
1664 [ # # # # ]: 0 : if (ee <= vmax .and. vmax - ee <= erange(1)) then
1665 : 0 : ib_work(1, ik, spin) = min(ib_work(1, ik, spin), band)
1666 : 0 : ib_work(2, ik, spin) = max(ib_work(2, ik, spin), band)
1667 : 0 : elow = min(elow, ee); ehigh = max(ehigh, ee)
1668 : 0 : band_low = min(band_low, band); band_high = max(band_high, band)
1669 : : !write(std_out, *), "Adding valence", band
1670 : : end if
1671 : : end if
1672 [ # # ]: 0 : if (erange(2) > zero) then
1673 [ # # # # ]: 0 : if (ee >= cmin .and. ee - cmin <= erange(2)) then
1674 : 0 : ib_work(1, ik, spin) = min(ib_work(1, ik, spin), band)
1675 : 0 : ib_work(2, ik, spin) = max(ib_work(2, ik, spin), band)
1676 : 0 : elow = min(elow, ee); ehigh = max(ehigh, ee)
1677 : 0 : band_low = min(band_low, band); band_high = max(band_high, band)
1678 : : !write(std_out, *)"Adding conduction", band
1679 : : end if
1680 : : end if
1681 : : end do
1682 : : end do
1683 : : end do
1684 : :
1685 [ # # ]: 0 : e_lowhigh = [elow, ehigh]
1686 [ # # ]: 0 : band_lowhigh = [band_low, band_high]
1687 : :
1688 [ # # # # : 0 : if (present(ks_range)) ks_range = ib_work
# # # # ]
1689 [ # # ]: 0 : ABI_FREE(ib_work)
1690 : :
1691 : : ! Set exit status and msg. Caller will handle it.
1692 [ # # ]: 0 : ierr = 0; msg = ""
1693 [ # # ]: 0 : if (elow > ehigh) then
1694 : 0 : ierr = 1
1695 : 0 : write(msg, *)"Cannot find states close to the band edges with erange: ", erange
1696 : : end if
1697 : :
1698 [ # # ]: 0 : end function ebands_vcbm_range_from_gaps
1699 : : !!***
1700 : :
1701 : : !----------------------------------------------------------------------
1702 : :
1703 : : !!****f* m_ebands/ebands_apply_scissors
1704 : : !! NAME
1705 : : !! ebands_apply_scissors
1706 : : !!
1707 : : !! FUNCTION
1708 : : !! Apply a scissor operator of amplitude scissor_energy.
1709 : : !!
1710 : : !! INPUTS
1711 : : !! scissor_energy=The energy shift in Hartree.
1712 : : !!
1713 : : !! OUTPUT
1714 : : !!
1715 : : !! SIDE EFFECT
1716 : : !! ebands<ebands_t>=The following quantities are modified:
1717 : : !! %eig(mband,nkpt,nsppol)=The band structure after the application of the scissor operator
1718 : : !! %fermi_energy
1719 : : !!
1720 : : !! SOURCE
1721 : :
1722 : 34 : subroutine ebands_apply_scissors(ebands, scissor_energy)
1723 : :
1724 : : !Arguments ------------------------------------
1725 : : !scalars
1726 : : real(dp),intent(in) :: scissor_energy
1727 : : class(ebands_t),intent(inout) :: ebands
1728 : :
1729 : : !Local variables-------------------------------
1730 : : integer :: ikpt,spin,ival,nband_k
1731 : : real(dp) :: spinmagntarget_
1732 : : character(len=500) :: msg
1733 : : !arrays
1734 : 68 : integer :: val_idx(ebands%nkpt,ebands%nsppol)
1735 : : ! *************************************************************************
1736 : :
1737 : : ! Get the valence band index for each k and spin
1738 : 34 : val_idx(:,:) = ebands_get_valence_idx(ebands)
1739 : :
1740 [ + + ]: 69 : do spin=1,ebands%nsppol
1741 [ + + + - : 1226 : if (any(val_idx(:, spin) /= val_idx(1, spin))) then
- + ]
1742 : : write(msg,'(a,i0,a)')&
1743 : 0 : 'Trying to apply a scissor operator on a metallic band structure for spin: ',spin,&
1744 : 0 : 'Assuming you know what you are doing, continuing anyway!'
1745 : 0 : ABI_COMMENT(msg)
1746 : : !Likely newocc will stop, unless the system is semimetallic ?
1747 : : end if
1748 : : end do
1749 : :
1750 : : ! Apply the scissor
1751 [ + + ]: 69 : do spin=1,ebands%nsppol
1752 [ + + ]: 1226 : do ikpt=1,ebands%nkpt
1753 : 1157 : nband_k = ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1754 : 1157 : ival = val_idx(ikpt,spin)
1755 : :
1756 [ + - ]: 1192 : if (nband_k >= ival+1) then
1757 [ + + ]: 4567 : ebands%eig(ival+1:,ikpt,spin) = ebands%eig(ival+1:,ikpt,spin) + scissor_energy
1758 : : else
1759 : : write(msg,'(2a,4(a,i0))')&
1760 : 0 : 'Not enough bands to apply the scissor operator. ',ch10,&
1761 : 0 : 'spin: ',spin,' ikpt: ',ikpt,' nband_k: ',nband_k,' but valence index: ',ival
1762 : 0 : ABI_ERROR(msg)
1763 : : end if
1764 : :
1765 : : end do
1766 : : end do
1767 : :
1768 : : ! Recalculate the Fermi level and occupation factors.
1769 : : ! For Semiconductors only the Fermi level is changed (in the middle of the new gap)
1770 : 34 : spinmagntarget_ = -99.99_dp !?; if (PRESENT(spinmagntarget)) spinmagntarget_=spinmagntarget
1771 : 34 : call ebands%update_occ(spinmagntarget_)
1772 : :
1773 : 34 : end subroutine ebands_apply_scissors
1774 : : !!***
1775 : :
1776 : : !----------------------------------------------------------------------
1777 : :
1778 : : !!****f* m_ebands/ebands_read_qpdata
1779 : : !! NAME
1780 : : !! ebands_read_qpdata
1781 : : !!
1782 : : !! FUNCTION
1783 : : !! Read quasi-particle energies from QPDATA file, update %eig and %fermi_energy
1784 : : !! The QPDATA is a text file usually produced by a python post-processing script
1785 : : !!
1786 : : !! INPUTS
1787 : : !!
1788 : : !! SIDE EFFECT
1789 : : !! ebands<ebands_t>=The following quantities are modified:
1790 : : !! %eig(mband,nkpt,nsppol)=The band structure after the application of the scissor operator
1791 : : !! %fermi_energy
1792 : : !!
1793 : : !! SOURCE
1794 : :
1795 : 0 : subroutine ebands_read_qpdata(qp_ebands, ks_ebands, filepath, comm)
1796 : :
1797 : : !Arguments ------------------------------------
1798 : : class(ebands_t),intent(out) :: qp_ebands
1799 : : class(ebands_t),intent(in) :: ks_ebands
1800 : : character(len=*),intent(in) :: filepath
1801 : : integer,intent(in) :: comm
1802 : :
1803 : : !Local variables-------------------------------
1804 : : integer,parameter :: master = 0
1805 : : integer :: units(2), irec, unt, nkibz_file, nsppol_file, nspinor_file !, ii
1806 : : integer :: spin, b_start, b_stop, b_stop__, ikpt, nband_k, version, ierr
1807 : : real(dp),parameter :: ktol = tol6
1808 : : real(dp) :: kpt(3), spinmagntarget_, delta
1809 : : character(len=500) :: msg, err_msg
1810 : : !arrays
1811 : 0 : integer :: ifound(ks_ebands%nkpt, ks_ebands%nsppol)
1812 : : !integer, allocatable :: iperm(:)
1813 [ # # ]: 0 : real(dp),allocatable :: re_enes(:), im_enes(:)
1814 : : ! *************************************************************************
1815 : :
1816 [ # # ]: 0 : units = [std_out, ab_out]
1817 : :
1818 : : ! Start by copying the input bands.
1819 : 0 : call ks_ebands%copy(qp_ebands)
1820 : :
1821 : : ! Only master read data and broadcast results.
1822 : : ! File format of QPDATA file with energies in eV units.
1823 : : !
1824 : : ! # Comment
1825 : : ! version
1826 : : ! nkibz, nsppol
1827 : : ! for spin in range(nsppol):
1828 : : ! for kpoint in kpoints:
1829 : : ! kpoint spin b_start, b_stop
1830 : : ! real_energies_ev
1831 : : ! imag_energies_ev
1832 : :
1833 [ # # ]: 0 : if (xmpi_comm_rank(comm) == master) then
1834 : 0 : call wrtout(units, sjoin("- Reading QP energies from:", filepath, ch10))
1835 [ # # ]: 0 : if (open_file(filepath, msg, newunit=unt, form="formatted", action="read") /= 0) then
1836 : 0 : ABI_ERROR(msg)
1837 : : end if
1838 : :
1839 : : ! Read dimensions + consistency check.
1840 [ # # ]: 0 : read(unt, *, err=10, iomsg=err_msg) msg
1841 [ # # ]: 0 : read(unt, *, err=10, iomsg=err_msg) version
1842 [ # # ]: 0 : read(unt, *, err=10, iomsg=err_msg) nkibz_file, nsppol_file, nspinor_file
1843 : 0 : call wrtout(units, msg)
1844 : 0 : call wrtout(units, sjoin("nkibz_file:", itoa(nkibz_file), ", nsppol_file:", itoa(nsppol_file)))
1845 : :
1846 [ # # ]: 0 : ABI_CHECK_IEQ(ks_ebands%nkpt, nkibz_file, "Different number of k-points.")
1847 [ # # ]: 0 : ABI_CHECK_IEQ(ks_ebands%nsppol, nsppol_file, "Different number of spins.")
1848 [ # # ]: 0 : ABI_CHECK_IEQ(ks_ebands%nspinor, nspinor_file, "Different values of nspinor.")
1849 : :
1850 : : ! Read records.
1851 [ # # # # ]: 0 : ifound = 0
1852 [ # # ]: 0 : do irec=1, nkibz_file * nsppol_file
1853 : : !write(std_out, *) "Reading record", irec
1854 [ # # ]: 0 : read(unt, *, err=10, iomsg=err_msg) kpt, spin, b_start, b_stop
1855 : : ! Find k-point in ks_ebands%kptns.
1856 [ # # ]: 0 : do ikpt=1,ks_ebands%nkpt
1857 [ # # # # : 0 : if (all(abs(ks_ebands%kptns(:, ikpt) - kpt) < ktol)) exit
# # ]
1858 : : end do
1859 [ # # ]: 0 : ABI_CHECK_ILEQ(ikpt, ks_ebands%nkpt, sjoin("Cannot find k-point:", ktoa(kpt)))
1860 : :
1861 : 0 : nband_k = ks_ebands%nband(ikpt+(spin-1)*ks_ebands%nkpt)
1862 : 0 : ifound(ikpt, spin) = ifound(ikpt, spin) + 1
1863 : :
1864 [ # # ]: 0 : ABI_CHECK_ILEQ(b_start, b_stop, "b_start cannot be greater than b_stop")
1865 : : !write(std_out, *) "About to read energies"
1866 : :
1867 : : ! Read new energies (first real, then imaginary part)
1868 [ # # # # : 0 : ABI_MALLOC(re_enes, (b_start:b_stop))
# # # # #
# # # #
# ]
1869 [ # # # # : 0 : ABI_MALLOC(im_enes, (b_start:b_stop))
# # # # #
# ]
1870 [ # # ]: 0 : read(unt, *, err=10, iomsg=err_msg) re_enes
1871 [ # # ]: 0 : read(unt, *, err=10, iomsg=err_msg) im_enes
1872 [ # # ]: 0 : re_enes = re_enes * eV_Ha
1873 [ # # ]: 0 : im_enes = im_enes * eV_Ha
1874 : :
1875 [ # # ]: 0 : if (b_start /= 1) then
1876 : 0 : call wrtout(units, " Extrapolating QP energies for low-energy states with band-independent shift.")
1877 : 0 : delta = re_enes(b_start) - ks_ebands%eig(b_start, ikpt, spin)
1878 [ # # ]: 0 : qp_ebands%eig(1:b_start-1, ikpt, spin) = qp_ebands%eig(1:b_start-1, ikpt, spin) + delta
1879 : : end if
1880 : :
1881 : 0 : b_stop__ = min(b_stop, nband_k)
1882 [ # # ]: 0 : if (b_stop__ /= nband_k) then
1883 : 0 : call wrtout(units, " Extrapolating QP energies for high-energy states with band-independent shift.")
1884 : 0 : delta = re_enes(b_stop__) - ks_ebands%eig(b_stop__, ikpt, spin)
1885 [ # # ]: 0 : qp_ebands%eig(b_stop__:nband_k, ikpt, spin) = qp_ebands%eig(b_stop__:nband_k, ikpt, spin) + delta
1886 : : end if
1887 : :
1888 : : ! Update energies with results from QPDATA file.
1889 [ # # ]: 0 : qp_ebands%eig(b_start:b_stop__, ikpt, spin) = re_enes(b_start:b_stop__)
1890 : :
1891 : : ! Make sure energies are sorted.
1892 : : ! FIXME: The sorting section should be removed as we loose the correspondence
1893 : : ! between the band indices for energies and the ones in the e-ph matrix elements.
1894 : : !ABI_MALLOC(iperm, (nband_k))
1895 : : !iperm = [(ii, ii=1, nband_k)]
1896 : : !call sort_dp(nband_k, qp_ebands%eig(:, ikpt, spin), iperm, tol6)
1897 : : !ABI_FREE(iperm)
1898 : :
1899 [ # # ]: 0 : ABI_FREE(re_enes)
1900 [ # # ]: 0 : ABI_FREE(im_enes)
1901 : : end do ! irec
1902 : :
1903 : 0 : close(unt)
1904 : :
1905 : : ! Final consistency check
1906 [ # # # # : 0 : if (any(ifound /= 1)) then
# # # # ]
1907 : 0 : write(std_out)" ifound:", ifound
1908 : 0 : ABI_ERROR("Not all k-points and spins have been found!")
1909 : : end if
1910 : :
1911 : : end if ! master
1912 : :
1913 : : ! Master broadcasts final results.
1914 : 0 : call xmpi_bcast(qp_ebands%eig, master, comm, ierr)
1915 : :
1916 : : ! Recalculate the Fermi level and occupation factors.
1917 : : ! For Semiconductors only the Fermi level is changed (in the middle of the new gap)
1918 : 0 : spinmagntarget_ = -99.99_dp !?; if (PRESENT(spinmagntarget)) spinmagntarget_=spinmagntarget
1919 : 0 : call qp_ebands%update_occ(spinmagntarget_)
1920 : :
1921 : 0 : return
1922 : :
1923 : : 10 continue
1924 : 0 : ABI_ERROR(err_msg)
1925 : :
1926 [ # # # # : 0 : end subroutine ebands_read_qpdata
# # # # ]
1927 : : !!***
1928 : :
1929 : : !----------------------------------------------------------------------
1930 : :
1931 : : !!****f* m_ebands/ebands_get_occupied
1932 : : !! NAME
1933 : : !! ebands_get_occupied
1934 : : !!
1935 : : !! FUNCTION
1936 : : !! For each k-point and spin polarisation, report the band index
1937 : : !! after which the occupation numbers are less than tol_occ.
1938 : : !!
1939 : : !! INPUTS
1940 : : !! ebands<ebands_t>=The object describing the band structure.
1941 : : !! tol_occ[Optional]=Tolerance on the occupation factors.
1942 : : !!
1943 : : !! OUTPUT
1944 : : !!
1945 : : !! NOTES
1946 : : !! We assume that the occupation factors monotonically decrease as a function of energy.
1947 : : !! This is not always true for every smearing technique implemented in Abinit.
1948 : : !! CP: this also not true for occopt 9
1949 : : !!
1950 : : !! SOURCE
1951 : :
1952 [ - + ]: 148 : pure function ebands_get_occupied(ebands, tol_occ) result(occ_idx)
1953 : :
1954 : : !Arguments ------------------------------------
1955 : : !scalars
1956 : : class(ebands_t),intent(in) :: ebands
1957 : : real(dp),optional,intent(in) :: tol_occ
1958 : : !arrays
1959 : : integer :: occ_idx(ebands%nkpt,ebands%nsppol)
1960 : :
1961 : : !Local variables-------------------------------
1962 : : integer :: band,ikpt,spin,idx,nband_k
1963 : : real(dp) :: tol_
1964 : : ! *************************************************************************
1965 : :
1966 [ + - ]: 148 : tol_=tol8; if (PRESENT(tol_occ)) tol_=tol_occ
1967 : :
1968 [ + + ]: 298 : do spin=1,ebands%nsppol
1969 [ + + ]: 1159 : do ikpt=1,ebands%nkpt
1970 : 861 : nband_k = ebands%nband(ikpt+(spin-1)*ebands%nkpt)
1971 : :
1972 : 861 : idx=0
1973 [ + - ]: 4948 : do band=1,nband_k
1974 [ + + ]: 4948 : if (ebands%occ(band,ikpt,spin) < ABS(tol_)) then
1975 : : idx=band; EXIT
1976 : : end if
1977 : : end do
1978 : 861 : occ_idx(ikpt,spin)=idx-1
1979 [ - + ]: 861 : if (idx==1) occ_idx(ikpt,spin)=idx
1980 [ - + ]: 1011 : if (idx==0) occ_idx(ikpt,spin)=nband_k
1981 : :
1982 : : end do
1983 : : end do
1984 : :
1985 : 148 : end function ebands_get_occupied
1986 : : !!***
1987 : :
1988 : : !----------------------------------------------------------------------
1989 : :
1990 : : !!****f* m_ebands/ebands_enclose_degbands
1991 : : !! NAME
1992 : : !! ebands_enclose_degbands
1993 : : !!
1994 : : !! FUNCTION
1995 : : !! Adjust ibmin and ibmax such that all the degenerate states are enclosed
1996 : : !! between ibmin and ibmax. The routine works for a given k-point a spin.
1997 : : !!
1998 : : !! INPUTS
1999 : : !! ebands<ebands_t>=The object describing the band structure.
2000 : : !! ikibz=Index of the k-point.
2001 : : !! spin=Spin index.
2002 : : !! tol_enedif=Tolerance on the energy difference.
2003 : : !!
2004 : : !! OUTPUT
2005 : : !! changed=.TRUE. if ibmin or ibmax has been changed.
2006 : : !! [degblock(2,ndeg)]=Table allocated by the routine containing the index
2007 : : !! of the bands in the `ndeg` degenerate sub-sets
2008 : : !! degblock(1, ii) = first band index in the ii-th degenerate subset.
2009 : : !! degblock(2, ii) = last band index in the ii-th degenerate subset.
2010 : : !!
2011 : : !! SIDE EFFECTS
2012 : : !! ibmin,ibmax=
2013 : : !! Input: initial guess for the indices
2014 : : !! Output: All the denerate states are between ibmin and ibmax
2015 : : !!
2016 : : !! SOURCE
2017 : :
2018 : 767 : subroutine ebands_enclose_degbands(ebands, ikibz, spin, ibmin, ibmax, changed, tol_enedif, &
2019 : : degblock) ! Optional
2020 : :
2021 : : !Arguments ------------------------------------
2022 : : !scalars
2023 : : class(ebands_t),intent(in) :: ebands
2024 : : integer,intent(in) :: ikibz,spin
2025 : : integer,intent(inout) :: ibmin,ibmax
2026 : : real(dp),intent(in) :: tol_enedif
2027 : : logical,intent(out) :: changed
2028 : : !arrays
2029 : : integer,allocatable,optional,intent(out) :: degblock(:,:)
2030 : :
2031 : : !Local variables-------------------------------
2032 : : !scalars
2033 : : integer :: ib,ibmin_bkp,ibmax_bkp,ndeg
2034 : : real(dp) :: emin,emax
2035 : : ! *************************************************************************
2036 : :
2037 : 767 : ibmin_bkp = ibmin; ibmax_bkp = ibmax
2038 : :
2039 : 767 : emin = ebands%eig(ibmin,ikibz,spin)
2040 [ + + ]: 916 : do ib=ibmin-1,1,-1
2041 [ + + ]: 916 : if (ABS(ebands%eig(ib,ikibz,spin) - emin) > tol_enedif) then
2042 : 233 : ibmin = ib +1
2043 : 233 : EXIT
2044 : : else
2045 : 149 : ibmin = ib
2046 : : end if
2047 : : end do
2048 : :
2049 : 767 : emax = ebands%eig(ibmax,ikibz,spin)
2050 [ + + ]: 901 : do ib=ibmax+1,ebands%nband(ikibz+(spin-1)*ebands%nkpt)
2051 [ + + ]: 901 : if (abs(ebands%eig(ib,ikibz,spin) - emax) > tol_enedif) then
2052 : 552 : ibmax = ib - 1
2053 : 552 : EXIT
2054 : : else
2055 : 134 : ibmax = ib
2056 : : end if
2057 : : end do
2058 : :
2059 [ + + + + ]: 767 : changed = (ibmin /= ibmin_bkp) .or. (ibmax /= ibmax_bkp)
2060 : :
2061 : : ! Compute degeneracy table.
2062 [ + + ]: 767 : if (present(degblock)) then
2063 : : ! Count number of degeneracies.
2064 : 226 : ndeg = 1
2065 [ + + ]: 1065 : do ib=ibmin+1,ibmax
2066 [ + + ]: 1065 : if ( abs(ebands%eig(ib,ikibz,spin) - ebands%eig(ib-1,ikibz,spin) ) > tol_enedif) ndeg = ndeg + 1
2067 : : end do
2068 : : ! Build degblock table.
2069 [ - + - + : 678 : ABI_REMALLOC(degblock, (2, ndeg))
+ - + - -
+ - + -
+ ]
2070 : 226 : ndeg = 1; degblock(1, 1) = ibmin
2071 [ + + ]: 1065 : do ib=ibmin+1,ibmax
2072 [ + + ]: 1065 : if ( abs(ebands%eig(ib,ikibz,spin) - ebands%eig(ib-1,ikibz,spin) ) > tol_enedif) then
2073 : 416 : degblock(2, ndeg) = ib - 1
2074 : 416 : ndeg = ndeg + 1
2075 : 416 : degblock(1, ndeg) = ib
2076 : : end if
2077 : : end do
2078 : 226 : degblock(2, ndeg) = ibmax
2079 : : end if
2080 : :
2081 : 767 : end subroutine ebands_enclose_degbands
2082 : : !!***
2083 : :
2084 : : !----------------------------------------------------------------------
2085 : :
2086 : : !!****f* m_ebands/ebands_get_bands_e0
2087 : : !! NAME
2088 : : !! ebands_get_bands_e0
2089 : : !!
2090 : : !! FUNCTION
2091 : : !! Find min/max band indices crossing energy e0
2092 : : !! min/max are returned in brange_spin(1:2, spin) for each spin.
2093 : : !! If no band crosses e0, bmin is set to +huge(1) and bmax to -huge(1) and ierr != 0
2094 : : !!
2095 : : !! INPUTS
2096 : : !!
2097 : : !! OUTPUT
2098 : : !!
2099 : : !! SOURCE
2100 : :
2101 : 0 : subroutine ebands_get_bands_e0(ebands, e0, brange_spin, ierr)
2102 : :
2103 : : !Arguments ------------------------------------
2104 : : !scalars
2105 : : class(ebands_t),intent(in) :: ebands
2106 : : real(dp),intent(in) :: e0
2107 : : integer,intent(out) :: brange_spin(2, ebands%nsppol)
2108 : : integer,intent(out) :: ierr
2109 : : !Local variables-------------------------------
2110 : : integer :: band, spin, bmin, bmax
2111 : : real(dp) :: emin, emax
2112 : : ! *************************************************************************
2113 : :
2114 : 0 : ierr = 0
2115 [ # # ]: 0 : do spin=1,ebands%nsppol
2116 : 0 : bmin = +huge(1); bmax = -huge(1)
2117 : :
2118 [ # # # # ]: 0 : do band=1,minval(ebands%nband)
2119 [ # # # # : 0 : emin = minval(ebands%eig(band, :, spin))
# # # # ]
2120 [ # # # # : 0 : emax = maxval(ebands%eig(band, :, spin))
# # # # ]
2121 [ # # # # ]: 0 : if (emin <= e0 .and. emax >= e0) then
2122 : 0 : bmin = min(bmin, band)
2123 : 0 : bmax = max(bmax, band)
2124 : : end if
2125 : : end do
2126 : :
2127 [ # # ]: 0 : brange_spin(:, spin) = [bmin, bmax]
2128 [ # # ]: 0 : if (bmin == +huge(1)) ierr = ierr + 1
2129 : : end do
2130 : :
2131 : 0 : end subroutine ebands_get_bands_e0
2132 : : !!***
2133 : :
2134 : : !----------------------------------------------------------------------
2135 : :
2136 : : !!****f* m_ebands/ebands_get_erange
2137 : : !! NAME
2138 : : !! ebands_get_erange
2139 : : !!
2140 : : !! FUNCTION
2141 : : !! Compute the minimum and maximum energy enclosing a list of states
2142 : : !! specified by k-points and band indices.
2143 : : !!
2144 : : !! INPUTS
2145 : : !! ebands<ebands_t>=The object describing the band structure.
2146 : : !! nkpts=Number of k-points
2147 : : !! kpoints(3,nkpts)=K-points
2148 : : !! band_range(2,nkpts)=Gives for each k-points, the initial and the final band index to include.
2149 : : !!
2150 : : !! OUTPUT
2151 : : !! emin,emax=min and max energy
2152 : : !!
2153 : : !! SOURCE
2154 : :
2155 : 0 : subroutine ebands_get_erange(ebands, nkpts, kpoints, band_range, emin, emax)
2156 : :
2157 : : !Arguments ------------------------------------
2158 : : !scalars
2159 : : class(ebands_t),intent(in) :: ebands
2160 : : integer,intent(in) :: nkpts
2161 : : real(dp),intent(out) :: emin,emax
2162 : : !arrays
2163 : : integer,intent(in) :: band_range(2,nkpts)
2164 : : real(dp),intent(in) :: kpoints(3,nkpts)
2165 : :
2166 : : !Local variables-------------------------------
2167 : : !scalars
2168 : : integer :: spin,ik,ikpt,cnt
2169 : 0 : type(krank_t) :: krank
2170 : : ! *************************************************************************
2171 : :
2172 : 0 : call krank%init(ebands%nkpt, ebands%kptns)
2173 : 0 : emin = huge(one); emax = -huge(one); cnt = 0
2174 : :
2175 [ # # ]: 0 : do spin=1,ebands%nsppol
2176 [ # # ]: 0 : do ik=1,nkpts
2177 : 0 : ikpt = krank%get_index(kpoints(:,ik))
2178 [ # # ]: 0 : if (ikpt == -1) then
2179 : 0 : ABI_WARNING(sjoin("Cannot find k-point:", ktoa(kpoints(:,ik))))
2180 : 0 : cycle
2181 : : end if
2182 [ # # # # ]: 0 : if (.not. (band_range(1,ik) >= 1 .and. band_range(2,ik) <= ebands%mband)) cycle
2183 : 0 : cnt = cnt + 1
2184 [ # # # # : 0 : emin = min(emin, minval(ebands%eig(band_range(1,ik):band_range(2,ik), ikpt, spin)))
# # # # ]
2185 [ # # # # : 0 : emax = max(emax, maxval(ebands%eig(band_range(1,ik):band_range(2,ik), ikpt, spin)))
# # # # ]
2186 : : end do
2187 : : end do
2188 : :
2189 : 0 : call krank%free()
2190 : :
2191 : : ! This can happen if wrong input.
2192 [ # # ]: 0 : if (cnt == 0) then
2193 : 0 : ABI_WARNING("None of the k-points/bands provided was found in ebands%")
2194 [ # # # # : 0 : emin = minval(ebands%eig); emax = maxval(ebands%eig)
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
2195 : : end if
2196 : :
2197 [ # # # # : 0 : end subroutine ebands_get_erange
# # ]
2198 : : !!***
2199 : :
2200 : : !----------------------------------------------------------------------
2201 : :
2202 : : !!****f* m_ebands/ebands_nelect_per_spin
2203 : : !! NAME
2204 : : !! ebands_nelect_per_spin
2205 : : !!
2206 : : !! FUNCTION
2207 : : !! Return number of electrons in each spin channel (computed from occoputation factors if nsppol=2)
2208 : : !!
2209 : : !! INPUTS
2210 : : !! ebands<ebands_t>=The object describing the band structure.
2211 : : !!
2212 : : !! OUTPUT
2213 : : !! nelect_per_spin(ebands%nsppol)=For each spin the number of electrons (eventually fractional)
2214 : : !!
2215 : : !! SOURCE
2216 : :
2217 [ - + ]: 2 : pure function ebands_nelect_per_spin(ebands) result(nelect_per_spin)
2218 : :
2219 : : !Arguments ------------------------------------
2220 : : !scalars
2221 : : class(ebands_t),intent(in) :: ebands
2222 : : !arrays
2223 : : real(dp) :: nelect_per_spin(ebands%nsppol)
2224 : :
2225 : : !Local variables-------------------------------
2226 : : integer :: iband,ikpt,spin
2227 : : ! *************************************************************************
2228 : :
2229 [ + + ]: 4 : nelect_per_spin = ebands%nelect
2230 [ - + ]: 2 : if (ebands%nsppol > 1) then
2231 [ # # ]: 0 : nelect_per_spin = zero
2232 [ # # ]: 0 : do spin=1,ebands%nsppol
2233 [ # # ]: 0 : do ikpt=1,ebands%nkpt
2234 [ # # ]: 0 : do iband=1,ebands%nband(ikpt+ebands%nkpt*(spin-1))
2235 : 0 : nelect_per_spin(spin) = nelect_per_spin(spin) + ebands%wtk(ikpt) * ebands%occ(iband, ikpt, spin)
2236 : : end do
2237 : : end do
2238 : : end do
2239 : : end if
2240 : :
2241 : 2 : end function ebands_nelect_per_spin
2242 : : !!***
2243 : :
2244 : : !----------------------------------------------------------------------
2245 : :
2246 : : !!****f* m_ebands/ebands_get_minmax
2247 : : !! NAME
2248 : : !! ebands_get_minmax
2249 : : !!
2250 : : !! FUNCTION
2251 : : !! Report the min and max value over k-points and bands of (eig|occ|doccde) for each
2252 : : !! spin. Cannot use F90 array syntax due to the internal storage used in abinit.
2253 : : !!
2254 : : !! INPUTS
2255 : : !! arr_name=The name of the array whose min and Max value has to be calculated.
2256 : : !! Possible values: 'occ', 'eig' 'doccde'
2257 : : !!
2258 : : !! OUTPUT
2259 : : !! minmax(2,ebands%nsppol)=For each spin the min and max value of the quantity specified by "arr_name"
2260 : : !!
2261 : : !! SOURCE
2262 : :
2263 [ - + ]: 18 : function ebands_get_minmax(ebands, arr_name) result(minmax)
2264 : :
2265 : : !Arguments ------------------------------------
2266 : : !scalars
2267 : : class(ebands_t),target,intent(in) :: ebands
2268 : : character(len=*),intent(in) :: arr_name
2269 : : !arrays
2270 : : real(dp) :: minmax(2,ebands%nsppol)
2271 : :
2272 : : !Local variables-------------------------------
2273 : : !scalars
2274 : : integer :: band,ikpt,spin,nband_k
2275 : : real(dp) :: datum
2276 : : !arrays
2277 : 18 : real(dp), contiguous, pointer :: rdata(:,:,:)
2278 : : ! *************************************************************************
2279 : :
2280 : 36 : select case (tolower(arr_name))
2281 : : case ('occ')
2282 : 0 : rdata => ebands%occ
2283 : : case ('eig')
2284 : 18 : rdata => ebands%eig
2285 : : case ('doccde')
2286 : 0 : rdata => ebands%doccde
2287 : : case default
2288 [ - + - - ]: 18 : ABI_BUG(sjoin('Wrong arr_name:', arr_name))
2289 : : end select
2290 : :
2291 [ + + ]: 36 : minmax(1,:)=greatest_real
2292 [ + + ]: 36 : minmax(2,:)=smallest_real
2293 : :
2294 [ + + ]: 36 : do spin=1,ebands%nsppol
2295 [ + + ]: 4088 : do ikpt=1,ebands%nkpt
2296 : 4052 : nband_k=ebands%nband(ikpt+(spin-1)*ebands%nkpt)
2297 [ + + ]: 38169 : do band=1,nband_k
2298 : 34099 : datum=rdata(band,ikpt,spin)
2299 : 34099 : minmax(1,spin)=MIN(minmax(1,spin),datum)
2300 : 38151 : minmax(2,spin)=MAX(minmax(2,spin),datum)
2301 : : end do
2302 : : end do
2303 : : end do
2304 : :
2305 : 18 : end function ebands_get_minmax
2306 : : !!***
2307 : :
2308 : : !----------------------------------------------------------------------
2309 : :
2310 : : !!****f* m_ebands/ebands_has_metal_scheme
2311 : : !! NAME
2312 : : !! ebands_metallic_scheme
2313 : : !!
2314 : : !! FUNCTION
2315 : : !! Returns .TRUE. if metallic occupation scheme is used.
2316 : : !! Note that this does not imply that the system is metallic.
2317 : : !!
2318 : : !! SOURCE
2319 : :
2320 : 1988 : pure logical function ebands_has_metal_scheme(ebands) result(ans)
2321 : :
2322 : : !Arguments ------------------------------------
2323 : : class(ebands_t),intent(in) :: ebands
2324 : : ! *************************************************************************
2325 : :
2326 [ + + + + : 13259 : ans = (any(ebands%occopt == [3, 4, 5, 6, 7, 8, 9]))
+ + + + +
- - + + -
- + ]
2327 : :
2328 : 922 : end function ebands_has_metal_scheme
2329 : : !!***
2330 : :
2331 : : !----------------------------------------------------------------------
2332 : :
2333 : : !!****f* m_ebands/ebands_write_bxsf
2334 : : !! NAME
2335 : : !! ebands_write_bxsf
2336 : : !!
2337 : : !! FUNCTION
2338 : : !! Write 3D energies for Fermi surface visualization (XSF format)
2339 : : !!
2340 : : !! INPUTS
2341 : : !! crystal<crystal_t>=Info on unit cell and symmetries.
2342 : : !! fname=File name for output.
2343 : : !!
2344 : : !! OUTPUT
2345 : : !! ierr=Status error.
2346 : : !!
2347 : : !! SIDE EFFECTS
2348 : : !! Produce BXSF file.
2349 : : !!
2350 : : !! SOURCE
2351 : :
2352 : 2 : integer function ebands_write_bxsf(ebands, crystal, fname) result(ierr)
2353 : :
2354 : : !Arguments ------------------------------------
2355 : : !scalars
2356 : : class(ebands_t),intent(in) :: ebands
2357 : : character(len=*),intent(in) :: fname
2358 : : class(crystal_t),intent(in) :: crystal
2359 : :
2360 : : !Local variables-------------------------------
2361 : : logical :: use_timrev
2362 : : ! *************************************************************************
2363 : :
2364 : 2 : use_timrev = (crystal%timrev==2)
2365 : :
2366 [ + - ]: 2 : if (ebands%occopt /= 9) then
2367 : : call printbxsf(ebands%eig,zero,ebands%fermie,crystal%gprimd,ebands%kptrlatt,ebands%mband,&
2368 : : ebands%nkpt,ebands%kptns,crystal%nsym,crystal%use_antiferro,crystal%symrec,crystal%symafm,&
2369 : 2 : use_timrev,ebands%nsppol,ebands%shiftk,ebands%nshiftk,fname,ierr)
2370 : : else
2371 : : call printbxsf(ebands%eig,zero,ebands%fermie,crystal%gprimd,ebands%kptrlatt,ebands%mband,&
2372 : : ebands%nkpt,ebands%kptns,crystal%nsym,crystal%use_antiferro,crystal%symrec,crystal%symafm,&
2373 [ # # ]: 0 : use_timrev,ebands%nsppol,ebands%shiftk,ebands%nshiftk,trim(fname)//"-e",ierr)
2374 : :
2375 : : call printbxsf(ebands%eig,zero,ebands%fermih,crystal%gprimd,ebands%kptrlatt,ebands%mband,&
2376 : : ebands%nkpt,ebands%kptns,crystal%nsym,crystal%use_antiferro,crystal%symrec,crystal%symafm,&
2377 [ # # ]: 0 : use_timrev,ebands%nsppol,ebands%shiftk,ebands%nshiftk,trim(fname)//"-h",ierr)
2378 : : end if
2379 : :
2380 : 2 : end function ebands_write_bxsf
2381 : : !!***
2382 : :
2383 : : !----------------------------------------------------------------------
2384 : :
2385 : : !!****f* m_ebands/ebands_update_occ
2386 : : !! NAME
2387 : : !! ebands_update_occ
2388 : : !!
2389 : : !! FUNCTION
2390 : : !! Calculate new occupation numbers, the Fermi level and the Max occupied band index
2391 : : !! for each spin channel starting from the the knowledge of eigenvalues.
2392 : : !!
2393 : : !! INPUTS
2394 : : !! ebands<ebands_t>=Info on the band structure, the smearing technique and the physical temperature used.
2395 : : !! spinmagntarget=if differ from -99.99d0, fix the spin polarization (in Bohr magneton)
2396 : : !! [stmbias]=
2397 : : !! [prtvol]=Verbosity level (0 for lowest level)
2398 : : !! [fermie_to_zero]=If True, fermie is set to zero and energies are shifted accordingly. Default: False
2399 : : !!
2400 : : !! OUTPUT
2401 : : !! see also SIDE EFFECTS.
2402 : : !!
2403 : : !! SIDE EFFECTS
2404 : : !! === For metallic occupation the following quantities are recalculated ===
2405 : : !! %fermie=the new Fermi energy
2406 : : !! %entropy=the new entropy associated with the smearing.
2407 : : !! %occ(mband,nkpt,nsppol)=occupation numbers
2408 : : !! %doccde(mband,nkpt,nsppol)=derivative of occupancies wrt the energy for each band and k point
2409 : : !!
2410 : : !! === In case of semiconductors ===
2411 : : !! All the quantitities in ebands are left unchanged with the exception of:
2412 : : !! %fermie=Redefined so that it is in the middle of the gap
2413 : : !! %entropy=Set to zero
2414 : : !!
2415 : : !! SOURCE
2416 : :
2417 : 1045 : subroutine ebands_update_occ(ebands, spinmagntarget, stmbias, prtvol, fermie_to_zero)
2418 : :
2419 : : !Arguments ------------------------------------
2420 : : !scalars
2421 : : class(ebands_t),intent(inout) :: ebands
2422 : : integer,optional,intent(in) :: prtvol
2423 : : real(dp),intent(in) :: spinmagntarget
2424 : : real(dp),optional,intent(in) :: stmbias
2425 : : logical,optional,intent(in) :: fermie_to_zero
2426 : :
2427 : : !Local variables-------------------------------
2428 : : !scalars
2429 : : integer :: band,mband,ikibz,nkpt,spin,nsppol,my_prtvol,nband_k
2430 : : real(dp) :: entropy,fermie,fermih,stmbias_local,ndiff,cbot,vtop,maxocc
2431 : : character(len=500) :: msg
2432 : : !arrays
2433 : 4180 : real(dp) :: nelect_spin(ebands%nsppol),condbottom(ebands%nsppol),valencetop(ebands%nsppol)
2434 : 1045 : real(dp),allocatable :: doccde(:),occ(:),eigen(:)
2435 : : ! *************************************************************************
2436 : :
2437 [ + + ]: 1045 : my_prtvol = 0; if (PRESENT(prtvol )) my_prtvol = prtvol
2438 [ - + ]: 1045 : stmbias_local = zero; if (PRESENT(stmbias)) stmbias_local = stmbias
2439 : :
2440 [ + + ]: 1045 : if (ebands_has_metal_scheme(ebands)) then
2441 : : ! Compute new occupation numbers if metallic occupation.
2442 [ - + ]: 347 : if (my_prtvol > 10) then
2443 : 0 : call wrtout(std_out, sjoin(' metallic scheme: calling newocc with spinmagntarget:', ftoa(spinmagntarget, fmt="f9.5")))
2444 : : end if
2445 : :
2446 : : ! newocc assumes eigenvalues and occupations packed in 1d-vector!!
2447 : 347 : mband = ebands%mband; nkpt = ebands%nkpt; nsppol = ebands%nsppol
2448 : :
2449 [ - + + - : 1041 : ABI_MALLOC(eigen, (mband*nkpt*nsppol))
+ - + - -
+ - + ]
2450 : 347 : call get_eneocc_vect(ebands, 'eig', eigen)
2451 : :
2452 [ - + + - : 694 : ABI_MALLOC(occ, (mband*nkpt*nsppol))
- + - + ]
2453 [ - + + - : 694 : ABI_MALLOC(doccde, (mband*nkpt*nsppol))
- + - + ]
2454 : :
2455 : : call newocc(doccde,eigen,entropy,fermie,fermih,ebands%ivalence,spinmagntarget,mband,ebands%nband,&
2456 : : ebands%nelect,ebands%ne_qFD,ebands%nh_qFD,ebands%nkpt,ebands%nspinor,ebands%nsppol,occ,ebands%occopt,&
2457 : 347 : my_prtvol,ebands%tphysel,ebands%tsmear,ebands%wtk,stmbias=stmbias_local)
2458 : :
2459 : : ! Save output in ebands%.
2460 : 347 : ebands%entropy = entropy
2461 : 347 : ebands%fermie = fermie
2462 : 347 : ebands%fermih = fermih
2463 : 347 : call put_eneocc_vect(ebands, 'occ', occ)
2464 : 347 : call put_eneocc_vect(ebands, 'doccde', doccde)
2465 [ - + ]: 347 : ABI_FREE(eigen)
2466 [ - + ]: 347 : ABI_FREE(occ)
2467 [ - + ]: 694 : ABI_FREE(doccde)
2468 : :
2469 : : else
2470 : : ! Semiconductor (non magnetic case)
2471 : 698 : maxocc = two / (ebands%nsppol*ebands%nspinor)
2472 : : !
2473 : : ! FIXME here there is an inconsistency btw the GW code and Abinit
2474 : : ! In ABINIT, Fermi is set to the HOMO level while in GW fermi is at midgap
2475 : : ! In case of crystal systems, the later convention should be preferable.
2476 : : ! Anyway we have to decide and follow a unique convention to avoid problems.
2477 : : !
2478 : : ! Occupation factors MUST be initialized
2479 : : !if (ALL(ABS(ebands%occ) < tol6)) then
2480 [ + + ]: 698 : if (ebands%occopt /= 2) then
2481 [ - + ]: 692 : ABI_CHECK(ebands%nelect == nint(ebands%nelect), "nelect should be integer")
2482 : 692 : mband = nint((ebands%nelect * ebands%nspinor) / 2)
2483 [ + + + + : 131513 : ebands%occ = zero
+ + ]
2484 [ + + + + : 42511 : ebands%occ(1:mband,:,:) = maxocc
+ + ]
2485 : : !ABI_ERROR("Occupation factors are not initialized, likely due to scf = -2")
2486 : : end if
2487 : :
2488 : : ! Calculate the valence index for each spin channel.
2489 [ + + ]: 1410 : do spin=1,ebands%nsppol
2490 : 712 : valencetop(spin) = smallest_real
2491 : 712 : condbottom(spin) = greatest_real / 1000000_dp ! to avoid overflow when multiply by Ha2meV.
2492 [ + + ]: 8882 : do ikibz=1,ebands%nkpt
2493 : 7472 : nband_k = ebands%nband(ikibz + (spin-1)*ebands%nkpt)
2494 [ + + ]: 130905 : do band=1,nband_k
2495 [ + + + + ]: 122721 : if (ebands%occ(band,ikibz,spin) / maxocc > one-tol6 .and. valencetop(spin) < ebands%eig(band,ikibz,spin)) then
2496 : 4307 : valencetop(spin) = ebands%eig(band,ikibz,spin)
2497 : : end if
2498 [ + + + + ]: 130193 : if (ebands%occ(band,ikibz,spin) / maxocc < tol6 .and. condbottom(spin) > ebands%eig(band,ikibz,spin)) then
2499 : 2029 : condbottom(spin) = ebands%eig(band,ikibz,spin)
2500 : : end if
2501 : : end do
2502 : : end do
2503 : : end do
2504 : :
2505 [ + - - + : 2108 : vtop = MAXVAL(valencetop)
- - + + ]
2506 [ + - - + : 2108 : cbot = MINVAL(condbottom)
- - + + ]
2507 : :
2508 : : write(msg,'(3(a,f8.4,2a))') &
2509 : 698 : " Top of valence: ", vtop * Ha_eV," (eV)", ch10, &
2510 : 698 : " Bottom of conduction: ", cbot * Ha_eV, " (eV)", ch10, &
2511 : 1396 : " Fundamental gap:", (cbot - vtop) * Ha_eV, " (eV)", ch10
2512 : 698 : call wrtout(std_out, msg)
2513 : :
2514 [ + + ]: 698 : if (ebands%nsppol == 2) then
2515 [ + - - + : 56 : if (ABS(vtop - MINVAL(valencetop)) > tol6) then
- - + + +
+ ]
2516 : 10 : call wrtout(std_out, sjoin(' Top of valence is spin: ', itoa(imax_loc(valencetop))))
2517 : : end if
2518 [ + - - + : 56 : if (ABS(cbot - MAXVAL(condbottom)) > tol6) then
- - + + +
+ ]
2519 : 6 : call wrtout(std_out, ' Bottom of conduction is spin: ', itoa(imin_loc(condbottom)))
2520 : : end if
2521 : : end if
2522 : :
2523 : : ! Save results. Here I dont know if it is better to be consistent with the abinit convention i.e fermi = vtop
2524 : 698 : ebands%entropy = zero
2525 : 698 : ebands%fermie = (vtop + cbot) / 2
2526 [ - + ]: 698 : if (ABS(cbot - vtop) < tol4) ebands%fermie = vtop ! To avoid error on the last digit
2527 : : end if
2528 : :
2529 : 1045 : call wrtout(std_out, sjoin(' Fermi level: ', ftoa(ebands%fermie * Ha_eV, fmt="f8.4"), " (eV)", ch10))
2530 : :
2531 : : ! Compute number of electrons for each spin channel.
2532 [ + + ]: 2106 : nelect_spin(:)=zero
2533 [ + + ]: 2106 : do spin=1,ebands%nsppol
2534 [ + + ]: 59298 : do ikibz=1,ebands%nkpt
2535 : 57192 : nband_k = ebands%nband(ikibz+(spin-1)*ebands%nkpt)
2536 [ + + ]: 661165 : nelect_spin(spin)= nelect_spin(spin) + ebands%wtk(ikibz) * sum(ebands%occ(1:nband_k,ikibz,spin))
2537 : : end do
2538 : : end do
2539 : :
2540 [ + + ]: 2106 : ndiff = ebands%nelect - SUM(nelect_spin)
2541 [ + + ]: 1045 : if (my_prtvol > 0) then
2542 : 109 : write(msg,'(2a,f6.2,2a,f7.4)')ch10,&
2543 [ + + ]: 218 : ' Total number of electrons: ', sum(nelect_spin),ch10,&
2544 : 218 : ' Input and calculated no. of electrons differ by ',ndiff
2545 : 109 : call wrtout(std_out, msg)
2546 : : end if
2547 : :
2548 [ - + ]: 1045 : if (ABS(ndiff) > 5.d-2*ebands%nelect) then
2549 : : write(msg,'(2a,2(a,es12.4))') &
2550 : 0 : 'Too large difference in number of electrons:,',ch10,&
2551 [ # # ]: 0 : 'Expected = ',ebands%nelect,' Calculated = ',sum(nelect_spin)
2552 : 0 : ABI_ERROR(msg)
2553 : : end if
2554 : :
2555 [ - + ]: 1045 : if (present(fermie_to_zero)) then
2556 [ # # ]: 0 : if (fermie_to_zero) then
2557 [ # # # # : 0 : ebands%eig = ebands%eig - ebands%fermie
# # ]
2558 : 0 : ebands%fermih = ebands%fermih - ebands%fermie
2559 : 0 : ebands%fermie = zero
2560 : : end if
2561 : : end if
2562 : :
2563 [ - + - + ]: 1045 : end subroutine ebands_update_occ
2564 : : !!***
2565 : :
2566 : : !----------------------------------------------------------------------
2567 : :
2568 : : !!****f* m_ebands/ebands_set_scheme
2569 : : !! NAME
2570 : : !! ebands_set_scheme
2571 : : !!
2572 : : !! FUNCTION
2573 : : !! Set the occupation scheme and re-calculate new occupation numbers,
2574 : : !! the Fermi level and the Max occupied band index for each spin channel starting
2575 : : !! from the the knowledge of eigenvalues. See ebands_update_occ for more info.
2576 : : !!
2577 : : !! INPUTS
2578 : : !! occopt=Occupation options (see input variable)
2579 : : !! tsmear=Temperature of smearing.
2580 : : !! spinmagntarget=if differ from -99.99d0, fix the spin polarization (in Bohr magneton)
2581 : : !! prtvol=Verbosity level (0 for lowest level)
2582 : : !! [update_occ]=False to avoid recomputing occupation factors (mainly used when a call to set_scheme is followed
2583 : : !! by another call to set_extrael (update_occ is expensive for large k-meshes). Default: True.
2584 : : !!
2585 : : !! SOURCE
2586 : :
2587 : 301 : subroutine ebands_set_scheme(ebands, occopt, tsmear, spinmagntarget, prtvol, update_occ)
2588 : :
2589 : : !Arguments ------------------------------------
2590 : : !scalars
2591 : : class(ebands_t),intent(inout) :: ebands
2592 : : integer,intent(in) :: occopt
2593 : : integer,intent(in) :: prtvol
2594 : : real(dp),intent(in) :: tsmear, spinmagntarget
2595 : : logical,optional,intent(in) :: update_occ
2596 : :
2597 : : !Local variables-------------------------------
2598 : : logical :: my_update_occ
2599 : : ! *************************************************************************
2600 : :
2601 [ + + ]: 301 : my_update_occ = .True.; if (present(update_occ)) my_update_occ = update_occ
2602 : :
2603 [ - + ]: 301 : if (prtvol > 10) then
2604 : 0 : call wrtout(std_out, " Changing occupation scheme in electron bands")
2605 : 0 : call wrtout(std_out, sjoin(" occopt:", itoa(ebands%occopt), " ==> ", itoa(occopt)))
2606 : 0 : call wrtout(std_out, sjoin(" tsmear:", ftoa(ebands%tsmear), " ==> ", ftoa(tsmear)))
2607 : : end if
2608 : :
2609 : 301 : ebands%occopt = occopt; ebands%tsmear = tsmear
2610 : :
2611 [ + + ]: 301 : if (my_update_occ) then
2612 : 265 : call ebands%update_occ(spinmagntarget, prtvol=prtvol)
2613 [ - + ]: 265 : if (prtvol > 10) call wrtout(std_out, sjoin(' Fermi level is now:', ftoa(ebands%fermie)))
2614 : : end if
2615 : :
2616 : 301 : end subroutine ebands_set_scheme
2617 : : !!***
2618 : :
2619 : : !----------------------------------------------------------------------
2620 : :
2621 : : !!****f* m_ebands/ebands_set_fermie
2622 : : !! NAME
2623 : : !! ebands_set_fermie
2624 : : !!
2625 : : !! FUNCTION
2626 : : !! Set the new Fermi level from eigenenergies eigen and change the number of electrons
2627 : : !! Compute also new occupation numbers at each k point, from eigenenergies eigen, according to the
2628 : : !! smearing scheme defined by occopt (and smearing width tsmear or tphysel) as well as
2629 : : !! entropy and derivative of occupancies wrt the energy for each band and k point.
2630 : : !!
2631 : : !! INPUTS
2632 : : !! fermie=New fermi level
2633 : : !!
2634 : : !! OUTPUT
2635 : : !! msg=String describing the changes in fermie and nelect.
2636 : : !!
2637 : : !! NOTES
2638 : : !! The routine assumes metallic occupation scheme and will abort it this condition is not satisfied.
2639 : : !! Use ebands_set_scheme before calling this routine, if you have a semiconductor.
2640 : : !!
2641 : : !! SOURCE
2642 : :
2643 : 1 : subroutine ebands_set_fermie(ebands, fermie, msg)
2644 : :
2645 : : !Arguments ------------------------------------
2646 : : !scalars
2647 : : class(ebands_t),intent(inout) :: ebands
2648 : : real(dp),intent(in) :: fermie
2649 : : character(len=*),intent(out) :: msg
2650 : :
2651 : : !Local variables-------------------------------
2652 : : !scalars
2653 : : integer,parameter :: option1=1, unitdos0 = 0
2654 : : integer :: mband, nkpt, nsppol
2655 : : real(dp),parameter :: dosdeltae0 = zero
2656 : : real(dp) :: prev_fermie, prev_nelect, maxocc
2657 : : !arrays
2658 : 1 : real(dp),allocatable :: doccde(:),occ(:),eigen(:)
2659 : : ! *************************************************************************
2660 : :
2661 [ - + ]: 1 : if (ebands%occopt == 9) then
2662 : 0 : ABI_ERROR("set_fermie unavailable when occopt 9")
2663 : : end if
2664 [ - + ]: 1 : if (.not. ebands_has_metal_scheme(ebands)) then
2665 : 0 : ABI_ERROR("set_fermie assumes a metallic occupation scheme. Use ebands_set_scheme before calling ebands_set_fermie!")
2666 : : end if
2667 : :
2668 : 1 : prev_fermie = ebands%fermie; prev_nelect = ebands%nelect
2669 : :
2670 : : ! newocc assumes eigenvalues and occupations packed in 1d-vector!!
2671 : 1 : mband = ebands%mband
2672 : 1 : nkpt = ebands%nkpt
2673 : 1 : nsppol = ebands%nsppol
2674 : 1 : maxocc = two / (nsppol*ebands%nspinor)
2675 : :
2676 [ - + + - : 3 : ABI_MALLOC(eigen, (mband*nkpt*nsppol))
+ - + - -
+ - + ]
2677 : 1 : call get_eneocc_vect(ebands, 'eig', eigen)
2678 [ - + + - : 2 : ABI_MALLOC(occ, (mband*nkpt*nsppol))
- + - + ]
2679 [ - + + - : 2 : ABI_MALLOC(doccde, (mband*nkpt*nsppol))
- + - + ]
2680 : :
2681 : : ! Get the total number of electrons nelect, given the new fermi energy.
2682 : : call getnel(doccde,dosdeltae0,eigen,ebands%entropy,fermie,fermie,maxocc,mband,ebands%nband,&
2683 : : ebands%nelect,nkpt,nsppol,occ,ebands%occopt,option1,ebands%tphysel,ebands%tsmear,unitdos0,&
2684 : 1 : ebands%wtk,1,ebands%nband(1))
2685 : :
2686 : : ! Save changes in ebands%.
2687 : 1 : ebands%fermie = fermie
2688 : 1 : call put_eneocc_vect(ebands,'occ' ,occ)
2689 : 1 : call put_eneocc_vect(ebands,'doccde',doccde)
2690 : :
2691 [ - + ]: 1 : ABI_FREE(eigen)
2692 [ - + ]: 1 : ABI_FREE(occ)
2693 [ - + ]: 1 : ABI_FREE(doccde)
2694 : :
2695 : : write(msg,"(2(a,es16.6),a,2(a,es16.6))") &
2696 : 1 : " Old fermi level: ",prev_fermie,", with nelect: ",prev_nelect,ch10, &
2697 : 2 : " New fermi level: ",ebands%fermie,", with nelect: ",ebands%nelect
2698 : :
2699 : 1 : end subroutine ebands_set_fermie
2700 : : !!***
2701 : :
2702 : : !----------------------------------------------------------------------
2703 : :
2704 : : !!****f* m_ebands/ebands_set_extrael
2705 : : !! NAME
2706 : : !! ebands_set_extrael
2707 : : !!
2708 : : !! FUNCTION
2709 : : !! Add extrael to ebands%nelect. Set value of ebands%extrael
2710 : : !! Recompute Fermi level from eigenenergies
2711 : : !! and new occupation numbers according to the smearing scheme defined by occopt
2712 : : !! (and smearing width tsmear or tphysel) as well as
2713 : : !! entropy and derivative of occupancies wrt the energy for each band and k point.
2714 : : !!
2715 : : !! INPUTS
2716 : : !! nelect=New number of electrons
2717 : : !! nholes=New number of excited holes
2718 : : !! extrael=Number of electrons be added in units. Negative to add holes
2719 : : !! spinmagntarget=if differ from -99.99d0, fix the spin polarization (in Bohr magneton)
2720 : : !! [prtvol]=Verbosity level
2721 : : !!
2722 : : !! OUTPUT
2723 : : !! msg=String describing the changes in fermie and nelect.
2724 : : !!
2725 : : !! NOTES
2726 : : !! The routine assumes metallic occupation scheme and will abort it this condition is not satisfied.
2727 : : !! Use ebands_set_scheme before calling this routine, if you have a semiconductor.
2728 : : !!
2729 : : !! SOURCE
2730 : 20 : subroutine ebands_set_extrael(ebands, nelect, nholes, spinmagntarget, msg, prtvol)
2731 : :
2732 : : !Arguments ------------------------------------
2733 : : !scalars
2734 : : class(ebands_t),intent(inout) :: ebands
2735 : : integer,optional,intent(in) :: prtvol
2736 : : real(dp),intent(in) :: nelect,nholes,spinmagntarget
2737 : : character(len=*),intent(out) :: msg
2738 : :
2739 : : !Local variables-------------------------------
2740 : : !scalars
2741 : : integer :: my_prtvol
2742 : : real(dp) :: prev_fermie,prev_fermih,prev_nelect,prev_nholes
2743 : : ! *************************************************************************
2744 : :
2745 [ - + ]: 20 : my_prtvol = 0; if (present(prtvol)) my_prtvol = prtvol
2746 : :
2747 [ - + ]: 20 : if (.not. ebands_has_metal_scheme(ebands)) then
2748 : 0 : ABI_ERROR("set_extrael assumes a metallic occupation scheme. Use ebands_set_scheme!")
2749 : : end if
2750 : :
2751 : 20 : prev_fermie = ebands%fermie; prev_nelect = ebands%nelect
2752 : 20 : prev_fermih = ebands%fermie; prev_nholes = zero
2753 : : ! Here we set the value of extrael
2754 : 20 : ebands%extrael = nelect-nholes
2755 : 20 : ebands%nelect = ebands%nelect + ebands%extrael
2756 [ + - ]: 20 : if (ebands%occopt /= 9) then
2757 : 20 : ebands%ne_qFD = zero
2758 : 20 : ebands%nh_qFD = zero
2759 : : else
2760 : 0 : prev_fermie = ebands%fermie; prev_nelect = ebands%ne_qFD
2761 : 0 : prev_fermih = ebands%fermih; prev_nholes = ebands%nh_qFD
2762 : 0 : ebands%ne_qFD = nelect
2763 : 0 : ebands%nh_qFD = nholes
2764 : : end if
2765 : :
2766 : 20 : call ebands%update_occ(spinmagntarget, prtvol=my_prtvol)
2767 : :
2768 [ + - ]: 20 : if (ebands%occopt/=9) then
2769 : : write(msg,"(2(a,es16.6),a,2(a,es16.6))")&
2770 : 20 : " Old fermi level: ",prev_fermie,", with nelect: ",prev_nelect,ch10,&
2771 : 40 : " New fermi level: ",ebands%fermie,", with nelect: ",ebands%nelect
2772 : 20 : call wrtout(std_out, msg)
2773 : : else
2774 : : write(msg,"(2(a,es16.6),a,2(a,es16.6))")&
2775 : 0 : " Old electron fermi level: ",prev_fermie,", with nelect: ",prev_nelect,ch10,&
2776 : 0 : " New electron fermi level: ",ebands%fermie,", with nelect: ",ebands%ne_qFD
2777 : 0 : call wrtout(std_out, msg)
2778 : : write(msg,"(2(a,es16.6),a,2(a,es16.6))")&
2779 : 0 : " Old holes fermi level: ",prev_fermih,", with nelect: ",prev_nelect-prev_nholes,ch10,&
2780 : 0 : " New holes fermi level: ",ebands%fermih,", with nholes: ",ebands%nelect-ebands%nh_qFD
2781 : 0 : call wrtout(std_out, msg)
2782 : : end if
2783 : :
2784 : 20 : end subroutine ebands_set_extrael
2785 : : !!***
2786 : :
2787 : : !----------------------------------------------------------------------
2788 : :
2789 : : !!****f* m_ebands/ebands_get_muT_with_fd
2790 : : !! NAME
2791 : : !! ebands_get_muT_with_fd
2792 : : !!
2793 : : !! FUNCTION
2794 : : !! Compute the Fermi level for different temperatures using Fermi-Dirac occupation function (physical T)
2795 : : !! Use ebands%nelect provided in input. Does not change input ebands.
2796 : : !!
2797 : : !! INPUTS
2798 : : !!
2799 : : !! OUTPUT
2800 : : !!
2801 : : !! SOURCE
2802 : :
2803 : 64 : subroutine ebands_get_muT_with_fd(self, ntemp, kTmesh, spinmagntarget, prtvol, mu_e, comm)
2804 : :
2805 : : !Arguments ------------------------------------
2806 : : !scalars
2807 : : class(ebands_t),intent(in) :: self
2808 : : integer,intent(in) :: ntemp, prtvol, comm
2809 : : real(dp),intent(in) :: spinmagntarget
2810 : : real(dp),intent(in) :: kTmesh(ntemp)
2811 : : real(dp),intent(out) :: mu_e(ntemp)
2812 : :
2813 : : !Local variables-------------------------------
2814 : : !scalars
2815 : : integer,parameter :: occopt3 = 3
2816 : : integer :: ierr, it, nprocs, my_rank
2817 : : real(dp) :: nelect, cpu, wall, gflops
2818 : 64 : type(ebands_t) :: tmp_ebands
2819 : : character(len=500) :: msg
2820 : : ! *************************************************************************
2821 : :
2822 : 64 : my_rank = xmpi_comm_rank(comm); nprocs = xmpi_comm_size(comm)
2823 : 64 : call cwtime(cpu, wall, gflops, "start")
2824 : :
2825 : 64 : call self%copy(tmp_ebands)
2826 : :
2827 : : ! Check if nband is "large enough" to compute the Fermi level.
2828 : 64 : ierr = self%has_enough_bands_for_ef(msg)
2829 [ + + ]: 64 : if (ierr /= 0) then
2830 : 1 : ABI_WARNING(msg)
2831 : : end if
2832 : : !if (ierr > 0) then
2833 : : ! ABI_ERROR(msg)
2834 : : !end if
2835 : : !if (ierr < 0) then
2836 : : ! ABI_WARNING(msg)
2837 : : !end if
2838 : :
2839 [ + + ]: 308 : mu_e = zero
2840 [ + + ]: 308 : do it=1,ntemp
2841 [ + - ]: 244 : if (mod(it, nprocs) /= my_rank) cycle ! MPI parallelism inside comm.
2842 : :
2843 : : ! Use Fermi-Dirac occopt
2844 : 244 : call tmp_ebands%set_scheme(occopt3, kTmesh(it), spinmagntarget, prtvol)
2845 : 244 : mu_e(it) = tmp_ebands%fermie
2846 : : !
2847 : : ! Check that the total number of electrons is correct
2848 : : ! This is to trigger problems as the routines that calculate the occupations in ebands_set_extrael
2849 : : ! are different from the occ_fd that will be used in the rest of the code.
2850 : 244 : nelect = ebands_calc_nelect(tmp_ebands, kTmesh(it), mu_e(it))
2851 : :
2852 [ + + ]: 308 : if (abs(nelect - self%nelect) > tol6) then
2853 : : ! For T = 0 the number of occupied states goes in discrete steps (according to the k-point sampling)
2854 : : ! for finite doping its hard to find nelect that exactly matches self%nelect.
2855 : : ! in this case we print a warning
2856 : : write(msg,'(2(a,f10.6,a), f10.6)') &
2857 : 4 : 'Calculated number of electrons nelect : ',nelect, ch10, &
2858 : 8 : ' does not correspond with ebands%nelect: ',tmp_ebands%nelect,' for kT: ', kTmesh(it)
2859 : :
2860 [ + - ]: 4 : if (kTmesh(it) == zero) then
2861 : 4 : ABI_WARNING(msg)
2862 : : else
2863 : 0 : ABI_ERROR(msg)
2864 : : end if
2865 : : end if
2866 : : end do ! it
2867 : :
2868 : 64 : call tmp_ebands%free()
2869 : 64 : call xmpi_sum(mu_e, comm, ierr)
2870 : :
2871 : 64 : call cwtime_report(" ebands_get_muT_with_fd", cpu, wall, gflops, end_str=ch10)
2872 : :
2873 [ - + - + : 64 : end subroutine ebands_get_muT_with_fd
- + - + -
+ - + - +
- + - + -
+ - + ]
2874 : : !!***
2875 : :
2876 : : !----------------------------------------------------------------------
2877 : :
2878 : : !!****f* m_ebands/ebands_calc_nelect
2879 : : !! NAME
2880 : : !! ebands_calc_nelect
2881 : : !!
2882 : : !! FUNCTION
2883 : : !! Compute nelect from Fermi level and Temperature.
2884 : : !!
2885 : : !! INPUTS
2886 : : !!
2887 : : !! OUTPUT
2888 : : !!
2889 : : !! SOURCE
2890 : :
2891 : 244 : real(dp) pure function ebands_calc_nelect(self, kt, fermie) result(nelect)
2892 : :
2893 : : !Arguments ------------------------------------
2894 : : !scalars
2895 : : class(ebands_t),intent(in) :: self
2896 : : real(dp),intent(in) :: kt, fermie
2897 : :
2898 : : !Local variables-------------------------------
2899 : : !scalars
2900 : : integer :: spin, ik, ib
2901 : : real(dp) :: ofact
2902 : : ! *************************************************************************
2903 : :
2904 : 244 : ofact = two / (self%nsppol * self%nspinor)
2905 : 244 : nelect = zero
2906 [ + + ]: 488 : do spin=1,self%nsppol
2907 [ + + ]: 37794 : do ik=1,self%nkpt
2908 [ + + ]: 406158 : do ib=1,self%nband(ik + (spin-1)*self%nkpt)
2909 : 405914 : nelect = nelect + self%wtk(ik) * occ_fd(self%eig(ib,ik,spin), kt, fermie)
2910 : : end do
2911 : : end do
2912 : : end do
2913 : :
2914 : 244 : nelect = ofact * nelect
2915 : :
2916 : 244 : end function ebands_calc_nelect
2917 : : !!***
2918 : :
2919 : : !----------------------------------------------------------------------
2920 : :
2921 : : !!****f* m_ebands/ebands_report_gap
2922 : : !! NAME
2923 : : !! ebands_report_gap
2924 : : !!
2925 : : !! FUNCTION
2926 : : !! Print info on the fundamental and direct gap.
2927 : : !!
2928 : : !! INPUTS
2929 : : !! ebands<ebands_t>=Info on the band structure, the smearing technique and the physical temperature used.
2930 : : !! [header]=Optional title.
2931 : : !! [unit]=Optional unit for output (std_out if not specified)
2932 : : !! [mode_paral]=Either "COLL" or "PERS", former is default.
2933 : : !!
2934 : : !! OUTPUT
2935 : : !! writing.
2936 : : !! [gaps(3,nsppol)]=Fundamental and direct gaps. The third index corresponds to a "status":
2937 : : !! 0.0dp if gaps were not computed (because there are only valence bands);
2938 : : !! -1.0dp if the system (or spin-channel) is metallic;
2939 : : !! 1.0dp if the gap has been computed.
2940 : : !!
2941 : : !! SOURCE
2942 : :
2943 : 5656 : subroutine ebands_report_gap(ebands, header, unit, mode_paral, gaps)
2944 : :
2945 : : !Arguments ------------------------------------
2946 : : !scalars
2947 : : integer,intent(in),optional :: unit
2948 : : character(len=4),intent(in),optional :: mode_paral
2949 : : character(len=*),intent(in),optional :: header
2950 : : class(ebands_t),intent(in) :: ebands
2951 : : !arrays
2952 : : real(dp),optional,intent(out) :: gaps(3,ebands%nsppol)
2953 : :
2954 : : !Local variables-------------------------------
2955 : : !scalars
2956 : : integer :: ikibz,nband_k,spin,nsppol,ikopt,ivk,ick,ivb,icb,unt,first
2957 : : real(dp),parameter :: tol_fermi = tol6
2958 : : real(dp) :: fun_gap,opt_gap
2959 : : logical :: ismetal
2960 : : character(len=4) :: my_mode
2961 : : character(len=500) :: msg
2962 : : !arrays
2963 : 12364 : integer :: val_idx(ebands%nkpt,ebands%nsppol)
2964 : 6182 : real(dp) :: top_valence(ebands%nkpt),bot_conduct(ebands%nkpt)
2965 : : ! *********************************************************************
2966 : :
2967 : 6182 : nsppol = ebands%nsppol
2968 : :
2969 [ + - ]: 6182 : unt =std_out; if (PRESENT(unit )) unt =unit
2970 [ + + ]: 6182 : my_mode='COLL' ; if (PRESENT(mode_paral)) my_mode=mode_paral
2971 : :
2972 [ + + + + : 30974 : if (PRESENT(gaps)) gaps=zero
+ + ]
2973 : :
2974 : 6182 : val_idx(:,:) = ebands_get_valence_idx(ebands, tol_fermi)
2975 : 6182 : first = 0
2976 : :
2977 : : ! Initialize the return status for the gaps
2978 [ + + + + : 30974 : if (PRESENT(gaps)) gaps(1:3,1:nsppol)=zero
+ + ]
2979 : :
2980 [ + + ]: 10027 : do spin=1,nsppol
2981 : :
2982 : : ! No output if system i metallic
2983 [ + + + + ]: 67451 : ismetal=ANY(val_idx(:,spin)/=val_idx(1,spin))
2984 [ + + + + ]: 6511 : if (ismetal .or. (ebands%occopt==9)) then
2985 [ + + ]: 946 : if (PRESENT(gaps)) gaps(3,nsppol)=-one
2986 : : cycle
2987 : : endif
2988 : :
2989 : 5565 : first=first+1
2990 [ + + ]: 5565 : if (first==1) then
2991 : 5361 : msg=ch10
2992 [ + + + - : 5361 : if (PRESENT(header)) msg=ch10//' === '//TRIM(ADJUSTL(header))//' === '
+ - ]
2993 : 5361 : call wrtout(unt,msg,my_mode)
2994 : : end if
2995 : :
2996 : 5565 : ivb=val_idx(1,spin)
2997 : 5565 : icb=ivb+1
2998 : :
2999 [ + + ]: 26908 : do ikibz=1,ebands%nkpt
3000 : 24009 : nband_k = ebands%nband(ikibz+(spin-1)*ebands%nkpt)
3001 : 24009 : top_valence(ikibz) = ebands%eig(ivb,ikibz,spin)
3002 [ + + ]: 24009 : if (icb>nband_k) then
3003 : : GOTO 10 ! Only occupied states are present, no output!
3004 : : end if
3005 : 24242 : bot_conduct(ikibz) = ebands%eig(icb,ikibz,spin)
3006 : : end do
3007 : :
3008 : : ! Get minimum of the direct Gap
3009 [ + - + + ]: 24242 : ikopt= imin_loc(bot_conduct-top_valence)
3010 : 2899 : opt_gap=bot_conduct(ikopt)-top_valence(ikopt)
3011 : :
3012 : : ! Get fundamental Gap
3013 : 2899 : ick = imin_loc(bot_conduct)
3014 : 2899 : ivk = imax_loc(top_valence)
3015 : 2899 : fun_gap = ebands%eig(icb,ick,spin)-ebands%eig(ivb,ivk,spin)
3016 : :
3017 : : write(msg,'(a,i2,a,2(a,f8.4,a,3f8.4,a),33x,a,3f8.4)')&
3018 : 2899 : ' >>>> For spin ',spin,ch10,&
3019 : 2899 : ' Minimum direct gap = ',opt_gap*Ha_eV,' [eV], located at k-point : ',ebands%kptns(:,ikopt),ch10,&
3020 : 2899 : ' Fundamental gap = ',fun_gap*Ha_eV,' [eV], Top of valence bands at : ',ebands%kptns(:,ivk),ch10, &
3021 : 5798 : ' Bottom of conduction at : ',ebands%kptns(:,ick)
3022 : 2899 : call wrtout(unt,msg, my_mode)
3023 : :
3024 [ + + + + ]: 13579 : if (present(gaps)) gaps(:,spin) = [fun_gap, opt_gap, one]
3025 : : end do !spin
3026 : :
3027 : 2666 : return
3028 : :
3029 : : 10 continue
3030 : 2666 : call wrtout(std_out, "Not enough states to calculate the band gap.", "COLL")
3031 : :
3032 [ + + ]: 6182 : end subroutine ebands_report_gap
3033 : : !!***
3034 : :
3035 : : !----------------------------------------------------------------------
3036 : :
3037 : : !!****f* m_ebands/ebands_ncwrite
3038 : : !! NAME
3039 : : !! ebands_ncwrite
3040 : : !!
3041 : : !! FUNCTION
3042 : : !! Writes the content of an ebands_t object to a NETCDF file
3043 : : !! according to the ETSF-IO specifications. Return nf90_noerr if success.
3044 : : !!
3045 : : !! INPUTS
3046 : : !! ncid =NC file handle
3047 : : !!
3048 : : !! SOURCE
3049 : :
3050 : 11188 : integer function ebands_ncwrite(ebands, ncid) result(ncerr)
3051 : :
3052 : : !Arguments ------------------------------------
3053 : : !scalars
3054 : : class(ebands_t),intent(in) :: ebands
3055 : : integer,intent(in) :: ncid
3056 : :
3057 : : !Local variables-------------------------------
3058 : : !scalars
3059 : : integer :: ii,nelect_int
3060 : : logical :: write_ngkpt
3061 : : character(len=etsfio_charlen) :: smearing,k_dependent
3062 : : !arrays
3063 : : integer :: ngkpt(3)
3064 : : ! *************************************************************************
3065 : :
3066 : 11188 : smearing = nctk_string_from_occopt(ebands%occopt)
3067 : :
3068 : : ! ==============================================
3069 : : ! === Write the dimensions specified by ETSF ===
3070 : : ! ==============================================
3071 : : ncerr = nctk_def_dims(ncid, [ &
3072 : : nctkdim_t("max_number_of_states", ebands%mband), &
3073 : : nctkdim_t("number_of_spinor_components", ebands%nspinor), &
3074 : : nctkdim_t("number_of_spins", ebands%nsppol), &
3075 : : nctkdim_t("number_of_kpoints", ebands%nkpt), &
3076 : : nctkdim_t("nshiftk_orig", ebands%nshiftk_orig), &
3077 : : nctkdim_t("nshiftk", ebands%nshiftk)], &
3078 [ + + ]: 78316 : defmode=.True.)
3079 [ - + ]: 11188 : NCF_CHECK(ncerr)
3080 : :
3081 : : ! FIXME
3082 : : ! Unofficial variables. Notes:
3083 : : ! 1) ETSF-IO does not support nshifts > 1
3084 : : ! 2) shiftk_orig, nshiftk_orig refers to the values specified in the input (most useful ones).
3085 : : ! 3) shiftk, kptrlatt refers to the values computed in inkpts.
3086 : : ! 4) Should define a protocol so that abipy understands if we have a path or a mesh.
3087 : : !write_kptrlatt = (SUM(ABS(ebands%kptrlatt))/=0)
3088 : : !write_kptrlatt = (ebands%kptopt /= 0)
3089 : :
3090 : 11188 : ngkpt = 0; write_ngkpt = .False.
3091 [ + + + - ]: 11188 : if (isdiagmat(ebands%kptrlatt) .and. ebands%nshiftk == 1) then
3092 : 34156 : write_ngkpt = .True.
3093 [ + + ]: 34156 : do ii=1,3
3094 : 34156 : ngkpt(ii) = ebands%kptrlatt(ii, ii)
3095 : : end do
3096 : 8539 : ncerr = nctk_def_dims(ncid, nctkdim_t('ngkpt_nshiftk', ebands%nshiftk_orig))
3097 [ - + ]: 8539 : NCF_CHECK(ncerr)
3098 : : end if
3099 : :
3100 : : ! Define k-points
3101 : : ncerr = nctk_def_arrays(ncid, [&
3102 : : nctkarr_t("reduced_coordinates_of_kpoints", "dp", "number_of_reduced_dimensions, number_of_kpoints"), &
3103 : : nctkarr_t("kpoint_weights", "dp", "number_of_kpoints"), &
3104 : : nctkarr_t("monkhorst_pack_folding", "int", "number_of_vectors") &
3105 [ + + ]: 44752 : ])
3106 [ - + ]: 11188 : NCF_CHECK(ncerr)
3107 : :
3108 : : ! Define states section.
3109 : : ncerr = nctk_def_arrays(ncid, [&
3110 : : nctkarr_t("number_of_states", "int", "number_of_kpoints, number_of_spins"), &
3111 : : nctkarr_t("eigenvalues", "dp", "max_number_of_states, number_of_kpoints, number_of_spins"), &
3112 : : nctkarr_t("occupations", "dp", "max_number_of_states, number_of_kpoints, number_of_spins"), &
3113 : : nctkarr_t("smearing_scheme", "char", "character_string_length") &
3114 [ + + ]: 55940 : ])
3115 [ - + ]: 11188 : NCF_CHECK(ncerr)
3116 : :
3117 [ + + ]: 22376 : ncerr = nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "number_of_electrons"])
3118 [ - + ]: 11188 : NCF_CHECK(ncerr)
3119 [ + + ]: 33564 : ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "fermi_energy", "smearing_width"])
3120 [ - + ]: 11188 : NCF_CHECK(ncerr)
3121 : :
3122 : : ! Some variables require the specifications of units.
3123 [ - + ]: 11188 : NCF_CHECK(nctk_set_atomic_units(ncid, "eigenvalues"))
3124 [ - + ]: 11188 : NCF_CHECK(nctk_set_atomic_units(ncid, "fermi_energy"))
3125 : :
3126 [ + + + + : 138344 : k_dependent = "no"; if (any(ebands%nband(1) /= ebands%nband)) k_dependent = "yes"
+ + ]
3127 [ - + ]: 11188 : NCF_CHECK(nf90_put_att(ncid, vid("number_of_states"), "k_dependent", k_dependent))
3128 : :
3129 : : ! Write data.
3130 : : ! 1) Electrons.
3131 : : ! NB: In etsf_io the number of electrons is declared as integer.
3132 : : ! We use abinit nelect to store the value as real(dp).
3133 : 11188 : nelect_int = nint(ebands%nelect)
3134 : :
3135 [ - + ]: 11188 : NCF_CHECK(nctk_set_datamode(ncid))
3136 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("fermi_energy"), ebands%fermie))
3137 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("number_of_electrons"), nelect_int))
3138 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("smearing_width"), ebands%tsmear))
3139 [ + + - + : 33564 : NCF_CHECK(nf90_put_var(ncid, vid("number_of_states"), ebands%nband, count=[ebands%nkpt, ebands%nsppol]))
- - ]
3140 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("eigenvalues"), ebands%eig))
3141 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("occupations"), ebands%occ))
3142 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("smearing_scheme"), smearing))
3143 : :
3144 : : ! K-points
3145 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("reduced_coordinates_of_kpoints"), ebands%kptns))
3146 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("kpoint_weights"), ebands%wtk))
3147 : :
3148 [ + + ]: 11188 : if (write_ngkpt) then
3149 [ - + ]: 8539 : NCF_CHECK(nf90_put_var(ncid, vid("monkhorst_pack_folding"), ngkpt))
3150 : : end if
3151 : :
3152 : : ! ===========================================================
3153 : : ! === Write abinit-related stuff (not covered by ETSF-IO) ===
3154 : : ! ===========================================================
3155 : : ! Define variables.
3156 [ + + - + : 33564 : NCF_CHECK(nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "occopt", "kptopt"], defmode=.True.))
- - ]
3157 [ + + - + : 55940 : NCF_CHECK(nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "tphysel", "charge", "nelect", "extrael"]))
- - ]
3158 : :
3159 : 11188 : ncerr = nctk_def_arrays(ncid, nctkarr_t('istwfk', "i", 'number_of_kpoints'))
3160 [ - + ]: 11188 : NCF_CHECK(ncerr)
3161 : :
3162 : : ! Abinit variables defining the K-point sampling.
3163 : : ncerr = nctk_def_arrays(ncid, [ &
3164 : : nctkarr_t('kptrlatt_orig', "i", 'number_of_reduced_dimensions, number_of_reduced_dimensions'), &
3165 : : nctkarr_t('shiftk_orig', "dp", 'number_of_reduced_dimensions, nshiftk_orig'), &
3166 : : nctkarr_t('kptrlatt', "i", 'number_of_reduced_dimensions, number_of_reduced_dimensions'), &
3167 : : nctkarr_t('shiftk', "dp", 'number_of_reduced_dimensions, nshiftk') &
3168 [ + + ]: 55940 : ])
3169 [ - + ]: 11188 : NCF_CHECK(ncerr)
3170 : :
3171 [ + + ]: 11188 : if (write_ngkpt) then
3172 : 8539 : ncerr = nctk_def_arrays(ncid, nctkarr_t('ngkpt_shiftk', "dp", "number_of_reduced_dimensions, ngkpt_nshiftk"))
3173 [ - + ]: 8539 : NCF_CHECK(ncerr)
3174 : : end if
3175 : :
3176 : : ! Write Abinit variables
3177 [ - + ]: 11188 : NCF_CHECK(nctk_set_datamode(ncid))
3178 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("tphysel"), ebands%tphysel))
3179 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("occopt"), ebands%occopt))
3180 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("istwfk"), ebands%istwfk))
3181 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("kptopt"), ebands%kptopt))
3182 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("charge"), ebands%cellcharge))
3183 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("extrael"), ebands%extrael))
3184 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid("nelect"), ebands%nelect))
3185 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid('kptrlatt_orig'), ebands%kptrlatt_orig))
3186 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid('shiftk_orig'), ebands%shiftk_orig))
3187 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid('kptrlatt'),ebands%kptrlatt))
3188 [ - + ]: 11188 : NCF_CHECK(nf90_put_var(ncid, vid('shiftk'), ebands%shiftk))
3189 : :
3190 [ + + ]: 11188 : if (write_ngkpt) then
3191 [ - + ]: 8539 : NCF_CHECK(nf90_put_var(ncid, vid('ngkpt_shiftk'), ebands%shiftk_orig))
3192 : : end if
3193 : :
3194 : : !In the case occopt 9
3195 [ + + ]: 11188 : if (ebands%occopt == 9) then
3196 : : ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: &
3197 [ + + ]: 3 : "number_of_conduction_electrons", "number_of_valence_holes"])
3198 [ - + ]: 1 : NCF_CHECK(ncerr)
3199 [ + + ]: 2 : ncerr = nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "holes_fermi_energy"])
3200 [ - + ]: 1 : NCF_CHECK(ncerr)
3201 [ - + ]: 1 : NCF_CHECK(nctk_set_atomic_units(ncid,"holes_fermi_energy"))
3202 [ - + ]: 1 : NCF_CHECK(nf90_put_var(ncid, vid("holes_fermi_energy"), ebands%fermih))
3203 [ - + ]: 1 : NCF_CHECK(nf90_put_var(ncid, vid("number_of_conduction_electrons"), ebands%ne_qFD))
3204 [ - + ]: 1 : NCF_CHECK(nf90_put_var(ncid, vid("number_of_valence_holes"), ebands%nh_qFD))
3205 : : endif
3206 : :
3207 : : contains
3208 : 252029 : integer function vid(vname)
3209 : : character(len=*),intent(in) :: vname
3210 : 252029 : vid = nctk_idname(ncid, vname)
3211 : : end function vid
3212 : :
3213 : : end function ebands_ncwrite
3214 : : !!***
3215 : :
3216 : : !----------------------------------------------------------------------
3217 : :
3218 : : !!****f* m_ebands/ebands_ncwrite_path
3219 : : !! NAME
3220 : : !! ebands_ncwrite_path
3221 : : !!
3222 : : !! FUNCTION
3223 : : !! Writes the content of an ebands_t object to a NETCDF file
3224 : : !!
3225 : : !! INPUTS
3226 : : !! cryst=Crystal structure
3227 : : !! path=File name
3228 : : !!
3229 : : !! OUTPUT
3230 : : !!
3231 : : !! SOURCE
3232 : :
3233 : 0 : integer function ebands_ncwrite_path(ebands, cryst, path) result(ncerr)
3234 : :
3235 : : !Arguments ------------------------------------
3236 : : !scalars
3237 : : class(ebands_t),intent(in) :: ebands
3238 : : type(crystal_t),intent(in) :: cryst
3239 : : character(len=*),intent(in) :: path
3240 : :
3241 : : !Local variables-------------------------------
3242 : : !scalars
3243 : : integer :: ncid
3244 : : ! *************************************************************************
3245 : :
3246 : 0 : ncerr = nf90_noerr
3247 [ # # ]: 0 : if (file_exists(path)) then
3248 [ # # ]: 0 : NCF_CHECK(nctk_open_modify(ncid, path, xmpi_comm_self))
3249 : : else
3250 : 0 : ncerr = nctk_open_create(ncid, path, xmpi_comm_self)
3251 [ # # ]: 0 : NCF_CHECK_MSG(ncerr, sjoin("Creating", path))
3252 : : end if
3253 : :
3254 [ # # ]: 0 : NCF_CHECK(cryst%ncwrite(ncid))
3255 [ # # ]: 0 : NCF_CHECK(ebands_ncwrite(ebands, ncid))
3256 [ # # ]: 0 : NCF_CHECK(nf90_close(ncid))
3257 : :
3258 : 0 : end function ebands_ncwrite_path
3259 : : !!***
3260 : :
3261 : : !----------------------------------------------------------------------
3262 : :
3263 : : !!****f* m_ebands/ebands_get_edos
3264 : : !! NAME
3265 : : !! ebands_get_edos
3266 : : !!
3267 : : !! FUNCTION
3268 : : !! Calculate the electronic density of states from ebands_t
3269 : : !!
3270 : : !! INPUTS
3271 : : !! ebands<ebands_t>=Band structure object.
3272 : : !! cryst<cryst_t>=Info on the crystalline structure.
3273 : : !! intmeth= 1 for Gaussian, 2 or -2 for tetrahedra (-2 if Blochl corrections must be included).
3274 : : !! If nkpt == 1 (Gamma only), the routine fallbacks to gaussian method.
3275 : : !! step=Step on the linear mesh in Ha. If <0, the routine will use the mean of the energy level spacing
3276 : : !! broad=Gaussian broadening, If <0, the routine will use a default
3277 : : !! value for the broadening computed from the mean of the energy level spacing.
3278 : : !! No meaning for tetrahedra
3279 : : !! comm=MPI communicator
3280 : : !!
3281 : : !! OUTPUT
3282 : : !! edos<edos_t>=Electronic DOS and IDOS.
3283 : : !!
3284 : : !! SOURCE
3285 : :
3286 : 5 : type(edos_t) function ebands_get_edos(ebands, cryst, intmeth, step, broad, comm) result(edos)
3287 : :
3288 : : !Arguments ------------------------------------
3289 : : !scalars
3290 : : class(ebands_t),target,intent(in) :: ebands
3291 : : type(crystal_t),intent(in) :: cryst
3292 : : integer,intent(in) :: intmeth,comm
3293 : : real(dp),intent(in) :: step,broad
3294 : :
3295 : : !Local variables-------------------------------
3296 : : !scalars
3297 : : integer :: nw,spin,band,ikpt,ief,ihf,nproc,my_rank,ierr,cnt,bcorr
3298 : : real(dp) :: max_ene,min_ene,wtk,max_occ
3299 : : character(len=500) :: msg
3300 : 5 : type(htetra_t) :: tetra
3301 : : !arrays
3302 : 10 : real(dp) :: eminmax_spin(2,ebands%nsppol)
3303 : 5 : real(dp),allocatable :: wme0(:),wdt(:,:),tmp_eigen(:)
3304 : : ! *********************************************************************
3305 : :
3306 : 5 : nproc = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
3307 : 5 : ierr = 0
3308 : :
3309 : 5 : edos%nkibz = ebands%nkpt; edos%nsppol = ebands%nsppol; edos%nspinor = ebands%nspinor
3310 : 5 : edos%intmeth = intmeth
3311 : 5 : edos%nelect = ebands%nelect
3312 : :
3313 [ - + ]: 5 : if (ebands%nkpt == 1) then
3314 : 0 : ABI_COMMENT("Cannot use tetrahedra for e-DOS when nkpt == 1. Switching to gaussian method")
3315 : 0 : edos%intmeth = 1
3316 : : end if
3317 : :
3318 : 5 : edos%broad = broad; edos%step = step
3319 : :
3320 : : ! Compute the linear mesh so that it encloses all bands.
3321 : 5 : eminmax_spin = ebands_get_minmax(ebands, "eig")
3322 [ + - - + : 15 : min_ene = minval(eminmax_spin(1, :)); min_ene = min_ene - 0.1_dp * abs(min_ene)
- - + + ]
3323 [ + - - + : 15 : max_ene = maxval(eminmax_spin(2, :)); max_ene = max_ene + 0.1_dp * abs(max_ene)
- - + + ]
3324 : :
3325 : 5 : nw = nint((max_ene - min_ene) / edos%step) + 1; edos%nw = nw
3326 : :
3327 [ - + + - : 15 : ABI_MALLOC(edos%mesh, (nw))
+ - + - -
+ - + ]
3328 [ + - - + : 15510 : edos%mesh = arth(min_ene, edos%step, nw)
+ + ]
3329 : :
3330 [ - + + - : 25 : ABI_CALLOC(edos%gef, (0:edos%nsppol))
+ - + - -
+ - + +
+ ]
3331 [ - + + - : 20 : ABI_CALLOC(edos%ghf, (0:edos%nsppol))
- + - + +
+ ]
3332 [ - + + - : 31030 : ABI_CALLOC(edos%dos, (nw, 0:edos%nsppol))
- + + - +
- + - - +
- + + + +
+ ]
3333 [ - + + - : 31025 : ABI_CALLOC(edos%idos, (nw, 0:edos%nsppol))
- + + - -
+ - + + +
+ + ]
3334 : :
3335 : 5 : select case (edos%intmeth)
3336 : : case (1)
3337 : : !call wrtout(std_out, " Computing electron-DOS with Gaussian method")
3338 : : !call wrtout(std_out, sjoin(" broadening: ", ftoa(edos%broad * Ha_eV), " (eV), step: ", ftoa(edos%step * Ha_eV), "(eV), npts: ",
3339 : : !itoa(nw)))
3340 : : ! Gaussian
3341 [ # # # # : 0 : ABI_MALLOC(wme0, (nw))
# # # # ]
3342 : 0 : cnt = 0
3343 [ # # ]: 0 : do spin=1,edos%nsppol
3344 [ # # ]: 0 : do ikpt=1,ebands%nkpt
3345 [ # # ]: 0 : cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle ! MPI parallelism
3346 : 0 : wtk = ebands%wtk(ikpt)
3347 [ # # ]: 0 : do band=1,ebands%nband(ikpt+(spin-1)*ebands%nkpt)
3348 [ # # # # : 0 : wme0 = edos%mesh - ebands%eig(band, ikpt, spin)
# # # # ]
3349 [ # # ]: 0 : edos%dos(:, spin) = edos%dos(:, spin) + wtk * gaussian(wme0, edos%broad)
3350 : : end do
3351 : : end do
3352 : : end do
3353 [ # # ]: 0 : ABI_FREE(wme0)
3354 : 0 : call xmpi_sum(edos%dos, comm, ierr)
3355 : :
3356 : : case (2, -2)
3357 : : !call wrtout(std_out, " Computing electron-DOS with tetrahedron method")
3358 : : ! Consistency test
3359 [ + + + - : 150 : if (any(ebands%nband /= ebands%nband(1)) ) ABI_ERROR('for tetrahedra, nband(:) must be constant')
- + ]
3360 : :
3361 : : ! Build tetra object.
3362 : : tetra = tetra_from_kptrlatt(cryst, ebands%kptopt, ebands%kptrlatt, &
3363 : 5 : ebands%nshiftk, ebands%shiftk, ebands%nkpt, ebands%kptns, comm, msg, ierr)
3364 [ - + ]: 5 : ABI_CHECK(ierr == 0, msg)
3365 : :
3366 : : ! For each spin and band, interpolate over kpoints, calculate integration weights and DOS contribution.
3367 [ - + + - : 15 : ABI_MALLOC(tmp_eigen, (ebands%nkpt))
+ - + - -
+ - + ]
3368 [ - + + - : 15 : ABI_MALLOC(wdt, (nw, 2))
+ - + - -
+ - + ]
3369 : :
3370 [ - + ]: 5 : bcorr = 0; if (intmeth == -2) bcorr = 1
3371 : 5 : cnt = 0
3372 [ + + ]: 10 : do spin=1,ebands%nsppol
3373 [ + + ]: 35 : do band=1,ebands%nband(1)
3374 : : ! For each band get its contribution
3375 [ + - - + : 775 : tmp_eigen = ebands%eig(band,:,spin)
- - + + ]
3376 [ + + ]: 755 : do ikpt=1,ebands%nkpt
3377 [ + - ]: 725 : cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle ! MPI parallelism.
3378 : :
3379 : : ! Calculate integration weights at each irred k-point (Blochl et al PRB 49 16223 [[cite:Bloechl1994a]])
3380 : 725 : call tetra%get_onewk(ikpt, bcorr, nw, ebands%nkpt, tmp_eigen, min_ene, max_ene, one, wdt)
3381 : :
3382 [ + + ]: 2248225 : edos%dos(:,spin) = edos%dos(:,spin) + wdt(:, 1) * ebands%wtk(ikpt)
3383 [ + + ]: 2248250 : edos%idos(:,spin) = edos%idos(:,spin) + wdt(:, 2) * ebands%wtk(ikpt)
3384 : : end do ! ikpt
3385 : : end do ! band
3386 : : end do ! spin
3387 : :
3388 : 5 : call xmpi_sum(edos%dos, comm, ierr)
3389 : 5 : call xmpi_sum(edos%idos, comm, ierr)
3390 : :
3391 : : ! Free memory
3392 [ - + ]: 5 : ABI_FREE(tmp_eigen)
3393 [ - + ]: 5 : ABI_FREE(wdt)
3394 : 5 : call tetra%free()
3395 : :
3396 : : ! Filter so that dos[i] is always >= 0 and idos is monotonic
3397 : : ! IDOS is computed afterwards with simpson
3398 [ + + + + : 15515 : where (edos%dos(:,1:) <= zero)
+ + ]
3399 : : edos%dos(:,1:) = zero
3400 : : end where
3401 : :
3402 : : case default
3403 [ - + - ]: 5 : ABI_ERROR(sjoin("Wrong integration method:", itoa(intmeth)))
3404 : : end select
3405 : :
3406 : : ! Compute total DOS and IDOS by summing the two spin channels.
3407 : 5 : max_occ = two / (ebands%nspinor * ebands%nsppol)
3408 [ + + + + ]: 31005 : edos%dos(:, 0) = max_occ * sum(edos%dos(:,1:), dim=2)
3409 : :
3410 [ - + ]: 5 : if (edos%intmeth == 1) then
3411 [ # # ]: 0 : do spin=1,edos%nsppol
3412 : 0 : call simpson_int(nw, edos%step, edos%dos(:,spin), edos%idos(:,spin))
3413 : : end do
3414 : : end if
3415 [ + + + + ]: 31005 : edos%idos(:, 0) = max_occ * sum(edos%idos(:,1:), dim=2)
3416 : :
3417 : : ! Use bisection to find the Fermi level at T = 0
3418 : : ! Warning: this code assumes idos[i+1] >= idos[i]. This condition may not be
3419 : : ! fulfilled if we use tetra and this is the reason why we have filtered the DOS.
3420 [ - + ]: 5 : if (ebands%occopt == 9) then
3421 : 0 : ihf = bisect(edos%idos(:,0), ebands%nelect-ebands%nh_qFD)
3422 : 0 : ief = bisect(edos%idos(:,0), ebands%nelect+ebands%ne_qFD)
3423 : : else
3424 : 5 : ief = bisect(edos%idos(:,0), ebands%nelect)
3425 : 5 : ihf = ief
3426 : : end if
3427 : :
3428 : : ! Handle out of range condition.
3429 [ + - - + ]: 5 : if (ief == 0 .or. ief == nw) then
3430 : : write(msg,"(3a)")&
3431 : 0 : "Bisection could not find an initial guess for the Fermi level!",ch10,&
3432 : 0 : "Possible reasons: not enough bands or wrong number of electrons"
3433 : 0 : ABI_WARNING(msg)
3434 : 0 : return
3435 [ + - - + ]: 5 : else if (ihf == 0 .or. ihf == nw) then
3436 : : write(msg,"(3a)")&
3437 : 0 : "Bisection could not find an initial guess for the holes Fermi level!",ch10,&
3438 : 0 : "Possible reasons: not enough bands or wrong number of holes"
3439 : 0 : ABI_WARNING(msg)
3440 : 0 : return
3441 : : end if
3442 : :
3443 : : ! TODO: Use linear interpolation to find an improved estimate of the Fermi level?
3444 : 5 : edos%ief = ief
3445 : 5 : edos%ihf = ihf
3446 [ + + ]: 15 : do spin=0,edos%nsppol
3447 : 10 : edos%gef(spin) = edos%dos(ief,spin)
3448 : 15 : edos%ghf(spin) = edos%dos(ihf,spin)
3449 : : end do
3450 : :
3451 : : !write(std_out,*)"fermie from ebands: ",ebands%fermie
3452 : : !write(std_out,*)"fermie from IDOS: ",edos%mesh(ief)
3453 : : !write(std_out,*)"gef:from ebands%fermie: " ,edos%dos(bisect(edos%mesh, ebands%fermie), 0)
3454 : : !write(std_out,*)"gef:from edos: " ,edos%gef(0)
3455 : :
3456 [ - + - + : 10 : end function ebands_get_edos
- + - + -
- - - - +
- - - - ]
3457 : : !!***
3458 : :
3459 : : !----------------------------------------------------------------------
3460 : :
3461 : : !!****f* m_ebands/edos_free
3462 : : !! NAME
3463 : : !! edos_free
3464 : : !!
3465 : : !! FUNCTION
3466 : : !! Free the memory allocated in edos_t
3467 : : !!
3468 : : !! SOURCE
3469 : :
3470 : 76 : subroutine edos_free(edos)
3471 : :
3472 : : !Arguments ------------------------------------
3473 : : class(edos_t),intent(inout) :: edos
3474 : : ! *********************************************************************
3475 : :
3476 : : !real
3477 [ + + ]: 76 : ABI_SFREE(edos%mesh)
3478 [ + + ]: 76 : ABI_SFREE(edos%dos)
3479 [ + + ]: 76 : ABI_SFREE(edos%idos)
3480 [ + + ]: 76 : ABI_SFREE(edos%gef)
3481 [ + + ]: 76 : ABI_SFREE(edos%ghf)
3482 : :
3483 : 76 : end subroutine edos_free
3484 : : !!***
3485 : :
3486 : : !----------------------------------------------------------------------
3487 : :
3488 : : !!****f* m_ebands/edos_write
3489 : : !! NAME
3490 : : !! edos_write
3491 : : !!
3492 : : !! FUNCTION
3493 : : !! Write results to file.
3494 : : !!
3495 : : !! INPUTS
3496 : : !! path=File name.
3497 : : !!
3498 : : !! SOURCE
3499 : :
3500 : 5 : subroutine edos_write(edos, path)
3501 : :
3502 : : !Arguments ------------------------------------
3503 : : class(edos_t),intent(in) :: edos
3504 : : character(len=*),intent(in) :: path
3505 : :
3506 : : !Local variables-------------------------------
3507 : : integer :: iw,spin,unt
3508 : : real(dp) :: efermi, gef_tot, gef_up, gef_down
3509 : : character(len=500) :: msg
3510 : : type(yamldoc_t) :: ydoc
3511 : : ! *************************************************************************
3512 : :
3513 [ + + ]: 15 : call wrtout([std_out, ab_out], sjoin("- Writing electron DOS to file:", path, ch10))
3514 : :
3515 [ - + ]: 5 : if (open_file(path, msg, newunit=unt, form="formatted", action="write") /= 0) then
3516 : 0 : ABI_ERROR(msg)
3517 : : end if
3518 : :
3519 : : ! Write header (human-readable format)
3520 : 5 : write(unt,'(a)')'# Electron density of states: Energy in eV, DOS in states/eV per unit cell.'
3521 : 5 : write(unt,"(a)")"# The zero of energies corresponds to the Fermi level."
3522 : :
3523 : : ! Add Yaml section with parameters.
3524 : 5 : ydoc = yamldoc_open("EDOS_PARAMS")
3525 : : call ydoc%add_ints("nkibz, nsppol, nspinor, intmeth, edos_npts", &
3526 [ + + ]: 30 : [edos%nkibz, edos%nsppol, edos%nspinor, edos%intmeth, edos%nw])
3527 : : call ydoc%add_reals("nelect, edos_mesh_step_eV", &
3528 [ + + ]: 15 : [edos%nelect, edos%step * Ha_eV])
3529 : :
3530 : 5 : select case (edos%intmeth)
3531 : : case (1)
3532 : 0 : call ydoc%add_string("method", "Gaussian")
3533 : 0 : call ydoc%add_real("gaussian_broadening_eV", edos%broad * Ha_eV)
3534 : : case (2)
3535 : 5 : call ydoc%add_string("method", "Linear tetrahedron")
3536 : : case (-2)
3537 : 0 : call ydoc%add_string("method", "Linear tetrahedron method with Blochl corrections")
3538 : : case default
3539 [ - + - - ]: 5 : ABI_ERROR(sjoin("Wrong method:", itoa(edos%intmeth)))
3540 : : end select
3541 : :
3542 [ - + ]: 5 : if (edos%ief == 0) then
3543 : 0 : call ydoc%set_keys_to_string("Fermi_level_eV, gef, gef_up, gef_down", "null")
3544 : 0 : efermi = zero
3545 : : else
3546 : 5 : efermi = edos%mesh(edos%ief)
3547 : 5 : call ydoc%add_real("Fermi_level_eV", efermi * Ha_eV)
3548 : 5 : gef_tot = edos%gef(0) / Ha_eV
3549 : 5 : gef_up = gef_tot / two; gef_down = gef_tot / two
3550 [ - + ]: 5 : if (edos%nsppol == 2) then
3551 : 0 : gef_up = edos%gef(1) / Ha_eV; gef_down = edos%gef(2) / Ha_eV
3552 : : end if
3553 [ + - ]: 5 : if (edos%nspinor == 1) then
3554 [ + + ]: 20 : call ydoc%add_reals("gef, gef_up, gef_down", [gef_tot, gef_up, gef_down])
3555 : : else
3556 [ # # ]: 0 : call ydoc%add_reals("gef", [gef_tot])
3557 : : end if
3558 : : end if
3559 : :
3560 : : ! Write header in Yaml format but prepend # so that one can still use tools such as gnuplot or xmgrace.
3561 : 5 : call ydoc%write_and_free(unt, firstchar="#")
3562 : :
3563 : : ! Write data.
3564 : 5 : write(unt,"(a)")"# Energy DOS_TOT IDOS_TOT DOS[spin=UP] IDOS[spin=UP] ..."
3565 [ + + ]: 15505 : do iw=1,edos%nw
3566 : 15500 : write(unt,'(es17.8)',advance='no')(edos%mesh(iw) - efermi) * Ha_eV
3567 [ + + ]: 46500 : do spin=0,edos%nsppol
3568 : 46500 : write(unt,'(2es17.8)',advance='no')max(edos%dos(iw,spin) / Ha_eV, tol30), max(edos%idos(iw,spin), tol30)
3569 : : end do
3570 : 15505 : write(unt,*)
3571 : : end do
3572 : :
3573 : 5 : close(unt)
3574 : :
3575 : 5 : end subroutine edos_write
3576 : : !!***
3577 : :
3578 : : !----------------------------------------------------------------------
3579 : :
3580 : : !!****f* m_ebands/edos_ncwrite
3581 : : !! NAME
3582 : : !! edos_ncwrite
3583 : : !!
3584 : : !! FUNCTION
3585 : : !! Write results to netcdf file.
3586 : : !!
3587 : : !! INPUTS
3588 : : !! ncid=NC file handle.
3589 : : !! [prefix]=String prepended to netcdf dimensions/variables (HDF5 poor-man groups)
3590 : : !! Empty string if not specified.
3591 : : !!
3592 : : !! OUTPUT
3593 : : !! ncerr= netcdf exit status.
3594 : : !!
3595 : : !! SOURCE
3596 : :
3597 : 18 : integer function edos_ncwrite(edos, ncid, prefix) result(ncerr)
3598 : :
3599 : : !Arguments ------------------------------------
3600 : : class(edos_t),intent(in) :: edos
3601 : : integer,intent(in) :: ncid
3602 : : character(len=*),optional,intent(in) :: prefix
3603 : :
3604 : : !Local variables-------------------------------
3605 : : character(len=500) :: prefix_
3606 : : ! *************************************************************************
3607 : :
3608 [ # # ]: 0 : prefix_ = ""; if (present(prefix)) prefix_ = trim(prefix)
3609 : :
3610 : : ! Define dimensions.
3611 : : ncerr = nctk_def_dims(ncid, [ &
3612 [ + + ]: 54 : nctkdim_t("nsppol_plus1", edos%nsppol + 1), nctkdim_t("edos_nw", edos%nw)], defmode=.True., prefix=prefix_)
3613 [ - + ]: 18 : NCF_CHECK(ncerr)
3614 : :
3615 : : ! Define variables
3616 [ + + - + : 54 : NCF_CHECK(nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "edos_intmeth", "edos_nkibz"], prefix=prefix_))
- - ]
3617 [ + + - + : 54 : NCF_CHECK(nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "edos_ief", "edos_ihf"], prefix=prefix_))
- - ]
3618 [ + + - + : 36 : NCF_CHECK(nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "edos_broad"], prefix=prefix_))
- - ]
3619 : :
3620 : : ncerr = nctk_def_arrays(ncid, [ &
3621 : : nctkarr_t("edos_mesh", "dp", "edos_nw"), &
3622 : : nctkarr_t("edos_dos", "dp", "edos_nw, nsppol_plus1"), &
3623 : : nctkarr_t("edos_idos", "dp", "edos_nw, nsppol_plus1"), &
3624 : : nctkarr_t("edos_gef", "dp", "nsppol_plus1"), &
3625 : : nctkarr_t("edos_ghf", "dp", "nsppol_plus1") &
3626 [ + + ]: 108 : ], prefix=prefix_)
3627 [ - + ]: 18 : NCF_CHECK(ncerr)
3628 : :
3629 : : ! Write data.
3630 [ - + ]: 18 : NCF_CHECK(nctk_set_datamode(ncid))
3631 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_intmeth")), edos%intmeth))
3632 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_nkibz")), edos%nkibz))
3633 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_ief")), edos%ief))
3634 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_ihf")), edos%ihf))
3635 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_broad")), edos%broad))
3636 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_mesh")), edos%mesh))
3637 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_dos")), edos%dos))
3638 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_idos")), edos%idos))
3639 [ - + ]: 18 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_gef")), edos%gef))
3640 [ - + - + ]: 36 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_ghf")), edos%ghf))
3641 : :
3642 : : contains
3643 : 180 : pure function pre(istr) result(ostr)
3644 : : character(len=*),intent(in) :: istr
3645 : : character(len=len_trim(prefix_) + len_trim(istr)+1) :: ostr
3646 [ + - + - ]: 180 : ostr = trim(prefix_) // trim(istr)
3647 : 180 : end function pre
3648 : :
3649 : : end function edos_ncwrite
3650 : : !!***
3651 : :
3652 : : !!****f* m_ebands/edos_print
3653 : : !! NAME
3654 : : !! edos_print
3655 : : !!
3656 : : !! FUNCTION
3657 : : !! Print DOS info.
3658 : : !!
3659 : : !! INPUTS
3660 : : !! units=Unit numbers for output
3661 : : !! [header]=Header string.
3662 : : !!
3663 : : !! SOURCE
3664 : :
3665 : 36 : subroutine edos_print(edos, units, header)
3666 : :
3667 : : !Arguments ------------------------------------
3668 : : class(edos_t),intent(in) :: edos
3669 : : integer,intent(in) :: units(:)
3670 : : character(len=*),optional,intent(in) :: header
3671 : :
3672 : : !Local variables-------------------------------
3673 : : character(len=500) :: msg
3674 : : ! *************************************************************************
3675 : :
3676 [ + + ]: 18 : if (present(header)) then
3677 [ + - ]: 13 : write(msg, "(a)") ch10//' === '//trim(adjustl(header))//' === '
3678 : : else
3679 : 5 : write(msg, "(a)") ch10
3680 : : end if
3681 : 18 : call wrtout(units, msg)
3682 : :
3683 : 18 : select case (edos%intmeth)
3684 : : case (1)
3685 : 0 : write(msg, "(a,f5.1,a)") " Gaussian method with broadening: ", edos%broad * Ha_meV, " (meV)"
3686 : : case (2)
3687 : 18 : write(msg, "(a)")" Linear tetrahedron method."
3688 : : case (-2)
3689 : 0 : write(msg, "(a)")" Linear tetrahedron method with Blochl corrections."
3690 : : case default
3691 [ - + - - ]: 18 : ABI_ERROR(sjoin("Wrong intmeth:", itoa(edos%intmeth)))
3692 : : end select
3693 : 18 : call wrtout(units, msg)
3694 : :
3695 : 18 : write(msg, "(a,f5.1,a, i0)")" Mesh step: ", edos%step * Ha_meV, " (meV) with npts: ", edos%nw
3696 : 18 : call wrtout(units, msg)
3697 : 18 : write(msg, "(2(a,f5.1),a)")" From emin: ", edos%mesh(1) * Ha_eV, " to emax: ", edos%mesh(edos%nw) * Ha_eV, " (eV)"
3698 : 18 : call wrtout(units, msg)
3699 : 18 : write(msg, "(a, i0)")" Number of k-points in the IBZ: ", edos%nkibz
3700 : 18 : call wrtout(units, msg)
3701 : :
3702 [ + + ]: 18 : if (edos%ief == 0) then
3703 : 12 : call wrtout(units, " edos%ief == 0 --> Cannot print quantities at the Fermi level.", newlines=1)
3704 : 12 : return
3705 : : end if
3706 : :
3707 : 6 : write(msg,'(a,es16.8,a)')' Fermi level: ',edos%mesh(edos%ief) * Ha_eV, " (eV)"
3708 : 6 : call wrtout(units, msg)
3709 : 6 : write(msg,"(a,es16.8)")" Total electron DOS at Fermi level in states/eV: ", edos%gef(0) / Ha_eV
3710 : 6 : call wrtout(units, msg)
3711 : :
3712 [ - + ]: 6 : if (edos%nsppol == 2) then
3713 : 0 : write(msg,"(a,es16.8)")" g(eF) for spin up: ", edos%gef(1) / Ha_eV
3714 : 0 : call wrtout(units, msg)
3715 : 0 : write(msg,"(a,es16.8)")" g(eF) for spin down:", edos%gef(2) / Ha_eV
3716 : 0 : call wrtout(units, msg)
3717 : : end if
3718 : 6 : write(msg,"(a,f6.1)")" Total number of electrons at eF: ", edos%idos(edos%ief, 0)
3719 : 6 : call wrtout(units, msg)
3720 : :
3721 [ - + ]: 6 : if (edos%nsppol == 2) then
3722 : 0 : write(msg,"(a,es16.8)")" IDOS(eF) for spin up: ", edos%idos(edos%ief, 1)
3723 : 0 : call wrtout(units, msg)
3724 : 0 : write(msg,"(a,es16.8)")" IDOS(eF) for spin down:", edos%idos(edos%ief, 2)
3725 : 0 : call wrtout(units, msg)
3726 : : end if
3727 : :
3728 [ - + ]: 6 : if (edos%ihf /= edos%ief) then
3729 : 0 : write(msg,'(a,es16.8,a)')' Fermi level for excited holes: ',edos%mesh(edos%ihf) * Ha_eV, " (eV)"
3730 : 0 : call wrtout(units, msg)
3731 : 0 : write(msg,"(a,es16.8)")" Total hole DOS at Fermi level in states/eV: ", edos%ghf(0) / Ha_eV
3732 : 0 : call wrtout(units, msg)
3733 [ # # ]: 0 : if (edos%nsppol == 2) then
3734 : 0 : write(msg,"(a,es16.8)")" g(hF) for spin up: ", edos%ghf(1) / Ha_eV
3735 : 0 : call wrtout(units, msg)
3736 : 0 : write(msg,"(a,es16.8)")" g(hF) for spin down:", edos%ghf(2) / Ha_eV
3737 : 0 : call wrtout(units, msg)
3738 : : end if
3739 : 0 : write(msg,"(a,f6.1)")" Total number of electrons at hF: ", edos%idos(edos%ihf, 0)
3740 : 0 : call wrtout(units, msg)
3741 : :
3742 [ # # ]: 0 : if (edos%nsppol == 2) then
3743 : 0 : write(msg,"(a,es16.8)")" N(hF) for spin up: ", edos%idos(edos%ihf, 1)
3744 : 0 : call wrtout(units, msg)
3745 : 0 : write(msg,"(a,es16.8)")" N(hF) for spin down:", edos%idos(edos%ihf, 2)
3746 : 0 : call wrtout(units, msg)
3747 : : end if
3748 : : end if
3749 : :
3750 : 6 : call wrtout(units, " ")
3751 : :
3752 [ - + ]: 18 : end subroutine edos_print
3753 : : !!***
3754 : :
3755 : : !!****f* m_ebands/edos_get_carriers
3756 : : !! NAME
3757 : : !! edos_get_carriers
3758 : : !!
3759 : : !! FUNCTION
3760 : : !! Compute number of holes (nh) and electrons (ne) per unit cell from a given
3761 : : !! list of `ntemp` temperatures `kTmesh` and chemical potentials `mu_e`.
3762 : : !! Return n_ehst(2, nsppol, ntemp) where the first dimension if for electrons/holes.
3763 : : !! If nsppol == 2, the second dimension is the number of e/h for spin else the total number of e/h summed over spins.!!
3764 : : !! To discern between electrons and holes in semiconductors we assume that ef is inside the gap.
3765 : : !!
3766 : : !! INPUTS
3767 : : !!
3768 : : !! OUTPUT
3769 : : !!
3770 : : !! SOURCE
3771 : :
3772 : 0 : subroutine edos_get_carriers(edos, ntemp, kTmesh, mu_e, n_ehst)
3773 : :
3774 : : !Arguments ------------------------------------
3775 : : class(edos_t),intent(in) :: edos
3776 : : integer,intent(in) :: ntemp
3777 : : !arrays
3778 : : real(dp),intent(in) :: kTmesh(ntemp), mu_e(ntemp)
3779 : : real(dp),intent(out) :: n_ehst(2, edos%nsppol, ntemp)
3780 : :
3781 : : !Local variables-------------------------------
3782 : : integer :: itemp, iw, spin
3783 : 0 : real(dp),allocatable :: values(:)
3784 : : ! *************************************************************************
3785 : :
3786 : : ! Copy important dimensions
3787 [ # # # # : 0 : n_ehst = zero
# # ]
3788 [ # # # # : 0 : ABI_MALLOC(values, (edos%nw))
# # # # #
# # # ]
3789 : :
3790 [ # # ]: 0 : do itemp=1,ntemp
3791 : :
3792 : : ! For electrons (assuming ef inside the gap if semiconductor)
3793 [ # # ]: 0 : do spin=1,edos%nsppol
3794 [ # # ]: 0 : do iw=1,edos%nw
3795 [ # # ]: 0 : if (edos%mesh(iw) >= mu_e(itemp)) then
3796 : 0 : values(iw) = edos%dos(iw, spin) * occ_fd(edos%mesh(iw), kTmesh(itemp), mu_e(itemp))
3797 : : else
3798 : 0 : values(iw) = zero
3799 : : end if
3800 : : end do
3801 : 0 : n_ehst(1, spin, itemp) = simpson(edos%step, values)
3802 : : end do ! spin
3803 : :
3804 : : ! For holes
3805 [ # # ]: 0 : do spin=1,edos%nsppol
3806 [ # # ]: 0 : do iw=1,edos%nw
3807 [ # # ]: 0 : if (edos%mesh(iw) < mu_e(itemp)) then
3808 : 0 : values(iw) = edos%dos(iw, spin) * (one - occ_fd(edos%mesh(iw), kTmesh(itemp), mu_e(itemp)))
3809 : : else
3810 : 0 : values(iw) = zero
3811 : : end if
3812 : : end do
3813 : 0 : n_ehst(2, spin, itemp) = simpson(edos%step, values)
3814 : : end do ! spin
3815 : :
3816 : : end do ! itemp
3817 : :
3818 [ # # # # : 0 : if (edos%nsppol == 1 .and. edos%nspinor == 1) n_ehst = two * n_ehst
# # # # ]
3819 [ # # ]: 0 : ABI_FREE(values)
3820 : :
3821 : 0 : end subroutine edos_get_carriers
3822 : : !!***
3823 : :
3824 : : !----------------------------------------------------------------------
3825 : :
3826 : : !!****f* m_ebands/ebands_write_nesting
3827 : : !! NAME
3828 : : !! ebands_write_nesting
3829 : : !!
3830 : : !! FUNCTION
3831 : : !! Calculate the nesting function and output data to file.
3832 : : !!
3833 : : !! INPUTS
3834 : : !! ebands<ebands_t>=the ebands_t datatype
3835 : : !! cryst<crystal_t>=Info on unit cell and symmetries.
3836 : : !! filepath=File name for output data.
3837 : : !! prtnest = flags governing the format of the output file. see mknesting.
3838 : : !! 1 for X-Y format, 2 for XCrysden format (XSF)
3839 : : !! tsmear=Broadening used to approximation the delta function.
3840 : : !! fermie_nest
3841 : : !! qpath_vertices = vertices of the reciprocal space trajectory
3842 : : !!
3843 : : !! OUTPUT
3844 : : !! Return non-zero exist status if netsting factor cannot be produced.
3845 : : !! The errmsg string gives information on the error.
3846 : : !!
3847 : : !! SIDE EFFECTS
3848 : : !! Write data to file.
3849 : : !!
3850 : : !! SOURCE
3851 : :
3852 : 2 : integer function ebands_write_nesting(ebands,cryst,filepath,prtnest,tsmear,fermie_nest,qpath_vertices,errmsg) result(skip)
3853 : :
3854 : : !Arguments ------------------------------------
3855 : : class(ebands_t),intent(in) :: ebands
3856 : : type(crystal_t),intent(in) :: cryst
3857 : : integer,intent(in) :: prtnest
3858 : : real(dp),intent(in) :: tsmear,fermie_nest
3859 : : character(len=*),intent(in) :: filepath
3860 : : character(len=*),intent(out) :: errmsg
3861 : : !arrays
3862 : : real(dp),intent(in) :: qpath_vertices(:,:)
3863 : :
3864 : : !Local variables-------------------------------
3865 : : !scalaras
3866 : : integer :: ikpt,spin,iband,nqpath
3867 : : real(dp) :: invgauwidth,prefact,fermie
3868 : : !arrays
3869 : 1 : real(dp), allocatable :: fs_weights(:,:,:)
3870 : :
3871 : : ! *********************************************************************
3872 : :
3873 [ + - ]: 1 : skip = 0; errmsg = ""
3874 [ + + + - : 30 : if (any(ebands%nband /= ebands%nband(1))) then
- + ]
3875 : : errmsg = 'mknesting can not handle variable nband(1:nkpt). Skipped.'//&
3876 [ # # # # ]: 0 : ch10//' Correct input file to get nesting output'
3877 : 0 : skip = 1; return
3878 : : end if
3879 : :
3880 [ - + ]: 1 : if (ebands%nshiftk /= 1) then
3881 [ # # # # ]: 0 : errmsg = 'mknesting does not support nshiftk > 1. Change ngkpt and shiftk to have only one shift after inkpts'
3882 : 0 : skip = 1; return
3883 : : end if
3884 : :
3885 : : ! FIXME: needs to be generalized to complete the k grid for one of the arguments to mknesting
3886 : 1 : fermie = ebands%fermie
3887 : 1 : nqpath = size(qpath_vertices, dim=2)
3888 : :
3889 : : ! Compute weights. Set sigma to 0.1 eV is tsmear is zero
3890 [ + - ]: 1 : invgauwidth = one / (0.1_dp * eV_Ha); if (tsmear > tol10) invgauwidth = one / tsmear
3891 : 1 : prefact = one / sqrt(pi) * invgauwidth
3892 : :
3893 [ - + + - : 5 : ABI_MALLOC(fs_weights, (ebands%nband(1), ebands%nkpt, ebands%nsppol))
- + + - -
+ + - + -
+ - - + -
+ ]
3894 : :
3895 [ + + ]: 2 : do spin=1,ebands%nsppol
3896 [ + + ]: 31 : do ikpt=1,ebands%nkpt
3897 [ + + ]: 175 : do iband=1,ebands%nband(1)
3898 : : fs_weights(iband, ikpt, spin) = prefact * &
3899 : 174 : exp(-(invgauwidth*(ebands%eig(iband,ikpt,spin)-(fermie + fermie_nest)))**2)
3900 : : end do
3901 : : end do
3902 : : end do
3903 : :
3904 [ - + ]: 1 : if (any(ebands%kptopt == [3, 4])) then ! no symmetry
3905 : : call mknesting(ebands%nkpt,ebands%kptns,ebands%kptrlatt,ebands%nband(1),fs_weights,nqpath,&
3906 [ # # # # : 0 : qpath_vertices,1,[zero, zero, zero],filepath,cryst%gprimd,cryst%gmet,prtnest,identity_3d)
# # # # #
# ]
3907 : : else
3908 : : call mknesting(ebands%nkpt,ebands%kptns,ebands%kptrlatt,ebands%nband(1),fs_weights,nqpath,&
3909 : : qpath_vertices,1, [zero, zero, zero], filepath,cryst%gprimd,cryst%gmet,prtnest,identity_3d,&
3910 [ - + - - : 1 : nsym=cryst%nsym, symrec=cryst%symrec)
- - - - -
+ ]
3911 : : end if
3912 : :
3913 [ - + ]: 1 : ABI_FREE(fs_weights)
3914 : :
3915 [ - + ]: 1 : end function ebands_write_nesting
3916 : : !!***
3917 : :
3918 : : !----------------------------------------------------------------------
3919 : :
3920 : : !!****f* m_ebands/ebands_expandk
3921 : : !! NAME
3922 : : !! ebands_expandk
3923 : : !!
3924 : : !! FUNCTION
3925 : : !! Return a new object of type ebands_t corresponding to a list of k-points
3926 : : !! specified in input. Symmetry properties of the eigenvectors are used to
3927 : : !! symmetrize energies and occupation numbers.
3928 : : !!
3929 : : !! INPUTS
3930 : : !! inb<ebands_t>=Initial band structure with energies in the IBZ.
3931 : : !! ecut_eff=Effective cutoff energy i.e. ecut * dilatmx**2
3932 : : !! force_istwfk1=If True, istwfk if forced to 1 for all the k-points in the BZ.
3933 : : !!
3934 : : !! OUTPUT
3935 : : !! dksqmax=maximal value of the norm**2 of the difference between
3936 : : !! a kpt in the BZ and the closest k-point found in the inb%kpts set, using symmetries.
3937 : : !! bz2ibz(nkpt2,6)=describe k point number of kpt1 that allows to
3938 : : !! generate wavefunctions closest to given kpt2
3939 : : !! bz2ibz(:,1)=k point number of kptns1
3940 : : !! bz2ibz(:,2)=symmetry operation to be applied to kpt1, to give kpt1a
3941 : : !! (if 0, means no symmetry operation, equivalent to identity )
3942 : : !! bz2ibz(:,3:5)=shift in reciprocal space to be given to kpt1a,
3943 : : !! to give kpt1b, that is the closest to kpt2.
3944 : : !! bz2ibz(:,6)=1 if time-reversal was used to generate kpt1a from kpt1, 0 otherwise
3945 : : !! outb<ebands_t>=band structure with energies in the BZ.
3946 : : !!
3947 : : !! SOURCE
3948 : :
3949 : 8 : subroutine ebands_expandk(inb, cryst, ecut_eff, force_istwfk1, dksqmax, bz2ibz, outb)
3950 : :
3951 : : !Arguments ------------------------------------
3952 : : !scalars
3953 : : class(ebands_t),intent(in) :: inb
3954 : : real(dp),intent(in) :: ecut_eff
3955 : : real(dp),intent(out) :: dksqmax
3956 : : logical,intent(in) :: force_istwfk1
3957 : : class(ebands_t),intent(out) :: outb
3958 : : class(crystal_t),intent(in) :: cryst
3959 : : !arrays
3960 : : integer,allocatable,intent(out) :: bz2ibz(:,:)
3961 : :
3962 : : !Local variables-------------------------------
3963 : : !scalars
3964 : : integer,parameter :: istwfk_1=1,kptopt3=3
3965 : : integer :: nkfull,timrev,bantot,sppoldbl,npw_k,nsppol,istw
3966 : : integer :: ik_ibz,ikf,isym,itimrev,spin,mband,my_nkibz,comm
3967 : : logical :: isirred_k
3968 : : !character(len=500) :: msg
3969 : : !arrays
3970 : : integer :: g0(3)
3971 : 8 : integer,allocatable :: istwfk(:),nband(:,:),npwarr(:),kg_k(:,:)
3972 : 8 : real(dp),allocatable :: kfull(:,:),doccde(:),eig(:),occ(:),wtk(:),my_kibz(:,:)
3973 [ + - ]: 8 : real(dp),allocatable :: doccde_3d(:,:,:),eig_3d(:,:,:),occ_3d(:,:,:)
3974 : : ! *********************************************************************
3975 : :
3976 [ - + ]: 8 : ABI_CHECK(inb%kptopt /= 0, "ebands_expandk does not support kptopt == 0")
3977 : :
3978 : 8 : comm = xmpi_comm_self
3979 : 8 : nsppol = inb%nsppol
3980 : :
3981 : : ! Note kptopt=3
3982 : : call kpts_ibz_from_kptrlatt(cryst, inb%kptrlatt, kptopt3, inb%nshiftk, inb%shiftk, &
3983 : 8 : my_nkibz, my_kibz, wtk, nkfull, kfull) ! new_kptrlatt, new_shiftk)
3984 : :
3985 [ - + ]: 8 : ABI_FREE(my_kibz)
3986 [ - + ]: 8 : ABI_FREE(wtk)
3987 : :
3988 : : ! Construct full BZ and create mapping BZ --> IBZ
3989 : : ! Note:
3990 : : ! - we don't change the value of nsppol hence sppoldbl is set to 1
3991 : : ! - we use symrel so that bz2ibz can be used to reconstruct the wavefunctions.
3992 : : !
3993 : 8 : sppoldbl = 1 !; if (any(cryst%symafm == -1) .and. inb%nsppol == 1) sppoldbl=2
3994 [ - + + - : 24 : ABI_MALLOC(bz2ibz, (nkfull*sppoldbl,6))
+ - + - -
+ - + -
+ ]
3995 : :
3996 : 8 : timrev = kpts_timrev_from_kptopt(inb%kptopt)
3997 : : call listkk(dksqmax, cryst%gmet, bz2ibz, inb%kptns, kfull, inb%nkpt, nkfull, cryst%nsym, &
3998 : 8 : sppoldbl, cryst%symafm, cryst%symrel, timrev, comm, use_symrec=.False.)
3999 : :
4000 [ - + + - : 24 : ABI_MALLOC(wtk, (nkfull))
+ - + - -
+ - + ]
4001 [ + + ]: 696 : wtk = one / nkfull ! weights normalized to one
4002 : :
4003 [ - + + - : 24 : ABI_MALLOC(istwfk, (nkfull))
+ - + - -
+ - + ]
4004 [ - + + - : 32 : ABI_MALLOC(nband, (nkfull, nsppol))
- + + - +
- + - - +
- + ]
4005 [ - + + - : 16 : ABI_MALLOC(npwarr, (nkfull))
- + - + ]
4006 : :
4007 [ + + + + : 128 : if (any(cryst%symrel(:,:,1) /= identity_3d) .and. any(abs(cryst%tnons(:,1)) > tol10) ) then
+ - + + +
- - + ]
4008 : 0 : ABI_ERROR('The first symmetry is not the identity operator!')
4009 : : end if
4010 : :
4011 [ + + ]: 696 : do ikf=1,nkfull
4012 : 688 : ik_ibz = bz2ibz(ikf,1)
4013 : 688 : isym = bz2ibz(ikf,2)
4014 : 688 : itimrev = bz2ibz(ikf,6)
4015 [ + + ]: 2752 : g0 = bz2ibz(ikf,3:5) ! IS(k_ibz) + g0 = k_bz
4016 [ + + + + : 2300 : isirred_k = (isym == 1 .and. itimrev == 0 .and. all(g0 == 0))
+ + - + ]
4017 : :
4018 [ + + ]: 1376 : do spin=1,nsppol
4019 : 1376 : nband(ikf,spin) = inb%nband(ik_ibz+(spin-1)*inb%nkpt)
4020 : : end do
4021 : :
4022 [ + - ]: 696 : if (force_istwfk1) then
4023 [ - + ]: 688 : call get_kg(kfull(:,ikf),istwfk_1,ecut_eff,cryst%gmet,npw_k,kg_k)
4024 [ - + ]: 688 : ABI_FREE(kg_k)
4025 : 688 : istwfk(ikf) = 1
4026 : 688 : npwarr(ikf) = npw_k
4027 : : else
4028 [ # # ]: 0 : if (isirred_k) then
4029 : 0 : istwfk(ikf) = inb%istwfk(ik_ibz)
4030 : 0 : npwarr(ikf) = inb%npwarr(ik_ibz)
4031 : : else
4032 : 0 : istw = set_istwfk(kfull(:,ikf))
4033 [ # # ]: 0 : call get_kg(kfull(:,ikf),istw,ecut_eff,cryst%gmet,npw_k,kg_k)
4034 [ # # ]: 0 : ABI_FREE(kg_k)
4035 : 0 : istwfk(ikf) = istw
4036 : 0 : npwarr(ikf) = npw_k
4037 : : end if
4038 : : end if
4039 : : end do
4040 : :
4041 : : ! Recostruct eig, occ and doccde in the BZ.
4042 [ + + + + : 1400 : bantot = sum(nband); mband = maxval(nband)
+ + + + ]
4043 : :
4044 [ - + + - : 40 : ABI_MALLOC(doccde_3d, (mband, nkfull, nsppol))
- + + - -
+ + - + -
+ - - + -
+ ]
4045 [ - + + - : 32 : ABI_MALLOC(eig_3d, (mband, nkfull, nsppol))
- + + - -
+ + - - +
- + ]
4046 [ - + + - : 32 : ABI_MALLOC(occ_3d, (mband, nkfull, nsppol))
- + + - -
+ + - - +
- + ]
4047 : :
4048 [ + + ]: 16 : do spin=1,nsppol
4049 [ + + ]: 704 : do ikf=1,nkfull
4050 : 688 : ik_ibz = bz2ibz(ikf,1)
4051 [ + + ]: 11184 : doccde_3d(:,ikf,spin) = inb%doccde(:,ik_ibz,spin)
4052 [ + + ]: 11184 : eig_3d(:,ikf,spin) = inb%eig(:,ik_ibz,spin)
4053 [ + + ]: 11192 : occ_3d(:,ikf,spin) = inb%occ(:,ik_ibz,spin)
4054 : : end do
4055 : : end do
4056 : :
4057 : : ! Have to pack data to call ebands_init (I wonder who decided to use vectors!)
4058 [ - + + - : 24 : ABI_MALLOC(doccde, (bantot))
+ - + - -
+ - + ]
4059 [ - + + - : 16 : ABI_MALLOC(eig, (bantot))
- + - + ]
4060 [ - + + - : 16 : ABI_MALLOC(occ, (bantot))
- + - + ]
4061 : :
4062 : 8 : call pack_eneocc(nkfull, nsppol, mband, nband, bantot, doccde_3d, doccde)
4063 : 8 : call pack_eneocc(nkfull, nsppol, mband, nband, bantot, eig_3d, eig)
4064 : 8 : call pack_eneocc(nkfull, nsppol, mband, nband, bantot, occ_3d, occ)
4065 : :
4066 [ - + ]: 8 : ABI_FREE(doccde_3d)
4067 [ - + ]: 8 : ABI_FREE(eig_3d)
4068 [ - + ]: 8 : ABI_FREE(occ_3d)
4069 : :
4070 : : call outb%init(bantot, inb%nelect, inb%ne_qFD, inb%nh_qFD, inb%ivalence, doccde, eig, istwfk, kfull, &
4071 : : nband, nkfull, npwarr, nsppol, inb%nspinor, inb%tphysel, inb%tsmear, inb%occopt, occ, wtk, &
4072 : 8 : inb%cellcharge, kptopt3, inb%kptrlatt_orig, inb%nshiftk_orig, inb%shiftk_orig, inb%kptrlatt, inb%nshiftk, inb%shiftk)
4073 : :
4074 : : ! The expansion changes only the k-point representation. Preserve the Fermi
4075 : : ! energies stored in the input band structure instead of keeping the zero
4076 : : ! values assigned by ebands_init.
4077 : 8 : outb%fermie = inb%fermie
4078 : 8 : outb%fermih = inb%fermih
4079 : :
4080 [ - + ]: 8 : ABI_FREE(istwfk)
4081 [ - + ]: 8 : ABI_FREE(nband)
4082 [ - + ]: 8 : ABI_FREE(npwarr)
4083 [ - + ]: 8 : ABI_FREE(doccde)
4084 [ - + ]: 8 : ABI_FREE(eig)
4085 [ - + ]: 8 : ABI_FREE(occ)
4086 [ - + ]: 8 : ABI_FREE(wtk)
4087 [ - + ]: 8 : ABI_FREE(kfull)
4088 : :
4089 [ - + ]: 8 : end subroutine ebands_expandk
4090 : : !!***
4091 : :
4092 : : !----------------------------------------------------------------------
4093 : :
4094 : : !!****f* m_ebands/ebands_downsample
4095 : : !! NAME
4096 : : !! ebands_downsample
4097 : : !!
4098 : : !! FUNCTION
4099 : : !! Return a new ebands_t object of type ebands_t with a coarser IBZ contained in the initial one.
4100 : : !!
4101 : : !! INPUTS
4102 : : !! cryst<crystal_t>=Info on unit cell and symmetries.
4103 : : !! in_kptrlatt(3,3)=Defines the sampling of the "small" IBZ. Must be submesh of the "fine" mesh.
4104 : : !! in_nshiftk= Number of shifts in the coarse k-mesh
4105 : : !! in_shiftk(3, in_nshiftk) = Shifts of the coarse k-mesh
4106 : : !!
4107 : : !! SOURCE
4108 : :
4109 : 3 : type(ebands_t) function ebands_downsample(self, cryst, in_kptrlatt, in_nshiftk, in_shiftk) result(new)
4110 : :
4111 : : !Arguments ------------------------------------
4112 : : !scalars
4113 : : integer,intent(in) :: in_nshiftk
4114 : : class(ebands_t),intent(in) :: self
4115 : : type(crystal_t),intent(in) :: cryst
4116 : : !arrays
4117 : : integer,intent(in) :: in_kptrlatt(3,3)
4118 : : real(dp),intent(in) :: in_shiftk(3, in_nshiftk)
4119 : :
4120 : : !Local variables-------------------------------
4121 : : !scalars
4122 : : integer,parameter :: sppoldbl1 = 1
4123 : : integer :: new_nkbz , timrev, bantot, new_nkibz, ik_ibz, ikf, spin,mband, comm
4124 : : real(dp) :: dksqmax
4125 : : character(len=500) :: msg
4126 : : !arrays
4127 : 3 : integer,allocatable :: ibz_c2f(:,:)
4128 : : integer :: new_kptrlatt(3,3)
4129 : 3 : integer,allocatable :: istwfk(:),nband(:,:),npwarr(:)
4130 : 3 : real(dp),allocatable :: new_kbz(:,:), new_wtk(:), new_kibz(:,:), doccde(:), eig(:), occ(:)
4131 : 3 : real(dp),allocatable :: doccde_3d(:,:,:), eig_3d(:,:,:), occ_3d(:,:,:), new_shiftk(:,:)
4132 : : ! *********************************************************************
4133 : :
4134 : 3 : comm = xmpi_comm_self
4135 : :
4136 : : ! Find IBZ associated to the new mesh.
4137 : : call kpts_ibz_from_kptrlatt(cryst, in_kptrlatt, self%kptopt, in_nshiftk, in_shiftk, &
4138 : 3 : new_nkibz, new_kibz, new_wtk, new_nkbz, new_kbz, new_kptrlatt=new_kptrlatt, new_shiftk=new_shiftk)
4139 : :
4140 : : ! Construct mapping IBZ_coarse --> IBZ_fine
4141 : : ! We don't change the value of nsppol hence sppoldbl1 is set to 1
4142 [ - + + - : 9 : ABI_MALLOC(ibz_c2f, (new_nkibz*sppoldbl1, 6))
+ - + - -
+ - + ]
4143 : :
4144 : 3 : timrev = kpts_timrev_from_kptopt(self%kptopt)
4145 : : call listkk(dksqmax, cryst%gmet, ibz_c2f, self%kptns, new_kibz, self%nkpt, new_nkibz, cryst%nsym, &
4146 : 3 : sppoldbl1, cryst%symafm, cryst%symrel, timrev, comm, use_symrec=.False.)
4147 : :
4148 [ - + ]: 3 : if (dksqmax > tol12) then
4149 : : write(msg, '(a,es16.6,6a)' )&
4150 : 0 : "At least one of the k-points could not be generated from a symmetrical one. dksqmax: ",dksqmax, ch10,&
4151 [ # # ]: 0 : "kptrlatt of input ebands: ",trim(ltoa(pack(self%kptrlatt, mask=.True.))),ch10, &
4152 [ # # ]: 0 : "downsampled K-mesh: ",trim(ltoa(pack(in_kptrlatt, mask=.True.)))
4153 : 0 : ABI_ERROR(msg)
4154 : : end if
4155 : :
4156 [ - + + - : 9 : ABI_MALLOC(istwfk, (new_nkibz))
+ - + - -
+ - + ]
4157 [ - + + - : 12 : ABI_MALLOC(nband, (new_nkibz, self%nsppol))
- + + - +
- + - - +
- + ]
4158 [ - + + - : 6 : ABI_MALLOC(npwarr, (new_nkibz))
- + - + ]
4159 : :
4160 [ + + ]: 81 : do ik_ibz=1,new_nkibz
4161 : 78 : ikf = ibz_c2f(ik_ibz, 1)
4162 [ + + ]: 156 : do spin=1,self%nsppol
4163 : 156 : nband(ik_ibz, spin) = self%nband(ikf + (spin-1) * self%nkpt)
4164 : : end do
4165 : 78 : istwfk(ik_ibz) = self%istwfk(ikf)
4166 : 81 : npwarr(ik_ibz) = self%npwarr(ikf)
4167 : : end do
4168 : :
4169 : : ! Recostruct eig, occ and doccde in the new IBZ.
4170 [ + + + + : 165 : bantot = sum(nband); mband = maxval(nband)
+ + + + ]
4171 : :
4172 [ - + + - : 15 : ABI_MALLOC(doccde_3d, (mband, new_nkibz, self%nsppol))
- + + - -
+ + - + -
+ - - + -
+ ]
4173 [ - + + - : 12 : ABI_MALLOC(eig_3d, (mband, new_nkibz, self%nsppol))
- + + - -
+ + - - +
- + ]
4174 [ - + + - : 12 : ABI_MALLOC(occ_3d, (mband, new_nkibz, self%nsppol))
- + + - -
+ + - - +
- + ]
4175 : :
4176 [ + + ]: 6 : do spin=1,self%nsppol
4177 [ + + ]: 84 : do ik_ibz=1,new_nkibz
4178 : 78 : ikf = ibz_c2f(ik_ibz, 1)
4179 [ + + ]: 606 : doccde_3d(:, ik_ibz, spin) = self%doccde(:, ikf, spin)
4180 [ + + ]: 606 : eig_3d(:, ik_ibz, spin) = self%eig(:, ikf, spin)
4181 [ + + ]: 609 : occ_3d(:, ik_ibz, spin) = self%occ(:, ikf, spin)
4182 : : end do
4183 : : end do
4184 : :
4185 : : ! Have to pack data to call ebands_init (I wonder who decided to use vectors!)
4186 [ - + + - : 9 : ABI_MALLOC(doccde, (bantot))
+ - + - -
+ - + ]
4187 [ - + + - : 6 : ABI_MALLOC(eig, (bantot))
- + - + ]
4188 [ - + + - : 6 : ABI_MALLOC(occ, (bantot))
- + - + ]
4189 : :
4190 : 3 : call pack_eneocc(new_nkibz, self%nsppol, mband, nband, bantot, doccde_3d, doccde)
4191 : 3 : call pack_eneocc(new_nkibz, self%nsppol, mband, nband, bantot, eig_3d, eig)
4192 : 3 : call pack_eneocc(new_nkibz, self%nsppol, mband, nband, bantot, occ_3d, occ)
4193 : :
4194 [ - + ]: 3 : ABI_FREE(doccde_3d)
4195 [ - + ]: 3 : ABI_FREE(eig_3d)
4196 [ - + ]: 3 : ABI_FREE(occ_3d)
4197 : :
4198 : : call new%init(bantot, self%nelect, self%ne_qFD, self%nh_qFD, self%ivalence, doccde, eig, istwfk, new_kibz, &
4199 : : nband, new_nkibz, npwarr, self%nsppol, self%nspinor, self%tphysel, self%tsmear, self%occopt, occ, new_wtk, &
4200 : 3 : self%cellcharge, self%kptopt, in_kptrlatt, in_nshiftk, self%shiftk, new_kptrlatt, size(new_shiftk, dim=2), new_shiftk)
4201 : :
4202 : 3 : new%fermie = self%fermie
4203 : 3 : new%fermih = self%fermih
4204 : :
4205 [ - + ]: 3 : ABI_FREE(istwfk)
4206 [ - + ]: 3 : ABI_FREE(nband)
4207 [ - + ]: 3 : ABI_FREE(npwarr)
4208 [ - + ]: 3 : ABI_FREE(doccde)
4209 [ - + ]: 3 : ABI_FREE(eig)
4210 [ - + ]: 3 : ABI_FREE(occ)
4211 [ - + ]: 3 : ABI_FREE(new_kibz)
4212 [ - + ]: 3 : ABI_FREE(new_kbz)
4213 [ - + ]: 3 : ABI_FREE(new_wtk)
4214 [ - + ]: 3 : ABI_FREE(new_shiftk)
4215 [ - + ]: 3 : ABI_FREE(ibz_c2f)
4216 : :
4217 : 3 : end function ebands_downsample
4218 : : !!***
4219 : :
4220 : : !----------------------------------------------------------------------
4221 : :
4222 : : !!****f* m_ebands/ebands_chop
4223 : : !! NAME
4224 : : !! ebands_chop
4225 : : !!
4226 : : !! FUNCTION
4227 : : !! Return a new ebands_t object with a selected number of bands between bstart and bstop
4228 : : !!
4229 : : !! INPUTS
4230 : : !!
4231 : : !! SOURCE
4232 : :
4233 : 15 : type(ebands_t) function ebands_chop(self, bstart, bstop) result(new)
4234 : :
4235 : : !Arguments ------------------------------------
4236 : : !scalars
4237 : : class(ebands_t),intent(in) :: self
4238 : : integer,intent(in) :: bstart, bstop
4239 : :
4240 : : !Local variables ------------------------------
4241 : : integer :: mband, nkpt, nsppol
4242 : : ! *********************************************************************
4243 : :
4244 [ - + ]: 15 : ABI_CHECK_IRANGE(bstart, 1, self%mband, "Invalid bstart")
4245 [ + - - + ]: 15 : ABI_CHECK_IRANGE(bstop, 1, self%mband, "Invalid bstop")
4246 [ - + ]: 15 : ABI_CHECK_ILEQ(bstart, bstop, "bstart should be <= bstop")
4247 : :
4248 : : ! First copy the bands
4249 : 15 : call self%copy(new)
4250 : :
4251 : : ! Now chop them
4252 [ - + ]: 15 : ABI_FREE(new%eig)
4253 [ - + ]: 15 : ABI_FREE(new%occ)
4254 [ - + ]: 15 : ABI_FREE(new%doccde)
4255 : :
4256 : 15 : mband = bstop - bstart + 1
4257 : 15 : nkpt = self%nkpt
4258 : 15 : nsppol = self%nsppol
4259 : :
4260 [ - + + - : 75 : ABI_MALLOC(new%eig, (mband, nkpt, nsppol))
- + + - -
+ + - + -
+ - - + -
+ ]
4261 [ - + + - : 60 : ABI_MALLOC(new%occ, (mband, nkpt, nsppol))
- + + - -
+ + - - +
- + ]
4262 [ - + + - : 60 : ABI_MALLOC(new%doccde, (mband, nkpt, nsppol))
- + + - -
+ + - - +
- + ]
4263 : :
4264 : 15 : new%mband = mband
4265 [ + + ]: 3928 : new%nband = mband
4266 [ + - + - : 22951 : new%eig = self%eig(bstart:bstop,:,:)
+ - - + -
- + + + +
+ + ]
4267 [ + - + - : 22951 : new%occ = self%occ(bstart:bstop,:,:)
+ - - + -
- + + + +
+ + ]
4268 [ + - + - : 22951 : new%doccde = self%doccde(bstart:bstop,:,:)
+ - - + -
- + + + +
+ + ]
4269 : :
4270 [ + + ]: 3928 : new%bantot = sum(new%nband)
4271 : :
4272 [ + - ]: 15 : end function ebands_chop
4273 : : !!***
4274 : :
4275 : : !----------------------------------------------------------------------
4276 : :
4277 : : !!****f* m_ebands/ebands_sort
4278 : : !! NAME
4279 : : !! ebands_sort
4280 : : !!
4281 : : !! FUNCTION
4282 : : !! Sort eigvalues_k in ascending order and reorder arrays depending on nband_k
4283 : : !! Mainly used when interpolating band energies as the interpolator may not produce ordered eigenvalues
4284 : : !! and there are routines whose implementation assumes eig(b) <= eig(b+1)
4285 : : !!
4286 : : !! SOURCE
4287 : :
4288 : 6 : subroutine ebands_sort(self)
4289 : :
4290 : : !Arguments ------------------------------------
4291 : : class(ebands_t),intent(inout) :: self
4292 : :
4293 : : !Local variables-------------------------------
4294 : : !scalars
4295 : : integer :: spin, ik_ibz, band, nband_k
4296 : : !arrays
4297 : 12 : integer :: iperm_k(self%mband)
4298 : : ! *********************************************************************
4299 : :
4300 [ + + ]: 12 : do spin=1,self%nsppol
4301 [ + + ]: 1044 : do ik_ibz=1,self%nkpt
4302 : 1032 : nband_k = self%nband(ik_ibz + (spin - 1) * self%nkpt)
4303 [ + - + + : 27436 : iperm_k = [(band, band=1, nband_k)]
+ + ]
4304 : 1032 : call sort_dp(nband_k, self%eig(:, ik_ibz, spin), iperm_k, tol12)
4305 : :
4306 : : ! Shuffle other arrays depending on nband_k
4307 [ + - + + : 27436 : self%occ(1:nband_k, ik_ibz, spin) = self%occ(iperm_k(1:nband_k), ik_ibz, spin)
+ + ]
4308 [ + + + + ]: 27442 : self%doccde(1:nband_k, ik_ibz, spin) = self%doccde(iperm_k(1:nband_k), ik_ibz, spin)
4309 : : !if (allocated(self%velocity)) then
4310 : : ! self%velocity(:, 1:nband_k, ik_ibz, spin) = self%velocity(:, iperm_k(1:nband_k), ik_ibz, spin)
4311 : : !end if
4312 : : end do
4313 : : end do
4314 : :
4315 : 6 : end subroutine ebands_sort
4316 : : !!***
4317 : :
4318 : : !!****f* m_ebands/ebands_has_enough_bands_for_ef
4319 : : !! NAME
4320 : : !! ebands_has_enough_bands_for_ef
4321 : : !!
4322 : : !! FUNCTION
4323 : : !! Check if nband is "large enough" to compute the Fermi level Ef(T).
4324 : : !!
4325 : : !! OUTPUT
4326 : : !! msg: error/warning message.
4327 : : !! ierr:
4328 : : !! > 0: if critical error that should trigger abortion.
4329 : : !! < 0: if non-critical error that should trigger warning
4330 : : !! = 0: everything seems ok.
4331 : : !!
4332 : : !! NOTES
4333 : : !! The logic here is far from perfect since what really matter is not the number of bands but the
4334 : : !! electronic DOS in the conduction region. Systems with a large DOS require more bands
4335 : : !! for an accurate evaluation of Ef(T). For simplicity, we just use a simple scaling factor `fact`
4336 : : !! that mutiplies the number of electrons.
4337 : : !!
4338 : : !! SOURCE
4339 : :
4340 : 64 : integer function ebands_has_enough_bands_for_ef(ebands, msg) result(ierr)
4341 : :
4342 : : !Arguments ------------------------------------
4343 : : !scalars
4344 : : class(ebands_t),intent(in) :: ebands
4345 : : character(len=*),intent(out) :: msg
4346 : :
4347 : : !Local variables-------------------------------
4348 : : real(dp), parameter :: fact = 1.2_dp
4349 : : integer :: nbv
4350 : : ! *********************************************************************
4351 : :
4352 : 64 : ierr = 0; msg = ""
4353 : :
4354 : : ! We do the math assuming a semiconductor (spin unpolarized if nsppol == 2)
4355 [ - + ]: 64 : nbv = ebands%nelect / 2; if (ebands%nspinor == 2) nbv = ebands%nelect
4356 : :
4357 [ + + ]: 64 : if (ebands%mband <= nbv) then
4358 : : ! Catch the worst-case-scenario in which only occupied states in a semiconductor are provided.
4359 : 1 : ierr = 1
4360 [ - + + - : 1 : msg = sjoin("In order to compute Ef(T) you should use nband > ", itoa(ceiling(ebands%nelect)))
+ - ]
4361 : 1 : return
4362 : : end if
4363 : :
4364 [ + + - + ]: 63 : if (ebands%mband <= ceiling(fact * nbv)) then
4365 : 0 : ierr = -1
4366 [ # # # # ]: 0 : msg = "nband might be too small to compute Ef(T). Try to increase nband."
4367 : : end if
4368 : :
4369 [ + - ]: 64 : end function ebands_has_enough_bands_for_ef
4370 : : !!***
4371 : :
4372 : : !----------------------------------------------------------------------
4373 : :
4374 : : !!****f* m_ebands/ebands_interp_kmesh
4375 : : !! NAME
4376 : : !! ebands_interp_kmesh
4377 : : !!
4378 : : !! FUNCTION
4379 : : !! Interpolate energies on a k-mesh.
4380 : : !!
4381 : : !! INPUTS
4382 : : !! ebands<ebands_t> = Object with input energies.
4383 : : !! cryst<crystal_t> = Crystalline structure.
4384 : : !! params(:):
4385 : : !! params(0): interpolation type. 1 for star-functions
4386 : : !! 2 for star-functions with group velocities
4387 : : !! if star-functions:
4388 : : !! params(2): Ratio between star functions and ab-initio k-points.
4389 : : !! params(3:4): Activate Fourier filtering (Eq 9 of PhysRevB.61.1639) if params(2) > tol6
4390 : : !! params(3)=rcut, params(4) = rsigma
4391 : : !! intp_kptrlatt(3,3) = New k-mesh
4392 : : !! intp_nshiftk= Number of shifts in new k-mesh.
4393 : : !! intp_shiftk(3,intp_nshiftk) = Shifts in new k-mesh.
4394 : : !! band_range(2)=Initial and final band index. If [0,0], all bands are used
4395 : : !! This is a global variable i.e. all MPI procs must call the routine with the same value.
4396 : : !! comm=MPI communicator
4397 : : !! [out_prefix]: optional string prefix used to write netcdf file.
4398 : : !! [malloc_only]: if true, create new bands object but don't interpolate eigenvalues.
4399 : : !!
4400 : : !! OUTPUT
4401 : : !! New ebands_t object with interpolated energies.
4402 : : !!
4403 : : !! NOTES
4404 : : !! Fermi level and occupation factors of the interpolated bands are not recomputed by this routine.
4405 : : !! This operation is delegated to the caller.
4406 : : !!
4407 : : !! SOURCE
4408 : :
4409 : 8 : type(ebands_t) function ebands_interp_kmesh(ebands, cryst, params, intp_kptrlatt, intp_nshiftk, intp_shiftk, band_range, comm, &
4410 : : out_prefix, malloc_only) result(new)
4411 : :
4412 : : !Arguments ------------------------------------
4413 : : !scalars
4414 : : class(ebands_t),intent(in) :: ebands
4415 : : integer,intent(in) :: intp_nshiftk,comm
4416 : : type(crystal_t),intent(in) :: cryst
4417 : : character(len=*),optional,intent(in) :: out_prefix
4418 : : logical,optional,intent(in) :: malloc_only
4419 : : !arrays
4420 : : integer,intent(in) :: intp_kptrlatt(3,3),band_range(2)
4421 : : real(dp),intent(in) :: params(:)
4422 : : real(dp),intent(in) :: intp_shiftk(3,intp_nshiftk)
4423 : :
4424 : : !Local variables-------------------------------
4425 : : !scalars
4426 : : integer,parameter :: master = 0
4427 : : integer :: ik_ibz,spin,new_bantot,new_mband,cplex,itype,nb,ib
4428 : : integer :: nprocs,my_rank,cnt,ierr,band,new_nkbz,new_nkibz,new_nshiftk, ncid
4429 : 4 : type(skw_t) :: skw
4430 : : !arrays
4431 : : integer :: new_kptrlatt(3,3),my_bblock(2)
4432 : 4 : integer,allocatable :: new_istwfk(:),new_nband(:,:),new_npwarr(:)
4433 : 4 : real(dp),allocatable :: new_shiftk(:,:),new_kibz(:,:),new_kbz(:,:),new_wtk(:)
4434 : 4 : real(dp),allocatable :: new_doccde(:),new_eig(:),new_occ(:)
4435 : : ! *********************************************************************
4436 : :
4437 : 4 : nprocs = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
4438 : :
4439 [ + - - + : 4 : my_bblock = band_range; if (all(band_range == 0)) my_bblock = [1, ebands%mband]
- + - - ]
4440 : 4 : nb = my_bblock(2) - my_bblock(1) + 1
4441 : :
4442 : : ! Get ibz, new shifts and new kptrlatt.
4443 : : call kpts_ibz_from_kptrlatt(cryst, intp_kptrlatt, ebands%kptopt, intp_nshiftk, intp_shiftk, &
4444 : 4 : new_nkibz, new_kibz, new_wtk, new_nkbz, new_kbz, new_kptrlatt=new_kptrlatt, new_shiftk=new_shiftk)
4445 : 4 : new_nshiftk = size(new_shiftk, dim=2)
4446 : :
4447 : : ! Initialize new ebands_t in new IBZ
4448 [ - + + - : 12 : ABI_MALLOC(new_istwfk, (new_nkibz))
+ - + - -
+ - + ]
4449 [ + + ]: 236 : new_istwfk = 1
4450 : : !do ik_ibz=1,new_nkibz
4451 : : ! new_istwfk(ik_ibz) = set_istwfk(new%kptns(:, ik_ibz))
4452 : : !end do
4453 [ - + + - : 16 : ABI_MALLOC(new_nband, (new_nkibz, ebands%nsppol))
- + + - +
- + - - +
- + ]
4454 [ + + + + ]: 240 : new_nband = nb
4455 [ - + + - : 8 : ABI_MALLOC(new_npwarr, (new_nkibz))
- + - + ]
4456 [ + + + + ]: 268 : new_npwarr = maxval(ebands%npwarr)
4457 [ + + + + ]: 240 : new_bantot = sum(new_nband); new_mband = maxval(new_nband)
4458 [ - + + - : 3898 : ABI_CALLOC(new_doccde, (new_bantot))
+ - + - -
+ - + +
+ ]
4459 [ - + + - : 3894 : ABI_CALLOC(new_eig, (new_bantot))
- + - + +
+ ]
4460 [ - + + - : 3894 : ABI_CALLOC(new_occ, (new_bantot))
- + - + +
+ ]
4461 : :
4462 : : call new%init(new_bantot, ebands%nelect, ebands%ne_qFD,ebands%nh_qFD,ebands%ivalence,&
4463 : : new_doccde, new_eig, new_istwfk, new_kibz,&
4464 : : new_nband, new_nkibz, new_npwarr, ebands%nsppol, ebands%nspinor, ebands%tphysel, ebands%tsmear,&
4465 : : ebands%occopt, new_occ, new_wtk, &
4466 : 4 : ebands%cellcharge, ebands%kptopt, intp_kptrlatt, intp_nshiftk, intp_shiftk, new_kptrlatt, new_nshiftk, new_shiftk)
4467 : :
4468 : : ! Get fermi level from input ebands.
4469 : 4 : new%fermie = ebands%fermie
4470 : 4 : new%fermih = ebands%fermih
4471 : :
4472 [ - + ]: 4 : ABI_FREE(new_kibz)
4473 [ - + ]: 4 : ABI_FREE(new_wtk)
4474 [ - + ]: 4 : ABI_FREE(new_shiftk)
4475 [ - + ]: 4 : ABI_FREE(new_kbz)
4476 [ - + ]: 4 : ABI_FREE(new_istwfk)
4477 [ - + ]: 4 : ABI_FREE(new_nband)
4478 [ - + ]: 4 : ABI_FREE(new_npwarr)
4479 [ - + ]: 4 : ABI_FREE(new_doccde)
4480 [ - + ]: 4 : ABI_FREE(new_eig)
4481 [ - + ]: 4 : ABI_FREE(new_occ)
4482 : :
4483 [ - + ]: 4 : if (present(malloc_only)) then
4484 [ # # ]: 0 : if (malloc_only) return
4485 : : end if
4486 : :
4487 : : ! Build SKW object for all bands.
4488 : 4 : itype = nint(params(1))
4489 [ + - ]: 4 : if (itype == 1 .or. itype == 2) then
4490 [ - + ]: 4 : cplex = 1; if (kpts_timrev_from_kptopt(ebands%kptopt) == 0) cplex = 2
4491 : 4 : skw = skw_new(cryst, params(2:), cplex, ebands%mband, ebands%nkpt, ebands%nsppol, ebands%kptns, ebands%eig, my_bblock, comm)
4492 : : !if (itype == 2) then
4493 : : ! ABI_CALLOC(new%velocity,(3,new%mband,new%nkpt,new%nsppol))
4494 : : !end if
4495 : : else
4496 : 0 : ABI_ERROR(sjoin("Wrong einterp params(1):", itoa(itype)))
4497 : : end if
4498 : :
4499 : : ! Interpolate eigenvalues and velocities.
4500 [ + + + + : 4126 : new%eig = zero; cnt = 0
+ + ]
4501 [ + + ]: 8 : do spin=1,new%nsppol
4502 [ + + ]: 240 : do ik_ibz=1,new%nkpt
4503 [ + + ]: 4122 : do ib=1,nb
4504 [ - + ]: 3886 : cnt = cnt + 1; if (mod(cnt, nprocs) /= my_rank) cycle ! Mpi parallelism.
4505 : : ! Note the difference between band and ib index if band_range.
4506 : 3886 : band = my_bblock(1) + ib - 1
4507 : 232 : select case (itype)
4508 : : case (1)
4509 : 3886 : call skw%eval_bks(band, new%kptns(:,ik_ibz), spin, new%eig(ib,ik_ibz,spin))
4510 : : !case (2)
4511 : : ! call skw%eval_bks(band, new%kptns(:,ik_ibz), spin, new%eig(ib,ik_ibz,spin), new%velocity(:,ib,ik_ibz,spin))
4512 : : case default
4513 [ + - ]: 3886 : ABI_ERROR(sjoin("Wrong params(1):", itoa(itype)))
4514 : : end select
4515 : : end do
4516 : : end do
4517 : : end do
4518 : 4 : call xmpi_sum(new%eig, comm, ierr)
4519 : : !if (itype == 2) call xmpi_sum(new%velocity, comm, ierr)
4520 : :
4521 : : ! Sort eigvalues_k in ascending order to be compatible with other ebands routines.
4522 : 4 : call new%sort()
4523 : : !call new%update_occ(dtset%spinmagntarget, prtvol=dtset%prtvol)
4524 : :
4525 [ + - + - : 4 : if (my_rank == master .and. itype == 1 .and. present(out_prefix)) then
- + ]
4526 : : ! Write ESKW file with crystal and (interpolated) band structure energies.
4527 : : !call wrtout(ab_out, sjoin("- Writing interpolated bands to file:", strcat(prefix, tag)))
4528 [ # # ]: 0 : NCF_CHECK(nctk_open_create(ncid, strcat(out_prefix, "_ESKW.nc"), xmpi_comm_self))
4529 [ # # ]: 0 : NCF_CHECK(cryst%ncwrite(ncid))
4530 [ # # ]: 0 : NCF_CHECK(ebands_ncwrite(new, ncid))
4531 [ # # ]: 0 : NCF_CHECK(nf90_close(ncid))
4532 : : end if
4533 : :
4534 : 4 : call skw%free()
4535 : :
4536 [ - + - + : 12 : end function ebands_interp_kmesh
- + - + -
+ - + - +
- + ]
4537 : : !!***
4538 : :
4539 : : !----------------------------------------------------------------------
4540 : :
4541 : : !!****f* m_ebands/ebands_interp_kpath
4542 : : !! NAME
4543 : : !! ebands_interp_kpath
4544 : : !!
4545 : : !! FUNCTION
4546 : : !! Interpolate energies on a k-path
4547 : : !!
4548 : : !! INPUTS
4549 : : !! ebands<ebands_t> = Object with input energies.
4550 : : !! cryst<crystal_t> = Crystalline structure.
4551 : : !! kpath<kpath_t> = Object describing the k-path
4552 : : !! params(:):
4553 : : !! params(1): 1 for SKW.
4554 : : !! band_range(2)=Initial and final band index to be interpolated. [0,0] if all bands are used.
4555 : : !! This is a global variable i.e. all MPI procs must call the routine with the same value.
4556 : : !! comm=MPI communicator
4557 : : !! [malloc_only]: if true, create new bands object but don't interpolate eigenvalues.
4558 : : !!
4559 : : !! OUTPUT
4560 : : !! New ebands_t object with interpolated energies.
4561 : : !!
4562 : : !! SOURCE
4563 : :
4564 : 4 : type(ebands_t) function ebands_interp_kpath(ebands, cryst, kpath, params, band_range, comm, malloc_only) result(new)
4565 : :
4566 : : !Arguments ------------------------------------
4567 : : !scalars
4568 : : class(ebands_t),intent(in) :: ebands
4569 : : integer,intent(in) :: comm
4570 : : type(crystal_t),intent(in) :: cryst
4571 : : type(kpath_t),intent(in) :: kpath
4572 : : logical,optional,intent(in) :: malloc_only
4573 : : !arrays
4574 : : integer,intent(in) :: band_range(2)
4575 : : real(dp),intent(in) :: params(:)
4576 : :
4577 : : !Local variables-------------------------------
4578 : : !scalars
4579 : : integer,parameter :: new_nshiftk=1
4580 : : integer :: ik_ibz,spin,new_bantot,new_mband,cplex
4581 : : integer :: nprocs,my_rank,cnt,ierr,band,new_nkibz,itype,nb,ib, new_kptopt
4582 : 2 : type(skw_t) :: skw
4583 : : !arrays
4584 : : integer,parameter :: new_kptrlatt(3,3)=0
4585 : : integer :: my_bblock(2)
4586 : 2 : integer,allocatable :: new_istwfk(:),new_nband(:,:),new_npwarr(:)
4587 : : real(dp),parameter :: new_shiftk(3,1) = zero
4588 : 2 : real(dp),allocatable :: new_wtk(:),new_doccde(:),new_eig(:),new_occ(:)
4589 : : ! *********************************************************************
4590 : :
4591 : 2 : nprocs = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
4592 : :
4593 [ + + + + : 6 : my_bblock = band_range; if (all(band_range == 0)) my_bblock = [1, ebands%mband]
+ + + + ]
4594 : 2 : nb = my_bblock(2) - my_bblock(1) + 1
4595 : :
4596 [ - + ]: 2 : if (ebands%nkpt == 1) then
4597 : 0 : ABI_WARNING("Cannot interpolate band energies when nkpt = 1. Returning")
4598 : 0 : return
4599 : : end if
4600 : :
4601 : : ! Initialize new ebands_t.
4602 : 2 : new_nkibz = kpath%npts
4603 [ - + + - : 6 : ABI_MALLOC(new_istwfk, (new_nkibz))
+ - + - -
+ - + ]
4604 [ + + ]: 802 : new_istwfk = 1
4605 [ - + + - : 8 : ABI_MALLOC(new_nband, (new_nkibz, ebands%nsppol))
- + + - +
- + - - +
- + ]
4606 [ + + + + ]: 804 : new_nband = nb
4607 [ - + + - : 4 : ABI_MALLOC(new_npwarr, (new_nkibz))
- + - + ]
4608 [ + + + + ]: 837 : new_npwarr = maxval(ebands%npwarr)
4609 [ + + + + ]: 804 : new_bantot = sum(new_nband); new_mband = maxval(new_nband)
4610 [ - + + - : 8806 : ABI_CALLOC(new_eig, (new_bantot))
+ - + - -
+ - + +
+ ]
4611 [ - + + - : 8804 : ABI_CALLOC(new_doccde, (new_bantot))
- + - + +
+ ]
4612 [ - + + - : 8804 : ABI_CALLOC(new_occ, (new_bantot))
- + - + +
+ ]
4613 [ - + + - : 806 : ABI_CALLOC(new_wtk, (new_nkibz))
+ - + - -
+ - + +
+ ]
4614 : :
4615 : : ! Needed by AbiPy to understand that we have a k-path instead of a mesh.
4616 : 2 : new_kptopt = -kpath%nbounds
4617 : :
4618 : : call new%init(new_bantot, ebands%nelect, ebands%ne_qFD,ebands%nh_qFD,ebands%ivalence, &
4619 : : new_doccde, new_eig, new_istwfk, kpath%points, &
4620 : : new_nband, new_nkibz, new_npwarr, ebands%nsppol, ebands%nspinor, ebands%tphysel, ebands%tsmear, &
4621 : : ebands%occopt, new_occ, new_wtk,&
4622 : 2 : ebands%cellcharge, new_kptopt, new_kptrlatt, new_nshiftk, new_shiftk, new_kptrlatt, new_nshiftk, new_shiftk)
4623 : :
4624 : 2 : new%fermie = ebands%fermie
4625 : 2 : new%fermih = ebands%fermih
4626 : :
4627 [ - + ]: 2 : ABI_FREE(new_wtk)
4628 [ - + ]: 2 : ABI_FREE(new_istwfk)
4629 [ - + ]: 2 : ABI_FREE(new_nband)
4630 [ - + ]: 2 : ABI_FREE(new_npwarr)
4631 [ - + ]: 2 : ABI_FREE(new_doccde)
4632 [ - + ]: 2 : ABI_FREE(new_eig)
4633 [ - + ]: 2 : ABI_FREE(new_occ)
4634 : :
4635 [ - + ]: 2 : if (present(malloc_only)) then
4636 [ # # ]: 0 : if (malloc_only) return
4637 : : end if
4638 : :
4639 : : ! Build SKW object for all bands.
4640 : 2 : itype = nint(params(1))
4641 : 2 : select case (itype)
4642 : : case (1)
4643 [ - + ]: 2 : cplex = 1; if (kpts_timrev_from_kptopt(ebands%kptopt) == 0) cplex = 2
4644 : : skw = skw_new(cryst, params(2:), cplex, ebands%mband, ebands%nkpt, ebands%nsppol, ebands%kptns, ebands%eig, &
4645 : 2 : my_bblock, comm)
4646 : :
4647 : : case default
4648 [ + - ]: 2 : ABI_ERROR(sjoin("Wrong einterp params(1):", itoa(itype)))
4649 : : end select
4650 : :
4651 : : ! Interpolate eigenvalues.
4652 [ + + + + : 9604 : new%eig = zero; cnt = 0
+ + ]
4653 [ + + ]: 4 : do spin=1,new%nsppol
4654 [ + + ]: 804 : do ik_ibz=1,new%nkpt
4655 [ + + ]: 9602 : do ib=1,nb
4656 [ - + ]: 8800 : cnt = cnt + 1; if (mod(cnt, nprocs) /= my_rank) cycle ! Mpi parallelism.
4657 : : ! Note the difference between band and ib index if band_range.
4658 : 8800 : band = my_bblock(1) + ib - 1
4659 : 800 : select case (itype)
4660 : : case (1)
4661 : 8800 : call skw%eval_bks(band, new%kptns(:,ik_ibz), spin, new%eig(ib,ik_ibz,spin))
4662 : : case default
4663 [ + - ]: 8800 : ABI_ERROR(sjoin("Wrong einterp params(1):", itoa(itype)))
4664 : : end select
4665 : : end do
4666 : : end do
4667 : : end do
4668 : 2 : call xmpi_sum(new%eig, comm, ierr)
4669 : :
4670 : : ! Sort eigvalues_k in ascending order to be compatible with other ebands routines.
4671 : 2 : call new%sort()
4672 : 2 : call skw%free()
4673 : :
4674 [ - + - + : 6 : end function ebands_interp_kpath
- + - + -
+ - + - +
- + ]
4675 : : !!***
4676 : :
4677 : : !----------------------------------------------------------------------
4678 : :
4679 : : !!****f* m_ebands/ebands_get_edos_matrix_elements
4680 : : !! NAME
4681 : : !! ebands_get_edos_matrix_elements
4682 : : !!
4683 : : !! FUNCTION
4684 : : !! Compute electron DOS and weighted e-DOS with weights given by precomputed scalar, vectorial
4685 : : !! or tensorial matrix elements.
4686 : : !! Weights are provided in input as (..., num_entries, bsize, nkpt, nsppol) tables, see below.
4687 : : !!
4688 : : !! INPUTS
4689 : : !! ebands<ebands_t>=Band structure object.
4690 : : !! cryst<cryst_t>=Info on the crystalline structure.
4691 : : !! bsize=Number of bands in bks_vals, bks_vecs and bks_tens
4692 : : !! Not necessarily equal to ebands%mband when brange is used.
4693 : : !! nvals=Number of scalar entries. Maybe zero
4694 : : !! bks_vals=Scalar matrix elements
4695 : : !! nvecs=Number of 3d-vectorial entries. Maybe zero
4696 : : !! bks_vecs=Vectorial matrix elements in Cartesian Coordinates
4697 : : !! ntens=Number of 3x3 tensorial entries in Cartesian coordinates. Maybe zero
4698 : : !! bks_tens= Tensorial matrix elements (3x3) in Cartesian Coordinates
4699 : : !! intmeth=
4700 : : !! 1 for Gaussian,
4701 : : !! 2 or -2 for tetrahedra (-2 if Blochl corrections must be included).
4702 : : !! If nkpt == 1 (Gamma only), the routine fallbacks to the Gaussian method.
4703 : : !! step=Step on the linear mesh in Ha. If < 0, the routine will use the mean of the energy level spacing
4704 : : !! broad=Gaussian broadening, If < 0, the routine will use a default
4705 : : !! value for the broadening computed from the mean of the energy level spacing.
4706 : : !! No meaning for tetrahedra
4707 : : !! comm=MPI communicator
4708 : : !! [brange(2)]=Minimum and maximum band index. Default if not present is `full band range`.
4709 : : !! If given bsize must be equal: to brange(2) - brange(1) + 1
4710 : : !! [erange(2)]=Minimum and maximum energy to be considered. Default if not present is `full energy range`.
4711 : : !!
4712 : : !! OUTPUT
4713 : : !! out_valsdos: (nw, 2, nvals, nsppol) array with DOS for scalar quantities if nvals > 0
4714 : : !! out_vecsdos: (nw, 2, 3, nvecs, nsppol)) array with DOS weighted by vectorial terms if nvecs > 0
4715 : : !! out_tensdos: (nw, 2,3, 3, ntens, nsppol) array with DOS weighted by tensorial terms if ntens > 0
4716 : : !!
4717 : : !! All these arrays are allocated by the routine. The number of points is available in edos%nw.
4718 : : !! (nw, 1, ...) stores the weighted DOS (w-DOS)
4719 : : !! (nw, 2, ...) stores the integrated w-DOS
4720 : : !!
4721 : : !! SOURCE
4722 : :
4723 : 13 : type(edos_t) function ebands_get_edos_matrix_elements(ebands, cryst, bsize, &
4724 : 13 : nvals, bks_vals, nvecs, bks_vecs, ntens, bks_tens, &
4725 : : intmeth, step, broad, out_valsdos, out_vecsdos, out_tensdos, comm, &
4726 : : brange, erange) result(edos)
4727 : :
4728 : : !Arguments ------------------------------------
4729 : : !scalars
4730 : : class(ebands_t),intent(in) :: ebands
4731 : : integer,intent(in) :: bsize, nvals, nvecs, ntens, intmeth, comm
4732 : : real(dp),intent(in) :: step, broad
4733 : : type(crystal_t),intent(in) :: cryst
4734 : : !arrays
4735 : : integer,optional,intent(in) :: brange(2)
4736 : : real(dp),optional,intent(in) :: erange(2)
4737 : : real(dp),intent(in) :: bks_vals(nvals, bsize, ebands%nkpt, ebands%nsppol)
4738 : : real(dp),intent(in) :: bks_vecs(3, nvecs, bsize, ebands%nkpt, ebands%nsppol)
4739 : : real(dp),intent(in) :: bks_tens(3, 3, ntens, bsize, ebands%nkpt, ebands%nsppol)
4740 : : real(dp),allocatable,intent(out) :: out_valsdos(:,:,:,:), out_vecsdos(:,:,:,:,:), out_tensdos(:,:,:,:,:,:)
4741 : :
4742 : : !Local variables-------------------------------
4743 : : !scalars
4744 : : integer :: nproc, my_rank, nw, spin, band, ib, ik_ibz, cnt, idat, ierr, bcorr, time_opt
4745 : : integer :: ii, jj, ief, ihf, bmin_, bmax_
4746 : : real(dp),parameter :: max_occ1 = one
4747 : : real(dp) :: emax, emin, wtk, max_occ
4748 : : real(dp) :: cpu, wall, gflops
4749 : : logical :: check_erange
4750 : : character(len=500) :: msg
4751 : 13 : type(htetra_t) :: tetra
4752 : : !arrays
4753 : 26 : real(dp) :: eminmax_spin(2,ebands%nsppol), vsum(3), tsum(3,3)
4754 : 13 : real(dp),allocatable :: wme0(:),tmp_eigen(:), weights(:,:)
4755 : : ! *********************************************************************
4756 : :
4757 : 13 : call cwtime(cpu, wall, gflops, "start")
4758 : :
4759 : 13 : nproc = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
4760 : :
4761 : 13 : edos%nkibz = ebands%nkpt; edos%nsppol = ebands%nsppol; edos%nspinor = ebands%nspinor
4762 : 13 : edos%intmeth = intmeth
4763 : 13 : edos%nelect = ebands%nelect
4764 [ - + ]: 13 : if (ebands%nkpt == 1) then
4765 : 0 : ABI_COMMENT("Cannot use tetrahedra for e-DOS when nkpt == 1. Switching to gaussian method")
4766 : 0 : edos%intmeth = 1
4767 : : end if
4768 : :
4769 : 13 : edos%broad = broad; edos%step = step
4770 : :
4771 : : ! Define band range.
4772 : 13 : bmin_ = 1; bmax_ = ebands%mband
4773 [ + - ]: 13 : if (present(brange)) then
4774 : 13 : bmin_ = brange(1); bmax_ = brange(2)
4775 : : end if
4776 : :
4777 [ + - - + ]: 13 : ABI_CHECK_IRANGE(bmin_, 1, ebands%mband, "Wrong bmin:")
4778 [ + - - + ]: 13 : ABI_CHECK_IRANGE(bmax_, bmin_, ebands%mband, "Wrong bmax:")
4779 [ + - - + ]: 13 : ABI_CHECK_IRANGE(bsize, 1, ebands%mband, "Wrong bsize:")
4780 : :
4781 [ + - ]: 13 : if (present(erange)) then
4782 : : ! use optional args if provided.
4783 : 13 : emin = erange(1)
4784 : 13 : emax = erange(2)
4785 : 13 : check_erange = .True.
4786 : : else
4787 : : ! Compute the linear mesh so that it encloses all bands.
4788 : 0 : eminmax_spin = ebands_get_minmax(ebands, "eig")
4789 [ # # # # : 0 : emin = minval(eminmax_spin(1, :)); emin = emin - 0.1_dp * abs(emin)
# # # # ]
4790 [ # # # # : 0 : emax = maxval(eminmax_spin(2, :)); emax = emax + 0.1_dp * abs(emax)
# # # # ]
4791 : 0 : check_erange = .False.
4792 : : end if
4793 : :
4794 : 13 : nw = nint((emax - emin) / edos%step) + 1
4795 : 13 : edos%nw = nw
4796 : :
4797 [ - + + - : 39 : ABI_MALLOC(edos%mesh, (nw))
+ - + - -
+ - + ]
4798 [ + - - + : 5576 : edos%mesh = arth(emin, edos%step, nw)
+ + ]
4799 : :
4800 [ - + + - : 65 : ABI_CALLOC(edos%gef, (0:edos%nsppol))
+ - + - -
+ - + +
+ ]
4801 [ - + + - : 52 : ABI_CALLOC(edos%ghf, (0:edos%nsppol))
- + - + +
+ ]
4802 [ - + + - : 11178 : ABI_CALLOC(edos%dos, (nw, 0:edos%nsppol))
- + + - +
- + - - +
- + + + +
+ ]
4803 [ - + + - : 11165 : ABI_CALLOC(edos%idos, (nw, 0:edos%nsppol))
- + + - -
+ - + + +
+ + ]
4804 : :
4805 : : ! Allocate output arrays depending on input.
4806 [ + - ]: 13 : if (nvals > 0) then
4807 [ - + + - : 51890 : ABI_CALLOC(out_valsdos, (nw, 2, nvals, ebands%nsppol))
- + + - -
+ + - + -
+ - - + -
+ - + + +
+ + + + +
+ ]
4808 : : endif
4809 [ - + ]: 13 : if (nvecs > 0) then
4810 [ # # # # : 0 : ABI_CALLOC(out_vecsdos, (nw, 2, 3, nvecs, ebands%nsppol))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
4811 : : end if
4812 [ + - ]: 13 : if (ntens > 0) then
4813 [ - + + - : 667514 : ABI_CALLOC(out_tensdos, (nw, 2, 3, 3, ntens, ebands%nsppol))
+ - + - -
+ + - - +
+ - + - +
- - + - +
- + + + +
+ + + + +
+ + + + ]
4814 : : end if
4815 : :
4816 : 13 : time_opt = 0 ! This to preserve the previous behaviour in which TR was not used.
4817 : :
4818 : : !call wrtout(std_out, " Computing DOS weighted by matrix elements.")
4819 : 0 : select case (intmeth)
4820 : : case (1)
4821 : : ! Gaussian
4822 [ # # # # : 0 : ABI_MALLOC(wme0, (nw))
# # # # ]
4823 : 0 : cnt = 0
4824 [ # # ]: 0 : do spin=1,ebands%nsppol
4825 [ # # ]: 0 : do ik_ibz=1,ebands%nkpt
4826 [ # # ]: 0 : cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle ! MPI parallelism
4827 : 0 : wtk = ebands%wtk(ik_ibz)
4828 [ # # ]: 0 : do band=bmin_,bmax_
4829 : 0 : ib = band - bmin_ + 1
4830 : :
4831 [ # # ]: 0 : if (check_erange) then
4832 [ # # ]: 0 : if (ebands%eig(band, ik_ibz, spin) < emin - five * broad) cycle
4833 [ # # ]: 0 : if (ebands%eig(band, ik_ibz, spin) > emax + five * broad) cycle
4834 : : end if
4835 : :
4836 [ # # # # : 0 : wme0 = edos%mesh - ebands%eig(band, ik_ibz, spin)
# # # # ]
4837 [ # # ]: 0 : wme0 = gaussian(wme0, broad) * wtk
4838 [ # # ]: 0 : edos%dos(:,spin) = edos%dos(:,spin) + wme0(:)
4839 : :
4840 : : ! scalars
4841 [ # # ]: 0 : do idat=1,nvals
4842 [ # # ]: 0 : out_valsdos(:, 1, idat, spin) = out_valsdos(:,1, idat, spin) + wme0(:) * bks_vals(idat, ib, ik_ibz, spin)
4843 : : ! FIXME: This is quite inefficient! Integration should be performed outside!
4844 : 0 : call simpson_int(nw, step, out_valsdos(:,1, idat, spin), out_valsdos(:,2,idat,spin))
4845 : : end do
4846 : :
4847 : : ! vectors
4848 [ # # ]: 0 : do idat=1,nvecs
4849 : : ! get components, symmetrize and accumulate.
4850 : 0 : vsum = cryst%symmetrize_cart_vec3(bks_vecs(:, idat, ib, ik_ibz, spin), time_opt)
4851 [ # # ]: 0 : do ii=1,3
4852 [ # # ]: 0 : out_vecsdos(:, 1, ii, idat, spin) = out_vecsdos(:, 1, ii, idat, spin) + wme0(:) * vsum(ii)
4853 : 0 : call simpson_int(nw, step, out_vecsdos(:,1,ii,idat,spin), out_vecsdos(:,2,ii,idat,spin))
4854 : : end do
4855 : : end do
4856 : :
4857 : : ! tensor
4858 [ # # ]: 0 : do idat=1,ntens
4859 : : ! get components, symmetrize and accumulate.
4860 : 0 : tsum = cryst%symmetrize_cart_tens33(bks_tens(:, :, idat, ib, ik_ibz, spin), time_opt)
4861 [ # # ]: 0 : do ii=1,3
4862 [ # # ]: 0 : do jj=1,3
4863 [ # # ]: 0 : out_tensdos(:,1,jj,ii,idat,spin) = out_tensdos(:,1,jj,ii,idat,spin) + wme0(:) * tsum(jj,ii)
4864 : 0 : call simpson_int(nw, step, out_tensdos(:,1,jj,ii,idat,spin), out_tensdos(:,2,jj,ii,idat,spin))
4865 : : end do
4866 : : end do
4867 : : end do
4868 : :
4869 : : end do !band
4870 : : end do !ik_ibz
4871 : : end do !spin
4872 : :
4873 [ # # ]: 0 : ABI_FREE(wme0)
4874 : 0 : call xmpi_sum(edos%dos, comm, ierr)
4875 [ # # ]: 0 : if (nvals > 0) call xmpi_sum(out_valsdos, comm, ierr)
4876 [ # # ]: 0 : if (nvecs > 0) call xmpi_sum(out_vecsdos, comm, ierr)
4877 [ # # ]: 0 : if (ntens > 0) call xmpi_sum(out_tensdos, comm, ierr)
4878 : :
4879 : : case (2, -2)
4880 : : ! Consistency test
4881 [ + + + - : 3569 : ABI_CHECK(all(ebands%nband == ebands%nband(1)), 'For tetrahedra, nband(:) must be constant')
- + ]
4882 : :
4883 : : ! Build tetra object.
4884 : : tetra = tetra_from_kptrlatt(cryst, ebands%kptopt, ebands%kptrlatt, &
4885 : 13 : ebands%nshiftk, ebands%shiftk, ebands%nkpt, ebands%kptns, comm, msg, ierr)
4886 [ - + ]: 13 : ABI_CHECK(ierr == 0, msg)
4887 : :
4888 : : ! For each spin and band, interpolate over kpoints,
4889 : : ! calculate integration weights and DOS contribution.
4890 [ - + + - : 39 : ABI_MALLOC(tmp_eigen, (ebands%nkpt))
+ - + - -
+ - + ]
4891 [ - + + - : 39 : ABI_MALLOC(weights, (nw, 2))
+ - + - -
+ - + ]
4892 : :
4893 : : ! Blochl's corrections?
4894 [ - + ]: 13 : bcorr = 0; if (intmeth == -2) bcorr = 1
4895 : :
4896 : 13 : cnt = 0
4897 [ + + ]: 26 : do spin=1,ebands%nsppol
4898 [ + + ]: 48 : do band=bmin_,bmax_
4899 : : ! For each band get its contribution
4900 [ + - - + : 3705 : tmp_eigen = ebands%eig(band,:,spin)
- - + + ]
4901 : 22 : ib = band - bmin_ + 1
4902 : :
4903 [ + - ]: 22 : if (check_erange) then
4904 [ + - - + : 22 : if (all(tmp_eigen < emin)) cycle
+ - ]
4905 [ + - + + : 1273 : if (all(tmp_eigen > emax)) cycle
- + ]
4906 : : end if
4907 : :
4908 [ + + ]: 3696 : do ik_ibz=1,ebands%nkpt
4909 [ + - ]: 3661 : cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle ! MPI parallelism
4910 : :
4911 : 3661 : call tetra%get_onewk(ik_ibz, bcorr, nw, ebands%nkpt, tmp_eigen, emin, emax, max_occ1, weights)
4912 [ + + + + ]: 1617091 : weights = weights * ebands%wtk(ik_ibz)
4913 : :
4914 : : ! Compute DOS and IDOS
4915 [ + + ]: 806715 : edos%dos(:,spin) = edos%dos(:,spin) + weights(:, 1)
4916 [ + + ]: 806715 : edos%idos(:,spin) = edos%idos(:,spin) + weights(:, 2)
4917 : :
4918 : : ! scalar
4919 : : !$OMP PARALLEL DO
4920 [ + + ]: 45313 : do idat=1,nvals
4921 [ + + + + ]: 9193225 : out_valsdos(:, :, idat, spin) = out_valsdos(:, :, idat, spin) + weights(:, :) * bks_vals(idat, ib, ik_ibz, spin)
4922 : : end do
4923 : :
4924 : : ! vector
4925 : : !$OMP PARALLEL DO PRIVATE(vsum)
4926 [ - + ]: 3661 : do idat=1,nvecs
4927 : : ! get components, symmetrize and accumulate.
4928 : 0 : vsum = cryst%symmetrize_cart_vec3(bks_vecs(:, idat, ib, ik_ibz, spin), time_opt)
4929 [ - - ]: 3661 : do ii=1,3
4930 [ # # # # ]: 0 : out_vecsdos(:, :, ii, idat, spin) = out_vecsdos(:, :, ii, idat, spin) + weights(:, :) * vsum(ii)
4931 : : end do
4932 : : end do
4933 : :
4934 : : ! tensor
4935 : : !$OMP PARALLEL DO PRIVATE(tsum)
4936 [ + + ]: 52657 : do idat=1,ntens
4937 : : ! get components, symmetrize and accumulate.
4938 : 48974 : tsum = cryst%symmetrize_cart_tens33(bks_tens(:, :, idat, ib, ik_ibz, spin), time_opt)
4939 [ + + ]: 199557 : do ii=1,3
4940 [ + + ]: 636662 : do jj=1,3
4941 [ + + + + ]: 111960636 : out_tensdos(:, :, jj, ii, idat, spin) = out_tensdos(:, :, jj, ii, idat, spin) + weights(:, :) * tsum(jj,ii)
4942 : : end do
4943 : : end do
4944 : : end do
4945 : :
4946 : : end do ! ik_ibz
4947 : : end do ! band
4948 : : end do ! spin
4949 : :
4950 : : ! Free memory
4951 [ - + ]: 13 : ABI_FREE(weights)
4952 [ - + ]: 13 : ABI_FREE(tmp_eigen)
4953 : 13 : call tetra%free()
4954 : :
4955 : 13 : call xmpi_sum(edos%dos, comm, ierr)
4956 : 13 : call xmpi_sum(edos%idos, comm, ierr)
4957 [ + - ]: 13 : if (nvals > 0) call xmpi_sum(out_valsdos, comm, ierr)
4958 [ - + ]: 13 : if (nvecs > 0) call xmpi_sum(out_vecsdos, comm, ierr)
4959 [ + - ]: 26 : if (ntens > 0) call xmpi_sum(out_tensdos, comm, ierr)
4960 : :
4961 : : case default
4962 [ - + - ]: 13 : ABI_ERROR(sjoin("Wrong integration method:", itoa(intmeth)))
4963 : : end select
4964 : :
4965 : : ! Compute total DOS and IDOS
4966 : 13 : max_occ = two / (ebands%nspinor * ebands%nsppol)
4967 [ + + + + ]: 11113 : edos%dos(:, 0) = max_occ * sum(edos%dos(:,1:), dim=2)
4968 : :
4969 [ - + ]: 13 : if (intmeth == 1) then
4970 [ # # ]: 0 : do spin=1,edos%nsppol
4971 : 0 : call simpson_int(nw, edos%step, edos%dos(:,spin), edos%idos(:,spin))
4972 : : end do
4973 : : end if
4974 [ + + + + ]: 11113 : edos%idos(:, 0) = max_occ * sum(edos%idos(:,1:), dim=2)
4975 : :
4976 : : ! Use bisection to find the Fermi level.
4977 : : ! Warning: this code assumes idos[i+1] >= idos[i]. This condition may not be
4978 : : ! fulfilled if we use tetra and this is the reason why we have filtered the DOS.
4979 [ - + ]: 13 : if (ebands%occopt == 9) then
4980 : 0 : ihf = bisect(edos%idos(:,0), ebands%nelect-ebands%nh_qFD)
4981 : 0 : ief = bisect(edos%idos(:,0), ebands%nelect+ebands%ne_qFD)
4982 : : else
4983 : 13 : ief = bisect(edos%idos(:,0), ebands%nelect)
4984 : 13 : ihf = ief
4985 : : end if
4986 : :
4987 : : ! Handle out of range condition.
4988 [ + - + + ]: 13 : if (ief == 0 .or. ief == nw) then
4989 : : write(msg,"(a, f14.2, 4a)") &
4990 : 12 : "Bisection could not find an initial guess for the Fermi level with nelect: ",ebands%nelect, ch10, &
4991 : 12 : "Possible reasons: not enough bands for DOS or wrong number of electrons.", ch10, &
4992 : 24 : "Returning from ebands_get_edos_matrix_elements without setting edos%ief !"
4993 : 12 : ABI_WARNING(msg)
4994 : 12 : return
4995 : : end if
4996 : :
4997 [ + - - + ]: 1 : if (ihf == 0 .or. ihf == nw) then
4998 : : write(msg,"(3a)")&
4999 : 0 : "Bisection could not find an initial guess for the holes Fermi level!",ch10,&
5000 : 0 : "Possible reasons: not enough bands or wrong number of holes"
5001 : 0 : ABI_WARNING(msg)
5002 : 0 : return
5003 : : end if
5004 : :
5005 : : ! TODO: Use linear interpolation to find an improved estimate of the Fermi level?
5006 : 1 : edos%ief = ief
5007 : 1 : edos%ihf = ihf
5008 [ + + ]: 3 : do spin=0,edos%nsppol
5009 : 2 : edos%gef(spin) = edos%dos(ief,spin)
5010 : 3 : edos%ghf(spin) = edos%dos(ihf,spin)
5011 : : end do
5012 : :
5013 : 1 : call cwtime_report(" ebands_get_edos_matrix_elements", cpu, wall, gflops)
5014 : :
5015 [ - + - + : 26 : end function ebands_get_edos_matrix_elements
- + - + -
- - - - +
- - - - ]
5016 : : !!***
5017 : :
5018 : : !----------------------------------------------------------------------
5019 : :
5020 : : !!****f* m_ebands/ebands_get_jdos
5021 : : !! NAME
5022 : : !! ebands_get_jdos
5023 : : !!
5024 : : !! FUNCTION
5025 : : !! Compute the joint density of states.
5026 : : !!
5027 : : !! INPUTS
5028 : : !! ebands<ebands_t>=Band structure object.
5029 : : !! cryst<cryst_t>=Info on the crystalline structure.
5030 : : !! intmeth= 1 for gaussian, 2 or -2 for tetrahedra (-2 if Blochl corrections must be included).
5031 : : !! step=Step on the linear mesh in Ha. If <0, the routine will use the mean of the energy level spacing
5032 : : !! broad=Gaussian broadening, If <0, the routine will use a default
5033 : : !! value for the broadening computed from the mean of the energy level spacing.
5034 : : !! No meaning if tetra method
5035 : : !! comm=MPI communicator
5036 : : !!
5037 : : !! OUTPUT
5038 : : !!
5039 : : !! SOURCE
5040 : :
5041 : 0 : type(jdos_t) function ebands_get_jdos(ebands, cryst, intmeth, step, broad, comm, ierr) result (jdos)
5042 : :
5043 : : !Arguments ------------------------------------
5044 : : !scalars
5045 : : class(ebands_t),intent(in) :: ebands
5046 : : integer,intent(in) :: intmeth,comm
5047 : : integer,intent(out) :: ierr
5048 : : real(dp),intent(in) :: step,broad
5049 : : type(crystal_t),intent(in) :: cryst
5050 : :
5051 : : !Local variables-------------------------------
5052 : : !scalars
5053 : : integer :: ik_ibz,ibc,ibv,spin,nw,nband_k,nbv,nproc,my_rank,cnt,mpierr,bcorr !iw, unt,
5054 : : real(dp) :: wtk,wmax
5055 : 0 : type(htetra_t) :: tetra
5056 : : character(len=500) :: msg
5057 : : !character(len=fnlen) :: path
5058 : : !arrays
5059 : 0 : integer :: val_idx(ebands%nkpt,ebands%nsppol)
5060 : 0 : real(dp) :: eminmax(2,ebands%nsppol)
5061 : 0 : real(dp),allocatable :: cvmw(:),wdt(:,:)
5062 : : ! *********************************************************************
5063 : :
5064 : 0 : ierr = 0
5065 : 0 : nproc = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
5066 : :
5067 : 0 : jdos%nsppol = ebands%nsppol
5068 : 0 : jdos%nkibz = ebands%nkpt
5069 : :
5070 : : ! Find the valence band index for each k and spin.
5071 : 0 : val_idx = ebands_get_valence_idx(ebands)
5072 : :
5073 [ # # ]: 0 : do spin=1,ebands%nsppol
5074 [ # # # # : 0 : if (any(val_idx(:,spin) /= val_idx(1,spin))) then
# # ]
5075 : : write(msg,'(a,i0,a)')&
5076 : 0 : 'Trying to compute JDOS with a metallic band structure for spin: ',spin,&
5077 : 0 : 'Assuming you know what you are doing, continuing anyway! '
5078 : 0 : ABI_COMMENT(msg)
5079 : : end if
5080 : : end do
5081 : :
5082 : : ! Compute the linear mesh so that it encloses all bands.
5083 : : !if (.not. present(mesh)) then
5084 : 0 : eminmax = ebands_get_minmax(ebands, "eig")
5085 [ # # # # : 0 : wmax = maxval(eminmax(2,:) - eminmax(1,:))
# # # # ]
5086 : 0 : nw = nint(wmax/step) + 1
5087 [ # # # # : 0 : ABI_MALLOC(jdos%mesh, (nw))
# # # # #
# # # ]
5088 [ # # # # : 0 : jdos%mesh = arth(zero, step, nw)
# # ]
5089 : :
5090 : 0 : jdos%nw = nw
5091 : 0 : jdos%intmeth = intmeth
5092 : 0 : jdos%broad = broad
5093 : :
5094 : : !if (ebands%nkpt == 1) then
5095 : : ! ABI_COMMENT("Cannot use tetrahedra for e-DOS when nkpt == 1. Switching to gaussian method")
5096 : : ! jdos%intmeth = 1
5097 : : !end if
5098 : :
5099 [ # # # # : 0 : ABI_CALLOC(jdos%values, (nw, ebands%nsppol))
# # # # #
# # # # #
# # # # #
# ]
5100 : :
5101 : 0 : select case (intmeth)
5102 : : case (1)
5103 : : ! Gaussian
5104 [ # # # # : 0 : ABI_MALLOC(cvmw, (nw))
# # # # ]
5105 : :
5106 : 0 : cnt = 0
5107 [ # # ]: 0 : do spin=1,ebands%nsppol
5108 [ # # ]: 0 : do ik_ibz=1,ebands%nkpt
5109 : 0 : wtk = ebands%wtk(ik_ibz)
5110 : 0 : nband_k = ebands%nband(ik_ibz + (spin-1)*ebands%nkpt)
5111 : 0 : nbv = val_idx(ik_ibz, spin)
5112 : :
5113 [ # # ]: 0 : do ibv=1,nbv
5114 [ # # ]: 0 : cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle
5115 [ # # ]: 0 : do ibc=nbv+1,nband_k
5116 [ # # # # : 0 : cvmw = ebands%eig(ibc,ik_ibz,spin) - ebands%eig(ibv,ik_ibz,spin) - jdos%mesh
# # # # ]
5117 [ # # ]: 0 : jdos%values(:, spin) = jdos%values(:, spin) + wtk * gaussian(cvmw, broad)
5118 : : end do
5119 : : end do
5120 : :
5121 : : end do ! ik_ibz
5122 : : end do ! spin
5123 : :
5124 [ # # ]: 0 : ABI_FREE(cvmw)
5125 : 0 : call xmpi_sum(jdos%values, comm, mpierr)
5126 : :
5127 : : case (2, -2)
5128 : : ! Tetrahedron method
5129 [ # # # # : 0 : if (any(ebands%nband /= ebands%nband(1)) ) then
# # ]
5130 : 0 : ABI_WARNING('For tetrahedra, nband(:) must be constant')
5131 : 0 : ierr = ierr + 1
5132 : : end if
5133 [ # # ]: 0 : if (ierr/=0) return
5134 : :
5135 : : tetra = tetra_from_kptrlatt(cryst, ebands%kptopt, ebands%kptrlatt, &
5136 : 0 : ebands%nshiftk, ebands%shiftk, ebands%nkpt, ebands%kptns, comm, msg, ierr)
5137 [ # # ]: 0 : if (ierr /= 0) then
5138 : 0 : call tetra%free(); return
5139 : : end if
5140 : :
5141 : : ! For each spin and band, interpolate over kpoints,
5142 : : ! calculate integration weights and DOS contribution.
5143 [ # # # # : 0 : ABI_MALLOC(cvmw, (jdos%nkibz))
# # # # #
# # # ]
5144 [ # # # # : 0 : ABI_MALLOC(wdt, (nw, 2))
# # # # #
# # # ]
5145 : :
5146 [ # # ]: 0 : bcorr = 0; if (intmeth == -2) bcorr = 1
5147 : 0 : cnt = 0
5148 [ # # ]: 0 : do spin=1,ebands%nsppol
5149 : 0 : nbv = val_idx(1, spin)
5150 [ # # ]: 0 : do ibv=1,nbv
5151 [ # # ]: 0 : do ibc=nbv+1,ebands%mband
5152 : : ! For each (c, v) get its contribution
5153 [ # # # # : 0 : cvmw = ebands%eig(ibc,:,spin) - ebands%eig(ibv,:,spin)
# # # # ]
5154 [ # # ]: 0 : do ik_ibz=1,ebands%nkpt
5155 [ # # ]: 0 : cnt = cnt + 1; if (mod(cnt, nproc) /= my_rank) cycle ! mpi-parallelism
5156 : :
5157 : : ! Calculate integration weights at each irred k-point (Blochl et al PRB 49 16223 [[cite:Bloechl1994a]])
5158 : 0 : call tetra%get_onewk(ik_ibz, bcorr, nw, ebands%nkpt, cvmw, jdos%mesh(0), jdos%mesh(nw), one, wdt)
5159 [ # # ]: 0 : jdos%values(:,spin) = jdos%values(:,spin) + wdt(:, 1) * ebands%wtk(ik_ibz)
5160 : : end do
5161 : : end do ! ibc
5162 : : end do ! ibv
5163 : : end do ! spin
5164 : :
5165 : 0 : call xmpi_sum(jdos%values, comm, mpierr)
5166 : :
5167 : : ! Free memory
5168 [ # # ]: 0 : ABI_FREE(wdt)
5169 [ # # ]: 0 : ABI_FREE(cvmw)
5170 : 0 : call tetra%free()
5171 : :
5172 : : case default
5173 [ # # # ]: 0 : ABI_ERROR(sjoin("Wrong integration method:", itoa(intmeth)))
5174 : : end select
5175 : :
5176 [ # # ]: 0 : if (ebands%nsppol == 1) then
5177 [ # # ]: 0 : jdos%values(0,:) = two * jdos%values(1,:)
5178 : : else
5179 [ # # # # ]: 0 : jdos%values(0,:) = sum(jdos%values(1:2, :), dim=2)
5180 : : end if
5181 : :
5182 : : ! Write data.
5183 : : !if (my_rank == 0) then
5184 : : ! path = "jdos_gauss.data"; if (intmeth == 2) path = "jdos_tetra.data"
5185 : : ! if (open_file(path, msg, newunit=unt, form="formatted", action="write") /= 0) then
5186 : : ! ABI_ERROR(msg)
5187 : : ! end if
5188 : : ! do iw=1,nw
5189 : : ! write(unt,*)jdos%mesh(iw),(jdos(iw,spin), spin=1,ebands%nsppol)
5190 : : ! end do
5191 : : ! close(unt)
5192 : : !end if
5193 : :
5194 [ # # # # : 0 : end function ebands_get_jdos
# # # # #
# # # # #
# # # # ]
5195 : : !!***
5196 : :
5197 : : !----------------------------------------------------------------------
5198 : :
5199 : : !!****f* m_ebands/jdos_ncwrite
5200 : : !! NAME
5201 : : !! jdos_ncwrite
5202 : : !!
5203 : : !! FUNCTION
5204 : : !! Write JDOS to netcdf file.
5205 : : !!
5206 : : !! INPUTS
5207 : : !! ncid=NC file handle.
5208 : : !! [prefix]=String prepended to netcdf dimensions/variables (HDF5 poor-man groups)
5209 : : !! Empty string if not specified.
5210 : : !!
5211 : : !! SOURCE
5212 : :
5213 : 0 : integer function jdos_ncwrite(jdos, ncid, prefix) result(ncerr)
5214 : :
5215 : : !Arguments ------------------------------------
5216 : : !scalars
5217 : : class(jdos_t),intent(inout) :: jdos
5218 : : integer,intent(in) :: ncid
5219 : : character(len=*),optional,intent(in) :: prefix
5220 : :
5221 : : !Local variables-------------------------------
5222 : : character(len=500) :: prefix_
5223 : : ! *********************************************************************
5224 : :
5225 [ # # ]: 0 : prefix_ = ""; if (present(prefix)) prefix_ = trim(prefix)
5226 : :
5227 : : ! Define dimensions.
5228 : : ncerr = nctk_def_dims(ncid, [ &
5229 [ # # ]: 0 : nctkdim_t("nsppol_plus1", jdos%nsppol + 1), nctkdim_t("jdos_nw", jdos%nw)], defmode=.True., prefix=prefix_)
5230 [ # # ]: 0 : NCF_CHECK(ncerr)
5231 : :
5232 : : ! Define variables
5233 [ # # # # : 0 : NCF_CHECK(nctk_def_iscalars(ncid, [character(len=nctk_slen) :: "jdos_intmeth", "jdos_nkibz"], prefix=prefix_))
# # ]
5234 [ # # # # : 0 : NCF_CHECK(nctk_def_dpscalars(ncid, [character(len=nctk_slen) :: "jdos_broad"], prefix=prefix_))
# # ]
5235 : :
5236 : : ncerr = nctk_def_arrays(ncid, [ &
5237 : : nctkarr_t("jdos_mesh", "dp", "jdos_nw"), &
5238 : : nctkarr_t("jdos_values", "dp", "jdos_nw, nsppol_plus1") &
5239 [ # # ]: 0 : ], prefix=prefix_)
5240 [ # # ]: 0 : NCF_CHECK(ncerr)
5241 : :
5242 : : ! Write data.
5243 [ # # ]: 0 : NCF_CHECK(nctk_set_datamode(ncid))
5244 [ # # ]: 0 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("jdos_intmeth")), jdos%intmeth))
5245 [ # # ]: 0 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("jdos_nkibz")), jdos%nkibz))
5246 [ # # ]: 0 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("jdos_broad")), jdos%broad))
5247 [ # # ]: 0 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("jdos_mesh")), jdos%mesh))
5248 [ # # # # ]: 0 : NCF_CHECK(nf90_put_var(ncid, nctk_idname(ncid, pre("edos_values")), jdos%values))
5249 : :
5250 : : contains
5251 : 0 : pure function pre(istr) result(ostr)
5252 : : character(len=*),intent(in) :: istr
5253 : : character(len=len_trim(prefix_) + len_trim(istr)+1) :: ostr
5254 [ # # # # ]: 0 : ostr = trim(prefix_) // trim(istr)
5255 : 0 : end function pre
5256 : :
5257 : : end function jdos_ncwrite
5258 : : !!***
5259 : :
5260 : : !----------------------------------------------------------------------
5261 : :
5262 : : !!****f* m_ebands/jdos_free
5263 : : !! NAME
5264 : : !! jdos_free
5265 : : !!
5266 : : !! FUNCTION
5267 : : !! Free memory
5268 : : !!
5269 : : !! SOURCE
5270 : :
5271 : 0 : subroutine jdos_free(jdos)
5272 : :
5273 : : !Arguments ------------------------------------
5274 : : class(jdos_t),intent(inout) :: jdos
5275 : : ! *********************************************************************
5276 : :
5277 [ # # ]: 0 : ABI_SFREE(jdos%mesh)
5278 [ # # ]: 0 : ABI_SFREE(jdos%values)
5279 : :
5280 : 0 : end subroutine jdos_free
5281 : : !!***
5282 : :
5283 : : !----------------------------------------------------------------------
5284 : :
5285 : : !!****f* m_ebands/ebands_prtbltztrp
5286 : : !! NAME
5287 : : !! ebands_prtbltztrp
5288 : : !!
5289 : : !! FUNCTION
5290 : : !! Output files for BoltzTraP code, which integrates Boltzmann transport quantities
5291 : : !! over the Fermi surface for different T and chemical potentials. Abinit provides
5292 : : !! all necessary input files: struct, energy, input file, and def file for the unit
5293 : : !! definitions of fortran files in BT.
5294 : : !! See http://www.icams.de/content/departments/ams/madsen/boltztrap.html
5295 : : !!
5296 : : !! INPUTS
5297 : : !! ebands<ebands_t>=Band structure object.
5298 : : !! cryst<cryst_t>=Info on the crystalline structure.
5299 : : !! fname_radix = radix of file names for output
5300 : : !!
5301 : : !! OUTPUT
5302 : : !! (only writing, printing)
5303 : : !!
5304 : : !! SOURCE
5305 : :
5306 : 0 : subroutine ebands_prtbltztrp(ebands, crystal, fname_radix, tau_k)
5307 : :
5308 : : !Arguments ------------------------------------
5309 : : !scalars
5310 : : class(ebands_t),intent(in) :: ebands
5311 : : type(crystal_t),intent(in) :: crystal
5312 : : character(len=fnlen), intent(in) :: fname_radix
5313 : : !arrays
5314 : : real(dp), intent(in), optional :: tau_k(ebands%nsppol,ebands%nkpt,ebands%mband)
5315 : :
5316 : : !Local variables-------------------------------
5317 : : !scalars
5318 : : integer :: iout, isym, iband, isppol, ikpt, nsppol, nband
5319 : : real(dp),parameter :: ha2ryd=two
5320 : : real(dp) :: ewindow
5321 : : character(len=fnlen) :: filename
5322 : : character(len=2) :: so_suffix
5323 : : character(len=500) :: msg
5324 : : !arrays
5325 : 4 : real(dp) :: nelec(ebands%nsppol)
5326 : 4 : character(len=3) :: spinsuffix(ebands%nsppol)
5327 : : ! *************************************************************************
5328 : :
5329 : : !MG FIXME The number of electrons is wrong if the file is produced in a NSCF run.
5330 : : ! See https://forum.abinit.org/viewtopic.php?f=19&t=3339
5331 : :
5332 : : ! CP test to prevent use in case occopt = 9
5333 [ - + ]: 2 : if (ebands%occopt==9) then
5334 : 0 : write(msg,'(a)') "Boltztrap outputting not possible with occopt = 9 at the moment"
5335 : 0 : ABI_ERROR(msg)
5336 : : end if
5337 : :
5338 : 2 : nelec = ebands_nelect_per_spin(ebands)
5339 : 2 : nsppol = ebands%nsppol
5340 : 2 : nband = ebands%nband(1)
5341 : :
5342 : 2 : so_suffix=""
5343 [ + - - + ]: 2 : if (nsppol > 1 .or. ebands%nspinor > 1) so_suffix="so"
5344 : :
5345 [ + - ]: 2 : if (nsppol == 1) then
5346 : 2 : spinsuffix(1) = "ns_"
5347 : : else
5348 [ # # ]: 0 : spinsuffix = ["up_", "dn_"]
5349 : : end if
5350 : :
5351 [ + + ]: 4 : do isppol=1,nsppol
5352 : :
5353 : : !input file for boltztrap: general info, Ef, Nelec, etc...
5354 [ + - + - ]: 2 : filename= trim(fname_radix)//"_"//trim(spinsuffix(isppol))//"BLZTRP.intrans"
5355 [ - + ]: 2 : if (open_file(filename, msg, newunit=iout, form='formatted') /= 0) then
5356 : 0 : ABI_ERROR(msg)
5357 : : end if
5358 : :
5359 [ + - - + : 62 : ewindow = 1.1_dp * (ebands%fermie-minval(ebands%eig(1, :, isppol)))
- - + + ]
5360 : 2 : write (iout, '(a)') "GENE # Format of input: generic format, with Symmetries"
5361 : 2 : write (iout, '(a)') "0 0 0 0.0 # iskip (not presently used) idebug setgap shiftgap"
5362 : 2 : write (iout, '(E15.5,a,2F10.4,a)') ebands%fermie*ha2ryd, " 0.0005 ", ewindow*ha2ryd, nelec(isppol), &
5363 : 4 : & " # Fermilevel (Ry), energy grid spacing, energy span around Fermilevel, number of electrons for this spin"
5364 : 2 : write (iout, '(a)') "CALC # CALC (calculate expansion coeff), NOCALC read from file"
5365 : 2 : write (iout, '(a)') "3 # lpfac, number of latt-points per k-point"
5366 : 2 : write (iout, '(a)') "BOLTZ # run mode (only BOLTZ is supported)"
5367 : 2 : write (iout, '(a)') ".15 # (efcut) energy range of chemical potential"
5368 : 2 : write (iout, '(a)') "300. 10. # Tmax, temperature grid spacing"
5369 : 2 : write (iout, '(2a)') "-1 # energyrange of bands given ",&
5370 : 4 : & "individual DOS output sig_xxx and dos_xxx (xxx is band number)"
5371 : 2 : write (iout, '(a)') "HISTO # DOS calculation method. Other possibility is TETRA"
5372 : 2 : write (iout, '(a)') "No # not using model for relaxation time"
5373 : 2 : write (iout, '(a)') "3 # Number of doping levels coefficients will be output for"
5374 : 2 : write (iout, '(a)') "-1.e16 0.0d0 1.e16 # Values of doping levels (in carriers / cm^3"
5375 : 2 : close(iout)
5376 : :
5377 : : !files file, with association of all units for Boltztrap
5378 [ + - + - ]: 2 : filename= trim(fname_radix)//"_"//trim(spinsuffix(isppol))//"BLZTRP.def"
5379 [ - + ]: 2 : if (open_file(filename, msg, newunit=iout, form='formatted') /= 0) then
5380 : 0 : ABI_ERROR(msg)
5381 : : end if
5382 : :
5383 [ + - ]: 2 : write (iout, '(3a)') "5, '", trim(fname_radix)//"_"//trim(spinsuffix(isppol))//"BLZTRP.intrans', 'old', 'formatted',0"
5384 : 2 : write (iout, '(3a)') "6, '", trim(fname_radix)//"_BLZTRP", ".outputtrans', 'unknown', 'formatted',0"
5385 : 2 : write (iout, '(3a)') "20,'", trim(fname_radix)//"_BLZTRP", ".struct', 'old', 'formatted',0"
5386 [ + - ]: 2 : write (iout, '(3a)') "10,'", trim(fname_radix)//"_BLZTRP."//trim(spinsuffix(isppol))//"energy"//trim(so_suffix),&
5387 : 4 : & "', 'old', 'formatted',0"
5388 [ - + ]: 2 : if (present (tau_k)) then
5389 : 0 : write (iout, '(3a)') "11,'", trim(fname_radix)//"_BLZTRP", ".tau_k', 'old', 'formatted',0"
5390 : : end if
5391 : 2 : write (iout, '(3a)') "48,'", trim(fname_radix)//"_BLZTRP", ".engre', 'unknown', 'unformatted',0"
5392 : 2 : write (iout, '(3a)') "49,'", trim(fname_radix)//"_BLZTRP", ".transdos', 'unknown', 'formatted',0"
5393 : 2 : write (iout, '(3a)') "50,'", trim(fname_radix)//"_BLZTRP", ".sigxx', 'unknown', 'formatted',0"
5394 : 2 : write (iout, '(3a)') "51,'", trim(fname_radix)//"_BLZTRP", ".sigxxx', 'unknown', 'formatted',0"
5395 : 2 : write (iout, '(3a)') "21,'", trim(fname_radix)//"_BLZTRP", ".trace', 'unknown', 'formatted',0"
5396 : 2 : write (iout, '(3a)') "22,'", trim(fname_radix)//"_BLZTRP", ".condtens', 'unknown', 'formatted',0"
5397 : 2 : write (iout, '(3a)') "24,'", trim(fname_radix)//"_BLZTRP", ".halltens', 'unknown', 'formatted',0"
5398 : 2 : write (iout, '(3a)') "25,'", trim(fname_radix)//"_BLZTRP", ".trace_fixdoping', 'unknown', 'formatted',0"
5399 : 2 : write (iout, '(3a)') "26,'", trim(fname_radix)//"_BLZTRP", ".condtens_fixdoping', 'unknown', 'formatted',0"
5400 : 2 : write (iout, '(3a)') "27,'", trim(fname_radix)//"_BLZTRP", ".halltens_fixdoping', 'unknown', 'formatted',0"
5401 : 2 : write (iout, '(3a)') "30,'", trim(fname_radix)//"_BLZTRP", "_BZ.dx', 'unknown', 'formatted',0"
5402 : 2 : write (iout, '(3a)') "31,'", trim(fname_radix)//"_BLZTRP", "_fermi.dx', 'unknown', 'formatted',0"
5403 : 2 : write (iout, '(3a)') "32,'", trim(fname_radix)//"_BLZTRP", "_sigxx.dx', 'unknown', 'formatted',0"
5404 : 2 : write (iout, '(3a)') "33,'", trim(fname_radix)//"_BLZTRP", "_sigyy.dx', 'unknown', 'formatted',0"
5405 : 2 : write (iout, '(3a)') "34,'", trim(fname_radix)//"_BLZTRP", "_sigzz.dx', 'unknown', 'formatted',0"
5406 : 2 : write (iout, '(3a)') "35,'", trim(fname_radix)//"_BLZTRP", "_band.dat', 'unknown', 'formatted',0"
5407 : 2 : write (iout, '(3a)') "36,'", trim(fname_radix)//"_BLZTRP", "_band.gpl', 'unknown', 'formatted',0"
5408 : 2 : write (iout, '(3a)') "37,'", trim(fname_radix)//"_BLZTRP", "_deriv.dat', 'unknown', 'formatted',0"
5409 : 2 : write (iout, '(3a)') "38,'", trim(fname_radix)//"_BLZTRP", "_mass.dat', 'unknown', 'formatted',0"
5410 : :
5411 : 4 : close(iout)
5412 : : end do !isppol
5413 : :
5414 : : !file is for geometry symmetries etc
5415 [ + - ]: 2 : filename= trim(fname_radix)//"_BLZTRP.struct"
5416 [ - + ]: 2 : if (open_file(filename, msg, newunit=iout, form='formatted') /= 0) then
5417 : 0 : ABI_ERROR(msg)
5418 : : end if
5419 : :
5420 : 2 : write (iout, '(a)') "BoltzTraP geometry file generated by ABINIT."
5421 : :
5422 : : !here we need to print out the unit cell vectors
5423 : 2 : write (iout, '(3E20.10)') crystal%rprimd(:,1)
5424 : 2 : write (iout, '(3E20.10)') crystal%rprimd(:,2)
5425 : 2 : write (iout, '(3E20.10)') crystal%rprimd(:,3)
5426 : 2 : write (iout, '(I7)') crystal%nsym
5427 : :
5428 [ + + ]: 98 : do isym=1,crystal%nsym
5429 : : write (iout,'(3(3I5,2x), a, I5)') &
5430 : 96 : & crystal%symrel(1,:,isym), &
5431 : 96 : & crystal%symrel(2,:,isym), &
5432 : 96 : & crystal%symrel(3,:,isym), &
5433 : 194 : & ' ! symmetry rotation matrix isym = ', isym
5434 : : end do
5435 : :
5436 : 2 : close (iout)
5437 : :
5438 : : ! second file is for eigenvalues
5439 : : ! two file names for each spin, if necessary
5440 [ + + ]: 4 : do isppol=1,nsppol
5441 [ + - ]: 2 : filename=trim(fname_radix)//"_BLZTRP."//spinsuffix(isppol)//"energy"//trim(so_suffix)
5442 : :
5443 [ - + ]: 2 : if (open_file (filename, msg, newunit=iout, form='formatted') /= 0) then
5444 : 0 : ABI_ERROR(msg)
5445 : : end if
5446 : :
5447 : 2 : write (iout, '(a,I5)') "BoltzTraP eigen-energies file generated by ABINIT. ispin = ", isppol
5448 : : write (iout, '(I7, I7, E20.10, a)') &
5449 : 2 : & ebands%nkpt, nsppol, ha2ryd*ebands%fermie, ' ! nk, nspin, Fermi level(Ry) : energies below in Ry'
5450 : :
5451 [ + + ]: 60 : do ikpt=1,ebands%nkpt
5452 : : ! these need to be in reduced coordinates
5453 : : write (iout, '(3E20.10, I7, a)') &
5454 : 58 : & ebands%kptns(1,ikpt), ebands%kptns(2,ikpt), ebands%kptns(3,ikpt), nband, ' ! kpt nband'
5455 [ + + ]: 582 : do iband=1,nband
5456 : : ! output in Rydberg
5457 : 580 : write (iout, '(E20.10)') ha2ryd*ebands%eig(iband, ikpt, isppol)
5458 : : end do
5459 : : end do
5460 : :
5461 : 4 : close (iout)
5462 : : end do
5463 : :
5464 : : !this file is for tau_k
5465 [ - + ]: 2 : if (present (tau_k)) then
5466 [ # # ]: 0 : do isppol = 1, nsppol
5467 [ # # ]: 0 : filename= trim(fname_radix)//"_"//spinsuffix(isppol)//"BLZTRP.tau_k"
5468 [ # # ]: 0 : if (open_file(filename, msg, newunit=iout, form='formatted') /= 0) then
5469 : 0 : ABI_ERROR(msg)
5470 : : end if
5471 : :
5472 : 0 : write (iout, '(a)') "BoltzTraP tau_k file generated by ANADDB."
5473 : : write (iout, '(I7, I7, E20.10, a)')&
5474 : 0 : & ebands%nkpt, nsppol, ha2ryd*ebands%fermie, ' ! nk, nspin, Fermi level(Ry) : energies below in Ry'
5475 : :
5476 [ # # ]: 0 : do ikpt=1,ebands%nkpt
5477 : : ! these need to be in reduced coordinates
5478 : : write (iout, '(3E20.10, I7, a)') &
5479 : 0 : & ebands%kptns(1,ikpt), ebands%kptns(2,ikpt), ebands%kptns(3,ikpt), nband, ' ! kpt nband'
5480 [ # # ]: 0 : do iband=1,nband
5481 : : ! output in eV
5482 : 0 : write (iout, '(E20.10)') tau_k(isppol,ikpt,iband)
5483 : : end do
5484 : : end do
5485 : 0 : close (iout)
5486 : : end do
5487 : :
5488 : : end if
5489 : :
5490 [ - + ]: 2 : end subroutine ebands_prtbltztrp
5491 : : !!***
5492 : :
5493 : : !!****f* m_ebands/ebands_prtbltztrp_tau_out
5494 : : !! NAME
5495 : : !! ebands_prtbltztrp_tau_out
5496 : : !!
5497 : : !! FUNCTION
5498 : : !! output files for BoltzTraP code, which integrates Boltzmann transport quantities
5499 : : !! over the Fermi surface for different T and chemical potentials. Abinit provides
5500 : : !! all necessary input files: struct, energy, input file, and def file for the unit
5501 : : !! definitions of fortran files in BT.
5502 : : !! See http://www.icams.de/content/departments/ams/madsen/boltztrap.html
5503 : : !! Output T-depedent tau_k, modified from ebands_prtbltztrp
5504 : : !!
5505 : : !! INPUTS
5506 : : !! eigen(mband*nkpt*nsppol) = array for holding eigenvalues (hartree)
5507 : : !! fermie = Fermi level
5508 : : !! fname_radix = radix of file names for output
5509 : : !! nband = number of bands
5510 : : !! nkpt = number of k points.
5511 : : !! nsppol = 1 for unpolarized, 2 for spin-polarized
5512 : : !! nsym = number of symmetries in space group
5513 : : !! rprimd(3,3) = dimensional primitive translations for real space (bohr)
5514 : : !! symrel = symmetry operations in reduced coordinates, real space
5515 : : !! to be used in future xred(3,natom) = reduced dimensionless atomic coordinates
5516 : : !!
5517 : : !! OUTPUT
5518 : : !! (only writing, printing)
5519 : : !!
5520 : : !! SOURCE
5521 : :
5522 : 0 : subroutine ebands_prtbltztrp_tau_out(eigen, tempermin, temperinc, ntemper, fermie, fname_radix, kpt, &
5523 : 0 : nband, nelec, nkpt, nspinor, nsppol, nsym, rprimd, symrel, tau_k)
5524 : :
5525 : : !Arguments ------------------------------------
5526 : : !scalars
5527 : : integer, intent(in) :: nsym, nband, nkpt, nsppol, nspinor, ntemper
5528 : : real(dp), intent(in) :: tempermin, temperinc, nelec
5529 : : character(len=fnlen), intent(in) :: fname_radix
5530 : : !arrays
5531 : : real(dp), intent(in) :: fermie(ntemper)
5532 : : integer, intent(in) :: symrel(3,3,nsym)
5533 : : real(dp), intent(in) :: kpt(3,nkpt)
5534 : : real(dp), intent(in) :: eigen(nband, nkpt, nsppol)
5535 : : real(dp), intent(in) :: rprimd(3,3)
5536 : : real(dp), intent(in) :: tau_k(ntemper,nsppol,nkpt,nband)
5537 : :
5538 : : !Local variables-------------------------------
5539 : : !scalars
5540 : : integer :: iout, isym, iband, isppol, ikpt, itemp
5541 : : real(dp) :: Temp
5542 : : real(dp),parameter :: ha2ryd = two
5543 : : character(len=500) :: msg
5544 : : character(len=fnlen) :: filename,appendix
5545 : : ! *************************************************************************
5546 : :
5547 : : !input file for boltztrap: general info, Ef, Nelec, etc...
5548 [ # # ]: 0 : do itemp = 1, ntemper
5549 : 0 : write(appendix,"(i0)") itemp
5550 : 0 : filename= trim(fname_radix)//"_BLZTRP.intrans_"//trim(appendix)
5551 [ # # ]: 0 : if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
5552 : 0 : ABI_ERROR(msg)
5553 : : end if
5554 : :
5555 : 0 : write (iout, '(a)') "GENE # Format of input: generic format, with Symmetries"
5556 : 0 : write (iout, '(a)') "0 0 0 0.0 # iskip (not presently used) idebug setgap shiftgap"
5557 : 0 : write (iout, '(E15.5,a,F10.4,a)') fermie(itemp)*two, " 0.0005 0.4 ", nelec, &
5558 : 0 : " # Fermilevel (Ry), energy grid spacing, energy span around Fermilevel, number of electrons"
5559 : 0 : write (iout, '(a)') "CALC # CALC (calculate expansion coeff), NOCALC read from file"
5560 : 0 : write (iout, '(a)') "3 # lpfac, number of latt-points per k-point"
5561 : 0 : write (iout, '(a)') "BOLTZ # run mode (only BOLTZ is supported)"
5562 : 0 : write (iout, '(a)') ".15 # (efcut) energy range of chemical potential"
5563 : : write (iout, '(2f8.2,a)')&
5564 : 0 : tempermin+temperinc*dble(itemp),tempermin+temperinc*dble(itemp), " # Tmax, temperature grid spacing"
5565 : 0 : write (iout, '(2a)') "-1 # energyrange of bands given ",&
5566 : 0 : "individual DOS output sig_xxx and dos_xxx (xxx is band number)"
5567 : 0 : write (iout, '(a)') "TETRA # DOS calculation method. Other possibility is TETRA"
5568 : 0 : write (iout, '(a)') "No # not using model for relaxation time"
5569 : 0 : write (iout, '(a)') "3 # Number of doping levels coefficients will be output for"
5570 : 0 : write (iout, '(a)') "-1.e16 0.0d0 1.e16 # Values of doping levels (in carriers / cm^3"
5571 : 0 : close(iout)
5572 : : end do
5573 : :
5574 : : !files file, with association of all units for Boltztrap
5575 [ # # ]: 0 : filename= trim(fname_radix)//"_BLZTRP.def"
5576 [ # # ]: 0 : if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
5577 : 0 : ABI_ERROR(msg)
5578 : : end if
5579 : 0 : write (iout, '(3a)') "5, '", trim(fname_radix)//"_BLZTRP", ".intrans', 'old', 'formatted',0"
5580 : 0 : write (iout, '(3a)') "6, '", trim(fname_radix)//"_BLZTRP", ".outputtrans', 'unknown', 'formatted',0"
5581 : 0 : write (iout, '(3a)') "20,'", trim(fname_radix)//"_BLZTRP", ".struct', 'old', 'formatted',0"
5582 [ # # ]: 0 : if (nspinor == 1) then
5583 : 0 : write (iout, '(3a)') "10,'", trim(fname_radix)//"_BLZTRP", ".energy', 'old', 'formatted',0"
5584 [ # # ]: 0 : else if (nspinor == 2) then
5585 : 0 : write (iout, '(3a)') "10,'", trim(fname_radix)//"_BLZTRP", ".energyso', 'old', 'formatted',0"
5586 : : end if
5587 : 0 : write (iout, '(3a)') "10,'", trim(fname_radix)//"_BLZTRP", ".energy', 'old', 'formatted',0"
5588 : 0 : write (iout, '(3a)') "11,'", trim(fname_radix)//"_BLZTRP", ".tau_k', 'old', 'formatted',0"
5589 : 0 : write (iout, '(3a)') "48,'", trim(fname_radix)//"_BLZTRP", ".engre', 'unknown', 'unformatted',0"
5590 : 0 : write (iout, '(3a)') "49,'", trim(fname_radix)//"_BLZTRP", ".transdos', 'unknown', 'formatted',0"
5591 : 0 : write (iout, '(3a)') "50,'", trim(fname_radix)//"_BLZTRP", ".sigxx', 'unknown', 'formatted',0"
5592 : 0 : write (iout, '(3a)') "51,'", trim(fname_radix)//"_BLZTRP", ".sigxxx', 'unknown', 'formatted',0"
5593 : 0 : write (iout, '(3a)') "21,'", trim(fname_radix)//"_BLZTRP", ".trace', 'unknown', 'formatted',0"
5594 : 0 : write (iout, '(3a)') "22,'", trim(fname_radix)//"_BLZTRP", ".condtens', 'unknown', 'formatted',0"
5595 : 0 : write (iout, '(3a)') "24,'", trim(fname_radix)//"_BLZTRP", ".halltens', 'unknown', 'formatted',0"
5596 : 0 : write (iout, '(3a)') "25,'", trim(fname_radix)//"_BLZTRP", ".trace_fixdoping', 'unknown', 'formatted',0"
5597 : 0 : write (iout, '(3a)') "26,'", trim(fname_radix)//"_BLZTRP", ".condtens_fixdoping', 'unknown', 'formatted',0"
5598 : 0 : write (iout, '(3a)') "27,'", trim(fname_radix)//"_BLZTRP", ".halltens_fixdoping', 'unknown', 'formatted',0"
5599 : 0 : write (iout, '(3a)') "30,'", trim(fname_radix)//"_BLZTRP", "_BZ.dx', 'unknown', 'formatted',0"
5600 : 0 : write (iout, '(3a)') "31,'", trim(fname_radix)//"_BLZTRP", "_fermi.dx', 'unknown', 'formatted',0"
5601 : 0 : write (iout, '(3a)') "32,'", trim(fname_radix)//"_BLZTRP", "_sigxx.dx', 'unknown', 'formatted',0"
5602 : 0 : write (iout, '(3a)') "33,'", trim(fname_radix)//"_BLZTRP", "_sigyy.dx', 'unknown', 'formatted',0"
5603 : 0 : write (iout, '(3a)') "34,'", trim(fname_radix)//"_BLZTRP", "_sigzz.dx', 'unknown', 'formatted',0"
5604 : 0 : write (iout, '(3a)') "35,'", trim(fname_radix)//"_BLZTRP", "_band.dat', 'unknown', 'formatted',0"
5605 : 0 : write (iout, '(3a)') "36,'", trim(fname_radix)//"_BLZTRP", "_band.gpl', 'unknown', 'formatted',0"
5606 : 0 : write (iout, '(3a)') "37,'", trim(fname_radix)//"_BLZTRP", "_deriv.dat', 'unknown', 'formatted',0"
5607 : 0 : write (iout, '(3a)') "38,'", trim(fname_radix)//"_BLZTRP", "_mass.dat', 'unknown', 'formatted',0"
5608 : 0 : close(iout)
5609 : :
5610 : : !file is for geometry symmetries etc
5611 [ # # ]: 0 : filename= trim(fname_radix)//"_BLZTRP.struct"
5612 [ # # ]: 0 : if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
5613 : 0 : ABI_ERROR(msg)
5614 : : end if
5615 : 0 : write (iout, '(a)') "BoltzTraP geometry file generated by ABINIT."
5616 : :
5617 : : !here we need to print out the unit cell vectors
5618 : 0 : write (iout, '(3E20.10)') rprimd(:,1)
5619 : 0 : write (iout, '(3E20.10)') rprimd(:,2)
5620 : 0 : write (iout, '(3E20.10)') rprimd(:,3)
5621 : 0 : write (iout, '(I7)') nsym
5622 : :
5623 [ # # ]: 0 : do isym=1, nsym
5624 : : write (iout,'(3(3I5,2x), a, I5)') &
5625 : 0 : symrel(1,:,isym), symrel(2,:,isym), symrel(3,:,isym), ' ! symmetry rotation matrix isym = ', isym
5626 : : end do
5627 : 0 : close (iout)
5628 : :
5629 : : !second file is for eigenvalues
5630 [ # # ]: 0 : if (nspinor == 1) then
5631 [ # # ]: 0 : filename= trim(fname_radix)//"_BLZTRP.energy"
5632 [ # # ]: 0 : else if (nspinor == 2) then
5633 [ # # ]: 0 : filename= trim(fname_radix)//"_BLZTRP.energyso"
5634 : : end if
5635 : :
5636 [ # # ]: 0 : if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
5637 : 0 : ABI_ERROR(msg)
5638 : : end if
5639 : 0 : write (iout, '(a)') "BoltzTraP eigen-energies file generated by ABINIT."
5640 : 0 : write (iout, '(I7, I7, E20.10, a)') nkpt, nsppol, ha2ryd*fermie(1), ' ! nk, nspin, Fermi level(Ry) : energies below in Ry'
5641 [ # # ]: 0 : do isppol = 1, nsppol
5642 [ # # ]: 0 : do ikpt = 1, nkpt
5643 : : ! these need to be in reduced coordinates
5644 : 0 : write (iout, '(3E20.10, I7, a)') kpt(1,ikpt), kpt(2,ikpt), kpt(3,ikpt), nband, ' ! kpt nband'
5645 [ # # ]: 0 : do iband = 1, nband
5646 : : ! output in eV
5647 : 0 : write (iout, '(E20.10)') ha2ryd*eigen(iband, ikpt, isppol)
5648 : : end do
5649 : : end do
5650 : : end do
5651 : 0 : close (iout)
5652 : :
5653 : : !this file is for tau_k
5654 [ # # ]: 0 : do itemp = 1, ntemper
5655 : 0 : Temp=tempermin+temperinc*dble(itemp)
5656 : :
5657 : 0 : write(appendix,"(i0)") itemp
5658 : 0 : filename= trim(fname_radix)//"_BLZTRP.tau_k_"//trim(appendix)
5659 [ # # ]: 0 : if (open_file(filename, msg, newunit=iout, form="formatted", action="write") /= 0) then
5660 : 0 : ABI_ERROR(msg)
5661 : : end if
5662 : 0 : write (iout, '(a,f12.6)') "BoltzTraP tau_k file generated by ANADDB for T= ", Temp
5663 : 0 : write (iout, '(I7, I7, E20.10, a)') nkpt, nsppol, ha2ryd*fermie(itemp), &
5664 : 0 : ' ! nk, nspin, Fermi level(Ry) : energies below in Ry'
5665 [ # # ]: 0 : do isppol = 1, nsppol
5666 [ # # ]: 0 : do ikpt = 1, nkpt
5667 : : ! these need to be in reduced coordinates
5668 : 0 : write (iout, '(3E20.10, I7, a)') kpt(1,ikpt), kpt(2,ikpt), kpt(3,ikpt), nband, ' ! kpt nband'
5669 [ # # ]: 0 : do iband = 1, nband
5670 : : ! output in sec
5671 : 0 : write (iout, '(E20.10)') tau_k(itemp,isppol,ikpt,iband)
5672 : : end do
5673 : : end do
5674 : : end do
5675 : 0 : close (iout)
5676 : : end do
5677 : :
5678 : 0 : end subroutine ebands_prtbltztrp_tau_out
5679 : : !!***
5680 : :
5681 : : !----------------------------------------------------------------------
5682 : :
5683 : : !!****f* m_ebands/ebands_write
5684 : : !! NAME
5685 : : !! ebands_write
5686 : : !!
5687 : : !! FUNCTION
5688 : : !! Driver routine to write bands in different (txt) formats.
5689 : : !! This routine should be called by a single processor.
5690 : : !!
5691 : : !! INPUTS
5692 : : !! prtebands=Flag selecting the output format:
5693 : : !! 0 --> None
5694 : : !! 1 --> xmgrace
5695 : : !! 2 --> gnuplot (not coded yet)
5696 : : !! 3 --> EIG format (not coded yet)
5697 : : !! prefix=Prefix for output filename.
5698 : : !! [kptbounds(:,:)]=Optional argument giving the extrema of the k-path.
5699 : : !!
5700 : : !! OUTPUT
5701 : : !! Only writing.
5702 : : !!
5703 : : !! SOURCE
5704 : :
5705 [ + + + - : 5524 : subroutine ebands_write(ebands, prtebands, prefix, kptbounds)
- + ]
5706 : :
5707 : : !Arguments ------------------------------------
5708 : : !scalars
5709 : : class(ebands_t),intent(in) :: ebands
5710 : : integer,intent(in) :: prtebands
5711 : : character(len=*),intent(in) :: prefix
5712 : : real(dp),optional,intent(in) :: kptbounds(:,:)
5713 : : ! *********************************************************************
5714 : :
5715 : 5524 : select case (prtebands)
5716 : : case (0)
5717 : 4218 : return
5718 : : case (1)
5719 : : !call wrtout(std_out, sjoin(" Writing interpolated bands to:", path)
5720 [ + + ]: 4218 : if (present(kptbounds)) then
5721 : 130 : call ebands%write_xmgrace(strcat(prefix, "_EBANDS.agr"), kptbounds=kptbounds)
5722 : : else
5723 : 4088 : call ebands%write_xmgrace(strcat(prefix, "_EBANDS.agr"))
5724 : : end if
5725 : : case (2)
5726 : : !call wrtout(std_out, sjoin(" Writing interpolated bands to:", path)
5727 [ + + ]: 6 : if (present(kptbounds)) then
5728 : 4 : call ebands%write_gnuplot(prefix, kptbounds=kptbounds)
5729 : : else
5730 : 2 : call ebands%write_gnuplot(prefix)
5731 : : end if
5732 : : case default
5733 [ + + - + ]: 5524 : ABI_WARNING(sjoin("Unsupported value for prtebands:", itoa(prtebands)))
5734 : : end select
5735 : :
5736 : : end subroutine ebands_write
5737 : : !!***
5738 : :
5739 : : !----------------------------------------------------------------------
5740 : :
5741 : : !!****f* m_ebands/ebands_write_xmgrace
5742 : : !! NAME
5743 : : !! ebands_write_xmgrace
5744 : : !!
5745 : : !! FUNCTION
5746 : : !! Write bands in Xmgrace format. This routine should be called by a single processor.
5747 : : !! Use the driver `ebands_write` to support different formats.
5748 : : !!
5749 : : !! INPUTS
5750 : : !! filename=Filename
5751 : : !! [kptbounds(:,:)]=Optional argument giving the extrema of the k-path.
5752 : : !!
5753 : : !! OUTPUT
5754 : : !! Only writing
5755 : : !!
5756 : : !! SOURCE
5757 : :
5758 [ + + + - : 4218 : subroutine ebands_write_xmgrace(ebands, filename, kptbounds)
- + ]
5759 : :
5760 : : !Arguments ------------------------------------
5761 : : !scalars
5762 : : class(ebands_t),intent(in) :: ebands
5763 : : character(len=*),intent(in) :: filename
5764 : : real(dp),optional,intent(in) :: kptbounds(:,:)
5765 : :
5766 : : !Local variables-------------------------------
5767 : : !scalars
5768 : : integer :: unt,ik,spin,band,ii,start,nkbounds
5769 : : character(len=500) :: msg
5770 : : !arrays
5771 : : integer :: g0(3)
5772 : 4218 : integer,allocatable :: bounds2kpt(:)
5773 : : ! *********************************************************************
5774 : :
5775 : 4218 : nkbounds = 0
5776 [ + + ]: 4218 : if (present(kptbounds)) then
5777 [ + + + - ]: 390 : if (product(shape(kptbounds)) > 0 ) then
5778 : : ! Find correspondence between kptbounds and k-points in ebands.
5779 : 130 : nkbounds = size(kptbounds, dim=2)
5780 [ - + + - : 390 : ABI_MALLOC(bounds2kpt, (nkbounds))
+ - + - -
+ - + ]
5781 [ + + ]: 420 : bounds2kpt = 1; start = 1
5782 [ + + ]: 420 : do ii=1,nkbounds
5783 [ + + ]: 3231 : do ik=start,ebands%nkpt
5784 [ - + - - : 3101 : if (isamek(ebands%kptns(:, ik), kptbounds(:, ii), g0)) then
- - - + +
+ ]
5785 : 239 : bounds2kpt(ii) = ik; start = ik + 1; exit
5786 : : end if
5787 : : end do
5788 : : end do
5789 : : end if
5790 : : end if
5791 : :
5792 [ - + ]: 4218 : if (open_file(filename, msg, newunit=unt, form="formatted", action="write") /= 0) then
5793 : 0 : ABI_ERROR(msg)
5794 : : end if
5795 : :
5796 : 4218 : write(unt,'(a)') "# Grace project file"
5797 : 4218 : write(unt,'(a)') "# Generated by Abinit"
5798 : : write(unt,'(4(a,i0))') &
5799 : 4218 : "# mband: ",ebands%mband,", nkpt: ",ebands%nkpt,", nsppol: ",ebands%nsppol,", nspinor: ",ebands%nspinor
5800 : : write(unt,'(a,f8.2,a,i0,2(a,f8.2))') &
5801 : 4218 : "# nelect: ",ebands%nelect,", occopt: ",ebands%occopt,", tsmear: ",ebands%tsmear,", tphysel: ",ebands%tphysel
5802 : 4218 : write(unt,'(a,f8.2,a)') "# Energies are in eV. Zero set to efermi, previously it was at: ",ebands%fermie * Ha_eV, " [eV]"
5803 : 4218 : write(unt,'(a)')"# List of k-points and their index (C notation i.e. count from 0)"
5804 [ + + ]: 48106 : do ik=1,ebands%nkpt
5805 : 48106 : write(unt, "(a)")sjoin("#", itoa(ik-1), ktoa(ebands%kptns(:,ik)))
5806 : : end do
5807 : 4218 : write(unt,'(a)') "@page size 792, 612"
5808 : 4218 : write(unt,'(a)') "@page scroll 5%"
5809 : 4218 : write(unt,'(a)') "@page inout 5%"
5810 : 4218 : write(unt,'(a)') "@link page off"
5811 : 4218 : write(unt,'(a)') "@with g0"
5812 : 4218 : write(unt,'(a)') "@world xmin 0.00"
5813 : 4218 : write(unt,'(a,i0)') '@world xmax ',ebands%nkpt
5814 [ + + + + : 461317 : write(unt,'(a,es16.8)') '@world ymin ',minval((ebands%eig - ebands%fermie) * Ha_eV)
+ + + + +
- - + -
- ]
5815 [ + + + + : 461317 : write(unt,'(a,es16.8)') '@world ymax ',maxval((ebands%eig - ebands%fermie) * Ha_eV)
+ + + + +
- - + -
- ]
5816 : 4218 : write(unt,'(a)') '@default linewidth 1.5'
5817 : 4218 : write(unt,'(a)') '@xaxis tick on'
5818 : 4218 : write(unt,'(a)') '@xaxis tick major 1'
5819 : 4218 : write(unt,'(a)') '@xaxis tick major color 1'
5820 : 4218 : write(unt,'(a)') '@xaxis tick major linestyle 3'
5821 : 4218 : write(unt,'(a)') '@xaxis tick major grid on'
5822 : 4218 : write(unt,'(a)') '@xaxis tick spec type both'
5823 : 4218 : write(unt,'(a)') '@xaxis tick major 0, 0'
5824 [ + + ]: 4218 : if (nkbounds /= 0) then
5825 : 130 : write(unt,'(a,i0)') '@xaxis tick spec ',nkbounds
5826 [ + + ]: 420 : do ik=1,nkbounds
5827 : : !write(unt,'(a,i0,a,a)') '@xaxis ticklabel ',ik-1,',', "foo"
5828 : 420 : write(unt,'(a,i0,a,i0)') '@xaxis tick major ',ik-1,' , ',bounds2kpt(ik) - 1
5829 : : end do
5830 : : end if
5831 : 4218 : write(unt,'(a)') '@xaxis ticklabel char size 1.500000'
5832 : 4218 : write(unt,'(a)') '@yaxis tick major 10'
5833 : 4218 : write(unt,'(a)') '@yaxis label "Band Energy [eV]"'
5834 : 4218 : write(unt,'(a)') '@yaxis label char size 1.500000'
5835 : 4218 : write(unt,'(a)') '@yaxis ticklabel char size 1.500000'
5836 : 4218 : ii = -1
5837 [ + + ]: 8943 : do spin=1,ebands%nsppol
5838 [ + + ]: 55316 : do band=1,ebands%mband
5839 : 46373 : ii = ii + 1
5840 : 51098 : write(unt,'(a,i0,a,i0)') '@ s',ii,' line color ',spin
5841 : : end do
5842 : : end do
5843 : 4218 : ii = -1
5844 [ + + ]: 8943 : do spin=1,ebands%nsppol
5845 [ + + ]: 55316 : do band=1,ebands%mband
5846 : 46373 : ii = ii + 1
5847 : 46373 : write(unt,'(a,i0)') '@target G0.S',ii
5848 : 46373 : write(unt,'(a)') '@type xy'
5849 [ + + ]: 453161 : do ik=1,ebands%nkpt
5850 : 453161 : write(unt,'(i0,1x,es16.8)') ik-1, (ebands%eig(band, ik, spin) - ebands%fermie) * Ha_eV
5851 : : end do
5852 : 51098 : write(unt,'(a)') '&'
5853 : : end do
5854 : : end do
5855 : :
5856 : 4218 : close(unt)
5857 : :
5858 [ + + ]: 4218 : ABI_SFREE(bounds2kpt)
5859 : :
5860 : 4218 : end subroutine ebands_write_xmgrace
5861 : : !!***
5862 : :
5863 : : !----------------------------------------------------------------------
5864 : :
5865 : : !!****f* m_ebands/ebands_write_gnuplot
5866 : : !! NAME
5867 : : !! ebands_write_gnuplot
5868 : : !!
5869 : : !! FUNCTION
5870 : : !! Write bands in gnuplot format. This routine should be called by a single processor.
5871 : : !! Use the driver `ebands_write` to support different formats.
5872 : : !!
5873 : : !! INPUTS
5874 : : !! prefix=prefix for files (.data, .gnuplot)
5875 : : !! [kptbounds(:,:)]=Optional argument giving the extrema of the k-path.
5876 : : !!
5877 : : !! OUTPUT
5878 : : !! Only writing
5879 : : !!
5880 : : !! SOURCE
5881 : :
5882 [ + + + - : 6 : subroutine ebands_write_gnuplot(ebands, prefix, kptbounds)
- + ]
5883 : :
5884 : : !Arguments ------------------------------------
5885 : : !scalars
5886 : : class(ebands_t),intent(in) :: ebands
5887 : : character(len=*),intent(in) :: prefix
5888 : : real(dp),optional,intent(in) :: kptbounds(:,:)
5889 : :
5890 : : !Local variables-------------------------------
5891 : : !scalars
5892 : : integer :: unt,gpl_unt,ik,spin,ii,start,nkbounds
5893 : : character(len=500) :: msg,fmt
5894 : : character(len=fnlen) :: datafile,basefile
5895 : : !arrays
5896 : : integer :: g0(3)
5897 : 6 : integer,allocatable :: bounds2kpt(:)
5898 : : ! *********************************************************************
5899 : :
5900 : 6 : nkbounds = 0
5901 [ + + ]: 6 : if (present(kptbounds)) then
5902 [ + + + - ]: 12 : if (product(shape(kptbounds)) > 0 ) then
5903 : : ! Find correspondence between kptbounds and k-points in ebands.
5904 : 4 : nkbounds = size(kptbounds, dim=2)
5905 [ - + + - : 12 : ABI_MALLOC(bounds2kpt, (nkbounds))
+ - + - -
+ - + ]
5906 [ + + ]: 51 : bounds2kpt = 1; start = 1
5907 [ + + ]: 51 : do ii=1,nkbounds
5908 [ + + ]: 1504 : do ik=start,ebands%nkpt
5909 [ - + - - : 1500 : if (isamek(ebands%kptns(:, ik), kptbounds(:, ii), g0)) then
- - - + +
+ ]
5910 : 36 : bounds2kpt(ii) = ik; start = ik + 1; exit
5911 : : end if
5912 : : end do
5913 : : end do
5914 : : end if
5915 : : end if
5916 : :
5917 [ + - ]: 6 : datafile = strcat(prefix, "_EBANDS.data")
5918 [ - + ]: 6 : if (open_file(datafile, msg, newunit=unt, form="formatted", action="write") /= 0) then
5919 : 0 : ABI_ERROR(msg)
5920 : : end if
5921 [ - + ]: 6 : if (open_file(strcat(prefix, "_EBANDS.gnuplot"), msg, newunit=gpl_unt, form="formatted", action="write") /= 0) then
5922 : 6 : ABI_ERROR(msg)
5923 : : end if
5924 [ + - ]: 6 : basefile = basename(datafile)
5925 : :
5926 : 6 : write(unt,'(a)') "# Electron band structure data file"
5927 : 6 : write(unt,'(a)') "# Generated by Abinit"
5928 : : write(unt,'(4(a,i0))') &
5929 : 6 : "# mband: ",ebands%mband,", nkpt: ",ebands%nkpt,", nsppol: ",ebands%nsppol,", nspinor: ",ebands%nspinor
5930 : : write(unt,'(a,f8.2,a,i0,2(a,f8.2))') &
5931 : 6 : "# nelect: ",ebands%nelect,", occopt: ",ebands%occopt,", tsmear: ",ebands%tsmear,", tphysel: ",ebands%tphysel
5932 : 6 : write(unt,'(a,f8.2,a)') "# Energies are in eV. Zero set to efermi, Previously it was at: ",ebands%fermie * Ha_eV, " [eV]"
5933 : 6 : write(unt,'(a)')"# List of k-points and their index (C notation i.e. count from 0)"
5934 [ + + ]: 1267 : do ik=1,ebands%nkpt
5935 : 1267 : write(unt, "(a)")sjoin("#", itoa(ik-1), ktoa(ebands%kptns(:,ik)))
5936 : : end do
5937 : :
5938 [ + - ]: 6 : fmt = sjoin("(i0,1x,", itoa(ebands%mband), "(es16.8,1x))")
5939 : 6 : write(unt,'(a)') ' '
5940 [ + + ]: 12 : do spin=1,ebands%nsppol
5941 : 6 : write(unt,'(a,i0)') '# [kpt-index, band_1, band_2 ...] for spin: ',spin
5942 [ + + ]: 1267 : do ik=1,ebands%nkpt
5943 [ + + ]: 13647 : write(unt,fmt) ik-1, (ebands%eig(:, ik, spin) - ebands%fermie) * Ha_eV
5944 : : end do
5945 : 12 : write(unt,'(a)') ' '
5946 : : end do
5947 : :
5948 : : ! gnuplot script file
5949 : 6 : write(gpl_unt,'(a)') '# File to plot phonon bandstructure with gnuplot'
5950 : 6 : write(gpl_unt,'(a)') "#set terminal postscript eps enhanced color font 'Times-Roman,26' lw 2"
5951 : 6 : write(gpl_unt,'(a)') '#use the next lines to make a nice figure for a paper'
5952 : 6 : write(gpl_unt,'(a)') '#set term postscript enhanced eps color lw 0.5 dl 0.5'
5953 : 6 : write(gpl_unt,'(a)') '#set pointsize 0.275'
5954 : 6 : write(gpl_unt,'(a)') 'set palette defined ( 0 "blue", 3 "green", 6 "yellow", 10 "red" )'
5955 : 6 : write(gpl_unt,'(a)') 'unset key'
5956 : 6 : write(gpl_unt,'(a)') '# can make pointsize smaller (~0.5). Too small and nothing is printed'
5957 : 6 : write(gpl_unt,'(a)') 'set pointsize 0.8'
5958 : 6 : write(gpl_unt,'(a)') 'set view 0,0'
5959 : 6 : write(gpl_unt,'(a,i0,a)') 'set xrange [0:',ebands%nkpt-1,']'
5960 : : write(gpl_unt,'(2(a,es16.8),a)')&
5961 [ + + + + : 27300 : 'set yrange [',minval((ebands%eig - ebands%fermie) * Ha_eV),':',maxval((ebands%eig - ebands%fermie) * Ha_eV),']'
+ + + + +
- - + - -
+ + + + +
+ + + + -
- + - - ]
5962 : 6 : write(gpl_unt,'(a)') 'set xlabel "Momentum"'
5963 : 6 : write(gpl_unt,'(a)') 'set ylabel "Energy [eV]"'
5964 : 6 : write(gpl_unt,'(a)') strcat('set title "', replace(basefile, "_", "\\_"), '"')
5965 [ + + ]: 6 : if (nkbounds == 0) then
5966 : 2 : write(gpl_unt,'(a)') 'set grid xtics'
5967 : : else
5968 : 4 : write(gpl_unt,"(a)")"# Add vertical lines in correspondence of high-symmetry points."
5969 : 4 : write(gpl_unt,'(a)') 'unset xtics'
5970 [ + + ]: 51 : do ii=1,nkbounds
5971 : : write(gpl_unt,"(a,2(i0,a))") &
5972 : 51 : "set arrow from ",bounds2kpt(ii)-1,",graph(0,0) to ",bounds2kpt(ii)-1,",graph(1,1) nohead ls 'dashed'"
5973 : : !write(gpl_unt,"(a)")sjoin("set xtics add('kname'", itoa(bounds2kpt(ii)-1), ")")
5974 : : end do
5975 : :
5976 : : end if
5977 : 6 : write(gpl_unt,"(a)")sjoin("mband =", itoa(ebands%mband))
5978 : 6 : write(gpl_unt,"(a)")strcat('plot for [i=2:mband] "', basefile, '" u 1:i every :1 with lines linetype -1')
5979 [ - + ]: 6 : if (ebands%nsppol == 2) then
5980 : 0 : write(gpl_unt,"(a)")strcat('replot for [i=2:mband] "', basefile, '" u 1:i every :2 with lines linetype 4')
5981 : : end if
5982 : 6 : write(gpl_unt, "(a)")"pause -1"
5983 : :
5984 : 6 : close(unt)
5985 : 6 : close(gpl_unt)
5986 : :
5987 [ + + ]: 6 : ABI_SFREE(bounds2kpt)
5988 : :
5989 : 6 : end subroutine ebands_write_gnuplot
5990 : : !!***
5991 : :
5992 : : !----------------------------------------------------------------------
5993 : :
5994 : : !!****f* m_ebands/ebands_interpolate_kpath
5995 : : !!
5996 : : !! NAME
5997 : : !! ebands_interpolate_kpath
5998 : : !!
5999 : : !! FUNCTION
6000 : : !!
6001 : : !! INPUTS
6002 : : !! dtset<dataset_type>=Abinit dataset
6003 : : !! band_range(2)=Initial and final band index to be interpolated. [0,0] if all bands are used.
6004 : : !! This is a global variable i.e. all MPI procs must call the routine with the same value.
6005 : : !!
6006 : : !! OUTPUT
6007 : : !!
6008 : : !! SOURCE
6009 : :
6010 : 2 : subroutine ebands_interpolate_kpath(ebands, dtset, cryst, band_range, prefix, comm)
6011 : :
6012 : : !Arguments ------------------------------------
6013 : : !scalars
6014 : : class(ebands_t),intent(in) :: ebands
6015 : : type(dataset_type),intent(in) :: dtset
6016 : : type(crystal_t),intent(in) :: cryst
6017 : : integer,intent(in) :: comm
6018 : : character(len=*),intent(in) :: prefix
6019 : : !arrays
6020 : : integer,intent(in) :: band_range(2)
6021 : :
6022 : : !Local variables-------------------------------
6023 : : !scalars
6024 : : integer,parameter :: master = 0, intp_nshiftk1 = 1
6025 : : integer :: my_rank, ndivsm, nbounds, itype !, spin, ik, ib, ii, jj, ierr
6026 : 2 : type(ebands_t) :: ebands_kpath
6027 : 2 : type(kpath_t) :: kpath
6028 : : character(len=500) :: tag !msg
6029 : : !arrays
6030 : 2 : real(dp),allocatable :: bounds(:,:)
6031 : : ! *********************************************************************
6032 : :
6033 : 2 : my_rank = xmpi_comm_rank(comm)
6034 : :
6035 : : itype = nint(dtset%einterp(1)); tag = "_SKW"
6036 : 2 : tag = "_INTERP"
6037 : :
6038 : : ! Generate k-path
6039 : 2 : ndivsm = dtset%ndivsm
6040 [ - + ]: 2 : if (ndivsm <= 0) then
6041 : 0 : ABI_COMMENT("Setting ndivsm to 20 because variable is not given in input file")
6042 : 0 : ndivsm = 20
6043 : : end if
6044 : 2 : nbounds = dtset%nkpath
6045 [ - + ]: 2 : if (nbounds <= 0) then
6046 : 0 : ABI_COMMENT("Using hard-coded k-path because nkpath not present in input file.")
6047 : 0 : nbounds = 5
6048 [ # # ]: 0 : ABI_MALLOC(bounds, (3, 5))
6049 [ # # # # : 0 : bounds = reshape([zero, zero, zero, half, zero, zero, zero, half, zero, zero, zero, zero, zero, zero, half], [3,5])
# # ]
6050 : : else
6051 : 2 : call alloc_copy(dtset%kptbounds, bounds)
6052 : : end if
6053 : :
6054 : 2 : call kpath%init(bounds, cryst%gprimd, ndivsm)
6055 [ + + ]: 4 : call kpath%print([std_out], header="Interpolating energies on k-path")
6056 [ - + ]: 2 : ABI_FREE(bounds)
6057 : :
6058 : : ! Interpolate bands on k-path.
6059 : 2 : ebands_kpath = ebands_interp_kpath(ebands, cryst, kpath, dtset%einterp, band_range, comm)
6060 : :
6061 [ + - ]: 2 : if (my_rank == master) then
6062 : 2 : call wrtout(ab_out, sjoin("- Writing interpolated bands to file:", strcat(prefix, tag)))
6063 : 2 : call ebands_kpath%write(dtset%prtebands, strcat(prefix, tag), kptbounds=kpath%bounds)
6064 : : end if
6065 : :
6066 : 2 : call ebands_kpath%free()
6067 : 2 : call kpath%free()
6068 : :
6069 [ - + - + : 2 : end subroutine ebands_interpolate_kpath
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + ]
6070 : : !!***
6071 : :
6072 : : !----------------------------------------------------------------------
6073 : :
6074 : : !!****f* m_ebands/klinterp_new
6075 : : !! NAME
6076 : : !! klinterp_new
6077 : : !!
6078 : : !! FUNCTION
6079 : : !!
6080 : : !! INPUTS
6081 : : !!
6082 : : !! OUTPUT
6083 : : !!
6084 : : !! SOURCE
6085 : :
6086 : 0 : type(klinterp_t) function klinterp_new(cryst, kptrlatt, nshiftk, shiftk, kptopt, kibz, &
6087 : 0 : bsize, nkibz, nsppol, ndat, values_bksd, comm) result(new)
6088 : :
6089 : : !Arguments ------------------------------------
6090 : : !scalars
6091 : : type(crystal_t),intent(in) :: cryst
6092 : : integer,intent(in) :: nshiftk, kptopt, bsize, nkibz, nsppol, ndat, comm
6093 : : !arrays
6094 : : integer,intent(in) :: kptrlatt(3,3)
6095 : : real(dp),intent(in) :: kibz(3, nkibz), shiftk(3,nshiftk), values_bksd(bsize, nkibz, nsppol, ndat)
6096 : :
6097 : : !Local variables-------------------------------
6098 : : !scalars
6099 : : integer,parameter :: sppoldbl1 = 1
6100 : : integer :: ierr, nkfull, ikf, ik_ibz, timrev, ix, iy, iz, nkx, nky, nkz !spin, band, idat
6101 : : real(dp) :: dksqmax
6102 : : character(len=500) :: msg
6103 : : !arrays
6104 : 0 : integer,allocatable :: bz2ibz(:,:)
6105 : : real(dp) :: kpt(3)
6106 : 0 : real(dp),allocatable :: kfull(:,:)
6107 : : ! *********************************************************************
6108 : :
6109 : : ! Check input parameters
6110 : 0 : ierr = 0
6111 : 0 : if (nkibz == 1) then
6112 : 0 : ABI_ERROR_NOSTOP("Cannot interpolate with a single k-point", ierr)
6113 : : end if
6114 [ # # ]: 0 : if (.not. isdiagmat(kptrlatt)) then
6115 : 0 : ABI_ERROR_NOSTOP('kptrlatt is not diagonal. Multiple shifts are not allowed', ierr)
6116 : : end if
6117 [ # # ]: 0 : if (nshiftk /= 1) then
6118 : 0 : ABI_ERROR_NOSTOP('Multiple shifts not allowed', ierr)
6119 : : end if
6120 [ # # # # : 0 : if (any(abs(shiftk(:, 1)) > tol8)) then
# # ]
6121 : 0 : ABI_ERROR_NOSTOP("shifted k-mesh not implemented", ierr)
6122 : : end if
6123 : :
6124 [ # # ]: 0 : if (ierr /= 0) then
6125 : 0 : ABI_ERROR("Linear interpolation cannot be performed. See messages above.")
6126 : : end if
6127 : :
6128 : 0 : nkx = kptrlatt(1, 1)
6129 : 0 : nky = kptrlatt(2, 2)
6130 : 0 : nkz = kptrlatt(3, 3)
6131 : :
6132 : 0 : new%nkx = nkx; new%nky = nky; new%nkz = nkz
6133 : 0 : new%bsize = bsize; new%nsppol = nsppol; new%ndat = ndat
6134 : :
6135 : : ! Build list of k-points in the conventional unit cell.
6136 : : ! (x,y,z) ordered as required by interpolation routine
6137 : 0 : nkfull = nkx * nky * nkz
6138 [ # # # # : 0 : ABI_MALLOC(kfull, (3, nkfull))
# # # # #
# # # ]
6139 : 0 : ikf = 0
6140 [ # # ]: 0 : do iz=1,nkz
6141 : 0 : kpt(3) = (iz - 1 + shiftk(3, 1)) / nkz
6142 [ # # ]: 0 : do iy=1,nky
6143 : 0 : kpt(2) = (iy - 1 + shiftk(2, 1)) / nky
6144 [ # # ]: 0 : do ix=1,nkx
6145 : 0 : kpt(1) = (ix - 1 + shiftk(1, 1)) / nkx
6146 : 0 : ikf = ikf + 1
6147 [ # # ]: 0 : kfull(:, ikf) = kpt
6148 : : end do
6149 : : end do
6150 : : end do
6151 : :
6152 : : ! Build mapping kfull --> IBZ
6153 : 0 : timrev = kpts_timrev_from_kptopt(kptopt)
6154 [ # # # # : 0 : ABI_MALLOC(bz2ibz, (nkfull*sppoldbl1, 6))
# # # # #
# # # ]
6155 : :
6156 : : call listkk(dksqmax, cryst%gmet, bz2ibz, kibz, kfull, nkibz, nkfull, cryst%nsym,&
6157 : 0 : sppoldbl1, cryst%symafm, cryst%symrec, timrev, comm, use_symrec=.True.)
6158 : :
6159 [ # # ]: 0 : ABI_FREE(kfull)
6160 : :
6161 [ # # ]: 0 : if (dksqmax > tol12) then
6162 : : write(msg, '(3a,es16.6,4a)' )&
6163 : 0 : 'At least one of the k points could not be generated from a symmetrical one.',ch10,&
6164 : 0 : 'dksqmax: ',dksqmax,ch10,&
6165 : 0 : 'Action: check k-point input variables',ch10,&
6166 : 0 : ' e.g. kptopt or shiftk might be wrong in the present dataset or the preparatory one.'
6167 : 0 : ABI_ERROR(msg)
6168 : : end if
6169 : :
6170 [ # # # # : 0 : ABI_CALLOC(new%data_uk_bsd, (nkx, nky, nkz, bsize, nsppol, ndat))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
6171 : :
6172 : : ! Build array in the full BZ to prepare call to interpol3d_0d.
6173 : : ikf = 0
6174 [ # # ]: 0 : do iz=1,nkz
6175 [ # # ]: 0 : do iy=1,nky
6176 [ # # ]: 0 : do ix=1,nkx
6177 : 0 : ikf = ikf + 1
6178 : 0 : ik_ibz = bz2ibz(ikf, 1)
6179 [ # # # # : 0 : new%data_uk_bsd(ix, iy, iz, 1:bsize, 1:nsppol, 1:ndat) = values_bksd(1:bsize, ik_ibz, 1:nsppol, 1:ndat)
# # ]
6180 : : end do
6181 : : end do
6182 : : end do
6183 : :
6184 [ # # ]: 0 : ABI_FREE(bz2ibz)
6185 : :
6186 [ # # ]: 0 : end function klinterp_new
6187 : : !!***
6188 : :
6189 : : !----------------------------------------------------------------------
6190 : :
6191 : : !!****f* m_ebands/klinterp_free
6192 : : !! NAME
6193 : : !! klinterp_free
6194 : : !!
6195 : : !! FUNCTION
6196 : : !! Free dynamic memory.
6197 : : !!
6198 : : !! INPUTS
6199 : : !!
6200 : : !! OUTPUT
6201 : : !!
6202 : : !! SOURCE
6203 : :
6204 : 0 : subroutine klinterp_free(self)
6205 : :
6206 : : !Arguments ------------------------------------
6207 : : class(klinterp_t),intent(inout) :: self
6208 : : ! *********************************************************************
6209 : :
6210 [ # # ]: 0 : ABI_SFREE(self%data_uk_bsd)
6211 : :
6212 : 0 : end subroutine klinterp_free
6213 : : !!***
6214 : :
6215 : : !----------------------------------------------------------------------
6216 : :
6217 : : !!****f* m_ebands/klinterp_eval_bsd
6218 : : !! NAME
6219 : : !! klinterp_eval_bsd
6220 : : !!
6221 : : !! FUNCTION
6222 : : !!
6223 : : !! INPUTS
6224 : : !!
6225 : : !! OUTPUT
6226 : : !!
6227 : : !! SOURCE
6228 : :
6229 : 0 : subroutine klinterp_eval_bsd(self, kpt, vals_bsd)
6230 : :
6231 : : !Arguments ------------------------------------
6232 : : !scalars
6233 : : class(klinterp_t),intent(in) :: self
6234 : : real(dp),intent(in) :: kpt(3)
6235 : : real(dp),intent(out) :: vals_bsd(self%bsize, self%nsppol, self%ndat)
6236 : :
6237 : : !Local variables-------------------------------
6238 : : integer :: spin, idat, band
6239 : : !integer :: ir1, ir2, ir3, pr1, pr2, pr3
6240 : : real(dp) :: val !, vv(8)
6241 : : real(dp) :: kwrap(3), shift(3)
6242 : : ! *********************************************************************
6243 : :
6244 [ # # ]: 0 : call wrap2_zero_one(kpt, kwrap, shift)
6245 : : !write(std_out, *)"kwrap:", kwrap
6246 : :
6247 : : ! ir1,ir2,ir3 = bottom left neighbor
6248 : : ! pr1,pr2,pr3 = top right neighbor
6249 : : !call interpol3d_indices(kwrap, self%nkx, self%nky, self%nkz, ir1, ir2, ir3, pr1, pr2, pr3)
6250 : :
6251 [ # # ]: 0 : do idat=1,self%ndat
6252 [ # # ]: 0 : do spin=1,self%nsppol
6253 [ # # ]: 0 : do band=1,self%bsize
6254 : 0 : val = interpol3d_0d(kwrap, self%nkx, self%nky, self%nkz, self%data_uk_bsd(:,:,:,band, spin, idat))
6255 : :
6256 : : !if (val <= zero) then
6257 : : ! vv(1) = self%data_uk_bsd(ir1, ir2, ir3, band, spin, idat)
6258 : : ! vv(2) = self%data_uk_bsd(pr1, ir2, ir3, band, spin, idat)
6259 : : ! vv(3) = self%data_uk_bsd(ir1, pr2, ir3, band, spin, idat)
6260 : : ! vv(4) = self%data_uk_bsd(ir1, ir2, pr3, band, spin, idat)
6261 : : ! vv(5) = self%data_uk_bsd(pr1, pr2, ir3, band, spin, idat)
6262 : : ! vv(6) = self%data_uk_bsd(ir1, pr2, pr3, band, spin, idat)
6263 : : ! vv(7) = self%data_uk_bsd(pr1, ir2, pr3, band, spin, idat)
6264 : : ! vv(8) = self%data_uk_bsd(pr1, pr2, pr3, band, spin, idat)
6265 : : ! val = maxval(vv)
6266 : : !end if
6267 : :
6268 : 0 : vals_bsd(band, spin, idat) = val
6269 : : end do
6270 : : end do
6271 : : end do
6272 : :
6273 : 0 : end subroutine klinterp_eval_bsd
6274 : : !!***
6275 : :
6276 : : !!****f* m_ebands/ebands_get_carriers
6277 : : !! NAME
6278 : : !! ebands_get_carriers
6279 : : !!
6280 : : !! FUNCTION
6281 : : !! Compute number of electrons (e) and holes (h) per unit cell from a given list of `ntemp`
6282 : : !! temperatures `kTmesh` and chemical potentials `mu_e`.
6283 : : !! Return n_ehst(2, nsppol, ntemp) where the first dimension if for electrons/holes.
6284 : : !! If nsppol == 2, the second dimension is the number of e/h for spin else the total number of e/h summed over spins.
6285 : : !! To discern between electrons and holes in semiconductors we assume that ef is inside the gap.
6286 : : !!
6287 : : !! SOURCE
6288 : :
6289 : 15 : subroutine ebands_get_carriers(self, ntemp, kTmesh, mu_e, n_ehst)
6290 : :
6291 : : !Arguments ------------------------------------
6292 : : !scalars
6293 : : class(ebands_t),intent(in) :: self
6294 : : integer,intent(in) :: ntemp
6295 : : !arrays
6296 : : real(dp),intent(in) :: kTmesh(ntemp), mu_e(ntemp)
6297 : : real(dp),intent(out) :: n_ehst(2, self%nsppol, ntemp)
6298 : :
6299 : : !Local variables-------------------------------
6300 : : integer :: spin, ik_ibz, ib, itemp
6301 : : real(dp) :: max_occ, wtk, eig_nk
6302 : : !*********************************************************************
6303 : :
6304 : 15 : max_occ = two / (self%nspinor * self%nsppol)
6305 [ + + + + : 271 : n_ehst = zero
+ + ]
6306 : :
6307 [ + + ]: 30 : do spin=1,self%nsppol
6308 [ + + ]: 3602 : do ik_ibz=1,self%nkpt
6309 : 3572 : wtk = self%wtk(ik_ibz)
6310 [ + + ]: 20875 : do ib=1, self%nband(ik_ibz + (spin-1) * self%nkpt)
6311 : 17288 : eig_nk = self%eig(ib, ik_ibz, spin)
6312 : :
6313 [ + + ]: 122868 : do itemp=1,ntemp
6314 [ + + ]: 119296 : if (eig_nk >= mu_e(itemp)) then
6315 : : ! electron (assuming ef inside the gap if semiconductor)
6316 : : n_ehst(1, spin, itemp) = n_ehst(1, spin, itemp) + &
6317 : 20486 : wtk * occ_fd(eig_nk, kTmesh(itemp), mu_e(itemp)) * max_occ
6318 : : else
6319 : : ! holes
6320 : : n_ehst(2, spin, itemp) = n_ehst(2, spin, itemp) + &
6321 : 81522 : wtk * (one - occ_fd(eig_nk, kTmesh(itemp), mu_e(itemp))) * max_occ
6322 : : end if
6323 : : end do
6324 : :
6325 : : end do
6326 : : end do
6327 : : end do
6328 : :
6329 : 15 : end subroutine ebands_get_carriers
6330 : : !!***
6331 : :
6332 [ # # # # : 0 : end module m_ebands
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
6333 : : !!***
|
