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