1!-*- mode: F90 -*-! 2!------------------------------------------------------------! 3! This file is distributed as part of the Wannier90 code and ! 4! under the terms of the GNU General Public License. See the ! 5! file `LICENSE' in the root directory of the Wannier90 ! 6! distribution, or http://www.gnu.org/copyleft/gpl.txt ! 7! ! 8! The webpage of the Wannier90 code is www.wannier.org ! 9! ! 10! The Wannier90 code is hosted on GitHub: ! 11! ! 12! https://github.com/wannier-developers/wannier90 ! 13!------------------------------------------------------------! 14 15module w90_parameters 16 !! This module contains parameters to control the actions of wannier90. 17 !! Also routines to read the parameters and write them out again. 18 19 use w90_constants, only: dp 20 use w90_io, only: stdout, maxlen 21 22 implicit none 23 24 private 25 26 !Input 27 integer, public, save :: iprint 28 !! Controls the verbosity of the output 29 character(len=20), public, save :: energy_unit 30 !! Units for energy 31 character(len=20), public, save :: length_unit 32 !! Units for length 33 logical, public, save :: wvfn_formatted 34 !! Read the wvfn from fortran formatted file 35 logical, public, save :: spn_formatted 36 !! Read the spin from fortran formatted file 37 logical, public, save :: uHu_formatted 38 logical, public, save :: berry_uHu_formatted 39 !! Read the uHu from fortran formatted file 40 integer, public, save :: spin 41 !! Spin up=1 down=2 42 integer, public, save :: num_bands 43 !! Number of bands 44 integer, public, save :: num_dump_cycles 45 !! Number of steps before writing checkpoint 46 integer, public, save :: num_print_cycles 47 !! Number of steps between writing output 48 integer, public, save :: slwf_num 49 !! Number of objective Wannier functions (others excluded from spread functional) 50 logical, public, save :: selective_loc 51 !! Selective localization 52 logical, public, save :: slwf_constrain 53 !! Constrained centres 54 real(kind=dp), allocatable, public, save :: ccentres_frac(:, :) 55 real(kind=dp), allocatable, public, save :: ccentres_cart(:, :) 56 real(kind=dp), public, save :: slwf_lambda 57 !! Centre constraints for each Wannier function. Co-ordinates of centre constraint defaults 58 !! to centre of trial orbital. Individual Lagrange multipliers, lambdas, default to global Lagrange multiplier. 59 character(len=50), public, save :: devel_flag 60 ! Adaptive vs. fixed smearing stuff [GP, Jul 12, 2012] 61 ! Only internal, always use the local variables defined by each module 62 ! that take this value as default 63 logical :: adpt_smr 64 real(kind=dp) :: adpt_smr_fac 65 real(kind=dp) :: adpt_smr_max 66 real(kind=dp) :: smr_fixed_en_width 67 ! GP: added a flag to check if this is the first run of param_read in library mode or not 68 logical, public, save :: library_param_read_first_pass 69 !IVO 70 logical, public, save :: spin_moment 71 real(kind=dp), public, save :: spin_axis_polar 72 real(kind=dp), public, save :: spin_axis_azimuth 73 logical, public, save :: use_degen_pert 74 real(kind=dp), public, save :: degen_thr 75 logical, public, save :: spin_decomp 76 integer, public, save :: num_valence_bands 77 logical :: found_fermi_energy 78 real(kind=dp), public, save :: scissors_shift 79 !IVO_END 80 ! [gp-begin, Apr 20, 2012] Smearing type 81 ! The prefactor is given with the above parameters smr_... 82 ! This is an internal variable, obtained from the input string smr_type 83 ! Only internal, always use the local variables defined by each module 84 ! that take this value as default 85 integer :: smr_index 86 ! [gp-end] 87 integer, allocatable, public, save :: exclude_bands(:) 88 integer, public, save :: num_wann 89 !! number of wannier functions 90 integer, public, save :: mp_grid(3) 91 !! Dimensions of the Monkhorst-Pack grid 92! logical, public, save :: automatic_mp_grid 93 logical, public, save :: gamma_only 94 !! Use the special Gamma-point routines 95 real(kind=dp), public, save :: dis_win_min 96 !! lower bound of the disentanglement outer window 97 real(kind=dp), public, save :: dis_win_max 98 !! upper bound of the disentanglement outer window 99 real(kind=dp), public, save :: dis_froz_min 100 !! lower bound of the disentanglement inner (frozen) window 101 real(kind=dp), public, save :: dis_froz_max 102 !! upper bound of the disentanglement inner (frozen) window 103 integer, public, save :: dis_num_iter 104 !! number of disentanglement iteration steps 105 real(kind=dp), public, save :: dis_mix_ratio 106 !! Mixing ratio for the disentanglement routine 107 real(kind=dp), public, save :: dis_conv_tol 108 !! Convergence tolerance for the disentanglement 109 integer, public, save :: dis_conv_window 110 !! Size of the convergence window for disentanglement 111 ! GS-start 112 integer, public, save :: dis_spheres_first_wann 113 integer, public, save :: dis_spheres_num 114 real(kind=dp), allocatable, public, save :: dis_spheres(:, :) 115 ! GS-end 116 integer, public, save :: num_iter 117 !! Number of wannierisation iterations 118 integer, public, save :: num_cg_steps 119 !! Number of Conjugate Gradient steps 120 real(kind=dp), public, save :: conv_tol 121 integer, public, save :: conv_window 122 logical, public, save :: wannier_plot 123 integer, allocatable, public, save :: wannier_plot_list(:) 124 integer, public, save :: wannier_plot_supercell(3) 125 character(len=20), public, save :: wannier_plot_format 126 character(len=20), public, save :: wannier_plot_mode 127 character(len=20), public, save :: wannier_plot_spinor_mode 128 logical, public, save :: wannier_plot_spinor_phase 129 logical, public, save :: write_u_matrices 130 logical, public, save :: bands_plot 131 logical, public, save :: write_bvec 132 integer, public, save :: bands_num_points 133 character(len=20), public, save :: bands_plot_format 134 character(len=20), public, save :: bands_plot_mode 135 integer, allocatable, public, save :: bands_plot_project(:) 136 integer, public, save :: bands_plot_dim 137 logical, public, save :: write_hr 138 logical, public, save :: write_rmn 139 logical, public, save :: write_tb 140 real(kind=dp), public, save :: hr_cutoff 141 real(kind=dp), public, save :: dist_cutoff 142 character(len=20), public, save :: dist_cutoff_mode 143 real(kind=dp), public, save :: dist_cutoff_hc 144 character(len=20), public, save :: one_dim_axis 145 logical, public, save :: use_ws_distance 146 real(kind=dp), public, save :: ws_distance_tol 147 !! absolute tolerance for the distance to equivalent positions 148 integer, public, save :: ws_search_size(3) 149 !! maximum extension in each direction of the supercell of the BvK cell 150 !! to search for points inside the Wigner-Seitz cell 151 logical, public, save :: fermi_surface_plot 152 integer, public, save :: fermi_surface_num_points 153 character(len=20), public, save :: fermi_surface_plot_format 154 real(kind=dp), save :: fermi_energy 155 156 ! module k p a t h 157 logical, public, save :: kpath 158 character(len=20), public, save :: kpath_task 159 integer, public, save :: kpath_num_points 160 character(len=20), public, save :: kpath_bands_colour 161 162 ! module k s l i c e 163 logical, public, save :: kslice 164 character(len=20), public, save :: kslice_task 165 real(kind=dp), public, save :: kslice_corner(3) 166 real(kind=dp), public, save :: kslice_b1(3) 167 real(kind=dp), public, save :: kslice_b2(3) 168 integer, public, save :: kslice_2dkmesh(2) 169 character(len=20), public, save :: kslice_fermi_lines_colour 170 171 ! module d o s 172 logical, public, save :: dos 173! No need to save 'dos_plot', only used here (introduced 'dos_task') 174 logical, public :: dos_plot 175 character(len=20), public, save :: dos_task 176 logical, public, save :: dos_adpt_smr 177 real(kind=dp), public, save :: dos_adpt_smr_fac 178 integer, public, save :: dos_smr_index 179 real(kind=dp), public, save :: dos_smr_fixed_en_width 180 real(kind=dp), public, save :: dos_adpt_smr_max 181 real(kind=dp), public, save :: dos_energy_max 182 real(kind=dp), public, save :: dos_energy_min 183 real(kind=dp), public, save :: dos_energy_step 184 integer, public, save :: num_dos_project 185 integer, allocatable, public, save :: dos_project(:) 186! character(len=20), public, save :: dos_plot_format 187 real(kind=dp), public, save :: dos_kmesh_spacing 188 integer, public, save :: dos_kmesh(3) 189! real(kind=dp), public, save :: dos_gaussian_width 190 191! Module b e r r y 192 logical, public, save :: berry 193 character(len=120), public, save :: berry_task 194 real(kind=dp), public, save :: berry_kmesh_spacing 195 integer, public, save :: berry_kmesh(3) 196 ! --------------remove eventually---------------- 197! integer, public, save :: alpha 198! integer, public, save :: beta 199! integer, public, save :: gamma 200 ! --------------remove eventually---------------- 201 integer, public, save :: berry_curv_adpt_kmesh 202 real(kind=dp), public, save :: berry_curv_adpt_kmesh_thresh 203 character(len=20), public, save :: berry_curv_unit 204 logical, public, save :: kubo_adpt_smr 205 real(kind=dp), public, save :: kubo_adpt_smr_fac 206 integer, public, save :: kubo_smr_index 207 real(kind=dp), public, save :: kubo_smr_fixed_en_width 208 real(kind=dp), public, save :: kubo_adpt_smr_max 209 integer, public, save :: sc_phase_conv 210 real(kind=dp), public, save :: sc_eta 211 real(kind=dp), public, save :: sc_w_thr 212 logical, public, save :: wanint_kpoint_file 213! logical, public, save :: sigma_abc_onlyorb 214 logical, public, save :: transl_inv 215 216 ! spin Hall conductivity 217 logical, public, save :: shc_freq_scan 218 integer, public, save :: shc_alpha 219 integer, public, save :: shc_beta 220 integer, public, save :: shc_gamma 221 logical, public, save :: shc_bandshift 222 integer, public, save :: shc_bandshift_firstband 223 real(kind=dp), public, save :: shc_bandshift_energyshift 224 225 logical, public, save :: gyrotropic 226 character(len=120), public, save :: gyrotropic_task 227 integer, public, save :: gyrotropic_kmesh(3) 228 real(kind=dp), public, save :: gyrotropic_kmesh_spacing 229 integer, public, save :: gyrotropic_smr_index 230 real(kind=dp), public, save :: gyrotropic_smr_fixed_en_width 231 real(kind=dp) :: gyrotropic_freq_min 232 real(kind=dp) :: gyrotropic_freq_max 233 real(kind=dp) :: gyrotropic_freq_step 234 integer, public, save :: gyrotropic_nfreq 235 complex(kind=dp), allocatable, public, save :: gyrotropic_freq_list(:) 236 real(kind=dp), public, save :: gyrotropic_box_corner(3), gyrotropic_box(3, 3) 237 real(kind=dp) :: gyrotropic_box_tmp(3) 238 real(kind=dp), public, save :: gyrotropic_degen_thresh 239 integer, allocatable, public, save :: gyrotropic_band_list(:) 240 integer, public, save :: gyrotropic_num_bands 241 real(kind=dp) :: smr_max_arg 242 real(kind=dp), public, save :: gyrotropic_smr_max_arg 243 real(kind=dp), public, save :: gyrotropic_eigval_max 244 245 logical :: fermi_energy_scan 246 real(kind=dp) :: fermi_energy_min 247 real(kind=dp) :: fermi_energy_max 248 real(kind=dp) :: fermi_energy_step 249 integer, public, save :: nfermi 250 real(kind=dp), allocatable, public, save :: fermi_energy_list(:) 251 252 real(kind=dp) :: kubo_freq_min 253 real(kind=dp) :: kubo_freq_max 254 real(kind=dp) :: kubo_freq_step 255 integer, public, save :: kubo_nfreq 256 complex(kind=dp), allocatable, public, save :: kubo_freq_list(:) 257 real(kind=dp), public, save :: kubo_eigval_max 258 259! Module s p i n 260 real(kind=dp), public, save :: spin_kmesh_spacing 261 integer, public, save :: spin_kmesh(3) 262 263 ! [gp-begin, Apr 13, 2012] 264 ! Global interpolation k mesh variables 265 ! These don't need to be public, since their values are copied in the variables of the 266 ! local interpolation meshes. JRY: added save attribute 267 real(kind=dp), save :: kmesh_spacing 268 integer, save :: kmesh(3) 269 logical, save :: global_kmesh_set 270 ! [gp-end] 271 272 ! [gp-begin, Jun 1, 2012] 273 ! GeneralInterpolator variables 274 logical, public, save :: geninterp 275 logical, public, save :: geninterp_alsofirstder 276 logical, public, save :: geninterp_single_file 277 ! [gp-end, Jun 1, 2012] 278 279 ! [gp-begin, Apr 12, 2012] 280 ! BoltzWann variables 281 logical, public, save :: boltzwann 282 logical, public, save :: boltz_calc_also_dos 283 integer, public, save :: boltz_2d_dir_num 284 character(len=4), save :: boltz_2d_dir 285 real(kind=dp), public, save :: boltz_dos_energy_step 286 real(kind=dp), public, save :: boltz_dos_energy_min 287 real(kind=dp), public, save :: boltz_dos_energy_max 288 logical, public, save :: boltz_dos_adpt_smr 289 real(kind=dp), public, save :: boltz_dos_smr_fixed_en_width 290 real(kind=dp), public, save :: boltz_dos_adpt_smr_fac 291 real(kind=dp), public, save :: boltz_dos_adpt_smr_max 292 real(kind=dp), public, save :: boltz_mu_min 293 real(kind=dp), public, save :: boltz_mu_max 294 real(kind=dp), public, save :: boltz_mu_step 295 real(kind=dp), public, save :: boltz_temp_min 296 real(kind=dp), public, save :: boltz_temp_max 297 real(kind=dp), public, save :: boltz_temp_step 298 real(kind=dp), public, save :: boltz_kmesh_spacing 299 integer, public, save :: boltz_kmesh(3) 300 real(kind=dp), public, save :: boltz_tdf_energy_step 301 integer, public, save :: boltz_TDF_smr_index 302 integer, public, save :: boltz_dos_smr_index 303 real(kind=dp), public, save :: boltz_relax_time 304 real(kind=dp), public, save :: boltz_TDF_smr_fixed_en_width 305 logical, public, save :: boltz_bandshift 306 integer, public, save :: boltz_bandshift_firstband 307 real(kind=dp), public, save :: boltz_bandshift_energyshift 308 ! [gp-end, Apr 12, 2012] 309 310 logical, public, save :: transport 311 logical, public, save :: tran_easy_fix 312 character(len=20), public, save :: transport_mode 313 real(kind=dp), public, save :: tran_win_min 314 real(kind=dp), public, save :: tran_win_max 315 real(kind=dp), public, save :: tran_energy_step 316 integer, public, save :: tran_num_bb 317 integer, public, save :: tran_num_ll 318 integer, public, save :: tran_num_rr 319 integer, public, save :: tran_num_cc 320 integer, public, save :: tran_num_lc 321 integer, public, save :: tran_num_cr 322 integer, public, save :: tran_num_bandc 323 logical, public, save :: tran_write_ht 324 logical, public, save :: tran_read_ht 325 logical, public, save :: tran_use_same_lead 326 integer, public, save :: tran_num_cell_ll 327 integer, public, save :: tran_num_cell_rr 328 real(kind=dp), public, save :: tran_group_threshold 329 real(kind=dp), public, save :: translation_centre_frac(3) 330 integer, public, save :: num_shells 331 !! no longer an input keyword 332 logical, public, save :: skip_B1_tests 333 !! do not check the B1 condition 334 logical, public, save :: explicit_nnkpts 335 !! nnkpts block is in the input file (allowed only for post-proc setup) 336 integer, allocatable, public, save :: shell_list(:) 337 real(kind=dp), allocatable, public, save :: kpt_latt(:, :) 338 !! kpoints in lattice vecs 339 real(kind=dp), public, save :: real_lattice(3, 3) 340 logical, public, save :: postproc_setup 341 logical, public, save :: cp_pp 342 !! Car-Parinello post-proc flag/transport 343 344 logical, public, save :: calc_only_A 345 logical, public, save :: use_bloch_phases 346 character(len=20), public, save :: restart 347 logical, public, save :: write_r2mn 348 logical, public, save :: guiding_centres 349 integer, public, save :: num_guide_cycles 350 integer, public, save :: num_no_guide_iter 351 real(kind=dp), public, save :: fixed_step 352 real(kind=dp), public, save :: trial_step 353 logical, public, save :: precond 354 logical, public, save :: write_proj 355 integer, public, save :: timing_level 356 logical, public, save :: spinors !are our WF spinors? 357 integer, public, save :: num_elec_per_state 358 logical, public, save :: translate_home_cell 359 logical, public, save :: write_xyz 360 logical, public, save :: write_hr_diag 361 real(kind=dp), public, save :: conv_noise_amp 362 integer, public, save :: conv_noise_num 363 real(kind=dp), public, save :: wannier_plot_radius 364 real(kind=dp), public, save :: wannier_plot_scale 365 integer, public, save :: search_shells !for kmesh 366 real(kind=dp), public, save :: kmesh_tol 367 integer, public, save :: optimisation 368 ! aam: for WF-based calculation of vdW C6 coefficients 369 logical, public, save :: write_vdw_data 370 371 ! Restarts 372 real(kind=dp), public, save :: omega_invariant 373 character(len=20), public, save :: checkpoint 374 logical, public, save :: have_disentangled 375 376 ! Atom sites 377 real(kind=dp), allocatable, public, save :: atoms_pos_frac(:, :, :) 378 real(kind=dp), allocatable, public, save :: atoms_pos_cart(:, :, :) 379 integer, allocatable, public, save :: atoms_species_num(:) 380 character(len=maxlen), allocatable, public, save :: atoms_label(:) 381 character(len=2), allocatable, public, save :: atoms_symbol(:) 382 integer, public, save :: num_atoms 383 integer, public, save :: num_species 384 385 ! Projections 386 logical, public, save :: lhasproj 387 real(kind=dp), allocatable, public, save :: input_proj_site(:, :) 388 integer, allocatable, public, save :: input_proj_l(:) 389 integer, allocatable, public, save :: input_proj_m(:) 390 integer, allocatable, public, save :: input_proj_s(:) 391 real(kind=dp), allocatable, public, save :: input_proj_s_qaxis(:, :) 392 real(kind=dp), allocatable, public, save :: input_proj_z(:, :) 393 real(kind=dp), allocatable, public, save :: input_proj_x(:, :) 394 integer, allocatable, public, save :: input_proj_radial(:) 395 real(kind=dp), allocatable, public, save :: input_proj_zona(:) 396 real(kind=dp), allocatable, public, save :: proj_site(:, :) 397 integer, allocatable, public, save :: proj_l(:) 398 integer, allocatable, public, save :: proj_m(:) 399 integer, allocatable, public, save :: proj_s(:) 400 real(kind=dp), allocatable, public, save :: proj_s_qaxis(:, :) 401 real(kind=dp), allocatable, public, save :: proj_z(:, :) 402 real(kind=dp), allocatable, public, save :: proj_x(:, :) 403 integer, allocatable, public, save :: proj_radial(:) 404 real(kind=dp), allocatable, public, save :: proj_zona(:) 405 integer, public, save :: num_proj 406 ! projections selection 407 logical, public, save :: lselproj 408 integer, public, save :: num_select_projections 409 integer, allocatable, public, save :: select_projections(:) 410 integer, allocatable, public, save :: proj2wann_map(:) 411 ! a u t o m a t i c p r o j e c t i o n s 412 ! vv: Writes a new block in .nnkp 413 logical, public, save :: auto_projections 414 415 !parameters dervied from input 416 integer, public, save :: num_kpts 417 real(kind=dp), public, save :: recip_lattice(3, 3) 418 real(kind=dp), public, save :: cell_volume 419 real(kind=dp), public, save :: real_metric(3, 3) 420 real(kind=dp), public, save :: recip_metric(3, 3) 421 integer, public, save :: bands_num_spec_points 422 character(len=20), allocatable, public, save ::bands_label(:) 423 real(kind=dp), allocatable, public, save ::bands_spec_points(:, :) 424 real(kind=dp), allocatable, public, save ::kpt_cart(:, :) !kpoints in cartesians 425 logical, public, save :: disentanglement 426 real(kind=dp), public, save :: lenconfac 427 integer, public, save :: num_wannier_plot 428 integer, public, save :: num_bands_project 429 integer, public, save :: num_exclude_bands 430 logical, public, save :: lfixstep 431 432 ! kmesh parameters (set in kmesh) 433 434 integer, public, save :: nnh ! the number of b-directions (bka) 435 integer, public, save :: nntot ! total number of neighbours for each k-point 436 integer, public, save, allocatable :: nnlist(:, :) ! list of neighbours for each k-point 437 integer, public, save, allocatable :: neigh(:, :) 438 integer, public, save, allocatable :: nncell(:, :, :) ! gives BZ of each neighbour of each k-point 439 real(kind=dp), public, save :: wbtot 440 real(kind=dp), public, save, allocatable :: wb(:) ! weights associated with neighbours of each k-point 441 real(kind=dp), public, save, allocatable :: bk(:, :, :) ! the b-vectors that go from each k-point to its neighbours 442 real(kind=dp), public, save, allocatable :: bka(:, :) ! the b-directions from 1st k-point to its neighbours 443 444 ! disentangle parameters 445 integer, public, save, allocatable :: ndimwin(:) 446 logical, public, save, allocatable :: lwindow(:, :) 447 logical, public, save :: frozen_states 448 449 ! a_matrix and m_matrix_orig can be calculated internally from bloch states 450 ! or read in from an ab-initio grid 451 ! a_matrix = projection of trial orbitals on bloch states 452 ! m_matrix_orig = overlap of bloch states 453 454 complex(kind=dp), allocatable, save, public :: a_matrix(:, :, :) 455 complex(kind=dp), allocatable, save, public :: m_matrix_orig(:, :, :, :) 456 complex(kind=dp), allocatable, save, public :: m_matrix_orig_local(:, :, :, :) 457 real(kind=dp), allocatable, save, public :: eigval(:, :) 458 logical, save, public :: eig_found 459 460! $![ysl-b] 461! $ ! ph_g = phase factor of Bloch functions at Gamma 462! $ ! assuming that Bloch functions at Gamma are real except this phase factor 463! $ complex(kind=dp), allocatable, save, public :: ph_g(:) 464! $![ysl-e] 465 466 ! u_matrix_opt gives the num_wann dimension optimal subspace from the 467 ! original bloch states 468 469 complex(kind=dp), allocatable, save, public :: u_matrix_opt(:, :, :) 470 471 ! u_matrix gives the unitary rotations from the optimal subspace to the 472 ! optimally smooth states. 473 ! m_matrix we store here, becuase it is needed for restart of wannierise 474 475 complex(kind=dp), allocatable, save, public :: u_matrix(:, :, :) 476 complex(kind=dp), allocatable, save, public :: m_matrix(:, :, :, :) 477 complex(kind=dp), allocatable, save, public :: m_matrix_local(:, :, :, :) 478 479 ! RS: symmetry-adapted Wannier functions 480 logical, public, save :: lsitesymmetry = .false. 481 real(kind=dp), public, save :: symmetrize_eps = 1.d-3 482 483 ! The maximum number of shells we need to satisfy B1 condition in kmesh 484 integer, parameter, public :: max_shells = 6 485 integer, parameter, public :: num_nnmax = 12 486 487 ! Are we running as a library 488 logical, save, public :: library = .false. 489 490 ! Are we running postw90? 491 logical, save, public :: ispostw90 = .false. 492 493 ! IVO 494 ! Are we running postw90 starting from an effective model? 495 logical, save, public :: effective_model = .false. 496 497 ! Wannier centres and spreads 498 real(kind=dp), public, save, allocatable :: wannier_centres(:, :) 499 real(kind=dp), public, save, allocatable :: wannier_spreads(:) 500 real(kind=dp), public, save :: omega_total 501 real(kind=dp), public, save :: omega_tilde 502 ! [ omega_invariant is declared above ] 503 504 ! For Hamiltonian matrix in WF representation 505 logical, public, save :: automatic_translation 506 integer, public, save :: one_dim_dir 507 508 ! Private data 509 integer :: num_lines 510 character(len=maxlen), allocatable :: in_data(:) 511 character(len=maxlen) :: ctmp 512 logical :: ltmp 513 ! AAM_2016-09-15: hr_plot is a deprecated input parameter. Replaced by write_hr. 514 logical :: hr_plot 515 516 public :: param_read 517 public :: param_write 518 public :: param_postw90_write 519 public :: param_dealloc 520 public :: param_write_header 521 public :: param_write_chkpt 522 public :: param_read_chkpt 523 public :: param_lib_set_atoms 524 public :: param_memory_estimate 525 public :: param_get_smearing_type 526 public :: param_get_convention_type 527 public :: param_dist 528 public :: param_chkpt_dist 529 530contains 531 532 !==================================================================! 533 subroutine param_read() 534 !==================================================================! 535 ! ! 536 !! Read parameters and calculate derived values 537 !! 538 !! Note on parallelization: this function should be called 539 !! from the root node only! 540 !! 541 ! ! 542 !=================================================================== 543 use w90_constants, only: bohr, eps6, cmplx_i 544 use w90_utility, only: utility_recip_lattice, utility_metric 545 use w90_io, only: io_error, io_file_unit, seedname, post_proc_flag 546 implicit none 547 548 !local variables 549 real(kind=dp) :: real_lattice_tmp(3, 3) 550 integer :: nkp, i, j, n, k, itmp, i_temp, i_temp2, eig_unit, loop, ierr, iv_temp(3), rows 551 logical :: found, found2, lunits, chk_found 552 character(len=6) :: spin_str 553 real(kind=dp) :: cosa(3), rv_temp(3) 554 integer, allocatable, dimension(:, :) :: nnkpts_block 555 integer, allocatable, dimension(:) :: nnkpts_idx 556 557 call param_in_file 558 559 !%%%%%%%%%%%%%%%% 560 ! Site symmetry 561 !%%%%%%%%%%%%%%%% 562 563 ! default value is lsitesymmetry=.false. 564 call param_get_keyword('site_symmetry', found, l_value=lsitesymmetry)!YN: 565 566 ! default value is symmetrize_eps=0.001 567 call param_get_keyword('symmetrize_eps', found, r_value=symmetrize_eps)!YN: 568 569 !%%%%%%%%%%%%%%%% 570 ! Transport 571 !%%%%%%%%%%%%%%%% 572 573 transport = .false. 574 call param_get_keyword('transport', found, l_value=transport) 575 576 tran_read_ht = .false. 577 call param_get_keyword('tran_read_ht', found, l_value=tran_read_ht) 578 579 tran_easy_fix = .false. 580 call param_get_keyword('tran_easy_fix', found, l_value=tran_easy_fix) 581 582 if (transport .and. tran_read_ht) restart = ' ' 583 584 !%%%%%%%%%%%%%%%% 585 !System variables 586 !%%%%%%%%%%%%%%%% 587 588 timing_level = 1 ! Verbosity of timing output info 589 call param_get_keyword('timing_level', found, i_value=timing_level) 590 591 iprint = 1 ! Verbosity 592 call param_get_keyword('iprint', found, i_value=iprint) 593 594 optimisation = 3 ! Verbosity 595 call param_get_keyword('optimisation', found, i_value=optimisation) 596 597 if (transport .and. tran_read_ht) goto 301 598 599 !ivo 600 call param_get_keyword('effective_model', found, l_value=effective_model) 601 602 energy_unit = 'ev' ! 603 call param_get_keyword('energy_unit', found, c_value=energy_unit) 604 605 length_unit = 'ang' ! 606 lenconfac = 1.0_dp 607 call param_get_keyword('length_unit', found, c_value=length_unit) 608 if (length_unit .ne. 'ang' .and. length_unit .ne. 'bohr') & 609 call io_error('Error: value of length_unit not recognised in param_read') 610 if (length_unit .eq. 'bohr') lenconfac = 1.0_dp/bohr 611 612 wvfn_formatted = .false. ! formatted or "binary" file 613 call param_get_keyword('wvfn_formatted', found, l_value=wvfn_formatted) 614 615 spn_formatted = .false. ! formatted or "binary" file 616 call param_get_keyword('spn_formatted', found, l_value=spn_formatted) 617 618 uHu_formatted = .false. ! formatted or "binary" file 619 call param_get_keyword('uhu_formatted', found, l_value=uHu_formatted) 620 621 spin = 1 622 call param_get_keyword('spin', found, c_value=spin_str) 623 if (found) then 624 if (index(spin_str, 'up') > 0) then 625 spin = 1 626 elseif (index(spin_str, 'down') > 0) then 627 spin = 2 628 else 629 call io_error('Error: unrecognised value of spin found: '//trim(spin_str)) 630 end if 631 end if 632 633 num_wann = -99 634 call param_get_keyword('num_wann', found, i_value=num_wann) 635 if (.not. found) call io_error('Error: You must specify num_wann') 636 if (num_wann <= 0) call io_error('Error: num_wann must be greater than zero') 637 638 num_exclude_bands = 0 639 call param_get_range_vector('exclude_bands', found, num_exclude_bands, lcount=.true.) 640 if (found) then 641 if (num_exclude_bands < 1) call io_error('Error: problem reading exclude_bands') 642 if (allocated(exclude_bands)) deallocate (exclude_bands) 643 allocate (exclude_bands(num_exclude_bands), stat=ierr) 644 if (ierr /= 0) call io_error('Error allocating exclude_bands in param_read') 645 call param_get_range_vector('exclude_bands', found, num_exclude_bands, .false., exclude_bands) 646 if (any(exclude_bands < 1)) & 647 call io_error('Error: exclude_bands must contain positive numbers') 648 end if 649 650 ! AAM_2016-09-16: some changes to logic to patch a problem with uninitialised num_bands in library mode 651! num_bands = -1 652 call param_get_keyword('num_bands', found, i_value=i_temp) 653 if (found .and. library) write (stdout, '(/a)') ' Ignoring <num_bands> in input file' 654 if (.not. library .and. .not. effective_model) then 655 if (found) num_bands = i_temp 656 if (.not. found) num_bands = num_wann 657 end if 658 ! GP: I subtract it here, but only the first time when I pass the total number of bands 659 ! In later calls, I need to pass instead num_bands already subtracted. 660 if (library .and. library_param_read_first_pass) num_bands = num_bands - num_exclude_bands 661 if (.not. effective_model) then 662 if (found .and. num_bands < num_wann) then 663 write (stdout, *) 'num_bands', num_bands 664 write (stdout, *) 'num_wann', num_wann 665 call io_error('Error: num_bands must be greater than or equal to num_wann') 666 endif 667 endif 668 669 num_dump_cycles = 100 ! frequency to write backups at 670 call param_get_keyword('num_dump_cycles', found, i_value=num_dump_cycles) 671 if (num_dump_cycles < 0) call io_error('Error: num_dump_cycles must be positive') 672 673 num_print_cycles = 1 ! frequency to write at 674 call param_get_keyword('num_print_cycles', found, i_value=num_print_cycles) 675 if (num_print_cycles < 0) call io_error('Error: num_print_cycles must be positive') 676 677 devel_flag = ' ' ! 678 call param_get_keyword('devel_flag', found, c_value=devel_flag) 679 680! mp_grid=-99 681 call param_get_keyword_vector('mp_grid', found, 3, i_value=iv_temp) 682 if (found .and. library) write (stdout, '(a)') ' Ignoring <mp_grid> in input file' 683 if (.not. library .and. .not. effective_model) then 684 if (found) mp_grid = iv_temp 685 if (.not. found) then 686 call io_error('Error: You must specify dimensions of the Monkhorst-Pack grid by setting mp_grid') 687 elseif (any(mp_grid < 1)) then 688 call io_error('Error: mp_grid must be greater than zero') 689 end if 690 num_kpts = mp_grid(1)*mp_grid(2)*mp_grid(3) 691 end if 692 693![ysl-b] 694 ltmp = .false. 695 call param_get_keyword('gamma_only', found, l_value=ltmp) 696 if (.not. library) then 697 gamma_only = ltmp 698 if (gamma_only .and. (num_kpts .ne. 1)) & 699 call io_error('Error: gamma_only is true, but num_kpts > 1') 700 else 701 if (found) write (stdout, '(a)') ' Ignoring <gamma_only> in input file' 702 endif 703![ysl-e] 704 705! aam: automatic_mp_grid no longer used 706! automatic_mp_grid = .false. 707! call param_get_keyword('automatic_mp_grid',found,l_value=automatic_mp_grid) 708 709 postproc_setup = .false. ! set to true to write .nnkp file and exit 710 call param_get_keyword('postproc_setup', found, l_value=postproc_setup) 711 ! We allow this keyword to be overriden by a command line arg -pp 712 if (post_proc_flag) postproc_setup = .true. 713 714 cp_pp = .false. ! set to true if doing CP post-processing 715 call param_get_keyword('cp_pp', found, l_value=cp_pp) 716 717 calc_only_A = .false. 718 call param_get_keyword('calc_only_A', found, l_value=calc_only_A) 719 720 restart = ' ' 721 call param_get_keyword('restart', found, c_value=restart) 722 if (found) then 723 if ((restart .ne. 'default') .and. (restart .ne. 'wannierise') & 724 .and. (restart .ne. 'plot') .and. (restart .ne. 'transport')) then 725 call io_error('Error in input file: value of restart not recognised') 726 else 727 inquire (file=trim(seedname)//'.chk', exist=chk_found) 728 if (.not. chk_found) & 729 call io_error('Error: restart requested but '//trim(seedname)//'.chk file not found') 730 endif 731 endif 732 !post processing takes priority (user is not warned of this) 733 if (postproc_setup) restart = ' ' 734 735 write_r2mn = .false. 736 call param_get_keyword('write_r2mn', found, l_value=write_r2mn) 737 738 write_proj = .false. 739 call param_get_keyword('write_proj', found, l_value=write_proj) 740 741 ltmp = .false. ! by default our WF are not spinors 742 call param_get_keyword('spinors', found, l_value=ltmp) 743 if (.not. library) then 744 spinors = ltmp 745 else 746 if (found) write (stdout, '(a)') ' Ignoring <spinors> in input file' 747 endif 748! if(spinors .and. (2*(num_wann/2))/=num_wann) & 749! call io_error('Error: For spinor WF num_wann must be even') 750 751 ! We need to know if the bands are double degenerate due to spin, e.g. when 752 ! calculating the DOS 753 if (spinors) then 754 num_elec_per_state = 1 755 else 756 num_elec_per_state = 2 757 endif 758 call param_get_keyword('num_elec_per_state', found, i_value=num_elec_per_state) 759 if ((num_elec_per_state /= 1) .and. (num_elec_per_state /= 2)) & 760 call io_error('Error: num_elec_per_state can be only 1 or 2') 761 if (spinors .and. num_elec_per_state /= 1) & 762 call io_error('Error: when spinors = T num_elec_per_state must be 1') 763 764 translate_home_cell = .false. 765 call param_get_keyword('translate_home_cell', found, l_value=translate_home_cell) 766 767 write_xyz = .false. 768 call param_get_keyword('write_xyz', found, l_value=write_xyz) 769 770 write_hr_diag = .false. 771 call param_get_keyword('write_hr_diag', found, l_value=write_hr_diag) 772 773 !%%%%%%%%%%% 774 ! Wannierise 775 !%%%%%%%%%%% 776 777 num_iter = 100 778 call param_get_keyword('num_iter', found, i_value=num_iter) 779 if (num_iter < 0) call io_error('Error: num_iter must be positive') 780 781 num_cg_steps = 5 782 call param_get_keyword('num_cg_steps', found, i_value=num_cg_steps) 783 if (num_cg_steps < 0) call io_error('Error: num_cg_steps must be positive') 784 785 conv_tol = 1.0e-10_dp 786 call param_get_keyword('conv_tol', found, r_value=conv_tol) 787 if (conv_tol < 0.0_dp) call io_error('Error: conv_tol must be positive') 788 789 conv_noise_amp = -1.0_dp 790 call param_get_keyword('conv_noise_amp', found, r_value=conv_noise_amp) 791 792 conv_window = -1 793 if (conv_noise_amp > 0.0_dp) conv_window = 5 794 call param_get_keyword('conv_window', found, i_value=conv_window) 795 796 conv_noise_num = 3 797 call param_get_keyword('conv_noise_num', found, i_value=conv_noise_num) 798 if (conv_noise_num < 0) call io_error('Error: conv_noise_num must be positive') 799 800 guiding_centres = .false. 801 call param_get_keyword('guiding_centres', found, l_value=guiding_centres) 802 803 num_guide_cycles = 1 804 call param_get_keyword('num_guide_cycles', found, i_value=num_guide_cycles) 805 if (num_guide_cycles < 0) call io_error('Error: num_guide_cycles must be >= 0') 806 807 num_no_guide_iter = 0 808 call param_get_keyword('num_no_guide_iter', found, i_value=num_no_guide_iter) 809 if (num_no_guide_iter < 0) call io_error('Error: num_no_guide_iter must be >= 0') 810 811 fixed_step = -999.0_dp; lfixstep = .false. 812 call param_get_keyword('fixed_step', found, r_value=fixed_step) 813 if (found .and. (fixed_step < 0.0_dp)) call io_error('Error: fixed_step must be > 0') 814 if (fixed_step > 0.0_dp) lfixstep = .true. 815 816 trial_step = 2.0_dp 817 call param_get_keyword('trial_step', found, r_value=trial_step) 818 if (found .and. lfixstep) call io_error('Error: cannot specify both fixed_step and trial_step') 819 820 precond = .false. 821 call param_get_keyword('precond', found, l_value=precond) 822 823 slwf_num = num_wann 824 selective_loc = .false. 825 call param_get_keyword('slwf_num', found, i_value=slwf_num) 826 if (found) then 827 if (slwf_num .gt. num_wann .or. slwf_num .lt. 1) then 828 call io_error('Error: slwf_num must be an integer between 1 and num_wann') 829 end if 830 if (slwf_num .lt. num_wann) selective_loc = .true. 831 end if 832 833 slwf_constrain = .false. 834 call param_get_keyword('slwf_constrain', found, l_value=slwf_constrain) 835 if (found .and. slwf_constrain) then 836 if (selective_loc) then 837 allocate (ccentres_frac(num_wann, 3), stat=ierr) 838 if (ierr /= 0) call io_error('Error allocating ccentres_frac in param_get_centre_constraints') 839 allocate (ccentres_cart(num_wann, 3), stat=ierr) 840 if (ierr /= 0) call io_error('Error allocating ccentres_cart in param_get_centre_constraints') 841 else 842 write (stdout, *) ' No selective localisation requested. Ignoring constraints on centres' 843 slwf_constrain = .false. 844 end if 845 end if 846 847 slwf_lambda = 1.0_dp 848 call param_get_keyword('slwf_lambda', found, r_value=slwf_lambda) 849 if (found) then 850 if (slwf_lambda < 0.0_dp) call io_error('Error: slwf_lambda must be positive.') 851 endif 852 853 !%%%%%%%%% 854 ! Plotting 855 !%%%%%%%%% 856 857 wannier_plot = .false. 858 call param_get_keyword('wannier_plot', found, l_value=wannier_plot) 859 860 wannier_plot_supercell = 2 861 862 call param_get_vector_length('wannier_plot_supercell', found, length=i) 863 if (found) then 864 if (i .eq. 1) then 865 call param_get_keyword_vector('wannier_plot_supercell', found, 1, & 866 i_value=wannier_plot_supercell) 867 wannier_plot_supercell(2) = wannier_plot_supercell(1) 868 wannier_plot_supercell(3) = wannier_plot_supercell(1) 869 elseif (i .eq. 3) then 870 call param_get_keyword_vector('wannier_plot_supercell', found, 3, & 871 i_value=wannier_plot_supercell) 872 else 873 call io_error('Error: wannier_plot_supercell must be provided as either one integer or a vector of three integers') 874 end if 875 if (any(wannier_plot_supercell <= 0)) & 876 call io_error('Error: wannier_plot_supercell elements must be greater than zero') 877 end if 878 879 wannier_plot_format = 'xcrysden' 880 call param_get_keyword('wannier_plot_format', found, c_value=wannier_plot_format) 881 882 wannier_plot_mode = 'crystal' 883 call param_get_keyword('wannier_plot_mode', found, c_value=wannier_plot_mode) 884 885 wannier_plot_spinor_mode = 'total' 886 call param_get_keyword('wannier_plot_spinor_mode', found, c_value=wannier_plot_spinor_mode) 887 wannier_plot_spinor_phase = .true. 888 call param_get_keyword('wannier_plot_spinor_phase', found, l_value=wannier_plot_spinor_phase) 889 890 call param_get_range_vector('wannier_plot_list', found, num_wannier_plot, lcount=.true.) 891 if (found) then 892 if (num_wannier_plot < 1) call io_error('Error: problem reading wannier_plot_list') 893 if (allocated(wannier_plot_list)) deallocate (wannier_plot_list) 894 allocate (wannier_plot_list(num_wannier_plot), stat=ierr) 895 if (ierr /= 0) call io_error('Error allocating wannier_plot_list in param_read') 896 call param_get_range_vector('wannier_plot_list', found, num_wannier_plot, .false., wannier_plot_list) 897 if (any(wannier_plot_list < 1) .or. any(wannier_plot_list > num_wann)) & 898 call io_error('Error: wannier_plot_list asks for a non-valid wannier function to be plotted') 899 else 900 ! we plot all wannier functions 901 num_wannier_plot = num_wann 902 if (allocated(wannier_plot_list)) deallocate (wannier_plot_list) 903 allocate (wannier_plot_list(num_wannier_plot), stat=ierr) 904 if (ierr /= 0) call io_error('Error allocating wannier_plot_list in param_read') 905 do loop = 1, num_wann 906 wannier_plot_list(loop) = loop 907 end do 908 end if 909 910 wannier_plot_radius = 3.5_dp 911 call param_get_keyword('wannier_plot_radius', found, r_value=wannier_plot_radius) 912 913 wannier_plot_scale = 1.0_dp 914 call param_get_keyword('wannier_plot_scale', found, r_value=wannier_plot_scale) 915 916 ! checks 917 if (wannier_plot) then 918 if ((index(wannier_plot_format, 'xcrys') .eq. 0) .and. (index(wannier_plot_format, 'cub') .eq. 0)) & 919 call io_error('Error: wannier_plot_format not recognised') 920 if ((index(wannier_plot_mode, 'crys') .eq. 0) .and. (index(wannier_plot_mode, 'mol') .eq. 0)) & 921 call io_error('Error: wannier_plot_mode not recognised') 922 if ((index(wannier_plot_spinor_mode, 'total') .eq. 0) .and. (index(wannier_plot_spinor_mode, 'up') .eq. 0) & 923 .and. (index(wannier_plot_spinor_mode, 'down') .eq. 0)) & 924 call io_error('Error: wannier_plot_spinor_mode not recognised') 925 if (wannier_plot_radius < 0.0_dp) call io_error('Error: wannier_plot_radius must be positive') 926 if (wannier_plot_scale < 0.0_dp) call io_error('Error: wannier_plot_scale must be positive') 927 endif 928 929 write_u_matrices = .false. 930 call param_get_keyword('write_u_matrices', found, l_value=write_u_matrices) 931 932 bands_plot = .false. 933 call param_get_keyword('bands_plot', found, l_value=bands_plot) 934 935 write_bvec = .false. 936 call param_get_keyword('write_bvec', found, l_value=write_bvec) 937 938 bands_num_points = 100 939 call param_get_keyword('bands_num_points', found, i_value=bands_num_points) 940 941 bands_plot_format = 'gnuplot' 942 call param_get_keyword('bands_plot_format', found, c_value=bands_plot_format) 943 944 bands_plot_mode = 's-k' 945 call param_get_keyword('bands_plot_mode', found, c_value=bands_plot_mode) 946 947 bands_plot_dim = 3 948 call param_get_keyword('bands_plot_dim', found, i_value=bands_plot_dim) 949 950 num_bands_project = 0 951 call param_get_range_vector('bands_plot_project', found, num_bands_project, lcount=.true.) 952 if (found) then 953 if (num_bands_project < 1) call io_error('Error: problem reading bands_plot_project') 954 if (allocated(bands_plot_project)) deallocate (bands_plot_project) 955 allocate (bands_plot_project(num_bands_project), stat=ierr) 956 if (ierr /= 0) call io_error('Error allocating bands_plot_project in param_read') 957 call param_get_range_vector('bands_plot_project', found, num_bands_project, .false., bands_plot_project) 958 if (any(bands_plot_project < 1) .or. any(bands_plot_project > num_wann)) & 959 call io_error('Error: bands_plot_project asks for a non-valid wannier function to be projected') 960 endif 961 962 bands_num_spec_points = 0 963 call param_get_block_length('kpoint_path', found, i_temp) 964 if (found) then 965 bands_num_spec_points = i_temp*2 966 if (allocated(bands_label)) deallocate (bands_label) 967 allocate (bands_label(bands_num_spec_points), stat=ierr) 968 if (ierr /= 0) call io_error('Error allocating bands_label in param_read') 969 if (allocated(bands_spec_points)) deallocate (bands_spec_points) 970 allocate (bands_spec_points(3, bands_num_spec_points), stat=ierr) 971 if (ierr /= 0) call io_error('Error allocating bands_spec_points in param_read') 972 call param_get_keyword_kpath 973 end if 974 if (.not. found .and. bands_plot) & 975 call io_error('A bandstructure plot has been requested but there is no kpoint_path block') 976 977 ! checks 978 if (bands_plot) then 979 if ((index(bands_plot_format, 'gnu') .eq. 0) .and. (index(bands_plot_format, 'xmgr') .eq. 0)) & 980 call io_error('Error: bands_plot_format not recognised') 981 if ((index(bands_plot_mode, 's-k') .eq. 0) .and. (index(bands_plot_mode, 'cut') .eq. 0)) & 982 call io_error('Error: bands_plot_mode not recognised') 983 if (bands_num_points < 0) call io_error('Error: bands_num_points must be positive') 984 endif 985 986 fermi_surface_plot = .false. 987 call param_get_keyword('fermi_surface_plot', found, l_value=fermi_surface_plot) 988 989 fermi_surface_num_points = 50 990 call param_get_keyword('fermi_surface_num_points', found, i_value=fermi_surface_num_points) 991 992 fermi_surface_plot_format = 'xcrysden' 993 call param_get_keyword('fermi_surface_plot_format', & 994 found, c_value=fermi_surface_plot_format) 995 996 nfermi = 0 997 found_fermi_energy = .false. 998 call param_get_keyword('fermi_energy', found, r_value=fermi_energy) 999 if (found) then 1000 found_fermi_energy = .true. 1001 nfermi = 1 1002 endif 1003 ! 1004 fermi_energy_scan = .false. 1005 call param_get_keyword('fermi_energy_min', found, r_value=fermi_energy_min) 1006 if (found) then 1007 if (found_fermi_energy) call io_error( & 1008 'Error: Cannot specify both fermi_energy and fermi_energy_min') 1009 fermi_energy_scan = .true. 1010 fermi_energy_max = fermi_energy_min + 1.0_dp 1011 call param_get_keyword('fermi_energy_max', found, & 1012 r_value=fermi_energy_max) 1013 if (found .and. fermi_energy_max <= fermi_energy_min) call io_error( & 1014 'Error: fermi_energy_max must be larger than fermi_energy_min') 1015 fermi_energy_step = 0.01_dp 1016 call param_get_keyword('fermi_energy_step', found, & 1017 r_value=fermi_energy_step) 1018 if (found .and. fermi_energy_step <= 0.0_dp) call io_error( & 1019 'Error: fermi_energy_step must be positive') 1020 nfermi = nint(abs((fermi_energy_max - fermi_energy_min)/fermi_energy_step)) + 1 1021 endif 1022 ! 1023 if (found_fermi_energy) then 1024 if (allocated(fermi_energy_list)) deallocate (fermi_energy_list) 1025 allocate (fermi_energy_list(1), stat=ierr) 1026 fermi_energy_list(1) = fermi_energy 1027 elseif (fermi_energy_scan) then 1028 if (nfermi .eq. 1) then 1029 fermi_energy_step = 0.0_dp 1030 else 1031 fermi_energy_step = (fermi_energy_max - fermi_energy_min)/real(nfermi - 1, dp) 1032 endif 1033 if (allocated(fermi_energy_list)) deallocate (fermi_energy_list) 1034 allocate (fermi_energy_list(nfermi), stat=ierr) 1035 do i = 1, nfermi 1036 fermi_energy_list(i) = fermi_energy_min + (i - 1)*fermi_energy_step 1037 enddo 1038!! elseif(nfermi==0) then 1039!! ! This happens when both found_fermi_energy=.false. and 1040!! ! fermi_energy_scan=.false. Functionalities that require 1041!! ! specifying a Fermi level should give an error message 1042!! allocate(fermi_energy_list(1),stat=ierr) ! helps streamline things 1043!! 1044!! AAM_2017-03-27: if nfermi is zero (ie, fermi_energy* parameters are not set in input file) 1045!! then allocate fermi_energy_list with length 1 and set to zero as default. 1046 else 1047 if (allocated(fermi_energy_list)) deallocate (fermi_energy_list) 1048 allocate (fermi_energy_list(1), stat=ierr) 1049 fermi_energy_list(1) = 0.0_dp 1050 endif 1051 if (ierr /= 0) call io_error( & 1052 'Error allocating fermi_energy_list in param_read') 1053 1054 ! checks 1055 if (fermi_surface_plot) then 1056 if ((index(fermi_surface_plot_format, 'xcrys') .eq. 0)) & 1057 call io_error('Error: fermi_surface_plot_format not recognised') 1058 if (fermi_surface_num_points < 0) & 1059 call io_error('Error: fermi_surface_num_points must be positive') 1060 endif 1061 1062 kslice = .false. 1063 call param_get_keyword('kslice', found, l_value=kslice) 1064 1065 kslice_task = 'fermi_lines' 1066 call param_get_keyword('kslice_task', found, c_value=kslice_task) 1067 if (kslice .and. index(kslice_task, 'fermi_lines') == 0 .and. & 1068 index(kslice_task, 'curv') == 0 .and. & 1069 index(kslice_task, 'morb') == 0 .and. & 1070 index(kslice_task, 'shc') == 0) call io_error & 1071 ('Error: value of kslice_task not recognised in param_read') 1072 if (kslice .and. index(kslice_task, 'curv') > 0 .and. & 1073 index(kslice_task, 'morb') > 0) call io_error & 1074 ("Error: kslice_task cannot include both 'curv' and 'morb'") 1075 if (kslice .and. index(kslice_task, 'shc') > 0 .and. & 1076 index(kslice_task, 'morb') > 0) call io_error & 1077 ("Error: kslice_task cannot include both 'shc' and 'morb'") 1078 if (kslice .and. index(kslice_task, 'shc') > 0 .and. & 1079 index(kslice_task, 'curv') > 0) call io_error & 1080 ("Error: kslice_task cannot include both 'shc' and 'curv'") 1081 1082 kslice_2dkmesh(1:2) = 50 1083 call param_get_vector_length('kslice_2dkmesh', found, length=i) 1084 if (found) then 1085 if (i == 1) then 1086 call param_get_keyword_vector('kslice_2dkmesh', found, 1, & 1087 i_value=kslice_2dkmesh) 1088 kslice_2dkmesh(2) = kslice_2dkmesh(1) 1089 elseif (i == 2) then 1090 call param_get_keyword_vector('kslice_2dkmesh', found, 2, & 1091 i_value=kslice_2dkmesh) 1092 else 1093 call io_error('Error: kslice_2dkmesh must be provided as either' & 1094 //' one integer or a vector of two integers') 1095 endif 1096 if (any(kslice_2dkmesh <= 0)) & 1097 call io_error('Error: kslice_2dkmesh elements must be' & 1098 //' greater than zero') 1099 endif 1100 1101 kslice_corner = 0.0_dp 1102 call param_get_keyword_vector('kslice_corner', found, 3, r_value=kslice_corner) 1103 1104 kslice_b1(1) = 1.0_dp 1105 kslice_b1(2) = 0.0_dp 1106 kslice_b1(3) = 0.0_dp 1107 call param_get_keyword_vector('kslice_b1', found, 3, r_value=kslice_b1) 1108 1109 kslice_b2(1) = 0.0_dp 1110 kslice_b2(2) = 1.0_dp 1111 kslice_b2(3) = 0.0_dp 1112 call param_get_keyword_vector('kslice_b2', found, 3, r_value=kslice_b2) 1113 1114 kslice_fermi_lines_colour = 'none' 1115 call param_get_keyword('kslice_fermi_lines_colour', found, & 1116 c_value=kslice_fermi_lines_colour) 1117 if (kslice .and. index(kslice_fermi_lines_colour, 'none') == 0 .and. & 1118 index(kslice_fermi_lines_colour, 'spin') == 0) call io_error & 1119 ('Error: value of kslice_fermi_lines_colour not recognised ' & 1120 //'in param_read') 1121 1122! slice_plot_format = 'plotmv' 1123! call param_get_keyword('slice_plot_format',found,c_value=slice_plot_format) 1124 1125 ! [gp-begin, Apr 20, 2012] 1126 1127 ! By default: Gaussian 1128 smr_index = 0 1129 call param_get_keyword('smr_type', found, c_value=ctmp) 1130 if (found) smr_index = get_smearing_index(ctmp, 'smr_type') 1131 1132 ! By default: adaptive smearing 1133 adpt_smr = .true. 1134 call param_get_keyword('adpt_smr', found, l_value=adpt_smr) 1135 1136 ! By default: a=sqrt(2) 1137 adpt_smr_fac = sqrt(2.0_dp) 1138 call param_get_keyword('adpt_smr_fac', found, r_value=adpt_smr_fac) 1139 if (found .and. (adpt_smr_fac <= 0._dp)) & 1140 call io_error('Error: adpt_smr_fac must be greater than zero') 1141 1142 ! By default: 1 eV 1143 adpt_smr_max = 1.0_dp 1144 call param_get_keyword('adpt_smr_max', found, r_value=adpt_smr_max) 1145 if (adpt_smr_max <= 0._dp) & 1146 call io_error('Error: adpt_smr_max must be greater than zero') 1147 1148 ! By default: if adpt_smr is manually set to false by the user, but he/she doesn't 1149 ! define smr_fixed_en_width: NO smearing, i.e. just the histogram 1150 smr_fixed_en_width = 0.0_dp 1151 call param_get_keyword('smr_fixed_en_width', found, r_value=smr_fixed_en_width) 1152 if (found .and. (smr_fixed_en_width < 0._dp)) & 1153 call io_error('Error: smr_fixed_en_width must be greater than or equal to zero') 1154 ! [gp-end] 1155 1156 !IVO 1157 1158 dos = .false. 1159 call param_get_keyword('dos', found, l_value=dos) 1160 1161 berry = .false. 1162 call param_get_keyword('berry', found, l_value=berry) 1163 1164 transl_inv = .false. 1165 call param_get_keyword('transl_inv', found, l_value=transl_inv) 1166 1167 berry_task = ' ' 1168 call param_get_keyword('berry_task', found, c_value=berry_task) 1169 if (berry .and. .not. found) call io_error & 1170 ('Error: berry=T and berry_task is not set') 1171 if (berry .and. index(berry_task, 'ahc') == 0 .and. index(berry_task, 'morb') == 0 & 1172 .and. index(berry_task, 'kubo') == 0 .and. index(berry_task, 'sc') == 0 & 1173 .and. index(berry_task, 'shc') == 0) call io_error & 1174 ('Error: value of berry_task not recognised in param_read') 1175 1176 ! Stepan 1177 gyrotropic = .false. 1178 call param_get_keyword('gyrotropic', found, l_value=gyrotropic) 1179 gyrotropic_task = 'all' 1180 call param_get_keyword('gyrotropic_task', found, c_value=gyrotropic_task) 1181 gyrotropic_box(:, :) = 0.0 1182 gyrotropic_degen_thresh = 0.0_dp 1183 call param_get_keyword('gyrotropic_degen_thresh', found, r_value=gyrotropic_degen_thresh) 1184 1185 do i = 1, 3 1186 gyrotropic_box(i, i) = 1.0_dp 1187 gyrotropic_box_tmp(:) = 0.0_dp 1188 call param_get_keyword_vector('gyrotropic_box_b'//achar(48 + i), found, 3, r_value=gyrotropic_box_tmp) 1189 if (found) gyrotropic_box(i, :) = gyrotropic_box_tmp(:) 1190 enddo 1191 gyrotropic_box_corner(:) = 0.0_dp 1192 call param_get_keyword_vector('gyrotropic_box_center', found, 3, r_value=gyrotropic_box_tmp) 1193 if (found) gyrotropic_box_corner(:) = & 1194 gyrotropic_box_tmp(:) - 0.5*(gyrotropic_box(1, :) + gyrotropic_box(2, :) + gyrotropic_box(3, :)) 1195 1196 call param_get_range_vector('gyrotropic_band_list', found, gyrotropic_num_bands, lcount=.true.) 1197 if (found) then 1198 if (gyrotropic_num_bands < 1) call io_error('Error: problem reading gyrotropic_band_list') 1199 if (allocated(gyrotropic_band_list)) deallocate (gyrotropic_band_list) 1200 allocate (gyrotropic_band_list(gyrotropic_num_bands), stat=ierr) 1201 if (ierr /= 0) call io_error('Error allocating gyrotropic_band_list in param_read') 1202 call param_get_range_vector('gyrotropic_band_list', found, gyrotropic_num_bands, .false., gyrotropic_band_list) 1203 if (any(gyrotropic_band_list < 1) .or. any(gyrotropic_band_list > num_wann)) & 1204 call io_error('Error: gyrotropic_band_list asks for a non-valid bands') 1205 else 1206 ! include all bands in the calculation 1207 gyrotropic_num_bands = num_wann 1208 if (allocated(gyrotropic_band_list)) deallocate (gyrotropic_band_list) 1209 allocate (gyrotropic_band_list(gyrotropic_num_bands), stat=ierr) 1210 if (ierr /= 0) call io_error('Error allocating gyrotropic_band_list in param_read') 1211 do loop = 1, num_wann 1212 gyrotropic_band_list(loop) = loop 1213 end do 1214 end if 1215 1216 smr_max_arg = 5.0 1217 call param_get_keyword('smr_max_arg', found, r_value=smr_max_arg) 1218 if (found .and. (smr_max_arg <= 0._dp)) & 1219 call io_error('Error: smr_max_arg must be greater than zero') 1220 1221 gyrotropic_smr_max_arg = smr_max_arg 1222 call param_get_keyword('gyrotropic_smr_max_arg', found, & 1223 r_value=gyrotropic_smr_max_arg) 1224 if (found .and. (gyrotropic_smr_max_arg <= 0._dp)) call io_error & 1225 ('Error: gyrotropic_smr_max_arg must be greater than zero') 1226 1227!------------------------------------------------------- 1228! alpha=0 1229! call param_get_keyword('alpha',found,i_value=alpha) 1230 1231! beta=0 1232! call param_get_keyword('beta',found,i_value=beta) 1233 1234! gamma=0 1235! call param_get_keyword('gamma',found,i_value=gamma) 1236!------------------------------------------------------- 1237 1238 berry_curv_adpt_kmesh = 1 1239 call param_get_keyword('berry_curv_adpt_kmesh', found, & 1240 i_value=berry_curv_adpt_kmesh) 1241 if (berry_curv_adpt_kmesh < 1) & 1242 call io_error( & 1243 'Error: berry_curv_adpt_kmesh must be a positive integer') 1244 1245 berry_curv_adpt_kmesh_thresh = 100.0_dp 1246 call param_get_keyword('berry_curv_adpt_kmesh_thresh', found, & 1247 r_value=berry_curv_adpt_kmesh_thresh) 1248 1249 berry_curv_unit = 'ang2' 1250 call param_get_keyword('berry_curv_unit', found, c_value=berry_curv_unit) 1251 if (berry_curv_unit .ne. 'ang2' .and. berry_curv_unit .ne. 'bohr2') & 1252 call io_error & 1253 ('Error: value of berry_curv_unit not recognised in param_read') 1254 1255 wanint_kpoint_file = .false. 1256 call param_get_keyword('wanint_kpoint_file', found, & 1257 l_value=wanint_kpoint_file) 1258 1259! smear_temp = -1.0_dp 1260! call param_get_keyword('smear_temp',found,r_value=smear_temp) 1261 1262 kubo_adpt_smr = adpt_smr 1263 call param_get_keyword('kubo_adpt_smr', found, l_value=kubo_adpt_smr) 1264 1265 kubo_adpt_smr_fac = adpt_smr_fac 1266 call param_get_keyword('kubo_adpt_smr_fac', found, & 1267 r_value=kubo_adpt_smr_fac) 1268 if (found .and. (kubo_adpt_smr_fac <= 0._dp)) call io_error & 1269 ('Error: kubo_adpt_smr_fac must be greater than zero') 1270 1271 kubo_adpt_smr_max = adpt_smr_max 1272 call param_get_keyword('kubo_adpt_smr_max', found, & 1273 r_value=kubo_adpt_smr_max) 1274 if (kubo_adpt_smr_max <= 0._dp) call io_error & 1275 ('Error: kubo_adpt_smr_max must be greater than zero') 1276 1277 kubo_smr_fixed_en_width = smr_fixed_en_width 1278 call param_get_keyword('kubo_smr_fixed_en_width', found, & 1279 r_value=kubo_smr_fixed_en_width) 1280 if (found .and. (kubo_smr_fixed_en_width < 0._dp)) call io_error & 1281 ('Error: kubo_smr_fixed_en_width must be greater than or equal to zero') 1282 1283 gyrotropic_smr_fixed_en_width = smr_fixed_en_width 1284 call param_get_keyword('gyrotropic_smr_fixed_en_width', found, & 1285 r_value=gyrotropic_smr_fixed_en_width) 1286 if (found .and. (gyrotropic_smr_fixed_en_width < 0._dp)) call io_error & 1287 ('Error: gyrotropic_smr_fixed_en_width must be greater than or equal to zero') 1288 1289 sc_phase_conv = 1 1290 call param_get_keyword('sc_phase_conv', found, i_value=sc_phase_conv) 1291 if ((sc_phase_conv .ne. 1) .and. ((sc_phase_conv .ne. 2))) call io_error('Error: sc_phase_conv must be either 1 or 2') 1292 1293 scissors_shift = 0.0_dp 1294 call param_get_keyword('scissors_shift', found, & 1295 r_value=scissors_shift) 1296 1297 shc_freq_scan = .false. 1298 call param_get_keyword('shc_freq_scan', found, l_value=shc_freq_scan) 1299 1300 shc_alpha = 1 1301 call param_get_keyword('shc_alpha', found, i_value=shc_alpha) 1302 if (found .and. (shc_alpha < 1 .or. shc_alpha > 3)) call io_error & 1303 ('Error: shc_alpha must be 1, 2 or 3') 1304 1305 shc_beta = 2 1306 call param_get_keyword('shc_beta', found, i_value=shc_beta) 1307 if (found .and. (shc_beta < 1 .or. shc_beta > 3)) call io_error & 1308 ('Error: shc_beta must be 1, 2 or 3') 1309 1310 shc_gamma = 3 1311 call param_get_keyword('shc_gamma', found, i_value=shc_gamma) 1312 if (found .and. (shc_gamma < 1 .or. shc_gamma > 3)) call io_error & 1313 ('Error: shc_gamma must be 1, 2 or 3') 1314 1315 shc_bandshift = .false. 1316 call param_get_keyword('shc_bandshift', found, l_value=shc_bandshift) 1317 shc_bandshift = shc_bandshift .and. berry .and. .not. (index(berry_task, 'shc') == 0) 1318 if ((abs(scissors_shift) > 1.0e-7_dp) .and. shc_bandshift) & 1319 call io_error('Error: shc_bandshift and scissors_shift cannot be used simultaneously') 1320 1321 shc_bandshift_firstband = 0 1322 call param_get_keyword('shc_bandshift_firstband', found, i_value=shc_bandshift_firstband) 1323 if (shc_bandshift .and. (.not. found)) & 1324 call io_error('Error: shc_bandshift required but no shc_bandshift_firstband provided') 1325 if ((shc_bandshift_firstband < 1) .and. found) & 1326 call io_error('Error: shc_bandshift_firstband must >= 1') 1327 1328 shc_bandshift_energyshift = 0._dp 1329 call param_get_keyword('shc_bandshift_energyshift', found, r_value=shc_bandshift_energyshift) 1330 if (shc_bandshift .and. (.not. found)) & 1331 call io_error('Error: shc_bandshift required but no shc_bandshift_energyshift provided') 1332 1333 spin_moment = .false. 1334 call param_get_keyword('spin_moment', found, & 1335 l_value=spin_moment) 1336 1337 spin_axis_polar = 0.0_dp 1338 call param_get_keyword('spin_axis_polar', found, & 1339 r_value=spin_axis_polar) 1340 1341 spin_axis_azimuth = 0.0_dp 1342 call param_get_keyword('spin_axis_azimuth', found, & 1343 r_value=spin_axis_azimuth) 1344 1345 spin_decomp = .false. 1346 call param_get_keyword('spin_decomp', found, l_value=spin_decomp) 1347 1348 if (spin_decomp .and. (num_elec_per_state .ne. 1)) then 1349 call io_error('spin_decomp can be true only if num_elec_per_state is 1') 1350 end if 1351 1352 use_degen_pert = .false. 1353 call param_get_keyword('use_degen_pert', found, & 1354 l_value=use_degen_pert) 1355 1356 degen_thr = 1.0d-4 1357 call param_get_keyword('degen_thr', found, r_value=degen_thr) 1358 1359 kpath = .false. 1360 call param_get_keyword('kpath', found, l_value=kpath) 1361 1362 kpath_task = 'bands' 1363 call param_get_keyword('kpath_task', found, c_value=kpath_task) 1364 if (kpath .and. index(kpath_task, 'bands') == 0 .and. & 1365 index(kpath_task, 'curv') == 0 .and. & 1366 index(kpath_task, 'morb') == 0 .and. & 1367 index(kpath_task, 'shc') == 0) call io_error & 1368 ('Error: value of kpath_task not recognised in param_read') 1369 if (bands_num_spec_points == 0 .and. kpath) & 1370 call io_error('Error: a kpath plot has been requested but there is no kpoint_path block') 1371 1372 kpath_num_points = 100 1373 call param_get_keyword('kpath_num_points', found, & 1374 i_value=kpath_num_points) 1375 if (kpath_num_points < 0) & 1376 call io_error('Error: kpath_num_points must be positive') 1377 1378 kpath_bands_colour = 'none' 1379 call param_get_keyword('kpath_bands_colour', found, & 1380 c_value=kpath_bands_colour) 1381 if (kpath .and. index(kpath_bands_colour, 'none') == 0 .and. & 1382 index(kpath_bands_colour, 'spin') == 0 .and. & 1383 index(kpath_bands_colour, 'shc') == 0) call io_error & 1384 ('Error: value of kpath_bands_colour not recognised in param_read') 1385 if (kpath .and. index(kpath_task, 'shc') > 0 .and. & 1386 index(kpath_task, 'spin') > 0) call io_error & 1387 ("Error: kpath_task cannot include both 'shc' and 'spin'") 1388 1389 ! set to a negative default value 1390 num_valence_bands = -99 1391 call param_get_keyword('num_valence_bands', found, i_value=num_valence_bands) 1392 if (found .and. (num_valence_bands .le. 0)) & 1393 call io_error('Error: num_valence_bands should be greater than zero') 1394 ! there is a check on this parameter later 1395 1396 dos_task = 'dos_plot' 1397 if (dos) then 1398 dos_plot = .true. 1399 else 1400 dos_plot = .false. 1401 endif 1402 call param_get_keyword('dos_task', found, c_value=dos_task) 1403 if (dos) then 1404 if (index(dos_task, 'dos_plot') == 0 .and. & 1405 index(dos_task, 'find_fermi_energy') == 0) call io_error & 1406 ('Error: value of dos_task not recognised in param_read') 1407 if (index(dos_task, 'dos_plot') > 0) dos_plot = .true. 1408 if (index(dos_task, 'find_fermi_energy') > 0 .and. found_fermi_energy) & 1409 call io_error & 1410 ('Error: Cannot set "dos_task = find_fermi_energy" and give a value to "fermi_energy"') 1411 end if 1412 1413! sigma_abc_onlyorb=.false. 1414! call param_get_keyword('sigma_abc_onlyorb',found,l_value=sigma_abc_onlyorb) 1415 1416! ------------------------------------------------------------------- 1417 1418 !IVO_END 1419 1420 dos_energy_step = 0.01_dp 1421 call param_get_keyword('dos_energy_step', found, r_value=dos_energy_step) 1422 1423 dos_adpt_smr = adpt_smr 1424 call param_get_keyword('dos_adpt_smr', found, l_value=dos_adpt_smr) 1425 1426 dos_adpt_smr_fac = adpt_smr_fac 1427 call param_get_keyword('dos_adpt_smr_fac', found, r_value=dos_adpt_smr_fac) 1428 if (found .and. (dos_adpt_smr_fac <= 0._dp)) & 1429 call io_error('Error: dos_adpt_smr_fac must be greater than zero') 1430 1431 dos_adpt_smr_max = adpt_smr_max 1432 call param_get_keyword('dos_adpt_smr_max', found, r_value=dos_adpt_smr_max) 1433 if (dos_adpt_smr_max <= 0._dp) call io_error & 1434 ('Error: dos_adpt_smr_max must be greater than zero') 1435 1436 dos_smr_fixed_en_width = smr_fixed_en_width 1437 call param_get_keyword('dos_smr_fixed_en_width', found, r_value=dos_smr_fixed_en_width) 1438 if (found .and. (dos_smr_fixed_en_width < 0._dp)) & 1439 call io_error('Error: dos_smr_fixed_en_width must be greater than or equal to zero') 1440 1441! dos_gaussian_width = 0.1_dp 1442! call param_get_keyword('dos_gaussian_width',found,r_value=dos_gaussian_width) 1443 1444! dos_plot_format = 'gnuplot' 1445! call param_get_keyword('dos_plot_format',found,c_value=dos_plot_format) 1446 1447 call param_get_range_vector('dos_project', found, num_dos_project, & 1448 lcount=.true.) 1449 if (found) then 1450 if (num_dos_project < 1) call io_error('Error: problem reading dos_project') 1451 if (allocated(dos_project)) deallocate (dos_project) 1452 allocate (dos_project(num_dos_project), stat=ierr) 1453 if (ierr /= 0) call io_error('Error allocating dos_project in param_read') 1454 call param_get_range_vector('dos_project', found, num_dos_project, & 1455 .false., dos_project) 1456 if (any(dos_project < 1) .or. any(dos_project > num_wann)) call io_error & 1457 ('Error: dos_project asks for out-of-range Wannier functions') 1458 else 1459 ! by default plot all 1460 num_dos_project = num_wann 1461 if (allocated(dos_project)) deallocate (dos_project) 1462 allocate (dos_project(num_dos_project), stat=ierr) 1463 if (ierr /= 0) call io_error('Error allocating dos_project in param_read') 1464 do i = 1, num_dos_project 1465 dos_project(i) = i 1466 end do 1467 endif 1468 1469 hr_plot = .false. 1470 call param_get_keyword('hr_plot', found, l_value=hr_plot) 1471 if (found) call io_error('Input parameter hr_plot is no longer used. Please use write_hr instead.') 1472 write_hr = .false. 1473 call param_get_keyword('write_hr', found, l_value=write_hr) 1474 1475 write_rmn = .false. 1476 call param_get_keyword('write_rmn', found, l_value=write_rmn) 1477 1478 write_tb = .false. 1479 call param_get_keyword('write_tb', found, l_value=write_tb) 1480 1481 hr_cutoff = 0.0_dp 1482 call param_get_keyword('hr_cutoff', found, r_value=hr_cutoff) 1483 1484 dist_cutoff_mode = 'three_dim' 1485 call param_get_keyword('dist_cutoff_mode', found, c_value=dist_cutoff_mode) 1486 if ((index(dist_cutoff_mode, 'three_dim') .eq. 0) & 1487 .and. (index(dist_cutoff_mode, 'two_dim') .eq. 0) & 1488 .and. (index(dist_cutoff_mode, 'one_dim') .eq. 0)) & 1489 call io_error('Error: dist_cutoff_mode not recognised') 1490 1491! aam_2012-04-13: moved later 1492! dist_cutoff = 1000.0_dp 1493! call param_get_keyword('dist_cutoff',found,r_value=dist_cutoff) 1494 1495 one_dim_axis = 'none' 1496 call param_get_keyword('one_dim_axis', found, c_value=one_dim_axis) 1497 one_dim_dir = 0 1498 if (index(one_dim_axis, 'x') > 0) one_dim_dir = 1 1499 if (index(one_dim_axis, 'y') > 0) one_dim_dir = 2 1500 if (index(one_dim_axis, 'z') > 0) one_dim_dir = 3 1501 if (transport .and. .not. tran_read_ht .and. (one_dim_dir .eq. 0)) call io_error('Error: one_dim_axis not recognised') 1502 if (bands_plot .and. (index(bands_plot_mode, 'cut') .ne. 0)& 1503 & .and. ((bands_plot_dim .ne. 3) .or. (index(dist_cutoff_mode, 'three_dim') .eq. 0))& 1504 & .and. (one_dim_dir .eq. 0)) & 1505 call io_error('Error: one_dim_axis not recognised') 1506 1507301 continue 1508 1509 use_ws_distance = .true. 1510 call param_get_keyword('use_ws_distance', found, l_value=use_ws_distance) 1511 1512 ws_distance_tol = 1.e-5_dp 1513 call param_get_keyword('ws_distance_tol', found, r_value=ws_distance_tol) 1514 1515 ws_search_size = 2 1516 1517 call param_get_vector_length('ws_search_size', found, length=i) 1518 if (found) then 1519 if (i .eq. 1) then 1520 call param_get_keyword_vector('ws_search_size', found, 1, & 1521 i_value=ws_search_size) 1522 ws_search_size(2) = ws_search_size(1) 1523 ws_search_size(3) = ws_search_size(1) 1524 elseif (i .eq. 3) then 1525 call param_get_keyword_vector('ws_search_size', found, 3, & 1526 i_value=ws_search_size) 1527 else 1528 call io_error('Error: ws_search_size must be provided as either one integer or a vector of three integers') 1529 end if 1530 if (any(ws_search_size <= 0)) & 1531 call io_error('Error: ws_search_size elements must be greater than zero') 1532 end if 1533 1534 !%%%%%%%%%%%%%%%% 1535 ! Transport 1536 !%%%%%%%%%%%%%%%% 1537 1538 transport_mode = 'bulk' 1539 call param_get_keyword('transport_mode', found, c_value=transport_mode) 1540 1541! if ( .not.tran_read_ht .and. (index(transport_mode,'lcr').ne.0) ) & 1542! call io_error('Error: transport_mode.eq.lcr not compatible with tran_read_ht.eq.false') 1543 1544 tran_win_min = -3.0_dp 1545 call param_get_keyword('tran_win_min', found, r_value=tran_win_min) 1546 1547 tran_win_max = 3.0_dp 1548 call param_get_keyword('tran_win_max', found, r_value=tran_win_max) 1549 1550 tran_energy_step = 0.01_dp 1551 call param_get_keyword('tran_energy_step', found, r_value=tran_energy_step) 1552 1553 tran_num_bb = 0 1554 call param_get_keyword('tran_num_bb', found, i_value=tran_num_bb) 1555 1556 tran_num_ll = 0 1557 call param_get_keyword('tran_num_ll', found, i_value=tran_num_ll) 1558 1559 tran_num_rr = 0 1560 call param_get_keyword('tran_num_rr', found, i_value=tran_num_rr) 1561 1562 tran_num_cc = 0 1563 call param_get_keyword('tran_num_cc', found, i_value=tran_num_cc) 1564 1565 tran_num_lc = 0 1566 call param_get_keyword('tran_num_lc', found, i_value=tran_num_lc) 1567 1568 tran_num_cr = 0 1569 call param_get_keyword('tran_num_cr', found, i_value=tran_num_cr) 1570 1571 tran_num_bandc = 0 1572 call param_get_keyword('tran_num_bandc', found, i_value=tran_num_bandc) 1573 1574 tran_write_ht = .false. 1575 call param_get_keyword('tran_write_ht', found, l_value=tran_write_ht) 1576 1577 tran_use_same_lead = .true. 1578 call param_get_keyword('tran_use_same_lead', found, l_value=tran_use_same_lead) 1579 1580 tran_num_cell_ll = 0 1581 call param_get_keyword('tran_num_cell_ll', found, i_value=tran_num_cell_ll) 1582 1583 tran_num_cell_rr = 0 1584 call param_get_keyword('tran_num_cell_rr', found, i_value=tran_num_cell_rr) 1585 1586 tran_group_threshold = 0.15_dp 1587 call param_get_keyword('tran_group_threshold', found, r_value=tran_group_threshold) 1588 1589 dist_cutoff = 1000.0_dp 1590 call param_get_keyword('dist_cutoff', found, r_value=dist_cutoff) 1591 1592 dist_cutoff_hc = dist_cutoff 1593 call param_get_keyword('dist_cutoff_hc', found, r_value=dist_cutoff_hc) 1594 1595 ! checks 1596 if (transport) then 1597 if ((index(transport_mode, 'bulk') .eq. 0) .and. (index(transport_mode, 'lcr') .eq. 0)) & 1598 call io_error('Error: transport_mode not recognised') 1599 if (tran_num_bb < 0) call io_error('Error: tran_num_bb < 0') 1600 if (tran_num_ll < 0) call io_error('Error: tran_num_ll < 0') 1601 if (tran_num_rr < 0) call io_error('Error: tran_num_rr < 0') 1602 if (tran_num_cc < 0) call io_error('Error: tran_num_cc < 0') 1603 if (tran_num_lc < 0) call io_error('Error: tran_num_lc < 0') 1604 if (tran_num_cr < 0) call io_error('Error: tran_num_cr < 0') 1605 if (tran_num_bandc < 0) call io_error('Error: tran_num_bandc < 0') 1606 if (tran_num_cell_ll < 0) call io_error('Error: tran_num_cell_ll < 0') 1607 if (tran_num_cell_rr < 0) call io_error('Error: tran_num_cell_rr < 0') 1608 if (tran_group_threshold < 0.0_dp) call io_error('Error: tran_group_threshold < 0') 1609 endif 1610 1611 if (transport .and. tran_read_ht) goto 302 1612 1613 !%%%%%%%%%%%%%%%% 1614 ! Disentanglement 1615 !%%%%%%%%%%%%%%%% 1616 1617 disentanglement = .false. 1618 if (num_bands > num_wann) disentanglement = .true. 1619 1620 ! These must be read here, before the check on the existence of the .eig file! 1621 geninterp = .false. 1622 call param_get_keyword('geninterp', found, l_value=geninterp) 1623 boltzwann = .false. 1624 call param_get_keyword('boltzwann', found, l_value=boltzwann) 1625 1626 ! Read the eigenvalues from wannier.eig 1627 eig_found = .false. 1628 if (.not. library .and. .not. effective_model) then 1629 1630 if (.not. postproc_setup) then 1631 inquire (file=trim(seedname)//'.eig', exist=eig_found) 1632 if (.not. eig_found) then 1633 if (disentanglement) then 1634 call io_error('No '//trim(seedname)//'.eig file found. Needed for disentanglement') 1635 else if ((bands_plot .or. dos_plot .or. fermi_surface_plot .or. write_hr .or. boltzwann & 1636 .or. geninterp)) then 1637 call io_error('No '//trim(seedname)//'.eig file found. Needed for interpolation') 1638 end if 1639 else 1640 ! Allocate only here 1641 allocate (eigval(num_bands, num_kpts), stat=ierr) 1642 if (ierr /= 0) call io_error('Error allocating eigval in param_read') 1643 1644 eig_unit = io_file_unit() 1645 open (unit=eig_unit, file=trim(seedname)//'.eig', form='formatted', status='old', err=105) 1646 do k = 1, num_kpts 1647 do n = 1, num_bands 1648 read (eig_unit, *, err=106, end=106) i, j, eigval(n, k) 1649 if ((i .ne. n) .or. (j .ne. k)) then 1650 write (stdout, '(a)') 'Found a mismatch in '//trim(seedname)//'.eig' 1651 write (stdout, '(a,i0,a,i0)') 'Wanted band : ', n, ' found band : ', i 1652 write (stdout, '(a,i0,a,i0)') 'Wanted kpoint: ', k, ' found kpoint: ', j 1653 write (stdout, '(a)') ' ' 1654 write (stdout, '(a)') 'A common cause of this error is using the wrong' 1655 write (stdout, '(a)') 'number of bands. Check your input files.' 1656 write (stdout, '(a)') 'If your pseudopotentials have shallow core states remember' 1657 write (stdout, '(a)') 'to account for these electrons.' 1658 write (stdout, '(a)') ' ' 1659 call io_error('param_read: mismatch in '//trim(seedname)//'.eig') 1660 end if 1661 enddo 1662 end do 1663 close (eig_unit) 1664 end if 1665 end if 1666 end if 1667 1668 if (library .and. allocated(eigval)) eig_found = .true. 1669 1670 dis_win_min = -1.0_dp; dis_win_max = 0.0_dp 1671 if (eig_found) dis_win_min = minval(eigval) 1672 call param_get_keyword('dis_win_min', found, r_value=dis_win_min) 1673 1674 if (eig_found) dis_win_max = maxval(eigval) 1675 call param_get_keyword('dis_win_max', found, r_value=dis_win_max) 1676 if (eig_found .and. (dis_win_max .lt. dis_win_min)) & 1677 call io_error('Error: param_read: check disentanglement windows') 1678 1679 dis_froz_min = -1.0_dp; dis_froz_max = 0.0_dp 1680 ! no default for dis_froz_max 1681 frozen_states = .false. 1682 call param_get_keyword('dis_froz_max', found, r_value=dis_froz_max) 1683 if (found) then 1684 frozen_states = .true. 1685 dis_froz_min = dis_win_min ! default value for the bottom of frozen window 1686 end if 1687 call param_get_keyword('dis_froz_min', found2, r_value=dis_froz_min) 1688 if (eig_found) then 1689 if (dis_froz_max .lt. dis_froz_min) & 1690 call io_error('Error: param_read: check disentanglement frozen windows') 1691 if (found2 .and. .not. found) & 1692 call io_error('Error: param_read: found dis_froz_min but not dis_froz_max') 1693 endif 1694 1695 dis_num_iter = 200 1696 call param_get_keyword('dis_num_iter', found, i_value=dis_num_iter) 1697 if (dis_num_iter < 0) call io_error('Error: dis_num_iter must be positive') 1698 1699 dis_mix_ratio = 0.5_dp 1700 call param_get_keyword('dis_mix_ratio', found, r_value=dis_mix_ratio) 1701 if (dis_mix_ratio <= 0.0_dp .or. dis_mix_ratio > 1.0_dp) & 1702 call io_error('Error: dis_mix_ratio must be greater than 0.0 but not greater than 1.0') 1703 1704 dis_conv_tol = 1.0e-10_dp 1705 call param_get_keyword('dis_conv_tol', found, r_value=dis_conv_tol) 1706 if (dis_conv_tol < 0.0_dp) call io_error('Error: dis_conv_tol must be positive') 1707 1708 dis_conv_window = 3 1709 call param_get_keyword('dis_conv_window', found, i_value=dis_conv_window) 1710 if (dis_conv_window < 0) call io_error('Error: dis_conv_window must be positive') 1711 1712 ! GS-start 1713 dis_spheres_first_wann = 1 1714 call param_get_keyword('dis_spheres_first_wann', found, i_value=dis_spheres_first_wann) 1715 if (dis_spheres_first_wann < 1) call io_error('Error: dis_spheres_first_wann must be greater than 0') 1716 if (dis_spheres_first_wann > num_bands - num_wann + 1) & 1717 call io_error('Error: dis_spheres_first_wann is larger than num_bands-num_wann+1') 1718 dis_spheres_num = 0 1719 call param_get_keyword('dis_spheres_num', found, i_value=dis_spheres_num) 1720 if (dis_spheres_num < 0) call io_error('Error: dis_spheres_num cannot be negative') 1721 if (dis_spheres_num > 0) then 1722 allocate (dis_spheres(4, dis_spheres_num), stat=ierr) 1723 if (ierr /= 0) call io_error('Error allocating dis_spheres in param_read') 1724 call param_get_keyword_block('dis_spheres', found, dis_spheres_num, 4, r_value=dis_spheres) 1725 if (.not. found) call io_error('Error: Did not find dis_spheres in the input file') 1726 do nkp = 1, dis_spheres_num 1727 if (dis_spheres(4, nkp) < 1.0e-15_dp) & 1728 call io_error('Error: radius for dis_spheres must be > 0') 1729 enddo 1730 endif 1731 ! GS-end 1732 1733 ! [gp-begin, Jun 1, 2012] 1734 !%%%%%%%%%%%%%%%%%%%% 1735 ! General band interpolator (geninterp) 1736 !%%%%%%%%%%%%%%%%%%%% 1737 geninterp_alsofirstder = .false. 1738 call param_get_keyword('geninterp_alsofirstder', found, l_value=geninterp_alsofirstder) 1739 geninterp_single_file = .true. 1740 call param_get_keyword('geninterp_single_file', found, l_value=geninterp_single_file) 1741 ! [gp-end, Jun 1, 2012] 1742 1743 ! [gp-begin, Apr 12, 2012] 1744 !%%%%%%%%%%%%%%%%%%%% 1745 ! Boltzmann transport 1746 !%%%%%%%%%%%%%%%%%%%% 1747 ! Note: to be put AFTER the disentanglement routines! 1748 1749 boltz_calc_also_dos = .false. 1750 call param_get_keyword('boltz_calc_also_dos', found, l_value=boltz_calc_also_dos) 1751 1752 boltz_calc_also_dos = boltz_calc_also_dos .and. boltzwann 1753 1754 ! 0 means the normal 3d case for the calculation of the Seebeck coefficient 1755 ! The other valid possibilities are 1,2,3 for x,y,z respectively 1756 boltz_2d_dir_num = 0 1757 call param_get_keyword('boltz_2d_dir', found, c_value=boltz_2d_dir) 1758 if (found) then 1759 if (trim(boltz_2d_dir) == 'no') then 1760 boltz_2d_dir_num = 0 1761 elseif (trim(boltz_2d_dir) == 'x') then 1762 boltz_2d_dir_num = 1 1763 elseif (trim(boltz_2d_dir) == 'y') then 1764 boltz_2d_dir_num = 2 1765 elseif (trim(boltz_2d_dir) == 'z') then 1766 boltz_2d_dir_num = 3 1767 else 1768 call io_error('Error: boltz_2d_dir can only be "no", "x", "y" or "z".') 1769 end if 1770 end if 1771 1772 boltz_dos_energy_step = 0.001_dp 1773 call param_get_keyword('boltz_dos_energy_step', found, r_value=boltz_dos_energy_step) 1774 if (found .and. (boltz_dos_energy_step <= 0._dp)) & 1775 call io_error('Error: boltz_dos_energy_step must be positive') 1776 1777 if (allocated(eigval)) then 1778 boltz_dos_energy_min = minval(eigval) - 0.6667_dp 1779 else 1780 ! Boltz_dos cannot run if eigval is not allocated. 1781 ! We just set here a default numerical value. 1782 boltz_dos_energy_min = -1.0_dp 1783 end if 1784 call param_get_keyword('boltz_dos_energy_min', found, r_value=boltz_dos_energy_min) 1785 if (allocated(eigval)) then 1786 boltz_dos_energy_max = maxval(eigval) + 0.6667_dp 1787 else 1788 ! Boltz_dos cannot run if eigval is not allocated. 1789 ! We just set here a default numerical value. 1790 boltz_dos_energy_max = 0.0_dp 1791 end if 1792 call param_get_keyword('boltz_dos_energy_max', found, r_value=boltz_dos_energy_max) 1793 if (boltz_dos_energy_max <= boltz_dos_energy_min) & 1794 call io_error('Error: boltz_dos_energy_max must be greater than boltz_dos_energy_min') 1795 1796 boltz_dos_adpt_smr = adpt_smr 1797 call param_get_keyword('boltz_dos_adpt_smr', found, l_value=boltz_dos_adpt_smr) 1798 1799 boltz_dos_adpt_smr_fac = adpt_smr_fac 1800 call param_get_keyword('boltz_dos_adpt_smr_fac', found, r_value=boltz_dos_adpt_smr_fac) 1801 if (found .and. (boltz_dos_adpt_smr_fac <= 0._dp)) & 1802 call io_error('Error: boltz_dos_adpt_smr_fac must be greater than zero') 1803 1804 boltz_dos_adpt_smr_max = adpt_smr_max 1805 call param_get_keyword('boltz_dos_adpt_smr_max', found, r_value=boltz_dos_adpt_smr_max) 1806 if (boltz_dos_adpt_smr_max <= 0._dp) call io_error & 1807 ('Error: boltz_dos_adpt_smr_max must be greater than zero') 1808 1809 boltz_dos_smr_fixed_en_width = smr_fixed_en_width 1810 call param_get_keyword('boltz_dos_smr_fixed_en_width', found, r_value=boltz_dos_smr_fixed_en_width) 1811 if (found .and. (boltz_dos_smr_fixed_en_width < 0._dp)) & 1812 call io_error('Error: boltz_dos_smr_fixed_en_width must be greater than or equal to zero') 1813 1814 boltz_mu_min = -999._dp 1815 call param_get_keyword('boltz_mu_min', found, r_value=boltz_mu_min) 1816 if ((.not. found) .and. boltzwann) & 1817 call io_error('Error: BoltzWann required but no boltz_mu_min provided') 1818 boltz_mu_max = -999._dp 1819 call param_get_keyword('boltz_mu_max', found2, r_value=boltz_mu_max) 1820 if ((.not. found2) .and. boltzwann) & 1821 call io_error('Error: BoltzWann required but no boltz_mu_max provided') 1822 if (found .and. found2 .and. (boltz_mu_max < boltz_mu_min)) & 1823 call io_error('Error: boltz_mu_max must be greater than boltz_mu_min') 1824 boltz_mu_step = 0._dp 1825 call param_get_keyword('boltz_mu_step', found, r_value=boltz_mu_step) 1826 if ((.not. found) .and. boltzwann) & 1827 call io_error('Error: BoltzWann required but no boltz_mu_step provided') 1828 if (found .and. (boltz_mu_step <= 0._dp)) & 1829 call io_error('Error: boltz_mu_step must be greater than zero') 1830 1831 boltz_temp_min = -999._dp 1832 call param_get_keyword('boltz_temp_min', found, r_value=boltz_temp_min) 1833 if ((.not. found) .and. boltzwann) & 1834 call io_error('Error: BoltzWann required but no boltz_temp_min provided') 1835 boltz_temp_max = -999._dp 1836 call param_get_keyword('boltz_temp_max', found2, r_value=boltz_temp_max) 1837 if ((.not. found2) .and. boltzwann) & 1838 call io_error('Error: BoltzWann required but no boltz_temp_max provided') 1839 if (found .and. found2 .and. (boltz_temp_max < boltz_temp_min)) & 1840 call io_error('Error: boltz_temp_max must be greater than boltz_temp_min') 1841 if (found .and. (boltz_temp_min <= 0._dp)) & 1842 call io_error('Error: boltz_temp_min must be greater than zero') 1843 boltz_temp_step = 0._dp 1844 call param_get_keyword('boltz_temp_step', found, r_value=boltz_temp_step) 1845 if ((.not. found) .and. boltzwann) & 1846 call io_error('Error: BoltzWann required but no boltz_temp_step provided') 1847 if (found .and. (boltz_temp_step <= 0._dp)) & 1848 call io_error('Error: boltz_temp_step must be greater than zero') 1849 1850 ! The interpolation mesh is read later on 1851 1852 ! By default, the energy step for the TDF is 1 meV 1853 boltz_tdf_energy_step = 0.001_dp 1854 call param_get_keyword('boltz_tdf_energy_step', found, r_value=boltz_tdf_energy_step) 1855 if (boltz_tdf_energy_step <= 0._dp) & 1856 call io_error('Error: boltz_tdf_energy_step must be greater than zero') 1857 1858 ! For TDF: TDF smeared in a NON-adaptive way; value in eV, default = 0._dp 1859 ! (i.e., no smearing) 1860 boltz_TDF_smr_fixed_en_width = smr_fixed_en_width 1861 call param_get_keyword('boltz_tdf_smr_fixed_en_width', found, r_value=boltz_TDF_smr_fixed_en_width) 1862 if (found .and. (boltz_TDF_smr_fixed_en_width < 0._dp)) & 1863 call io_error('Error: boltz_TDF_smr_fixed_en_width must be greater than or equal to zero') 1864 1865 ! By default: use the "global" smearing index 1866 boltz_TDF_smr_index = smr_index 1867 call param_get_keyword('boltz_tdf_smr_type', found, c_value=ctmp) 1868 if (found) boltz_TDF_smr_index = get_smearing_index(ctmp, 'boltz_tdf_smr_type') 1869 1870 ! By default: use the "global" smearing index 1871 boltz_dos_smr_index = smr_index 1872 call param_get_keyword('boltz_dos_smr_type', found, c_value=ctmp) 1873 if (found) boltz_dos_smr_index = get_smearing_index(ctmp, 'boltz_dos_smr_type') 1874 1875 ! By default: use the "global" smearing index 1876 dos_smr_index = smr_index 1877 call param_get_keyword('dos_smr_type', found, c_value=ctmp) 1878 if (found) dos_smr_index = get_smearing_index(ctmp, 'dos_smr_type') 1879 1880 ! By default: use the "global" smearing index 1881 kubo_smr_index = smr_index 1882 call param_get_keyword('kubo_smr_type', found, c_value=ctmp) 1883 if (found) kubo_smr_index = get_smearing_index(ctmp, 'kubo_smr_type') 1884 1885 ! By default: use the "global" smearing index 1886 gyrotropic_smr_index = smr_index 1887 call param_get_keyword('gyrotropic_smr_type', found, c_value=ctmp) 1888 if (found) gyrotropic_smr_index = get_smearing_index(ctmp, 'gyrotropic_smr_type') 1889 1890 ! By default: 10 fs relaxation time 1891 boltz_relax_time = 10._dp 1892 call param_get_keyword('boltz_relax_time', found, r_value=boltz_relax_time) 1893 1894 boltz_bandshift = .false. 1895 call param_get_keyword('boltz_bandshift', found, l_value=boltz_bandshift) 1896 boltz_bandshift = boltz_bandshift .and. boltzwann 1897 1898 boltz_bandshift_firstband = 0 1899 call param_get_keyword('boltz_bandshift_firstband', found, i_value=boltz_bandshift_firstband) 1900 if (boltz_bandshift .and. (.not. found)) & 1901 call io_error('Error: boltz_bandshift required but no boltz_bandshift_firstband provided') 1902 boltz_bandshift_energyshift = 0._dp 1903 call param_get_keyword('boltz_bandshift_energyshift', found, r_value=boltz_bandshift_energyshift) 1904 if (boltz_bandshift .and. (.not. found)) & 1905 call io_error('Error: boltz_bandshift required but no boltz_bandshift_energyshift provided') 1906 ! [gp-end, Apr 12, 2012] 1907 1908 !%%%%%%%%%%%%%%%% 1909 ! Other Stuff 1910 !%%%%%%%%%%%%%%%% 1911 1912 ! aam: vdW 1913 write_vdw_data = .false. 1914 call param_get_keyword('write_vdw_data', found, l_value=write_vdw_data) 1915 if (write_vdw_data) then 1916 if ((.not. gamma_only) .or. (num_kpts .ne. 1)) & 1917 call io_error('Error: write_vdw_data may only be used with a single k-point at Gamma') 1918 endif 1919 if (write_vdw_data .and. disentanglement .and. num_valence_bands .le. 0) & 1920 call io_error('If writing vdw data and disentangling then num_valence_bands must be defined') 1921 1922 if (frozen_states) then 1923 dos_energy_max = dis_froz_max + 0.6667_dp 1924 elseif (allocated(eigval)) then 1925 dos_energy_max = maxval(eigval) + 0.6667_dp 1926 else 1927 dos_energy_max = dis_win_max + 0.6667_dp 1928 end if 1929 call param_get_keyword('dos_energy_max', found, r_value=dos_energy_max) 1930 1931 if (allocated(eigval)) then 1932 dos_energy_min = minval(eigval) - 0.6667_dp 1933 else 1934 dos_energy_min = dis_win_min - 0.6667_dp 1935 end if 1936 call param_get_keyword('dos_energy_min', found, r_value=dos_energy_min) 1937 1938 kubo_freq_min = 0.0_dp 1939 gyrotropic_freq_min = kubo_freq_min 1940 call param_get_keyword('kubo_freq_min', found, r_value=kubo_freq_min) 1941 ! 1942 if (frozen_states) then 1943 kubo_freq_max = dis_froz_max - fermi_energy_list(1) + 0.6667_dp 1944 elseif (allocated(eigval)) then 1945 kubo_freq_max = maxval(eigval) - minval(eigval) + 0.6667_dp 1946 else 1947 kubo_freq_max = dis_win_max - dis_win_min + 0.6667_dp 1948 end if 1949 gyrotropic_freq_max = kubo_freq_max 1950 call param_get_keyword('kubo_freq_max', found, r_value=kubo_freq_max) 1951 1952 ! 1953 kubo_freq_step = 0.01_dp 1954 call param_get_keyword('kubo_freq_step', found, r_value=kubo_freq_step) 1955 if (found .and. kubo_freq_step < 0.0_dp) call io_error( & 1956 'Error: kubo_freq_step must be positive') 1957 ! 1958 kubo_nfreq = nint((kubo_freq_max - kubo_freq_min)/kubo_freq_step) + 1 1959 if (kubo_nfreq <= 1) kubo_nfreq = 2 1960 kubo_freq_step = (kubo_freq_max - kubo_freq_min)/(kubo_nfreq - 1) 1961 ! 1962 if (allocated(kubo_freq_list)) deallocate (kubo_freq_list) 1963 allocate (kubo_freq_list(kubo_nfreq), stat=ierr) 1964 if (ierr /= 0) & 1965 call io_error('Error allocating kubo_freq_list in param_read') 1966 do i = 1, kubo_nfreq 1967 kubo_freq_list(i) = kubo_freq_min & 1968 + (i - 1)*(kubo_freq_max - kubo_freq_min)/(kubo_nfreq - 1) 1969 enddo 1970 ! 1971 ! TODO: Alternatively, read list of (complex) frequencies; kubo_nfreq is 1972 ! the length of the list 1973 1974 gyrotropic_freq_step = 0.01_dp 1975 call param_get_keyword('gyrotropic_freq_min', found, r_value=gyrotropic_freq_min) 1976 call param_get_keyword('gyrotropic_freq_max', found, r_value=gyrotropic_freq_max) 1977 call param_get_keyword('gyrotropic_freq_step', found, r_value=gyrotropic_freq_step) 1978 gyrotropic_nfreq = nint((gyrotropic_freq_max - gyrotropic_freq_min)/gyrotropic_freq_step) + 1 1979 if (gyrotropic_nfreq <= 1) gyrotropic_nfreq = 2 1980 gyrotropic_freq_step = (gyrotropic_freq_max - gyrotropic_freq_min)/(gyrotropic_nfreq - 1) 1981 if (allocated(gyrotropic_freq_list)) deallocate (gyrotropic_freq_list) 1982 allocate (gyrotropic_freq_list(gyrotropic_nfreq), stat=ierr) 1983 if (ierr /= 0) & 1984 call io_error('Error allocating gyrotropic_freq_list in param_read') 1985 do i = 1, gyrotropic_nfreq 1986 gyrotropic_freq_list(i) = gyrotropic_freq_min & 1987 + (i - 1)*(gyrotropic_freq_max - gyrotropic_freq_min)/(gyrotropic_nfreq - 1) & 1988 + cmplx_i*gyrotropic_smr_fixed_en_width 1989 enddo 1990 1991 if (frozen_states) then 1992 kubo_eigval_max = dis_froz_max + 0.6667_dp 1993 elseif (allocated(eigval)) then 1994 kubo_eigval_max = maxval(eigval) + 0.6667_dp 1995 else 1996 kubo_eigval_max = dis_win_max + 0.6667_dp 1997 end if 1998 gyrotropic_eigval_max = kubo_eigval_max 1999 2000 call param_get_keyword('kubo_eigval_max', found, r_value=kubo_eigval_max) 2001 call param_get_keyword('gyrotropic_eigval_max', found, r_value=gyrotropic_eigval_max) 2002 2003 automatic_translation = .true. 2004 translation_centre_frac = 0.0_dp 2005 call param_get_keyword_vector('translation_centre_frac', found, 3, r_value=rv_temp) 2006 if (found) then 2007 translation_centre_frac = rv_temp 2008 automatic_translation = .false. 2009 endif 2010 2011 sc_eta = 0.04 2012 call param_get_keyword('sc_eta', found, r_value=sc_eta) 2013 2014 sc_w_thr = 5.0d0 2015 call param_get_keyword('sc_w_thr', found, r_value=sc_w_thr) 2016 2017 use_bloch_phases = .false. 2018 call param_get_keyword('use_bloch_phases', found, l_value=use_bloch_phases) 2019 if (disentanglement .and. use_bloch_phases) & 2020 call io_error('Error: Cannot use bloch phases for disentanglement') 2021 2022 search_shells = 36 2023 call param_get_keyword('search_shells', found, i_value=search_shells) 2024 if (search_shells < 0) call io_error('Error: search_shells must be positive') 2025 2026 kmesh_tol = 0.000001_dp 2027 call param_get_keyword('kmesh_tol', found, r_value=kmesh_tol) 2028 if (kmesh_tol < 0.0_dp) call io_error('Error: kmesh_tol must be positive') 2029 2030 num_shells = 0 2031 call param_get_range_vector('shell_list', found, num_shells, lcount=.true.) 2032 if (found) then 2033 if (num_shells < 0 .or. num_shells > max_shells) & 2034 call io_error('Error: number of shell in shell_list must be between zero and six') 2035 if (allocated(shell_list)) deallocate (shell_list) 2036 allocate (shell_list(num_shells), stat=ierr) 2037 if (ierr /= 0) call io_error('Error allocating shell_list in param_read') 2038 call param_get_range_vector('shell_list', found, num_shells, .false., shell_list) 2039 if (any(shell_list < 1)) & 2040 call io_error('Error: shell_list must contain positive numbers') 2041 else 2042 if (allocated(shell_list)) deallocate (shell_list) 2043 allocate (shell_list(max_shells), stat=ierr) 2044 if (ierr /= 0) call io_error('Error allocating shell_list in param_read') 2045 end if 2046 2047 call param_get_keyword('num_shells', found, i_value=itmp) 2048 if (found .and. (itmp /= num_shells)) & 2049 call io_error('Error: Found obsolete keyword num_shells. Its value does not agree with shell_list') 2050 2051 ! If .true., does not perform the check of B1 of 2052 ! Marzari, Vanderbild, PRB 56, 12847 (1997) 2053 ! in kmesh.F90 2054 ! mainly needed for the interaction with Z2PACK 2055 ! By default: .false. (perform the tests) 2056 skip_B1_tests = .false. 2057 call param_get_keyword('skip_b1_tests', found, l_value=skip_B1_tests) 2058 2059 call param_get_keyword_block('unit_cell_cart', found, 3, 3, r_value=real_lattice_tmp) 2060 if (found .and. library) write (stdout, '(a)') ' Ignoring <unit_cell_cart> in input file' 2061 if (.not. library) then 2062 real_lattice = transpose(real_lattice_tmp) 2063 if (.not. found) call io_error('Error: Did not find the cell information in the input file') 2064 end if 2065 2066 if (.not. library) & 2067 call utility_recip_lattice(real_lattice, recip_lattice, cell_volume) 2068 call utility_metric(real_lattice, recip_lattice, real_metric, recip_metric) 2069 2070 if (.not. effective_model) allocate (kpt_cart(3, num_kpts), stat=ierr) 2071 if (ierr /= 0) call io_error('Error allocating kpt_cart in param_read') 2072 if (.not. library .and. .not. effective_model) then 2073 allocate (kpt_latt(3, num_kpts), stat=ierr) 2074 if (ierr /= 0) call io_error('Error allocating kpt_latt in param_read') 2075 end if 2076 2077 call param_get_keyword_block('kpoints', found, num_kpts, 3, r_value=kpt_cart) 2078 if (found .and. library) write (stdout, '(a)') ' Ignoring <kpoints> in input file' 2079 if (.not. library .and. .not. effective_model) then 2080 kpt_latt = kpt_cart 2081 if (.not. found) call io_error('Error: Did not find the kpoint information in the input file') 2082 end if 2083 2084 ! Calculate the kpoints in cartesian coordinates 2085 if (.not. effective_model) then 2086 do nkp = 1, num_kpts 2087 kpt_cart(:, nkp) = matmul(kpt_latt(:, nkp), recip_lattice(:, :)) 2088 end do 2089 endif 2090 2091 ! get the nnkpts block -- this is allowed only in postproc-setup mode 2092 call param_get_block_length('nnkpts', explicit_nnkpts, rows) 2093 if (explicit_nnkpts) then 2094 nntot = rows/num_kpts 2095 if (modulo(rows, num_kpts) /= 0) then 2096 call io_error('The number of rows in nnkpts must be a multiple of num_kpts') 2097 end if 2098 if (allocated(nnkpts_block)) deallocate (nnkpts_block) 2099 allocate (nnkpts_block(5, rows), stat=ierr) 2100 if (ierr /= 0) call io_error('Error allocating nnkpts_block in param_read') 2101 call param_get_keyword_block('nnkpts', found, rows, 5, i_value=nnkpts_block) 2102 ! check that postproc_setup is true 2103 if (.not. postproc_setup) & 2104 call io_error('Input parameter nnkpts_block is allowed only if postproc_setup = .true.') 2105 ! assign the values in nnkpts_block to nnlist and nncell 2106 ! this keeps track of how many neighbours have been seen for each k-point 2107 if (allocated(nnkpts_idx)) deallocate (nnkpts_idx) 2108 allocate (nnkpts_idx(num_kpts), stat=ierr) 2109 if (ierr /= 0) call io_error('Error allocating nnkpts_idx in param_read') 2110 nnkpts_idx = 1 2111 ! allocating "global" nnlist & nncell 2112 ! These are deallocated in kmesh_dealloc 2113 if (allocated(nnlist)) deallocate (nnlist) 2114 allocate (nnlist(num_kpts, nntot), stat=ierr) 2115 if (ierr /= 0) call io_error('Error allocating nnlist in param_read') 2116 if (allocated(nncell)) deallocate (nncell) 2117 allocate (nncell(3, num_kpts, nntot), stat=ierr) 2118 if (ierr /= 0) call io_error('Error allocating nncell in param_read') 2119 do i = 1, num_kpts*nntot 2120 k = nnkpts_block(1, i) 2121 nnlist(k, nnkpts_idx(k)) = nnkpts_block(2, i) 2122 nncell(:, k, nnkpts_idx(k)) = nnkpts_block(3:, i) 2123 nnkpts_idx(k) = nnkpts_idx(k) + 1 2124 end do 2125 ! check that all k-points have the same number of neighbours 2126 if (any(nnkpts_idx /= (/(nntot + 1, i=1, num_kpts)/))) then 2127 call io_error('Inconsistent number of nearest neighbours.') 2128 end if 2129 deallocate (nnkpts_idx, stat=ierr) 2130 if (ierr /= 0) call io_error('Error deallocating nnkpts_idx in param_read') 2131 deallocate (nnkpts_block, stat=ierr) 2132 if (ierr /= 0) call io_error('Error deallocating nnkpts_block in param_read') 2133 end if 2134 2135 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! 2136 ! k meshes ! 2137 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! 2138 ! [GP-begin, Apr13, 2012] 2139 ! Global interpolation k-mesh; this is overridden by "local" meshes of a given submodule 2140 ! This bit of code must appear *before* all other codes for the local interpolation meshes, 2141 ! BUT *after* having calculated the reciprocal-space vectors. 2142 global_kmesh_set = .false. 2143 kmesh_spacing = -1._dp 2144 kmesh = 0 2145 call param_get_keyword('kmesh_spacing', found, r_value=kmesh_spacing) 2146 if (found) then 2147 if (kmesh_spacing .le. 0._dp) & 2148 call io_error('Error: kmesh_spacing must be greater than zero') 2149 global_kmesh_set = .true. 2150 2151 call internal_set_kmesh(kmesh_spacing, recip_lattice, kmesh) 2152 end if 2153 call param_get_vector_length('kmesh', found, length=i) 2154 if (found) then 2155 if (global_kmesh_set) & 2156 call io_error('Error: cannot set both kmesh and kmesh_spacing') 2157 if (i .eq. 1) then 2158 global_kmesh_set = .true. 2159 call param_get_keyword_vector('kmesh', found, 1, i_value=kmesh) 2160 kmesh(2) = kmesh(1) 2161 kmesh(3) = kmesh(1) 2162 elseif (i .eq. 3) then 2163 global_kmesh_set = .true. 2164 call param_get_keyword_vector('kmesh', found, 3, i_value=kmesh) 2165 else 2166 call io_error('Error: kmesh must be provided as either one integer or a vector of three integers') 2167 end if 2168 if (any(kmesh <= 0)) & 2169 call io_error('Error: kmesh elements must be greater than zero') 2170 end if 2171 ! [GP-end] 2172 2173 ! To be called after having read the global flag 2174 call get_module_kmesh(moduleprefix='boltz', & 2175 should_be_defined=boltzwann, & 2176 module_kmesh=boltz_kmesh, & 2177 module_kmesh_spacing=boltz_kmesh_spacing) 2178 2179 call get_module_kmesh(moduleprefix='berry', & 2180 should_be_defined=berry, & 2181 module_kmesh=berry_kmesh, & 2182 module_kmesh_spacing=berry_kmesh_spacing) 2183 2184 call get_module_kmesh(moduleprefix='gyrotropic', & 2185 should_be_defined=gyrotropic, & 2186 module_kmesh=gyrotropic_kmesh, & 2187 module_kmesh_spacing=gyrotropic_kmesh_spacing) 2188 2189 call get_module_kmesh(moduleprefix='spin', & 2190 should_be_defined=spin_moment, & 2191 module_kmesh=spin_kmesh, & 2192 module_kmesh_spacing=spin_kmesh_spacing) 2193 2194 call get_module_kmesh(moduleprefix='dos', & 2195 should_be_defined=dos, & 2196 module_kmesh=dos_kmesh, & 2197 module_kmesh_spacing=dos_kmesh_spacing) 2198 2199 ! Atoms 2200 if (.not. library) num_atoms = 0 2201 call param_get_block_length('atoms_frac', found, i_temp) 2202 if (found .and. library) write (stdout, '(a)') ' Ignoring <atoms_frac> in input file' 2203 call param_get_block_length('atoms_cart', found2, i_temp2, lunits) 2204 if (found2 .and. library) write (stdout, '(a)') ' Ignoring <atoms_cart> in input file' 2205 if (.not. library) then 2206 if (found .and. found2) call io_error('Error: Cannot specify both atoms_frac and atoms_cart') 2207 if (found .and. i_temp > 0) then 2208 lunits = .false. 2209 num_atoms = i_temp 2210 elseif (found2 .and. i_temp2 > 0) then 2211 num_atoms = i_temp2 2212 if (lunits) num_atoms = num_atoms - 1 2213 end if 2214 if (num_atoms > 0) then 2215 call param_get_atoms(lunits) 2216 end if 2217 endif 2218 2219 ! Projections 2220 auto_projections = .false. 2221 call param_get_keyword('auto_projections', found, l_value=auto_projections) 2222 num_proj = 0 2223 call param_get_block_length('projections', found, i_temp) 2224 ! check to see that there are no unrecognised keywords 2225 if (found) then 2226 if (auto_projections) call io_error('Error: Cannot specify both auto_projections and projections block') 2227 lhasproj = .true. 2228 call param_get_projections(num_proj, lcount=.true.) 2229 else 2230 if (guiding_centres .and. .not. (gamma_only .and. use_bloch_phases)) & 2231 call io_error('param_read: Guiding centres requested, but no projection block found') 2232 lhasproj = .false. 2233 num_proj = num_wann 2234 end if 2235 2236 lselproj = .false. 2237 num_select_projections = 0 2238 call param_get_range_vector('select_projections', found, num_select_projections, lcount=.true.) 2239 if (found) then 2240 if (num_select_projections < 1) call io_error('Error: problem reading select_projections') 2241 if (allocated(select_projections)) deallocate (select_projections) 2242 allocate (select_projections(num_select_projections), stat=ierr) 2243 if (ierr /= 0) call io_error('Error allocating select_projections in param_read') 2244 call param_get_range_vector('select_projections', found, num_select_projections, .false., select_projections) 2245 if (any(select_projections < 1)) & 2246 call io_error('Error: select_projections must contain positive numbers') 2247 if (num_select_projections < num_wann) & 2248 call io_error('Error: too few projections selected') 2249 if (num_select_projections > num_wann) & 2250 call io_error('Error: too many projections selected') 2251 if (.not. lhasproj) & 2252 call io_error('Error: select_projections cannot be used without defining the projections') 2253 if (maxval(select_projections(:)) > num_proj) & 2254 call io_error('Error: select_projections contains a number greater than num_proj') 2255 lselproj = .true. 2256 end if 2257 2258 if (allocated(proj2wann_map)) deallocate (proj2wann_map) 2259 allocate (proj2wann_map(num_proj), stat=ierr) 2260 if (ierr /= 0) call io_error('Error allocating proj2wann_map in param_read') 2261 proj2wann_map = -1 2262 2263 if (lselproj) then 2264 do i = 1, num_proj 2265 do j = 1, num_wann 2266 if (select_projections(j) == i) proj2wann_map(i) = j 2267 enddo 2268 enddo 2269 else 2270 do i = 1, num_wann 2271 proj2wann_map(i) = i 2272 enddo 2273 endif 2274 2275 if (lhasproj) call param_get_projections(num_proj, lcount=.false.) 2276 2277 ! Constrained centres 2278 call param_get_block_length('slwf_centres', found, i_temp) 2279 if (found) then 2280 if (slwf_constrain) then 2281 ! Allocate array for constrained centres 2282 call param_get_centre_constraints 2283 else 2284 write (stdout, '(a)') ' slwf_constrain set to false. Ignoring <slwf_centres> block ' 2285 end if 2286 ! Check that either projections or constrained centres are specified if slwf_constrain=.true. 2287 elseif (.not. found) then 2288 if (slwf_constrain) then 2289 if (.not. allocated(proj_site)) then 2290 call io_error('Error: slwf_constrain = true, but neither & 2291 & <slwf_centre> block nor & 2292 & <projection_block> are specified.') 2293 else 2294 ! Allocate array for constrained centres 2295 call param_get_centre_constraints 2296 end if 2297 end if 2298 end if 2299 ! Warning 2300 if (slwf_constrain .and. allocated(proj_site) .and. .not. found) & 2301 & write (stdout, '(a)') ' Warning: No <slwf_centres> block found, but slwf_constrain set to true. & 2302 & Desired centres for SLWF same as projection centres.' 2303 2304302 continue 2305 2306 if (any(len_trim(in_data(:)) > 0)) then 2307 write (stdout, '(1x,a)') 'The following section of file '//trim(seedname)//'.win contained unrecognised keywords' 2308 write (stdout, *) 2309 do loop = 1, num_lines 2310 if (len_trim(in_data(loop)) > 0) then 2311 write (stdout, '(1x,a)') trim(in_data(loop)) 2312 end if 2313 end do 2314 write (stdout, *) 2315 call io_error('Unrecognised keyword(s) in input file, see also output file') 2316 end if 2317 2318 if (transport .and. tran_read_ht) goto 303 2319 2320 ! For aesthetic purposes, convert some things to uppercase 2321 call param_uppercase() 2322 2323303 continue 2324 2325 deallocate (in_data, stat=ierr) 2326 if (ierr /= 0) call io_error('Error deallocating in_data in param_read') 2327 2328 if (transport .and. tran_read_ht) return 2329 2330 ! =============================== ! 2331 ! Some checks and initialisations ! 2332 ! =============================== ! 2333 2334! if (restart.ne.' ') disentanglement=.false. 2335 2336 if (disentanglement) then 2337 if (allocated(ndimwin)) deallocate (ndimwin) 2338 allocate (ndimwin(num_kpts), stat=ierr) 2339 if (ierr /= 0) call io_error('Error allocating ndimwin in param_read') 2340 if (allocated(lwindow)) deallocate (lwindow) 2341 allocate (lwindow(num_bands, num_kpts), stat=ierr) 2342 if (ierr /= 0) call io_error('Error allocating lwindow in param_read') 2343 endif 2344 2345! if ( wannier_plot .and. (index(wannier_plot_format,'cub').ne.0) ) then 2346! cosa(1)=dot_product(real_lattice(1,:),real_lattice(2,:)) 2347! cosa(2)=dot_product(real_lattice(1,:),real_lattice(3,:)) 2348! cosa(3)=dot_product(real_lattice(2,:),real_lattice(3,:)) 2349! cosa = abs(cosa) 2350! if (any(cosa.gt.eps6)) & 2351! call io_error('Error: plotting in cube format requires orthogonal lattice vectors') 2352! endif 2353 2354 ! Initialise 2355 omega_total = -999.0_dp 2356 omega_tilde = -999.0_dp 2357 omega_invariant = -999.0_dp 2358 have_disentangled = .false. 2359 2360 if (allocated(wannier_centres)) deallocate (wannier_centres) 2361 allocate (wannier_centres(3, num_wann), stat=ierr) 2362 if (ierr /= 0) call io_error('Error allocating wannier_centres in param_read') 2363 wannier_centres = 0.0_dp 2364 if (allocated(wannier_spreads)) deallocate (wannier_spreads) 2365 allocate (wannier_spreads(num_wann), stat=ierr) 2366 if (ierr /= 0) call io_error('Error in allocating wannier_spreads in param_read') 2367 wannier_spreads = 0.0_dp 2368 2369 return 2370 2371105 call io_error('Error: Problem opening eigenvalue file '//trim(seedname)//'.eig') 2372106 call io_error('Error: Problem reading eigenvalue file '//trim(seedname)//'.eig') 2373 2374 end subroutine param_read 2375 2376 subroutine internal_set_kmesh(spacing, reclat, mesh) 2377 !! This routines returns the three integers that define the interpolation k-mesh, satisfying 2378 !! the condition that the spacing between two neighboring points along each of the three 2379 !! k_x, k_y and k_z directions is at smaller than a given spacing. 2380 !! 2381 !! The reclat is defined as: 2382 !! * 'b_1' = (recip_lattice(1,I), i=1,3) 2383 !! * 'b_2' = (recip_lattice(2,I), i=1,3) 2384 !! * 'b_3' = (recip_lattice(3,I), i=1,3) 2385 !! 2386 !! spacing must be > 0 (and in particular different from zero). We don't check this here. 2387 !! 2388 implicit none 2389 real(kind=dp), intent(in) :: spacing 2390 !! Minimum spacing between neighboring points, in angstrom^(-1) 2391 real(kind=dp), dimension(3, 3), intent(in) :: reclat 2392 !! Matrix of the reciprocal lattice vectors in cartesian coordinates, in angstrom^(-1) 2393 integer, dimension(3), intent(out) :: mesh 2394 !! Will contain the three integers defining the interpolation k-mesh 2395 2396 real(kind=dp), dimension(3) :: blen 2397 integer :: i 2398 2399 do i = 1, 3 2400 blen(i) = sqrt(sum(reclat(i, :)**2)) 2401 end do 2402 2403 do i = 1, 3 2404 mesh(i) = int(floor(blen(i)/spacing)) + 1 2405 end do 2406 2407 end subroutine internal_set_kmesh 2408 2409 subroutine get_module_kmesh(moduleprefix, should_be_defined, module_kmesh, module_kmesh_spacing) 2410 !! This function reads and sets the interpolation mesh variables needed by a given module 2411 !> 2412 !! This function MUST be called after having read the global kmesh and kmesh_spacing!! 2413 !! if the user didn't provide an interpolation_mesh_spacing, it is set to -1, so that 2414 !! one can check in the code what the user asked for 2415 !! The function takes care also of setting the default value to the global one if no local 2416 !! keyword is defined 2417 use w90_io, only: io_error 2418 character(len=*), intent(in) :: moduleprefix 2419 !!The prefix that is appended before the name of the variables. In particular, 2420 !!if the prefix is for instance XXX, the two variables that are read from the 2421 !!input file are XXX_kmesh and XXX_kmesh_spacing. 2422 logical, intent(in) :: should_be_defined 2423 !! A logical flag: if it is true, at the end the code stops if no value is specified. 2424 !! Define it to .false. if no check should be performed. 2425 !! Often, you can simply pass the flag that activates the module itself. 2426 integer, dimension(3), intent(out) :: module_kmesh 2427 !! the integer array (length 3) where the interpolation mesh will be saved 2428 real(kind=dp), intent(out) :: module_kmesh_spacing 2429 !! the real number on which the min mesh spacing is saved. -1 if it the 2430 !!user specifies in input the mesh and not the mesh_spacing 2431 2432 logical :: found, found2 2433 integer :: i 2434 2435 ! Default values 2436 module_kmesh_spacing = -1._dp 2437 module_kmesh = 0 2438 call param_get_keyword(trim(moduleprefix)//'_kmesh_spacing', found, r_value=module_kmesh_spacing) 2439 if (found) then 2440 if (module_kmesh_spacing .le. 0._dp) & 2441 call io_error('Error: '//trim(moduleprefix)//'_kmesh_spacing must be greater than zero') 2442 2443 call internal_set_kmesh(module_kmesh_spacing, recip_lattice, module_kmesh) 2444 end if 2445 call param_get_vector_length(trim(moduleprefix)//'_kmesh', found2, length=i) 2446 if (found2) then 2447 if (found) & 2448 call io_error('Error: cannot set both '//trim(moduleprefix)//'_kmesh and ' & 2449 //trim(moduleprefix)//'_kmesh_spacing') 2450 if (i .eq. 1) then 2451 call param_get_keyword_vector(trim(moduleprefix)//'_kmesh', found2, 1, i_value=module_kmesh) 2452 module_kmesh(2) = module_kmesh(1) 2453 module_kmesh(3) = module_kmesh(1) 2454 elseif (i .eq. 3) then 2455 call param_get_keyword_vector(trim(moduleprefix)//'_kmesh', found2, 3, i_value=module_kmesh) 2456 else 2457 call io_error('Error: '//trim(moduleprefix)// & 2458 '_kmesh must be provided as either one integer or a vector of 3 integers') 2459 end if 2460 if (any(module_kmesh <= 0)) & 2461 call io_error('Error: '//trim(moduleprefix)//'_kmesh elements must be greater than zero') 2462 end if 2463 2464 if ((found .eqv. .false.) .and. (found2 .eqv. .false.)) then 2465 ! This is the case where no "local" interpolation k-mesh is provided in the input 2466 if (global_kmesh_set) then 2467 module_kmesh = kmesh 2468 ! I set also boltz_kmesh_spacing so that I can check if it is < 0 or not, and if it is 2469 ! > 0 I can print on output the mesh spacing that was chosen 2470 module_kmesh_spacing = kmesh_spacing 2471 else 2472 if (should_be_defined) & 2473 call io_error('Error: '//trim(moduleprefix)//' module required, but no interpolation mesh given.') 2474 end if 2475 end if 2476 end subroutine get_module_kmesh 2477 2478 function param_get_smearing_type(smearing_index) 2479 !! This function returns a string describing the type of smearing 2480 !! associated to a given smr_index integer value. 2481 integer, intent(in) :: smearing_index 2482 !! The integer index for which we want to get the string 2483 character(len=80) :: param_get_smearing_type 2484 2485 character(len=4) :: orderstr 2486 2487 if (smearing_index > 0) then 2488 write (orderstr, '(I0)') smearing_index 2489 param_get_smearing_type = "Methfessel-Paxton of order "//trim(orderstr) 2490 else if (smearing_index .eq. 0) then 2491 param_get_smearing_type = "Gaussian" 2492 else if (smearing_index .eq. -1) then 2493 param_get_smearing_type = "Marzari-Vanderbilt cold smearing" 2494 else if (smearing_index .eq. -99) then 2495 param_get_smearing_type = "Fermi-Dirac smearing" 2496 else 2497 param_get_smearing_type = "Unknown type of smearing" 2498 end if 2499 2500 end function param_get_smearing_type 2501 2502 function param_get_convention_type(sc_phase_conv) 2503 !! This function returns a string describing the convention 2504 !! associated to a sc_phase_conv integer value. 2505 integer, intent(in) :: sc_phase_conv 2506 !! The integer index for which we want to get the string 2507 character(len=80) :: param_get_convention_type 2508 2509 character(len=4) :: orderstr 2510 2511 if (sc_phase_conv .eq. 1) then 2512 param_get_convention_type = "Tight-binding convention" 2513 else if (sc_phase_conv .eq. 2) then 2514 param_get_convention_type = "Wannier90 convention" 2515 else 2516 param_get_convention_type = "Unknown type of convention" 2517 end if 2518 2519 end function param_get_convention_type 2520 2521 function get_smearing_index(string, keyword) 2522 !! This function parses a string containing the type of 2523 !! smearing and returns the correct index for the smearing_index variable 2524 ! 2525 !! If the string is not valid, an io_error is issued 2526 use w90_io, only: io_error 2527 character(len=*), intent(in) :: string 2528 !! The string read from input 2529 character(len=*), intent(in) :: keyword 2530 !! The keyword that was read (e.g., smr_type), so that we can print a more useful error message 2531 integer :: get_smearing_index 2532 2533 integer :: pos 2534 2535 get_smearing_index = 0 ! To avoid warnings of unset variables 2536 2537 if (index(string, 'm-v') > 0) then 2538 get_smearing_index = -1 2539 elseif (index(string, 'm-p') > 0) then 2540 pos = index(string, 'm-p') 2541 if (len(trim(string(pos + 3:))) .eq. 0) then 2542 ! If the string is only 'm-p', we assume that 'm-p1' was intended 2543 get_smearing_index = 1 2544 else 2545 read (string(pos + 3:), *, err=337) get_smearing_index 2546 if (get_smearing_index < 0) & 2547 call io_error('Wrong m-p smearing order in keyword '//trim(keyword)) 2548 end if 2549 elseif (index(string, 'f-d') > 0) then 2550 get_smearing_index = -99 2551 ! Some aliases 2552 elseif (index(string, 'cold') > 0) then 2553 get_smearing_index = -1 2554 elseif (index(string, 'gauss') > 0) then 2555 get_smearing_index = 0 2556 ! Unrecognised keyword 2557 else 2558 call io_error('Unrecognised value for keyword '//trim(keyword)) 2559 end if 2560 2561 return 2562 2563337 call io_error('Wrong m-p smearing order in keyword '//trim(keyword)) 2564 2565 end function get_smearing_index 2566 2567!=================================================================== 2568 subroutine param_uppercase 2569 !=================================================================== 2570 ! ! 2571 !! Convert a few things to uppercase to look nice in the output 2572 ! ! 2573 !=================================================================== 2574 2575 implicit none 2576 2577 integer :: nsp, ic, loop, inner_loop 2578 2579 ! Atom labels (eg, si --> Si) 2580 do nsp = 1, num_species 2581 ic = ichar(atoms_label(nsp) (1:1)) 2582 if ((ic .ge. ichar('a')) .and. (ic .le. ichar('z'))) & 2583 atoms_label(nsp) (1:1) = char(ic + ichar('Z') - ichar('z')) 2584 enddo 2585 2586 do nsp = 1, num_species 2587 ic = ichar(atoms_symbol(nsp) (1:1)) 2588 if ((ic .ge. ichar('a')) .and. (ic .le. ichar('z'))) & 2589 atoms_symbol(nsp) (1:1) = char(ic + ichar('Z') - ichar('z')) 2590 enddo 2591 2592 ! Bands labels (eg, x --> X) 2593 do loop = 1, bands_num_spec_points 2594 do inner_loop = 1, len(bands_label(loop)) 2595 ic = ichar(bands_label(loop) (inner_loop:inner_loop)) 2596 if ((ic .ge. ichar('a')) .and. (ic .le. ichar('z'))) & 2597 bands_label(loop) (inner_loop:inner_loop) = char(ic + ichar('Z') - ichar('z')) 2598 enddo 2599 enddo 2600 2601 ! Length unit (ang --> Ang, bohr --> Bohr) 2602 ic = ichar(length_unit(1:1)) 2603 if ((ic .ge. ichar('a')) .and. (ic .le. ichar('z'))) & 2604 length_unit(1:1) = char(ic + ichar('Z') - ichar('z')) 2605 2606 return 2607 2608 end subroutine param_uppercase 2609 2610!=================================================================== 2611 subroutine param_write 2612 !==================================================================! 2613 ! ! 2614 !! write wannier90 parameters to stdout 2615 ! ! 2616 !=================================================================== 2617 2618 implicit none 2619 2620 integer :: i, nkp, loop, nat, nsp 2621 2622 if (transport .and. tran_read_ht) goto 401 2623 2624 ! System 2625 write (stdout, *) 2626 write (stdout, '(36x,a6)') '------' 2627 write (stdout, '(36x,a6)') 'SYSTEM' 2628 write (stdout, '(36x,a6)') '------' 2629 write (stdout, *) 2630 if (lenconfac .eq. 1.0_dp) then 2631 write (stdout, '(30x,a21)') 'Lattice Vectors (Ang)' 2632 else 2633 write (stdout, '(28x,a22)') 'Lattice Vectors (Bohr)' 2634 endif 2635 write (stdout, 101) 'a_1', (real_lattice(1, I)*lenconfac, i=1, 3) 2636 write (stdout, 101) 'a_2', (real_lattice(2, I)*lenconfac, i=1, 3) 2637 write (stdout, 101) 'a_3', (real_lattice(3, I)*lenconfac, i=1, 3) 2638 write (stdout, *) 2639 write (stdout, '(19x,a17,3x,f11.5)', advance='no') & 2640 'Unit Cell Volume:', cell_volume*lenconfac**3 2641 if (lenconfac .eq. 1.0_dp) then 2642 write (stdout, '(2x,a7)') '(Ang^3)' 2643 else 2644 write (stdout, '(2x,a8)') '(Bohr^3)' 2645 endif 2646 write (stdout, *) 2647 if (lenconfac .eq. 1.0_dp) then 2648 write (stdout, '(24x,a33)') 'Reciprocal-Space Vectors (Ang^-1)' 2649 else 2650 write (stdout, '(22x,a34)') 'Reciprocal-Space Vectors (Bohr^-1)' 2651 endif 2652 write (stdout, 101) 'b_1', (recip_lattice(1, I)/lenconfac, i=1, 3) 2653 write (stdout, 101) 'b_2', (recip_lattice(2, I)/lenconfac, i=1, 3) 2654 write (stdout, 101) 'b_3', (recip_lattice(3, I)/lenconfac, i=1, 3) 2655 write (stdout, *) ' ' 2656 ! Atoms 2657 if (num_atoms > 0) then 2658 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 2659 if (lenconfac .eq. 1.0_dp) then 2660 write (stdout, '(1x,a)') '| Site Fractional Coordinate Cartesian Coordinate (Ang) |' 2661 else 2662 write (stdout, '(1x,a)') '| Site Fractional Coordinate Cartesian Coordinate (Bohr) |' 2663 endif 2664 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2665 do nsp = 1, num_species 2666 do nat = 1, atoms_species_num(nsp) 2667 write (stdout, '(1x,a1,1x,a2,1x,i3,3F10.5,3x,a1,1x,3F10.5,4x,a1)') & 2668 & '|', atoms_symbol(nsp), nat, atoms_pos_frac(:, nat, nsp),& 2669 & '|', atoms_pos_cart(:, nat, nsp)*lenconfac, '|' 2670 end do 2671 end do 2672 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 2673 else 2674 write (stdout, '(25x,a)') 'No atom positions specified' 2675 end if 2676 ! Constrained centres 2677 if (selective_loc .and. slwf_constrain) then 2678 write (stdout, *) ' ' 2679 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 2680 write (stdout, '(1x,a)') '| Wannier# Original Centres Constrained centres |' 2681 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2682 do i = 1, slwf_num 2683 write (stdout, '(1x,a1,2x,i3,2x,3F10.5,3x,a1,1x,3F10.5,4x,a1)') & 2684 & '|', i, ccentres_frac(i, :), '|', wannier_centres(:, i), '|' 2685 end do 2686 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 2687 end if 2688 ! Projections 2689 if (iprint > 1 .and. allocated(input_proj_site)) then 2690 write (stdout, '(32x,a)') '-----------' 2691 write (stdout, '(32x,a)') 'PROJECTIONS' 2692 write (stdout, '(32x,a)') '-----------' 2693 write (stdout, *) ' ' 2694 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2695 write (stdout, '(1x,a)') '| Frac. Coord. l mr r z-axis x-axis Z/a |' 2696 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2697 do nsp = 1, num_proj 2698 write (stdout, '(1x,a1,3(1x,f5.2),1x,i2,1x,i2,1x,i2,3(1x,f6.3),3(1x,f6.3),2x,f4.1,1x,a1)')& 2699 & '|', input_proj_site(1, nsp), input_proj_site(2, nsp), & 2700 input_proj_site(3, nsp), input_proj_l(nsp), input_proj_m(nsp), input_proj_radial(nsp), & 2701 input_proj_z(1, nsp), input_proj_z(2, nsp), input_proj_z(3, nsp), input_proj_x(1, nsp), & 2702 input_proj_x(2, nsp), input_proj_x(3, nsp), input_proj_zona(nsp), '|' 2703 end do 2704 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2705 write (stdout, *) ' ' 2706 end if 2707 2708 if (iprint > 1 .and. lselproj .and. allocated(proj_site)) then 2709 write (stdout, '(30x,a)') '--------------------' 2710 write (stdout, '(30x,a)') 'SELECTED PROJECTIONS' 2711 write (stdout, '(30x,a)') '--------------------' 2712 write (stdout, *) ' ' 2713 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2714 write (stdout, '(1x,a)') '| Frac. Coord. l mr r z-axis x-axis Z/a |' 2715 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2716 do nsp = 1, num_wann 2717 if (proj2wann_map(nsp) < 0) cycle 2718 write (stdout, '(1x,a1,3(1x,f5.2),1x,i2,1x,i2,1x,i2,3(1x,f6.3),3(1x,f6.3),2x,f4.1,1x,a1)')& 2719 & '|', proj_site(1, nsp), proj_site(2, nsp), & 2720 proj_site(3, nsp), proj_l(nsp), proj_m(nsp), proj_radial(nsp), & 2721 proj_z(1, nsp), proj_z(2, nsp), proj_z(3, nsp), proj_x(1, nsp), & 2722 proj_x(2, nsp), proj_x(3, nsp), proj_zona(nsp), '|' 2723 end do 2724 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2725 write (stdout, *) ' ' 2726 end if 2727 2728 ! K-points 2729 write (stdout, '(32x,a)') '------------' 2730 write (stdout, '(32x,a)') 'K-POINT GRID' 2731 write (stdout, '(32x,a)') '------------' 2732 write (stdout, *) ' ' 2733 write (stdout, '(13x,a,i3,1x,a1,i3,1x,a1,i3,6x,a,i5)') 'Grid size =', mp_grid(1), 'x', mp_grid(2), 'x', mp_grid(3), & 2734 'Total points =', num_kpts 2735 write (stdout, *) ' ' 2736 if (iprint > 1) then 2737 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 2738 if (lenconfac .eq. 1.0_dp) then 2739 write (stdout, '(1x,a)') '| k-point Fractional Coordinate Cartesian Coordinate (Ang^-1) |' 2740 else 2741 write (stdout, '(1x,a)') '| k-point Fractional Coordinate Cartesian Coordinate (Bohr^-1) |' 2742 endif 2743 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 2744 do nkp = 1, num_kpts 2745 write (stdout, '(1x,a1,i6,1x,3F10.5,3x,a1,1x,3F10.5,4x,a1)') '|', nkp, kpt_latt(:, nkp), '|', & 2746 kpt_cart(:, nkp)/lenconfac, '|' 2747 end do 2748 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 2749 write (stdout, *) ' ' 2750 end if 2751 ! Main 2752 write (stdout, *) ' ' 2753 write (stdout, '(1x,a78)') '*---------------------------------- MAIN ------------------------------------*' 2754 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of Wannier Functions :', num_wann, '|' 2755 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of Objective Wannier Functions :', slwf_num, '|' 2756 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of input Bloch states :', num_bands, '|' 2757 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Output verbosity (1=low, 5=high) :', iprint, '|' 2758 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Timing Level (1=low, 5=high) :', timing_level, '|' 2759 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Optimisation (0=memory, 3=speed) :', optimisation, '|' 2760 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Length Unit :', trim(length_unit), '|' 2761 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Post-processing setup (write *.nnkp) :', postproc_setup, '|' 2762 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Using Gamma-only branch of algorithms :', gamma_only, '|' 2763 !YN: RS: 2764 if (lsitesymmetry) then 2765 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Using symmetry-adapted WF mode :', lsitesymmetry, '|' 2766 write (stdout, '(1x,a46,8x,E10.3,13x,a1)') '| Tolerance for symmetry condition on U :', symmetrize_eps, '|' 2767 endif 2768 2769 if (cp_pp .or. iprint > 2) & 2770 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| CP code post-processing :', cp_pp, '|' 2771 if (wannier_plot .or. iprint > 2) then 2772 if (wvfn_formatted) then 2773 write (stdout, '(1x,a46,9x,a9,13x,a1)') '| Wavefunction (UNK) file-type :', 'formatted', '|' 2774 else 2775 write (stdout, '(1x,a46,7x,a11,13x,a1)') '| Wavefunction (UNK) file-type :', 'unformatted', '|' 2776 endif 2777 if (spin == 1) then 2778 write (stdout, '(1x,a46,16x,a2,13x,a1)') '| Wavefunction spin channel :', 'up', '|' 2779 else 2780 write (stdout, '(1x,a46,14x,a4,13x,a1)') '| Wavefunction spin channel :', 'down', '|' 2781 endif 2782 endif 2783 2784 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2785 2786 ! Wannierise 2787 write (stdout, '(1x,a78)') '*------------------------------- WANNIERISE ---------------------------------*' 2788 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Total number of iterations :', num_iter, '|' 2789 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of CG steps before reset :', num_cg_steps, '|' 2790 if (lfixstep) then 2791 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Fixed step length for minimisation :', fixed_step, '|' 2792 else 2793 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Trial step length for line search :', trial_step, '|' 2794 endif 2795 write (stdout, '(1x,a46,8x,E10.3,13x,a1)') '| Convergence tolerence :', conv_tol, '|' 2796 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Convergence window :', conv_window, '|' 2797 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Iterations between writing output :', num_print_cycles, '|' 2798 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Iterations between backing up to disk :', num_dump_cycles, '|' 2799 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Write r^2_nm to file :', write_r2mn, '|' 2800 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Write xyz WF centres to file :', write_xyz, '|' 2801 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Write on-site energies <0n|H|0n> to file :', write_hr_diag, '|' 2802 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Use guiding centre to control phases :', guiding_centres, '|' 2803 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Use phases for initial projections :', use_bloch_phases, '|' 2804 if (guiding_centres .or. iprint > 2) then 2805 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Iterations before starting guiding centres:', num_no_guide_iter, '|' 2806 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Iterations between using guiding centres :', num_guide_cycles, '|' 2807 end if 2808 if (selective_loc .or. iprint > 2) then 2809 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Perform selective localization :', selective_loc, '|' 2810 end if 2811 if (slwf_constrain .or. iprint > 2) then 2812 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Use constrains in selective localization :', slwf_constrain, '|' 2813 write (stdout, '(1x,a46,8x,E10.3,13x,a1)') '| Value of the Lagrange multiplier :',& 2814 &slwf_lambda, '|' 2815 end if 2816 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2817 ! 2818 ! Disentanglement 2819 ! 2820 if (disentanglement .or. iprint > 2) then 2821 write (stdout, '(1x,a78)') '*------------------------------- DISENTANGLE --------------------------------*' 2822 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Using band disentanglement :', disentanglement, '|' 2823 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Total number of iterations :', dis_num_iter, '|' 2824 write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Mixing ratio :', dis_mix_ratio, '|' 2825 write (stdout, '(1x,a46,8x,ES10.3,13x,a1)') '| Convergence tolerence :', dis_conv_tol, '|' 2826 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Convergence window :', dis_conv_window, '|' 2827 ! GS-start 2828 if (dis_spheres_num .gt. 0) then 2829 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of spheres in k-space :', dis_spheres_num, '|' 2830 do nkp = 1, dis_spheres_num 2831 write (stdout, '(1x,a13,I4,a2,2x,3F8.3,a15,F8.3,9x,a1)') & 2832 '| center n.', nkp, ' :', dis_spheres(1:3, nkp), ', radius =', dis_spheres(4, nkp), '|' 2833 enddo 2834 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Index of first Wannier band :', dis_spheres_first_wann, '|' 2835 endif 2836 ! GS-end 2837 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2838 end if 2839 ! 2840 ! Plotting 2841 ! 2842 if (wannier_plot .or. bands_plot .or. fermi_surface_plot .or. kslice & 2843 .or. dos_plot .or. write_hr .or. iprint > 2) then 2844 ! 2845 write (stdout, '(1x,a78)') '*-------------------------------- PLOTTING ----------------------------------*' 2846 ! 2847 if (wannier_plot .or. iprint > 2) then 2848 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting Wannier functions :', wannier_plot, '|' 2849 write (stdout, '(1x,a46,1x,I5,a1,I5,a1,I5,13x,a1)') & 2850 '| Size of supercell for plotting :', & 2851 wannier_plot_supercell(1), 'x', wannier_plot_supercell(2), 'x', & 2852 wannier_plot_supercell(3), '|' 2853 2854 if (translate_home_cell) then 2855 write (stdout, '(1x,a46,10x,L8,13x,a1)') & 2856 '| Translating WFs to home cell :', translate_home_cell, '|' 2857 end if 2858 2859 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plotting mode (molecule or crystal) :', trim(wannier_plot_mode), '|' 2860 if (spinors) then 2861 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plotting mode for spinor WFs :', & 2862 trim(wannier_plot_spinor_mode), '|' 2863 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Include phase for spinor WFs :', & 2864 wannier_plot_spinor_phase, '|' 2865 end if 2866 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plotting format :', trim(wannier_plot_format), '|' 2867 if (index(wannier_plot_format, 'cub') > 0 .or. iprint > 2) then 2868 write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Plot radius :', wannier_plot_radius, '|' 2869 write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Plot scale :', wannier_plot_scale, '|' 2870 endif 2871 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2872 end if 2873 ! 2874 if (fermi_surface_plot .or. iprint > 2) then 2875 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting Fermi surface :', fermi_surface_plot, '|' 2876 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of plotting points (along b_1) :', fermi_surface_num_points, '|' 2877 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plotting format :' & 2878 , trim(fermi_surface_plot_format), '|' 2879 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2880 end if 2881 ! 2882 if (bands_plot .or. iprint > 2) then 2883 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting interpolated bandstructure :', bands_plot, '|' 2884 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of K-path sections :', bands_num_spec_points/2, '|' 2885 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Divisions along first K-path section :', bands_num_points, '|' 2886 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Output format :', trim(bands_plot_format), '|' 2887 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Output mode :', trim(bands_plot_mode), '|' 2888 if (index(bands_plot_mode, 'cut') .ne. 0) then 2889 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Dimension of the system :', bands_plot_dim, '|' 2890 if (bands_plot_dim .eq. 1) & 2891 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| System extended in :', trim(one_dim_axis), '|' 2892 if (bands_plot_dim .eq. 2) & 2893 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| System confined in :', trim(one_dim_axis), '|' 2894 write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Hamiltonian cut-off value :', hr_cutoff, '|' 2895 write (stdout, '(1x,a46,10x,F8.3,13x,a1)') '| Hamiltonian cut-off distance :', dist_cutoff, '|' 2896 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Hamiltonian cut-off distance mode :', trim(dist_cutoff_mode), '|' 2897 endif 2898 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2899 write (stdout, '(1x,a78)') '| K-space path sections: |' 2900 if (bands_num_spec_points == 0) then 2901 write (stdout, '(1x,a78)') '| None defined |' 2902 else 2903 do loop = 1, bands_num_spec_points, 2 2904 write (stdout, '(1x,a10,1x,a5,1x,3F7.3,5x,a3,1x,a5,1x,3F7.3,3x,a1)') '| From:', bands_label(loop), & 2905 (bands_spec_points(i, loop), i=1, 3), 'To:', bands_label(loop + 1), (bands_spec_points(i, loop + 1), i=1, 3), '|' 2906 end do 2907 end if 2908 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2909 end if 2910 ! 2911 if (write_hr .or. iprint > 2) then 2912 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting Hamiltonian in WF basis :', write_hr, '|' 2913 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2914 endif 2915 if (write_vdw_data .or. iprint > 2) then 2916 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Writing data for Van der Waals post-proc :', write_vdw_data, '|' 2917 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2918 endif 2919 ! 2920 endif 2921 2922401 continue 2923 ! 2924 ! Transport 2925 ! 2926 if (transport .or. iprint > 2) then 2927 ! 2928 write (stdout, '(1x,a78)') '*------------------------------- TRANSPORT ----------------------------------*' 2929 ! 2930 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Transport mode :', trim(transport_mode), '|' 2931 ! 2932 if (tran_read_ht) then 2933 ! 2934 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Hamiltonian from external files :', 'T', '|' 2935 ! 2936 else 2937 ! 2938 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Hamiltonian from external files :', 'F', '|' 2939 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| System extended in :', trim(one_dim_axis), '|' 2940 ! 2941 end if 2942 2943 write (stdout, '(1x,a78)') '| Centre of the unit cell to which WF are translated (fract. coords): |' 2944 write (stdout, '(1x,a1,35x,F12.6,a1,F12.6,a1,F12.6,3x,a1)') '|', translation_centre_frac(1), ',', & 2945 translation_centre_frac(2), ',', & 2946 translation_centre_frac(3), '|' 2947 2948 if (size(fermi_energy_list) == 1) then 2949 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Fermi energy (eV) :', fermi_energy_list(1), '|' 2950 else 2951 write (stdout, '(1x,a21,I8,a12,f8.3,a4,f8.3,a3,13x,a1)') '| Fermi energy :', size(fermi_energy_list), & 2952 ' steps from ', fermi_energy_list(1), ' to ', & 2953 fermi_energy_list(size(fermi_energy_list)), ' eV', '|' 2954 end if 2955 ! 2956 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 2957 ! 2958 endif 2959 2960101 format(20x, a3, 2x, 3F11.6) 2961 2962 end subroutine param_write 2963 2964!=================================================================== 2965 subroutine param_postw90_write 2966 !==================================================================! 2967 ! ! 2968 !! write postw90 parameters to stdout 2969 ! ! 2970 !=================================================================== 2971 2972 implicit none 2973 2974 integer :: i, loop, nat, nsp 2975 2976 ! System 2977 write (stdout, *) 2978 write (stdout, '(36x,a6)') '------' 2979 write (stdout, '(36x,a6)') 'SYSTEM' 2980 write (stdout, '(36x,a6)') '------' 2981 write (stdout, *) 2982 if (lenconfac .eq. 1.0_dp) then 2983 write (stdout, '(30x,a21)') 'Lattice Vectors (Ang)' 2984 else 2985 write (stdout, '(28x,a22)') 'Lattice Vectors (Bohr)' 2986 endif 2987 write (stdout, 101) 'a_1', (real_lattice(1, I)*lenconfac, i=1, 3) 2988 write (stdout, 101) 'a_2', (real_lattice(2, I)*lenconfac, i=1, 3) 2989 write (stdout, 101) 'a_3', (real_lattice(3, I)*lenconfac, i=1, 3) 2990 write (stdout, *) 2991 write (stdout, '(19x,a17,3x,f11.5)', advance='no') & 2992 'Unit Cell Volume:', cell_volume*lenconfac**3 2993 if (lenconfac .eq. 1.0_dp) then 2994 write (stdout, '(2x,a7)') '(Ang^3)' 2995 else 2996 write (stdout, '(2x,a8)') '(Bohr^3)' 2997 endif 2998 write (stdout, *) 2999 if (lenconfac .eq. 1.0_dp) then 3000 write (stdout, '(24x,a33)') 'Reciprocal-Space Vectors (Ang^-1)' 3001 else 3002 write (stdout, '(22x,a34)') 'Reciprocal-Space Vectors (Bohr^-1)' 3003 endif 3004 write (stdout, 101) 'b_1', (recip_lattice(1, I)/lenconfac, i=1, 3) 3005 write (stdout, 101) 'b_2', (recip_lattice(2, I)/lenconfac, i=1, 3) 3006 write (stdout, 101) 'b_3', (recip_lattice(3, I)/lenconfac, i=1, 3) 3007 write (stdout, *) ' ' 3008 ! Atoms 3009 if (num_atoms > 0) then 3010 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 3011 if (lenconfac .eq. 1.0_dp) then 3012 write (stdout, '(1x,a)') '| Site Fractional Coordinate Cartesian Coordinate (Ang) |' 3013 else 3014 write (stdout, '(1x,a)') '| Site Fractional Coordinate Cartesian Coordinate (Bohr) |' 3015 endif 3016 write (stdout, '(1x,a)') '+----------------------------------------------------------------------------+' 3017 do nsp = 1, num_species 3018 do nat = 1, atoms_species_num(nsp) 3019 write (stdout, '(1x,a1,1x,a2,1x,i3,3F10.5,3x,a1,1x,3F10.5,4x,a1)') & 3020 & '|', atoms_symbol(nsp), nat, atoms_pos_frac(:, nat, nsp),& 3021 & '|', atoms_pos_cart(:, nat, nsp)*lenconfac, '|' 3022 end do 3023 end do 3024 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 3025 else 3026 write (stdout, '(25x,a)') 'No atom positions specified' 3027 end if 3028 write (stdout, *) ' ' 3029 ! Main 3030 write (stdout, *) ' ' 3031 3032 write (stdout, '(1x,a78)') '*-------------------------------- POSTW90 -----------------------------------*' 3033 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of Wannier Functions :', num_wann, '|' 3034 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Number of electrons per state :', num_elec_per_state, '|' 3035 if (abs(scissors_shift) > 1.0e-7_dp .or. iprint > 0) then 3036 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Scissor shift applied to conduction bands :', scissors_shift, '|' 3037 if (num_valence_bands > 0) then 3038 write (stdout, '(1x,a46,10x,i8,13x,a1)') '| Number of valence bands :', num_valence_bands, '|' 3039 else 3040 write (stdout, '(1x,a78)') '| Number of valence bands : not defined |' 3041 endif 3042 endif 3043 if (spin_decomp .or. iprint > 2) & 3044 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Spin decomposition :', spin_decomp, '|' 3045 if (spin_moment .or. iprint > 2) & 3046 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Compute Spin moment :', spin_moment, '|' 3047 if (spin_decomp .or. spin_moment .or. iprint > 2) then 3048 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Polar angle of spin quantisation axis :', spin_axis_polar, '|' 3049 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Azimuthal angle of spin quantisation axis :', spin_axis_azimuth, '|' 3050 if (spn_formatted) then 3051 write (stdout, '(1x,a46,9x,a9,13x,a1)') '| Spn file-type :', 'formatted', '|' 3052 else 3053 write (stdout, '(1x,a46,7x,a11,13x,a1)') '| Spn file-type :', 'unformatted', '|' 3054 endif 3055 if (uHu_formatted) then 3056 write (stdout, '(1x,a46,9x,a9,13x,a1)') '| uHu file-type :', 'formatted', '|' 3057 else 3058 write (stdout, '(1x,a46,7x,a11,13x,a1)') '| uHu file-type :', 'unformatted', '|' 3059 endif 3060 end if 3061 3062 if (size(fermi_energy_list) == 1) then 3063 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Fermi energy (eV) :', fermi_energy_list(1), '|' 3064 else 3065 write (stdout, '(1x,a21,I8,a12,f8.3,a4,f8.3,a3,13x,a1)') '| Fermi energy :', size(fermi_energy_list), & 3066 ' steps from ', fermi_energy_list(1), ' to ', & 3067 fermi_energy_list(size(fermi_energy_list)), ' eV', '|' 3068 end if 3069 3070 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Output verbosity (1=low, 5=high) :', iprint, '|' 3071 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Timing Level (1=low, 5=high) :', timing_level, '|' 3072 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Optimisation (0=memory, 3=speed) :', optimisation, '|' 3073 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Length Unit :', trim(length_unit), '|' 3074 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3075 write (stdout, '(1x,a78)') '*------------------------ Global Smearing Parameters ------------------------*' 3076 if (adpt_smr) then 3077 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Adaptive width smearing :', ' T', '|' 3078 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Adaptive smearing factor :', adpt_smr_fac, '|' 3079 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Maximum allowed smearing width (eV) :', adpt_smr_max, '|' 3080 3081 else 3082 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Fixed width smearing :', ' T', '|' 3083 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Smearing width :', smr_fixed_en_width, '|' 3084 endif 3085 write (stdout, '(1x,a21,5x,a47,4x,a1)') '| Smearing Function ', trim(param_get_smearing_type(smr_index)), '|' 3086 if (global_kmesh_set) then 3087 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Global interpolation k-points defined :', ' T', '|' 3088 if (kmesh_spacing > 0.0_dp) then 3089 write (stdout, '(1x,a15,i4,1x,a1,i4,1x,a1,i4,16x,a11,f8.3,11x,1a)') '| Grid size = ', & 3090 kmesh(1), 'x', kmesh(2), 'x', kmesh(3), ' Spacing = ', kmesh_spacing, '|' 3091 else 3092 write (stdout, '(1x,a46,2x,i4,1x,a1,i4,1x,a1,i4,13x,1a)') '| Grid size :' & 3093 , kmesh(1), 'x', kmesh(2), 'x', kmesh(3), '|' 3094 endif 3095 else 3096 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Global interpolation k-points defined :', ' F', '|' 3097 endif 3098 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3099 3100 ! DOS 3101 if (dos .or. iprint > 2) then 3102 write (stdout, '(1x,a78)') '*---------------------------------- DOS -------------------------------------*' 3103 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plotting Density of States :', dos, '|' 3104 if (num_dos_project > 1) then 3105 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Wannier Projected DOS :', ' T', '|' 3106 else 3107 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Wannier Projected DOS :', ' F', '|' 3108 endif 3109 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Minimum energy range for DOS plot :', dos_energy_min, '|' 3110 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Maximum energy range for DOS plot :', dos_energy_max, '|' 3111 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Energy step for DOS plot :', dos_energy_step, '|' 3112 if (dos_adpt_smr .eqv. adpt_smr .and. dos_adpt_smr_fac == adpt_smr_fac .and. dos_adpt_smr_max == adpt_smr_max & 3113 .and. dos_smr_fixed_en_width == smr_fixed_en_width .and. smr_index == dos_smr_index) then 3114 write (stdout, '(1x,a78)') '| Using global smearing parameters |' 3115 else 3116 if (dos_adpt_smr) then 3117 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Adaptive width smearing :', ' T', '|' 3118 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Adaptive smearing factor :', dos_adpt_smr_fac, '|' 3119 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Maximum allowed smearing width :', dos_adpt_smr_max, '|' 3120 else 3121 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Fixed width smearing :', ' T', '|' 3122 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Smearing width :', dos_smr_fixed_en_width, '|' 3123 endif 3124 write (stdout, '(1x,a21,5x,a47,4x,a1)') '| Smearing Function ', trim(param_get_smearing_type(dos_smr_index)), '|' 3125 endif 3126 if (kmesh(1) == dos_kmesh(1) .and. kmesh(2) == dos_kmesh(2) .and. kmesh(3) == dos_kmesh(3)) then 3127 write (stdout, '(1x,a78)') '| Using global k-point set for interpolation |' 3128 else 3129 if (dos_kmesh_spacing > 0.0_dp) then 3130 write (stdout, '(1x,a15,i4,1x,a1,i4,1x,a1,i4,16x,a11,f8.3,11x,1a)') '| Grid size = ', & 3131 dos_kmesh(1), 'x', dos_kmesh(2), 'x', dos_kmesh(3), ' Spacing = ', dos_kmesh_spacing, '|' 3132 else 3133 write (stdout, '(1x,a46,2x,i4,1x,a1,i4,1x,a1,i4,13x,1a)') '| Grid size :' & 3134 , dos_kmesh(1), 'x', dos_kmesh(2), 'x', dos_kmesh(3), '|' 3135 endif 3136 endif 3137 endif 3138 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3139 3140 if (kpath .or. iprint > 2) then 3141 write (stdout, '(1x,a78)') '*--------------------------------- KPATH ------------------------------------*' 3142 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plot Properties along a path in k-space :', kpath, '|' 3143 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Divisions along first kpath section :', kpath_num_points, '|' 3144 if (index(kpath_task, 'bands') > 0) then 3145 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot energy bands :', ' T', '|' 3146 else 3147 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot energy bands :', ' F', '|' 3148 endif 3149 if (index(kpath_task, 'curv') > 0) then 3150 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot Berry curvature :', ' T', '|' 3151 else 3152 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot Berry curvature :', ' F', '|' 3153 endif 3154 if (index(kpath_task, 'morb') > 0) then 3155 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot orbital magnetisation contribution :', ' T', '|' 3156 else 3157 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot orbital magnetisation contribution :', ' F', '|' 3158 endif 3159 if (index(kpath_task, 'shc') > 0) then 3160 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot spin Hall conductivity contribution :', ' T', '|' 3161 else 3162 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot spin Hall conductivity contribution :', ' F', '|' 3163 endif 3164 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Property used to colour code the bands :', trim(kpath_bands_colour), '|' 3165 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3166 write (stdout, '(1x,a78)') '| K-space path sections: |' 3167 if (bands_num_spec_points == 0) then 3168 write (stdout, '(1x,a78)') '| None defined |' 3169 else 3170 do loop = 1, bands_num_spec_points, 2 3171 write (stdout, '(1x,a10,2x,a1,2x,3F7.3,5x,a3,2x,a1,2x,3F7.3,7x,a1)') '| From:', bands_label(loop), & 3172 (bands_spec_points(i, loop), i=1, 3), 'To:', bands_label(loop + 1), (bands_spec_points(i, loop + 1), i=1, 3), '|' 3173 end do 3174 end if 3175 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3176 endif 3177 3178 if (kslice .or. iprint > 2) then 3179 write (stdout, '(1x,a78)') '*--------------------------------- KSLICE -----------------------------------*' 3180 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Plot Properties along a slice in k-space :', kslice, '|' 3181 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Fermi level used for slice :', fermi_energy_list(1), '|' 3182 write (stdout, '(1x,a46,10x,I8,13x,a1)') '| Divisions along first kpath section :', kpath_num_points, '|' 3183 if (index(kslice_task, 'fermi_lines') > 0) then 3184 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot energy contours (fermi lines) :', ' T', '|' 3185 else 3186 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot energy contours (fermi lines) :', ' F', '|' 3187 endif 3188 if (index(kslice_task, 'curv') > 0) then 3189 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot Berry curvature (sum over occ states):', ' T', '|' 3190 else 3191 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot Berry curvature (sum over occ states):', ' F', '|' 3192 endif 3193 if (index(kslice_task, 'morb') > 0) then 3194 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot orbital magnetisation contribution :', ' T', '|' 3195 else 3196 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot orbital magnetisation contribution :', ' F', '|' 3197 endif 3198 if (index(kslice_task, 'shc') > 0) then 3199 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot spin Hall conductivity contribution :', ' T', '|' 3200 else 3201 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Plot spin Hall conductivity contribution :', ' F', '|' 3202 endif 3203 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Property used to colour code the lines :', & 3204 trim(kslice_fermi_lines_colour), '|' 3205 write (stdout, '(1x,a78)') '| 2D slice parameters (in reduced coordinates): |' 3206 write (stdout, '(1x,a14,2x,3F8.3,37x,a1)') '| Corner: ', (kslice_corner(i), i=1, 3), '|' 3207 write (stdout, '(1x,a14,2x,3F8.3,10x,a12,2x,i4,9x,a1)') & 3208 '| Vector1: ', (kslice_b1(i), i=1, 3), ' Divisions:', kslice_2dkmesh(1), '|' 3209 write (stdout, '(1x,a14,2x,3F8.3,10x,a12,2x,i4,9x,a1)') & 3210 '| Vector2: ', (kslice_b2(i), i=1, 3), ' Divisions:', kslice_2dkmesh(1), '|' 3211 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3212 endif 3213 3214 if (berry .or. iprint > 2) then 3215 write (stdout, '(1x,a78)') '*--------------------------------- BERRY ------------------------------------*' 3216 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Compute Berry Phase related properties :', berry, '|' 3217 if (index(berry_task, 'kubo') > 0) then 3218 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Optical Conductivity and JDOS :', ' T', '|' 3219 else 3220 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Optical Conductivity and JDOS :', ' F', '|' 3221 endif 3222 if (index(berry_task, 'ahc') > 0) then 3223 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Anomalous Hall Conductivity :', ' T', '|' 3224 else 3225 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Anomalous Hall Conductivity :', ' F', '|' 3226 endif 3227 if (index(berry_task, 'sc') > 0) then 3228 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Shift Current :', ' T', '|' 3229 else 3230 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Shift Current :', ' F', '|' 3231 endif 3232 if (index(berry_task, 'morb') > 0) then 3233 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Orbital Magnetisation :', ' T', '|' 3234 else 3235 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Orbital Magnetisation :', ' F', '|' 3236 endif 3237 if (index(berry_task, 'shc') > 0) then 3238 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Spin Hall Conductivity :', ' T', '|' 3239 else 3240 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Compute Spin Hall Conductivity :', ' F', '|' 3241 endif 3242 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Lower frequency for optical responses :', kubo_freq_min, '|' 3243 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Upper frequency for optical responses :', kubo_freq_max, '|' 3244 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Step size for optical responses :', kubo_freq_step, '|' 3245 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Upper eigenvalue for optical responses :', kubo_eigval_max, '|' 3246 if (index(berry_task, 'sc') > 0) then 3247 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Smearing factor for shift current :', sc_eta, '|' 3248 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Frequency theshold for shift current :', sc_w_thr, '|' 3249 write (stdout, '(1x,a46,1x,a27,3x,a1)') '| Bloch sums :', & 3250 trim(param_get_convention_type(sc_phase_conv)), '|' 3251 end if 3252 if (kubo_adpt_smr .eqv. adpt_smr .and. kubo_adpt_smr_fac == adpt_smr_fac .and. kubo_adpt_smr_max == adpt_smr_max & 3253 .and. kubo_smr_fixed_en_width == smr_fixed_en_width .and. smr_index == kubo_smr_index) then 3254 write (stdout, '(1x,a78)') '| Using global smearing parameters |' 3255 else 3256 if (kubo_adpt_smr) then 3257 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Adaptive width smearing :', ' T', '|' 3258 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Adaptive smearing factor :', kubo_adpt_smr_fac, '|' 3259 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Maximum allowed smearing width :', kubo_adpt_smr_max, '|' 3260 else 3261 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Fixed width smearing :', ' T', '|' 3262 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Smearing width :', kubo_smr_fixed_en_width, '|' 3263 endif 3264 write (stdout, '(1x,a21,5x,a47,4x,a1)') '| Smearing Function ', trim(param_get_smearing_type(kubo_smr_index)), '|' 3265 endif 3266 if (kmesh(1) == berry_kmesh(1) .and. kmesh(2) == berry_kmesh(2) .and. kmesh(3) == berry_kmesh(3)) then 3267 write (stdout, '(1x,a78)') '| Using global k-point set for interpolation |' 3268 else 3269 if (berry_kmesh_spacing > 0.0_dp) then 3270 write (stdout, '(1x,a15,i4,1x,a1,i4,1x,a1,i4,16x,a11,f8.3,11x,1a)') '| Grid size = ', & 3271 berry_kmesh(1), 'x', berry_kmesh(2), 'x', berry_kmesh(3), ' Spacing = ', berry_kmesh_spacing, '|' 3272 else 3273 write (stdout, '(1x,a46,2x,i4,1x,a1,i4,1x,a1,i4,13x,1a)') '| Grid size :' & 3274 , berry_kmesh(1), 'x', berry_kmesh(2), 'x', berry_kmesh(3), '|' 3275 endif 3276 endif 3277 if (berry_curv_adpt_kmesh > 1) then 3278 write (stdout, '(1x,a46,10x,i8,13x,a1)') '| Using an adaptive refinement mesh of size :', berry_curv_adpt_kmesh, '|' 3279 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Threshold for adaptive refinement :', & 3280 berry_curv_adpt_kmesh_thresh, '|' 3281 else 3282 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Adaptive refinement :', ' none', '|' 3283 endif 3284 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3285 endif 3286 3287 if (gyrotropic .or. iprint > 2) then 3288 write (stdout, '(1x,a78)') '*--------------------------------- GYROTROPIC ------------------------------------*' 3289 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Compute Gyrotropic properties :', gyrotropic, '|' 3290 write (stdout, '(1x,a46,10x,a20,1x,a1)') '| gyrotropic_task :', gyrotropic_task, '|' 3291 call parameters_gyro_write_task(gyrotropic_task, '-d0', 'calculate the D tensor') 3292 call parameters_gyro_write_task(gyrotropic_task, '-dw', 'calculate the tildeD tensor') 3293 call parameters_gyro_write_task(gyrotropic_task, '-c', 'calculate the C tensor') 3294 call parameters_gyro_write_task(gyrotropic_task, '-k', 'calculate the K tensor') 3295 call parameters_gyro_write_task(gyrotropic_task, '-noa', 'calculate the interbad natural optical activity') 3296 call parameters_gyro_write_task(gyrotropic_task, '-dos', 'calculate the density of states') 3297 3298 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Lower frequency for tildeD,NOA :', gyrotropic_freq_min, '|' 3299 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Upper frequency :', gyrotropic_freq_max, '|' 3300 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Step size for frequency :', gyrotropic_freq_step, '|' 3301 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Upper eigenvalue :', gyrotropic_eigval_max, '|' 3302 if (gyrotropic_smr_fixed_en_width == smr_fixed_en_width .and. smr_index == gyrotropic_smr_index) then 3303 write (stdout, '(1x,a78)') '| Using global smearing parameters |' 3304 else 3305 write (stdout, '(1x,a78)') '| Using local smearing parameters |' 3306 endif 3307 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Fixed width smearing :', ' T', '|' 3308 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Smearing width :', & 3309 gyrotropic_smr_fixed_en_width, '|' 3310 write (stdout, '(1x,a21,5x,a47,4x,a1)') '| Smearing Function :', & 3311 trim(param_get_smearing_type(gyrotropic_smr_index)), '|' 3312 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| degen_thresh :', gyrotropic_degen_thresh, '|' 3313 3314 if (kmesh(1) == gyrotropic_kmesh(1) .and. kmesh(2) == gyrotropic_kmesh(2) .and. kmesh(3) == gyrotropic_kmesh(3)) then 3315 write (stdout, '(1x,a78)') '| Using global k-point set for interpolation |' 3316 elseif (gyrotropic_kmesh_spacing > 0.0_dp) then 3317 write (stdout, '(1x,a15,i4,1x,a1,i4,1x,a1,i4,16x,a11,f8.3,11x,1a)') '| Grid size = ', & 3318 gyrotropic_kmesh(1), 'x', gyrotropic_kmesh(2), 'x', gyrotropic_kmesh(3), ' Spacing = ', gyrotropic_kmesh_spacing, '|' 3319 else 3320 write (stdout, '(1x,a46,2x,i4,1x,a1,i4,1x,a1,i4,13x,1a)') '| Grid size :' & 3321 , gyrotropic_kmesh(1), 'x', gyrotropic_kmesh(2), 'x', gyrotropic_kmesh(3), '|' 3322 endif 3323 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| Adaptive refinement :', ' not implemented', '|' 3324 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3325 endif 3326 3327 if (boltzwann .or. iprint > 2) then 3328 write (stdout, '(1x,a78)') '*------------------------------- BOLTZWANN ----------------------------------*' 3329 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Compute Boltzmann transport properties :', boltzwann, '|' 3330 if (boltz_2d_dir_num > 0) then 3331 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| 2d structure: non-periodic dimension :', trim(boltz_2d_dir), '|' 3332 else 3333 write (stdout, '(1x,a78)') '| 3d Structure : T |' 3334 endif 3335 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Relaxation Time (fs) :', boltz_relax_time, '|' 3336 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Minimum Value of Chemical Potential (eV) :', boltz_mu_min, '|' 3337 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Maximum Value of Chemical Potential (eV) :', boltz_mu_max, '|' 3338 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Step size for Chemical Potential (eV) :', boltz_mu_step, '|' 3339 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Minimum Value of Temperature (K) :', boltz_temp_min, '|' 3340 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Maximum Value of Temperature (K) :', boltz_temp_max, '|' 3341 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Step size for Temperature (K) :', boltz_temp_step, '|' 3342 3343 if (kmesh(1) == boltz_kmesh(1) .and. kmesh(2) == boltz_kmesh(2) .and. kmesh(3) == boltz_kmesh(3)) then 3344 write (stdout, '(1x,a78)') '| Using global k-point set for interpolation |' 3345 else 3346 if (boltz_kmesh_spacing > 0.0_dp) then 3347 write (stdout, '(1x,a15,i4,1x,a1,i4,1x,a1,i4,16x,a11,f8.3,11x,1a)') '| Grid size = ', & 3348 boltz_kmesh(1), 'x', boltz_kmesh(2), 'x', boltz_kmesh(3), ' Spacing = ', boltz_kmesh_spacing, '|' 3349 else 3350 write (stdout, '(1x,a46,2x,i4,1x,a1,i4,1x,a1,i4,13x,1a)') '| Grid size :' & 3351 , boltz_kmesh(1), 'x', boltz_kmesh(2), 'x', boltz_kmesh(3), '|' 3352 endif 3353 endif 3354 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Step size for TDF (eV) :', boltz_tdf_energy_step, '|' 3355 write (stdout, '(1x,a25,5x,a43,4x,a1)') '| TDF Smearing Function ', trim(param_get_smearing_type(boltz_tdf_smr_index)), '|' 3356 if (boltz_tdf_smr_fixed_en_width > 0.0_dp) then 3357 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') & 3358 '| TDF fixed Smearing width (eV) :', boltz_tdf_smr_fixed_en_width, '|' 3359 else 3360 write (stdout, '(1x,a78)') '| TDF fixed Smearing width : unsmeared |' 3361 endif 3362 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Compute DOS at same time :', boltz_calc_also_dos, '|' 3363 if (boltz_calc_also_dos .and. iprint > 2) then 3364 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Minimum energy range for DOS plot :', boltz_dos_energy_min, '|' 3365 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Maximum energy range for DOS plot :', boltz_dos_energy_max, '|' 3366 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| Energy step for DOS plot :', boltz_dos_energy_step, '|' 3367 if (boltz_dos_adpt_smr .eqv. adpt_smr .and. boltz_dos_adpt_smr_fac == adpt_smr_fac & 3368 .and. boltz_dos_adpt_smr_max == adpt_smr_max & 3369 .and. boltz_dos_smr_fixed_en_width == smr_fixed_en_width .and. smr_index == boltz_dos_smr_index) then 3370 write (stdout, '(1x,a78)') '| Using global smearing parameters |' 3371 else 3372 if (boltz_dos_adpt_smr) then 3373 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| DOS Adaptive width smearing :', ' T', '|' 3374 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') & 3375 '| DOS Adaptive smearing factor :', boltz_dos_adpt_smr_fac, '|' 3376 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') & 3377 '| DOS Maximum allowed smearing width :', boltz_dos_adpt_smr_max, '|' 3378 else 3379 write (stdout, '(1x,a46,10x,a8,13x,a1)') '| DOS Fixed width smearing :', ' T', '|' 3380 write (stdout, '(1x,a46,10x,f8.3,13x,a1)') '| DOS Smearing width :', & 3381 boltz_dos_smr_fixed_en_width, '|' 3382 endif 3383 write (stdout, '(1x,a21,5x,a47,4x,a1)') '| Smearing Function ', trim(param_get_smearing_type(boltz_dos_smr_index)), '|' 3384 endif 3385 endif 3386 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3387 endif 3388 3389 if (geninterp .or. iprint > 2) then 3390 write (stdout, '(1x,a78)') '*------------------------Generic Band Interpolation--------------------------*' 3391 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Compute Properties at given k-points :', geninterp, '|' 3392 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Calculate band gradients :', geninterp_alsofirstder, '|' 3393 write (stdout, '(1x,a46,10x,L8,13x,a1)') '| Write data into a single file :', geninterp_single_file, '|' 3394 write (stdout, '(1x,a78)') '*----------------------------------------------------------------------------*' 3395 endif 3396 3397101 format(20x, a3, 2x, 3F11.6) 3398 3399 end subroutine param_postw90_write 3400 3401 subroutine param_write_header 3402 !! Write a suitable header for the calculation - version authors etc 3403 use w90_io, only: io_date, w90_version 3404 use w90_constants, only: bohr_version_str, constants_version_str1, constants_version_str2 3405 implicit none 3406 3407 character(len=9) :: cdate, ctime 3408 3409 call io_date(cdate, ctime) 3410 3411 write (stdout, *) 3412 write (stdout, *) ' +---------------------------------------------------+' 3413 write (stdout, *) ' | |' 3414 write (stdout, *) ' | WANNIER90 |' 3415 write (stdout, *) ' | |' 3416 write (stdout, *) ' +---------------------------------------------------+' 3417 write (stdout, *) ' | |' 3418 write (stdout, *) ' | Welcome to the Maximally-Localized |' 3419 write (stdout, *) ' | Generalized Wannier Functions code |' 3420 write (stdout, *) ' | http://www.wannier.org |' 3421 write (stdout, *) ' | |' 3422 write (stdout, *) ' | |' 3423 write (stdout, *) ' | Wannier90 Developer Group: |' 3424 write (stdout, *) ' | Giovanni Pizzi (EPFL) |' 3425 write (stdout, *) ' | Valerio Vitale (Cambridge) |' 3426 write (stdout, *) ' | David Vanderbilt (Rutgers University) |' 3427 write (stdout, *) ' | Nicola Marzari (EPFL) |' 3428 write (stdout, *) ' | Ivo Souza (Universidad del Pais Vasco) |' 3429 write (stdout, *) ' | Arash A. Mostofi (Imperial College London) |' 3430 write (stdout, *) ' | Jonathan R. Yates (University of Oxford) |' 3431 write (stdout, *) ' | |' 3432 write (stdout, *) ' | For the full list of Wannier90 3.x authors, |' 3433 write (stdout, *) ' | please check the code documentation and the |' 3434 write (stdout, *) ' | README on the GitHub page of the code |' 3435 write (stdout, *) ' | |' 3436 write (stdout, *) ' | |' 3437 write (stdout, *) ' | Please cite |' 3438 write (stdout, *) ' | |' 3439 write (stdout, *) ' | [ref] "Wannier90 as a community code: |' 3440 write (stdout, *) ' | new features and applications", |' 3441 write (stdout, *) ' | G. Pizzi et al., J. Phys. Cond. Matt. 32, |' 3442 write (stdout, *) ' | 165902 (2020). |' 3443 write (stdout, *) ' | http://doi.org/10.1088/1361-648X/ab51ff |' 3444 write (stdout, *) ' | |' 3445 write (stdout, *) ' | in any publications arising from the use of |' 3446 write (stdout, *) ' | this code. For the method please cite |' 3447 write (stdout, *) ' | |' 3448 write (stdout, *) ' | [ref] "Maximally Localized Generalised Wannier |' 3449 write (stdout, *) ' | Functions for Composite Energy Bands" |' 3450 write (stdout, *) ' | N. Marzari and D. Vanderbilt |' 3451 write (stdout, *) ' | Phys. Rev. B 56 12847 (1997) |' 3452 write (stdout, *) ' | |' 3453 write (stdout, *) ' | [ref] "Maximally Localized Wannier Functions |' 3454 write (stdout, *) ' | for Entangled Energy Bands" |' 3455 write (stdout, *) ' | I. Souza, N. Marzari and D. Vanderbilt |' 3456 write (stdout, *) ' | Phys. Rev. B 65 035109 (2001) |' 3457 write (stdout, *) ' | |' 3458 write (stdout, *) ' | |' 3459 write (stdout, *) ' | Copyright (c) 1996-2020 |' 3460 write (stdout, *) ' | The Wannier90 Developer Group and |' 3461 write (stdout, *) ' | individual contributors |' 3462 write (stdout, *) ' | |' 3463 write (stdout, *) ' | Release: ', adjustl(w90_version), ' 5th March 2020 |' 3464 write (stdout, *) ' | |' 3465 write (stdout, *) ' | This program is free software; you can |' 3466 write (stdout, *) ' | redistribute it and/or modify it under the terms |' 3467 write (stdout, *) ' | of the GNU General Public License as published by |' 3468 write (stdout, *) ' | the Free Software Foundation; either version 2 of |' 3469 write (stdout, *) ' | the License, or (at your option) any later version|' 3470 write (stdout, *) ' | |' 3471 write (stdout, *) ' | This program is distributed in the hope that it |' 3472 write (stdout, *) ' | will be useful, but WITHOUT ANY WARRANTY; without |' 3473 write (stdout, *) ' | even the implied warranty of MERCHANTABILITY or |' 3474 write (stdout, *) ' | FITNESS FOR A PARTICULAR PURPOSE. See the GNU |' 3475 write (stdout, *) ' | General Public License for more details. |' 3476 write (stdout, *) ' | |' 3477 write (stdout, *) ' | You should have received a copy of the GNU General|' 3478 write (stdout, *) ' | Public License along with this program; if not, |' 3479 write (stdout, *) ' | write to the Free Software Foundation, Inc., |' 3480 write (stdout, *) ' | 675 Mass Ave, Cambridge, MA 02139, USA. |' 3481 write (stdout, *) ' | |' 3482 write (stdout, *) ' +---------------------------------------------------+' 3483 write (stdout, *) ' | Execution started on ', cdate, ' at ', ctime, ' |' 3484 write (stdout, *) ' +---------------------------------------------------+' 3485 write (stdout, *) '' 3486 write (stdout, '(1X,A)') '******************************************************************************' 3487 write (stdout, '(1X,A)') '* '//constants_version_str1//'*' 3488 write (stdout, '(1X,A)') '* '//constants_version_str2//'*' 3489 write (stdout, '(1X,A)') '* '//bohr_version_str//'*' 3490 write (stdout, '(1X,A)') '******************************************************************************' 3491 write (stdout, *) '' 3492 3493 end subroutine param_write_header 3494 3495!==================================================================! 3496 subroutine param_dealloc 3497 !==================================================================! 3498 ! ! 3499 !! release memory from allocated parameters 3500 ! ! 3501 !=================================================================== 3502 use w90_io, only: io_error 3503 3504 implicit none 3505 integer :: ierr 3506 3507 if (allocated(ndimwin)) then 3508 deallocate (ndimwin, stat=ierr) 3509 if (ierr /= 0) call io_error('Error in deallocating ndimwin in param_dealloc') 3510 end if 3511 if (allocated(lwindow)) then 3512 deallocate (lwindow, stat=ierr) 3513 if (ierr /= 0) call io_error('Error in deallocating lwindow in param_dealloc') 3514 end if 3515 if (allocated(eigval)) then 3516 deallocate (eigval, stat=ierr) 3517 if (ierr /= 0) call io_error('Error in deallocating eigval in param_dealloc') 3518 endif 3519 if (allocated(shell_list)) then 3520 deallocate (shell_list, stat=ierr) 3521 if (ierr /= 0) call io_error('Error in deallocating shell_list in param_dealloc') 3522 endif 3523 if (allocated(kpt_latt)) then 3524 deallocate (kpt_latt, stat=ierr) 3525 if (ierr /= 0) call io_error('Error in deallocating kpt_latt in param_dealloc') 3526 endif 3527 if (allocated(kpt_cart)) then 3528 deallocate (kpt_cart, stat=ierr) 3529 if (ierr /= 0) call io_error('Error in deallocating kpt_cart in param_dealloc') 3530 endif 3531 if (allocated(bands_label)) then 3532 deallocate (bands_label, stat=ierr) 3533 if (ierr /= 0) call io_error('Error in deallocating bands_label in param_dealloc') 3534 end if 3535 if (allocated(bands_spec_points)) then 3536 deallocate (bands_spec_points, stat=ierr) 3537 if (ierr /= 0) call io_error('Error in deallocating bands_spec_points in param_dealloc') 3538 end if 3539 if (allocated(atoms_label)) then 3540 deallocate (atoms_label, stat=ierr) 3541 if (ierr /= 0) call io_error('Error in deallocating atoms_label in param_dealloc') 3542 end if 3543 if (allocated(atoms_symbol)) then 3544 deallocate (atoms_symbol, stat=ierr) 3545 if (ierr /= 0) call io_error('Error in deallocating atoms_symbol in param_dealloc') 3546 end if 3547 if (allocated(atoms_pos_frac)) then 3548 deallocate (atoms_pos_frac, stat=ierr) 3549 if (ierr /= 0) call io_error('Error in deallocating atom_pos_frac in param_dealloc') 3550 end if 3551 if (allocated(atoms_pos_cart)) then 3552 deallocate (atoms_pos_cart, stat=ierr) 3553 if (ierr /= 0) call io_error('Error in deallocating atoms_pos_cart in param_dealloc') 3554 end if 3555 if (allocated(atoms_species_num)) then 3556 deallocate (atoms_species_num, stat=ierr) 3557 if (ierr /= 0) call io_error('Error in deallocating atoms_species_num in param_dealloc') 3558 end if 3559 if (allocated(input_proj_site)) then 3560 deallocate (input_proj_site, stat=ierr) 3561 if (ierr /= 0) call io_error('Error in deallocating input_proj_site in param_dealloc') 3562 end if 3563 if (allocated(input_proj_l)) then 3564 deallocate (input_proj_l, stat=ierr) 3565 if (ierr /= 0) call io_error('Error in deallocating input_proj_l in param_dealloc') 3566 end if 3567 if (allocated(input_proj_m)) then 3568 deallocate (input_proj_m, stat=ierr) 3569 if (ierr /= 0) call io_error('Error in deallocating input_proj_m in param_dealloc') 3570 end if 3571 if (allocated(input_proj_s)) then 3572 deallocate (input_proj_s, stat=ierr) 3573 if (ierr /= 0) call io_error('Error in deallocating input_proj_s in param_dealloc') 3574 end if 3575 if (allocated(input_proj_s_qaxis)) then 3576 deallocate (input_proj_s_qaxis, stat=ierr) 3577 if (ierr /= 0) call io_error('Error in deallocating input_proj_s_qaxis in param_dealloc') 3578 end if 3579 if (allocated(input_proj_z)) then 3580 deallocate (input_proj_z, stat=ierr) 3581 if (ierr /= 0) call io_error('Error in deallocating input_proj_z in param_dealloc') 3582 end if 3583 if (allocated(input_proj_x)) then 3584 deallocate (input_proj_x, stat=ierr) 3585 if (ierr /= 0) call io_error('Error in deallocating input_proj_x in param_dealloc') 3586 end if 3587 if (allocated(input_proj_radial)) then 3588 deallocate (input_proj_radial, stat=ierr) 3589 if (ierr /= 0) call io_error('Error in deallocating input_proj_radial in param_dealloc') 3590 end if 3591 if (allocated(input_proj_zona)) then 3592 deallocate (input_proj_zona, stat=ierr) 3593 if (ierr /= 0) call io_error('Error in deallocating input_proj_zona in param_dealloc') 3594 end if 3595 if (allocated(proj_site)) then 3596 deallocate (proj_site, stat=ierr) 3597 if (ierr /= 0) call io_error('Error in deallocating proj_site in param_dealloc') 3598 end if 3599 if (allocated(proj_l)) then 3600 deallocate (proj_l, stat=ierr) 3601 if (ierr /= 0) call io_error('Error in deallocating proj_l in param_dealloc') 3602 end if 3603 if (allocated(proj_m)) then 3604 deallocate (proj_m, stat=ierr) 3605 if (ierr /= 0) call io_error('Error in deallocating proj_m in param_dealloc') 3606 end if 3607 if (allocated(proj_s)) then 3608 deallocate (proj_s, stat=ierr) 3609 if (ierr /= 0) call io_error('Error in deallocating proj_s in param_dealloc') 3610 end if 3611 if (allocated(proj_s_qaxis)) then 3612 deallocate (proj_s_qaxis, stat=ierr) 3613 if (ierr /= 0) call io_error('Error in deallocating proj_s_qaxis in param_dealloc') 3614 end if 3615 if (allocated(proj_z)) then 3616 deallocate (proj_z, stat=ierr) 3617 if (ierr /= 0) call io_error('Error in deallocating proj_z in param_dealloc') 3618 end if 3619 if (allocated(proj_x)) then 3620 deallocate (proj_x, stat=ierr) 3621 if (ierr /= 0) call io_error('Error in deallocating proj_x in param_dealloc') 3622 end if 3623 if (allocated(proj_radial)) then 3624 deallocate (proj_radial, stat=ierr) 3625 if (ierr /= 0) call io_error('Error in deallocating proj_radial in param_dealloc') 3626 end if 3627 if (allocated(proj_zona)) then 3628 deallocate (proj_zona, stat=ierr) 3629 if (ierr /= 0) call io_error('Error in deallocating proj_zona in param_dealloc') 3630 end if 3631 if (allocated(wannier_plot_list)) then 3632 deallocate (wannier_plot_list, stat=ierr) 3633 if (ierr /= 0) call io_error('Error in deallocating wannier_plot_list in param_dealloc') 3634 end if 3635 if (allocated(exclude_bands)) then 3636 deallocate (exclude_bands, stat=ierr) 3637 if (ierr /= 0) call io_error('Error in deallocating exclude_bands in param_dealloc') 3638 end if 3639 if (allocated(wannier_centres)) then 3640 deallocate (wannier_centres, stat=ierr) 3641 if (ierr /= 0) call io_error('Error in deallocating wannier_centres in param_dealloc') 3642 end if 3643 if (allocated(wannier_spreads)) then 3644 deallocate (wannier_spreads, stat=ierr) 3645 if (ierr /= 0) call io_error('Error in deallocating wannier_spreads in param_dealloc') 3646 endif 3647 if (allocated(bands_plot_project)) then 3648 deallocate (bands_plot_project, stat=ierr) 3649 if (ierr /= 0) call io_error('Error in deallocating bands_plot_project in param_dealloc') 3650 endif 3651 if (allocated(dos_project)) then 3652 deallocate (dos_project, stat=ierr) 3653 if (ierr /= 0) call io_error('Error in deallocating dos_project in param_dealloc') 3654 endif 3655 if (allocated(fermi_energy_list)) then 3656 deallocate (fermi_energy_list, stat=ierr) 3657 if (ierr /= 0) call io_error('Error in deallocating fermi_energy_list in param_dealloc') 3658 endif 3659 if (allocated(kubo_freq_list)) then 3660 deallocate (kubo_freq_list, stat=ierr) 3661 if (ierr /= 0) call io_error('Error in deallocating kubo_freq_list in param_dealloc') 3662 endif 3663 if (allocated(dis_spheres)) then 3664 deallocate (dis_spheres, stat=ierr) 3665 if (ierr /= 0) call io_error('Error in deallocating dis_spheres in param_dealloc') 3666 endif 3667 if (allocated(ccentres_frac)) then 3668 deallocate (ccentres_frac, stat=ierr) 3669 if (ierr /= 0) call io_error('Error deallocating ccentres_frac in param_dealloc') 3670 endif 3671 if (allocated(ccentres_cart)) then 3672 deallocate (ccentres_cart, stat=ierr) 3673 if (ierr /= 0) call io_error('Error deallocating ccentres_cart in param_dealloc') 3674 end if 3675 return 3676 3677 end subroutine param_dealloc 3678 3679!~ !================================! 3680!~ subroutine param_write_um 3681!~ !================================! 3682!~ ! ! 3683!~ ! Dump the U and M to *_um.dat ! 3684!~ ! ! 3685!~ !================================! 3686!~ 3687!~ 3688!~ use w90_io, only : io_file_unit,io_error,seedname,io_date 3689!~ implicit none 3690!~ 3691!~ integer :: i,j,k,l,um_unit 3692!~ character (len=9) :: cdate, ctime 3693!~ character(len=33) :: header 3694!~ 3695!~ call io_date(cdate, ctime) 3696!~ header='written on '//cdate//' at '//ctime 3697!~ 3698!~ um_unit=io_file_unit() 3699!~ open(unit=um_unit,file=trim(seedname)//'_um.dat',form='unformatted') 3700!~ write(um_unit) header 3701!~ write(um_unit) omega_invariant 3702!~ write(um_unit) num_wann,num_kpts,num_nnmax 3703!~ write(um_unit) (((u_matrix(i,j,k),i=1,num_wann),j=1,num_wann),k=1,num_kpts) 3704!~ write(um_unit) ((((m_matrix(i,j,k,l),i=1,num_wann),j=1,num_wann),k=1,nntot),l=1,num_kpts) 3705!~ close(um_unit) 3706!~ 3707!~ return 3708!~ 3709!~ end subroutine param_write_um 3710 3711!~ !================================! 3712!~ subroutine param_read_um 3713!~ !================================! 3714!~ ! ! 3715!~ ! Restore U and M from file ! 3716!~ ! ! 3717!~ !================================! 3718!~ 3719!~ use w90_io, only : io_file_unit,io_error,seedname 3720!~ implicit none 3721!~ 3722!~ integer :: tmp_num_wann,tmp_num_kpts,tmp_num_nnmax 3723!~ integer :: i,j,k,l,um_unit,ierr 3724!~ character(len=33) :: header 3725!~ real(kind=dp) :: tmp_omi 3726!~ 3727!~ um_unit=io_file_unit() 3728!~ open(unit=um_unit,file=trim(seedname)//'_um.dat',status="old",form='unformatted',err=105) 3729!~ read(um_unit) header 3730!~ write(stdout,'(1x,4(a))') 'Reading U and M from file ',trim(seedname),'_um.dat ', header 3731!~ read(um_unit) tmp_omi 3732!~ if ( have_disentangled ) then 3733!~ if ( abs(tmp_omi-omega_invariant).gt.1.0e-10_dp ) & 3734!~ call io_error('Error in restart: omega_invariant in .chk and um.dat files do not match') 3735!~ endif 3736!~ read(um_unit) tmp_num_wann,tmp_num_kpts,tmp_num_nnmax 3737!~ if(tmp_num_wann/=num_wann) call io_error('Error in param_read_um: num_wann mismatch') 3738!~ if(tmp_num_kpts/=num_kpts) call io_error('Error in param_read_um: num_kpts mismatch') 3739!~ if(tmp_num_nnmax/=num_nnmax) call io_error('Error in param_read_um: num_nnmax mismatch') 3740!~ if (.not.allocated(u_matrix)) then 3741!~ allocate(u_matrix(num_wann,num_wann,num_kpts),stat=ierr) 3742!~ if (ierr/=0) call io_error('Error allocating u_matrix in param_read_um') 3743!~ endif 3744!~ read(um_unit) (((u_matrix(i,j,k),i=1,num_wann),j=1,num_wann),k=1,num_kpts) 3745!~ if (.not.allocated(m_matrix)) then 3746!~ allocate(m_matrix(num_wann,num_wann,nntot,num_kpts),stat=ierr) 3747!~ if (ierr/=0) call io_error('Error allocating m_matrix in param_read_um') 3748!~ endif 3749!~ read(um_unit) ((((m_matrix(i,j,k,l),i=1,num_wann),j=1,num_wann),k=1,nntot),l=1,num_kpts) 3750!~ close(um_unit) 3751!~ 3752!~ return 3753!~ 3754!~105 call io_error('Error: Problem opening file '//trim(seedname)//'_um.dat in param_read_um') 3755!~ 3756! $ end subroutine param_read_um 3757 3758!=================================================! 3759 subroutine param_write_chkpt(chkpt) 3760 !=================================================! 3761 !! Write checkpoint file 3762 !! IMPORTANT! If you change the chkpt format, adapt 3763 !! accordingly also the w90chk2chk.x utility! 3764 !! Also, note that this routine writes the u_matrix and the m_matrix - in parallel 3765 !! mode these are however stored in distributed form in, e.g., u_matrix_loc only, so 3766 !! if you are changing the u_matrix, remember to gather it from u_matrix_loc first! 3767 !=================================================! 3768 3769 use w90_io, only: io_file_unit, io_date, seedname 3770 3771 implicit none 3772 3773 character(len=*), intent(in) :: chkpt 3774 3775 integer :: chk_unit, nkp, i, j, k, l 3776 character(len=9) :: cdate, ctime 3777 character(len=33) :: header 3778 character(len=20) :: chkpt1 3779 3780 write (stdout, '(/1x,3a)', advance='no') 'Writing checkpoint file ', trim(seedname), '.chk...' 3781 3782 call io_date(cdate, ctime) 3783 header = 'written on '//cdate//' at '//ctime 3784 3785 chk_unit = io_file_unit() 3786 open (unit=chk_unit, file=trim(seedname)//'.chk', form='unformatted') 3787 3788 write (chk_unit) header ! Date and time 3789 write (chk_unit) num_bands ! Number of bands 3790 write (chk_unit) num_exclude_bands ! Number of excluded bands 3791 write (chk_unit) (exclude_bands(i), i=1, num_exclude_bands) ! Excluded bands 3792 write (chk_unit) ((real_lattice(i, j), i=1, 3), j=1, 3) ! Real lattice 3793 write (chk_unit) ((recip_lattice(i, j), i=1, 3), j=1, 3) ! Reciprocal lattice 3794 write (chk_unit) num_kpts ! Number of k-points 3795 write (chk_unit) (mp_grid(i), i=1, 3) ! M-P grid 3796 write (chk_unit) ((kpt_latt(i, nkp), i=1, 3), nkp=1, num_kpts) ! K-points 3797 write (chk_unit) nntot ! Number of nearest k-point neighbours 3798 write (chk_unit) num_wann ! Number of wannier functions 3799 chkpt1 = adjustl(trim(chkpt)) 3800 write (chk_unit) chkpt1 ! Position of checkpoint 3801 write (chk_unit) have_disentangled ! Whether a disentanglement has been performed 3802 if (have_disentangled) then 3803 write (chk_unit) omega_invariant ! Omega invariant 3804 ! lwindow, ndimwin and U_matrix_opt 3805 write (chk_unit) ((lwindow(i, nkp), i=1, num_bands), nkp=1, num_kpts) 3806 write (chk_unit) (ndimwin(nkp), nkp=1, num_kpts) 3807 write (chk_unit) (((u_matrix_opt(i, j, nkp), i=1, num_bands), j=1, num_wann), nkp=1, num_kpts) 3808 endif 3809 write (chk_unit) (((u_matrix(i, j, k), i=1, num_wann), j=1, num_wann), k=1, num_kpts) ! U_matrix 3810 write (chk_unit) ((((m_matrix(i, j, k, l), i=1, num_wann), j=1, num_wann), k=1, nntot), l=1, num_kpts) ! M_matrix 3811 write (chk_unit) ((wannier_centres(i, j), i=1, 3), j=1, num_wann) 3812 write (chk_unit) (wannier_spreads(i), i=1, num_wann) 3813 close (chk_unit) 3814 3815 write (stdout, '(a/)') ' done' 3816 3817 return 3818 3819 end subroutine param_write_chkpt 3820 3821!=================================================! 3822 subroutine param_read_chkpt() 3823 !=================================================! 3824 !! Read checkpoint file 3825 !! IMPORTANT! If you change the chkpt format, adapt 3826 !! accordingly also the w90chk2chk.x utility! 3827 !! 3828 !! Note on parallelization: this function should be called 3829 !! from the root node only! 3830 !! 3831 !! This function should be called 3832 !=================================================! 3833 3834 use w90_constants, only: eps6 3835 use w90_io, only: io_error, io_file_unit, stdout, seedname 3836 3837 implicit none 3838 3839 integer :: chk_unit, nkp, i, j, k, l, ntmp, ierr 3840 character(len=33) :: header 3841 real(kind=dp) :: tmp_latt(3, 3), tmp_kpt_latt(3, num_kpts) 3842 integer :: tmp_excl_bands(1:num_exclude_bands), tmp_mp_grid(1:3) 3843 3844 write (stdout, '(1x,3a)') 'Reading restart information from file ', trim(seedname), '.chk :' 3845 3846 chk_unit = io_file_unit() 3847 open (unit=chk_unit, file=trim(seedname)//'.chk', status='old', form='unformatted', err=121) 3848 3849 ! Read comment line 3850 read (chk_unit) header 3851 write (stdout, '(1x,a)', advance='no') trim(header) 3852 3853 ! Consistency checks 3854 read (chk_unit) ntmp ! Number of bands 3855 if (ntmp .ne. num_bands) call io_error('param_read_chk: Mismatch in num_bands') 3856 read (chk_unit) ntmp ! Number of excluded bands 3857 if (ntmp .ne. num_exclude_bands) & 3858 call io_error('param_read_chk: Mismatch in num_exclude_bands') 3859 read (chk_unit) (tmp_excl_bands(i), i=1, num_exclude_bands) ! Excluded bands 3860 do i = 1, num_exclude_bands 3861 if (tmp_excl_bands(i) .ne. exclude_bands(i)) & 3862 call io_error('param_read_chk: Mismatch in exclude_bands') 3863 enddo 3864 read (chk_unit) ((tmp_latt(i, j), i=1, 3), j=1, 3) ! Real lattice 3865 do j = 1, 3 3866 do i = 1, 3 3867 if (abs(tmp_latt(i, j) - real_lattice(i, j)) .gt. eps6) & 3868 call io_error('param_read_chk: Mismatch in real_lattice') 3869 enddo 3870 enddo 3871 read (chk_unit) ((tmp_latt(i, j), i=1, 3), j=1, 3) ! Reciprocal lattice 3872 do j = 1, 3 3873 do i = 1, 3 3874 if (abs(tmp_latt(i, j) - recip_lattice(i, j)) .gt. eps6) & 3875 call io_error('param_read_chk: Mismatch in recip_lattice') 3876 enddo 3877 enddo 3878 read (chk_unit) ntmp ! K-points 3879 if (ntmp .ne. num_kpts) & 3880 call io_error('param_read_chk: Mismatch in num_kpts') 3881 read (chk_unit) (tmp_mp_grid(i), i=1, 3) ! M-P grid 3882 do i = 1, 3 3883 if (tmp_mp_grid(i) .ne. mp_grid(i)) & 3884 call io_error('param_read_chk: Mismatch in mp_grid') 3885 enddo 3886 read (chk_unit) ((tmp_kpt_latt(i, nkp), i=1, 3), nkp=1, num_kpts) 3887 do nkp = 1, num_kpts 3888 do i = 1, 3 3889 if (abs(tmp_kpt_latt(i, nkp) - kpt_latt(i, nkp)) .gt. eps6) & 3890 call io_error('param_read_chk: Mismatch in kpt_latt') 3891 enddo 3892 enddo 3893 read (chk_unit) ntmp ! nntot 3894 if (ntmp .ne. nntot) & 3895 call io_error('param_read_chk: Mismatch in nntot') 3896 read (chk_unit) ntmp ! num_wann 3897 if (ntmp .ne. num_wann) & 3898 call io_error('param_read_chk: Mismatch in num_wann') 3899 ! End of consistency checks 3900 3901 read (chk_unit) checkpoint ! checkpoint 3902 checkpoint = adjustl(trim(checkpoint)) 3903 3904 read (chk_unit) have_disentangled ! whether a disentanglement has been performed 3905 3906 if (have_disentangled) then 3907 3908 read (chk_unit) omega_invariant ! omega invariant 3909 3910 ! lwindow 3911 if (.not. allocated(lwindow)) then 3912 allocate (lwindow(num_bands, num_kpts), stat=ierr) 3913 if (ierr /= 0) call io_error('Error allocating lwindow in param_read_chkpt') 3914 endif 3915 read (chk_unit, err=122) ((lwindow(i, nkp), i=1, num_bands), nkp=1, num_kpts) 3916 3917 ! ndimwin 3918 if (.not. allocated(ndimwin)) then 3919 allocate (ndimwin(num_kpts), stat=ierr) 3920 if (ierr /= 0) call io_error('Error allocating ndimwin in param_read_chkpt') 3921 endif 3922 read (chk_unit, err=123) (ndimwin(nkp), nkp=1, num_kpts) 3923 3924 ! U_matrix_opt 3925 if (.not. allocated(u_matrix_opt)) then 3926 allocate (u_matrix_opt(num_bands, num_wann, num_kpts), stat=ierr) 3927 if (ierr /= 0) call io_error('Error allocating u_matrix_opt in param_read_chkpt') 3928 endif 3929 read (chk_unit, err=124) (((u_matrix_opt(i, j, nkp), i=1, num_bands), j=1, num_wann), nkp=1, num_kpts) 3930 3931 endif 3932 3933 ! U_matrix 3934 if (.not. allocated(u_matrix)) then 3935 allocate (u_matrix(num_wann, num_wann, num_kpts), stat=ierr) 3936 if (ierr /= 0) call io_error('Error allocating u_matrix in param_read_chkpt') 3937 endif 3938 read (chk_unit, err=125) (((u_matrix(i, j, k), i=1, num_wann), j=1, num_wann), k=1, num_kpts) 3939 3940 ! M_matrix 3941 if (.not. allocated(m_matrix)) then 3942 allocate (m_matrix(num_wann, num_wann, nntot, num_kpts), stat=ierr) 3943 if (ierr /= 0) call io_error('Error allocating m_matrix in param_read_chkpt') 3944 endif 3945 read (chk_unit, err=126) ((((m_matrix(i, j, k, l), i=1, num_wann), j=1, num_wann), k=1, nntot), l=1, num_kpts) 3946 3947 ! wannier_centres 3948 read (chk_unit, err=127) ((wannier_centres(i, j), i=1, 3), j=1, num_wann) 3949 3950 ! wannier spreads 3951 read (chk_unit, err=128) (wannier_spreads(i), i=1, num_wann) 3952 3953 close (chk_unit) 3954 3955 write (stdout, '(a/)') ' ... done' 3956 3957 return 3958 3959121 if (ispostw90) then 3960 call io_error('Error opening '//trim(seedname)//'.chk in param_read_chkpt: did you run wannier90.x first?') 3961 else 3962 call io_error('Error opening '//trim(seedname)//'.chk in param_read_chkpt') 3963 end if 3964122 call io_error('Error reading lwindow from '//trim(seedname)//'.chk in param_read_chkpt') 3965123 call io_error('Error reading ndimwin from '//trim(seedname)//'.chk in param_read_chkpt') 3966124 call io_error('Error reading u_matrix_opt from '//trim(seedname)//'.chk in param_read_chkpt') 3967125 call io_error('Error reading u_matrix from '//trim(seedname)//'.chk in param_read_chkpt') 3968126 call io_error('Error reading m_matrix from '//trim(seedname)//'.chk in param_read_chkpt') 3969127 call io_error('Error reading wannier_centres from '//trim(seedname)//'.chk in param_read_chkpt') 3970128 call io_error('Error reading wannier_spreads from '//trim(seedname)//'.chk in param_read_chkpt') 3971 3972 end subroutine param_read_chkpt 3973 3974!===========================================================! 3975 subroutine param_chkpt_dist 3976 !===========================================================! 3977 ! ! 3978 !! Distribute the chk files 3979 ! ! 3980 !===========================================================! 3981 3982 use w90_constants, only: dp, cmplx_0, cmplx_i, twopi 3983 use w90_io, only: io_error, io_file_unit, & 3984 io_date, io_time, io_stopwatch 3985 use w90_comms, only: on_root, comms_bcast 3986 3987 implicit none 3988 3989 integer :: ierr, loop_kpt, m, i, j 3990 3991 call comms_bcast(checkpoint, len(checkpoint)) 3992 3993 if (.not. on_root .and. .not. allocated(u_matrix)) then 3994 allocate (u_matrix(num_wann, num_wann, num_kpts), stat=ierr) 3995 if (ierr /= 0) & 3996 call io_error('Error allocating u_matrix in param_chkpt_dist') 3997 endif 3998 call comms_bcast(u_matrix(1, 1, 1), num_wann*num_wann*num_kpts) 3999 4000! if (.not.on_root .and. .not.allocated(m_matrix)) then 4001! allocate(m_matrix(num_wann,num_wann,nntot,num_kpts),stat=ierr) 4002! if (ierr/=0)& 4003! call io_error('Error allocating m_matrix in param_chkpt_dist') 4004! endif 4005! call comms_bcast(m_matrix(1,1,1,1),num_wann*num_wann*nntot*num_kpts) 4006 4007 call comms_bcast(have_disentangled, 1) 4008 4009 if (have_disentangled) then 4010 if (.not. on_root) then 4011 4012 if (.not. allocated(u_matrix_opt)) then 4013 allocate (u_matrix_opt(num_bands, num_wann, num_kpts), stat=ierr) 4014 if (ierr /= 0) & 4015 call io_error('Error allocating u_matrix_opt in param_chkpt_dist') 4016 endif 4017 4018 if (.not. allocated(lwindow)) then 4019 allocate (lwindow(num_bands, num_kpts), stat=ierr) 4020 if (ierr /= 0) & 4021 call io_error('Error allocating lwindow in param_chkpt_dist') 4022 endif 4023 4024 if (.not. allocated(ndimwin)) then 4025 allocate (ndimwin(num_kpts), stat=ierr) 4026 if (ierr /= 0) & 4027 call io_error('Error allocating ndimwin in param_chkpt_dist') 4028 endif 4029 4030 end if 4031 4032 call comms_bcast(u_matrix_opt(1, 1, 1), num_bands*num_wann*num_kpts) 4033 call comms_bcast(lwindow(1, 1), num_bands*num_kpts) 4034 call comms_bcast(ndimwin(1), num_kpts) 4035 call comms_bcast(omega_invariant, 1) 4036 end if 4037 call comms_bcast(wannier_centres(1, 1), 3*num_wann) 4038 call comms_bcast(wannier_spreads(1), num_wann) 4039 4040 end subroutine param_chkpt_dist 4041 4042!=======================================! 4043 subroutine param_in_file 4044 !=======================================! 4045 !! Load the *.win file into a character 4046 !! array in_file, ignoring comments and 4047 !! blank lines and converting everything 4048 !! to lowercase characters 4049 !=======================================! 4050 4051 use w90_io, only: io_file_unit, io_error, seedname 4052 use w90_utility, only: utility_lowercase 4053 4054 implicit none 4055 4056 integer :: in_unit, tot_num_lines, ierr, line_counter, loop, in1, in2 4057 character(len=maxlen) :: dummy 4058 integer :: pos 4059 character, parameter :: TABCHAR = char(9) 4060 4061 in_unit = io_file_unit() 4062 open (in_unit, file=trim(seedname)//'.win', form='formatted', status='old', err=101) 4063 4064 num_lines = 0; tot_num_lines = 0 4065 do 4066 read (in_unit, '(a)', iostat=ierr, err=200, end=210) dummy 4067 ! [GP-begin, Apr13, 2012]: I convert all tabulation characters to spaces 4068 pos = index(dummy, TABCHAR) 4069 do while (pos .ne. 0) 4070 dummy(pos:pos) = ' ' 4071 pos = index(dummy, TABCHAR) 4072 end do 4073 ! [GP-end] 4074 dummy = adjustl(dummy) 4075 tot_num_lines = tot_num_lines + 1 4076 if (.not. dummy(1:1) == '!' .and. .not. dummy(1:1) == '#') then 4077 if (len(trim(dummy)) > 0) num_lines = num_lines + 1 4078 endif 4079 4080 end do 4081 4082101 call io_error('Error: Problem opening input file '//trim(seedname)//'.win') 4083200 call io_error('Error: Problem reading input file '//trim(seedname)//'.win') 4084210 continue 4085 rewind (in_unit) 4086 4087 allocate (in_data(num_lines), stat=ierr) 4088 if (ierr /= 0) call io_error('Error allocating in_data in param_in_file') 4089 4090 line_counter = 0 4091 do loop = 1, tot_num_lines 4092 read (in_unit, '(a)', iostat=ierr, err=200) dummy 4093 ! [GP-begin, Apr13, 2012]: I convert all tabulation characters to spaces 4094 pos = index(dummy, TABCHAR) 4095 do while (pos .ne. 0) 4096 dummy(pos:pos) = ' ' 4097 pos = index(dummy, TABCHAR) 4098 end do 4099 ! [GP-end] 4100 dummy = utility_lowercase(dummy) 4101 dummy = adjustl(dummy) 4102 if (dummy(1:1) == '!' .or. dummy(1:1) == '#') cycle 4103 if (len(trim(dummy)) == 0) cycle 4104 line_counter = line_counter + 1 4105 in1 = index(dummy, '!') 4106 in2 = index(dummy, '#') 4107 if (in1 == 0 .and. in2 == 0) in_data(line_counter) = dummy 4108 if (in1 == 0 .and. in2 > 0) in_data(line_counter) = dummy(:in2 - 1) 4109 if (in2 == 0 .and. in1 > 0) in_data(line_counter) = dummy(:in1 - 1) 4110 if (in2 > 0 .and. in1 > 0) in_data(line_counter) = dummy(:min(in1, in2) - 1) 4111 end do 4112 4113 close (in_unit) 4114 4115 end subroutine param_in_file 4116 4117!===========================================================================! 4118 subroutine param_get_keyword(keyword, found, c_value, l_value, i_value, r_value) 4119 !===========================================================================! 4120 ! ! 4121 !! Finds the value of the required keyword. 4122 ! ! 4123 !===========================================================================! 4124 4125 use w90_io, only: io_error 4126 4127 implicit none 4128 4129 character(*), intent(in) :: keyword 4130 !! Keyword to examine 4131 logical, intent(out) :: found 4132 !! Is keyword present 4133 character(*), optional, intent(inout) :: c_value 4134 !! Keyword value 4135 logical, optional, intent(inout) :: l_value 4136 !! Keyword value 4137 integer, optional, intent(inout) :: i_value 4138 !! Keyword value 4139 real(kind=dp), optional, intent(inout) :: r_value 4140 !! Keyword value 4141 4142 integer :: kl, in, loop, itmp 4143 character(len=maxlen) :: dummy 4144 4145 kl = len_trim(keyword) 4146 4147 found = .false. 4148 4149 do loop = 1, num_lines 4150 in = index(in_data(loop), trim(keyword)) 4151 if (in == 0 .or. in > 1) cycle 4152 itmp = in + len(trim(keyword)) 4153 if (in_data(loop) (itmp:itmp) /= '=' & 4154 .and. in_data(loop) (itmp:itmp) /= ':' & 4155 .and. in_data(loop) (itmp:itmp) /= ' ') cycle 4156 if (found) then 4157 call io_error('Error: Found keyword '//trim(keyword)//' more than once in input file') 4158 endif 4159 found = .true. 4160 dummy = in_data(loop) (kl + 1:) 4161 in_data(loop) (1:maxlen) = ' ' 4162 dummy = adjustl(dummy) 4163 if (dummy(1:1) == '=' .or. dummy(1:1) == ':') then 4164 dummy = dummy(2:) 4165 dummy = adjustl(dummy) 4166 end if 4167 end do 4168 4169 if (found) then 4170 if (present(c_value)) c_value = dummy 4171 if (present(l_value)) then 4172 if (index(dummy, 't') > 0) then 4173 l_value = .true. 4174 elseif (index(dummy, 'f') > 0) then 4175 l_value = .false. 4176 else 4177 call io_error('Error: Problem reading logical keyword '//trim(keyword)) 4178 endif 4179 endif 4180 if (present(i_value)) read (dummy, *, err=220, end=220) i_value 4181 if (present(r_value)) read (dummy, *, err=220, end=220) r_value 4182 end if 4183 4184 return 4185 4186220 call io_error('Error: Problem reading keyword '//trim(keyword)) 4187 4188 end subroutine param_get_keyword 4189 4190!=========================================================================================! 4191 subroutine param_get_keyword_vector(keyword, found, length, c_value, l_value, i_value, r_value) 4192 !=========================================================================================! 4193 ! ! 4194 !! Finds the values of the required keyword vector 4195 ! ! 4196 !=========================================================================================! 4197 4198 use w90_io, only: io_error 4199 4200 implicit none 4201 4202 character(*), intent(in) :: keyword 4203 !! Keyword to examine 4204 logical, intent(out) :: found 4205 !! Is keyword present 4206 integer, intent(in) :: length 4207 !! Length of vecotr to read 4208 character(*), optional, intent(inout) :: c_value(length) 4209 !! Keyword data 4210 logical, optional, intent(inout) :: l_value(length) 4211 !! Keyword data 4212 integer, optional, intent(inout) :: i_value(length) 4213 !! Keyword data 4214 real(kind=dp), optional, intent(inout) :: r_value(length) 4215 !! Keyword data 4216 4217 integer :: kl, in, loop, i 4218 character(len=maxlen) :: dummy 4219 4220 kl = len_trim(keyword) 4221 4222 found = .false. 4223 4224 do loop = 1, num_lines 4225 in = index(in_data(loop), trim(keyword)) 4226 if (in == 0 .or. in > 1) cycle 4227 if (found) then 4228 call io_error('Error: Found keyword '//trim(keyword)//' more than once in input file') 4229 endif 4230 found = .true. 4231 dummy = in_data(loop) (kl + 1:) 4232 in_data(loop) (1:maxlen) = ' ' 4233 dummy = adjustl(dummy) 4234 if (dummy(1:1) == '=' .or. dummy(1:1) == ':') then 4235 dummy = dummy(2:) 4236 dummy = adjustl(dummy) 4237 end if 4238 end do 4239 4240 if (found) then 4241 if (present(c_value)) read (dummy, *, err=230, end=230) (c_value(i), i=1, length) 4242 if (present(l_value)) then 4243 ! I don't think we need this. Maybe read into a dummy charater 4244 ! array and convert each element to logical 4245 call io_error('param_get_keyword_vector unimplemented for logicals') 4246 endif 4247 if (present(i_value)) read (dummy, *, err=230, end=230) (i_value(i), i=1, length) 4248 if (present(r_value)) read (dummy, *, err=230, end=230) (r_value(i), i=1, length) 4249 end if 4250 4251 return 4252 4253230 call io_error('Error: Problem reading keyword '//trim(keyword)//' in param_get_keyword_vector') 4254 4255 end subroutine param_get_keyword_vector 4256 4257!========================================================! 4258 subroutine param_get_vector_length(keyword, found, length) 4259 !======================================================! 4260 ! ! 4261 !! Returns the length of a keyword vector 4262 ! ! 4263 !======================================================! 4264 4265 use w90_io, only: io_error 4266 4267 implicit none 4268 4269 character(*), intent(in) :: keyword 4270 !! Keyword to examine 4271 logical, intent(out) :: found 4272 !! Is keyword present 4273 integer, intent(out) :: length 4274 !! length of vector 4275 4276 integer :: kl, in, loop, pos 4277 character(len=maxlen) :: dummy 4278 4279 kl = len_trim(keyword) 4280 4281 found = .false. 4282 4283 do loop = 1, num_lines 4284 in = index(in_data(loop), trim(keyword)) 4285 if (in == 0 .or. in > 1) cycle 4286 if (found) then 4287 call io_error('Error: Found keyword '//trim(keyword)//' more than once in input file') 4288 endif 4289 found = .true. 4290 dummy = in_data(loop) (kl + 1:) 4291 dummy = adjustl(dummy) 4292 if (dummy(1:1) == '=' .or. dummy(1:1) == ':') then 4293 dummy = dummy(2:) 4294 dummy = adjustl(dummy) 4295 end if 4296 end do 4297 4298 length = 0 4299 if (found) then 4300 if (len_trim(dummy) == 0) call io_error('Error: keyword '//trim(keyword)//' is blank') 4301 length = 1 4302 dummy = adjustl(dummy) 4303 do 4304 pos = index(dummy, ' ') 4305 dummy = dummy(pos + 1:) 4306 dummy = adjustl(dummy) 4307 if (len_trim(dummy) > 0) then 4308 length = length + 1 4309 else 4310 exit 4311 endif 4312 4313 end do 4314 4315 end if 4316 4317 return 4318 4319 end subroutine param_get_vector_length 4320 4321!==============================================================================================! 4322 subroutine param_get_keyword_block(keyword, found, rows, columns, c_value, l_value, i_value, r_value) 4323 !==============================================================================================! 4324 ! ! 4325 !! Finds the values of the required data block 4326 ! ! 4327 !==============================================================================================! 4328 4329 use w90_constants, only: bohr 4330 use w90_io, only: io_error 4331 4332 implicit none 4333 4334 character(*), intent(in) :: keyword 4335 !! Keyword to examine 4336 logical, intent(out) :: found 4337 !! Is keyword present 4338 integer, intent(in) :: rows 4339 !! Number of rows 4340 integer, intent(in) :: columns 4341 !! Number of columns 4342 character(*), optional, intent(inout) :: c_value(columns, rows) 4343 !! keyword block data 4344 logical, optional, intent(inout) :: l_value(columns, rows) 4345 !! keyword block data 4346 integer, optional, intent(inout) :: i_value(columns, rows) 4347 !! keyword block data 4348 real(kind=dp), optional, intent(inout) :: r_value(columns, rows) 4349 !! keyword block data 4350 4351 integer :: in, ins, ine, loop, i, line_e, line_s, counter, blen 4352 logical :: found_e, found_s, lconvert 4353 character(len=maxlen) :: dummy, end_st, start_st 4354 4355 found_s = .false. 4356 found_e = .false. 4357 4358 start_st = 'begin '//trim(keyword) 4359 end_st = 'end '//trim(keyword) 4360 4361 do loop = 1, num_lines 4362 ins = index(in_data(loop), trim(keyword)) 4363 if (ins == 0) cycle 4364 in = index(in_data(loop), 'begin') 4365 if (in == 0 .or. in > 1) cycle 4366 line_s = loop 4367 if (found_s) then 4368 call io_error('Error: Found '//trim(start_st)//' more than once in input file') 4369 endif 4370 found_s = .true. 4371 end do 4372 4373 if (.not. found_s) then 4374 found = .false. 4375 return 4376 end if 4377 4378 do loop = 1, num_lines 4379 ine = index(in_data(loop), trim(keyword)) 4380 if (ine == 0) cycle 4381 in = index(in_data(loop), 'end') 4382 if (in == 0 .or. in > 1) cycle 4383 line_e = loop 4384 if (found_e) then 4385 call io_error('Error: Found '//trim(end_st)//' more than once in input file') 4386 endif 4387 found_e = .true. 4388 end do 4389 4390 if (.not. found_e) then 4391 call io_error('Error: Found '//trim(start_st)//' but no '//trim(end_st)//' in input file') 4392 end if 4393 4394 if (line_e <= line_s) then 4395 call io_error('Error: '//trim(end_st)//' comes before '//trim(start_st)//' in input file') 4396 end if 4397 4398 ! number of lines of data in block 4399 blen = line_e - line_s - 1 4400 4401 ! if( blen /= rows) then 4402 ! if ( index(trim(keyword),'unit_cell_cart').ne.0 ) then 4403 ! if ( blen /= rows+1 ) call io_error('Error: Wrong number of lines in block '//trim(keyword)) 4404 ! else 4405 ! call io_error('Error: Wrong number of lines in block '//trim(keyword)) 4406 ! endif 4407 ! endif 4408 4409 if ((blen .ne. rows) .and. (blen .ne. rows + 1)) & 4410 call io_error('Error: Wrong number of lines in block '//trim(keyword)) 4411 4412 if ((blen .eq. rows + 1) .and. (index(trim(keyword), 'unit_cell_cart') .eq. 0)) & 4413 call io_error('Error: Wrong number of lines in block '//trim(keyword)) 4414 4415 found = .true. 4416 4417 lconvert = .false. 4418 if (blen == rows + 1) then 4419 dummy = in_data(line_s + 1) 4420 if (index(dummy, 'ang') .ne. 0) then 4421 lconvert = .false. 4422 elseif (index(dummy, 'bohr') .ne. 0) then 4423 lconvert = .true. 4424 else 4425 call io_error('Error: Units in block '//trim(keyword)//' not recognised') 4426 endif 4427 in_data(line_s) (1:maxlen) = ' ' 4428 line_s = line_s + 1 4429 endif 4430 4431! r_value=1.0_dp 4432 counter = 0 4433 do loop = line_s + 1, line_e - 1 4434 dummy = in_data(loop) 4435 counter = counter + 1 4436 if (present(c_value)) read (dummy, *, err=240, end=240) (c_value(i, counter), i=1, columns) 4437 if (present(l_value)) then 4438 ! I don't think we need this. Maybe read into a dummy charater 4439 ! array and convert each element to logical 4440 call io_error('param_get_keyword_block unimplemented for logicals') 4441 endif 4442 if (present(i_value)) read (dummy, *, err=240, end=240) (i_value(i, counter), i=1, columns) 4443 if (present(r_value)) read (dummy, *, err=240, end=240) (r_value(i, counter), i=1, columns) 4444 end do 4445 4446 if (lconvert) then 4447 if (present(r_value)) then 4448 r_value = r_value*bohr 4449 endif 4450 endif 4451 4452 in_data(line_s:line_e) (1:maxlen) = ' ' 4453 4454 return 4455 4456240 call io_error('Error: Problem reading block keyword '//trim(keyword)) 4457 4458 end subroutine param_get_keyword_block 4459 4460!=====================================================! 4461 subroutine param_get_block_length(keyword, found, rows, lunits) 4462 !=====================================================! 4463 ! ! 4464 !! Finds the length of the data block 4465 ! ! 4466 !=====================================================! 4467 4468 use w90_io, only: io_error 4469 4470 implicit none 4471 4472 character(*), intent(in) :: keyword 4473 !! Keyword to examine 4474 logical, intent(out) :: found 4475 !! Is keyword present 4476 integer, intent(out) :: rows 4477 !! Number of rows 4478 logical, optional, intent(out) :: lunits 4479 !! Have we found a unit specification 4480 4481 integer :: i, in, ins, ine, loop, line_e, line_s 4482 logical :: found_e, found_s 4483 character(len=maxlen) :: end_st, start_st, dummy 4484 character(len=2) :: atsym 4485 real(kind=dp) :: atpos(3) 4486 4487 rows = 0 4488 found_s = .false. 4489 found_e = .false. 4490 4491 start_st = 'begin '//trim(keyword) 4492 end_st = 'end '//trim(keyword) 4493 4494 do loop = 1, num_lines 4495 ins = index(in_data(loop), trim(keyword)) 4496 if (ins == 0) cycle 4497 in = index(in_data(loop), 'begin') 4498 if (in == 0 .or. in > 1) cycle 4499 line_s = loop 4500 if (found_s) then 4501 call io_error('Error: Found '//trim(start_st)//' more than once in input file') 4502 endif 4503 found_s = .true. 4504 end do 4505 4506 if (.not. found_s) then 4507 found = .false. 4508 return 4509 end if 4510 4511 do loop = 1, num_lines 4512 ine = index(in_data(loop), trim(keyword)) 4513 if (ine == 0) cycle 4514 in = index(in_data(loop), 'end') 4515 if (in == 0 .or. in > 1) cycle 4516 line_e = loop 4517 if (found_e) then 4518 call io_error('Error: Found '//trim(end_st)//' more than once in input file') 4519 endif 4520 found_e = .true. 4521 end do 4522 4523 if (.not. found_e) then 4524 call io_error('Error: Found '//trim(start_st)//' but no '//trim(end_st)//' in input file') 4525 end if 4526 4527 if (line_e <= line_s) then 4528 call io_error('Error: '//trim(end_st)//' comes before '//trim(start_st)//' in input file') 4529 end if 4530 4531 rows = line_e - line_s - 1 4532 4533 found = .true. 4534 4535 ! Ignore atoms_cart and atoms_frac blocks if running in library mode 4536 if (library) then 4537 if (trim(keyword) .eq. 'atoms_cart' .or. trim(keyword) .eq. 'atoms_frac') then 4538 in_data(line_s:line_e) (1:maxlen) = ' ' 4539 endif 4540 endif 4541 4542 if (present(lunits)) then 4543 dummy = in_data(line_s + 1) 4544 ! write(stdout,*) dummy 4545 ! write(stdout,*) trim(dummy) 4546 read (dummy, *, end=555) atsym, (atpos(i), i=1, 3) 4547 lunits = .false. 4548 endif 4549 4550 if (rows <= 0) then !cope with empty blocks 4551 found = .false. 4552 in_data(line_s:line_e) (1:maxlen) = ' ' 4553 end if 4554 4555 return 4556 4557555 lunits = .true. 4558 4559 if (rows <= 1) then !cope with empty blocks 4560 found = .false. 4561 in_data(line_s:line_e) (1:maxlen) = ' ' 4562 end if 4563 4564 return 4565 4566 end subroutine param_get_block_length 4567 4568!===================================! 4569 subroutine param_get_atoms(lunits) 4570 !===================================! 4571 ! ! 4572 !! Fills the atom data block 4573 ! ! 4574 !===================================! 4575 4576 use w90_constants, only: bohr 4577 use w90_utility, only: utility_frac_to_cart, utility_cart_to_frac 4578 use w90_io, only: io_error 4579 implicit none 4580 4581 logical, intent(in) :: lunits 4582 !! Do we expect a first line with the units 4583 4584 real(kind=dp) :: atoms_pos_frac_tmp(3, num_atoms) 4585 real(kind=dp) :: atoms_pos_cart_tmp(3, num_atoms) 4586 character(len=20) :: keyword 4587 integer :: in, ins, ine, loop, i, line_e, line_s, counter 4588 integer :: i_temp, loop2, max_sites, ierr, ic 4589 logical :: found_e, found_s, found, frac 4590 character(len=maxlen) :: dummy, end_st, start_st 4591 character(len=maxlen) :: ctemp(num_atoms) 4592 character(len=maxlen) :: atoms_label_tmp(num_atoms) 4593 logical :: lconvert 4594 4595 keyword = "atoms_cart" 4596 frac = .false. 4597 call param_get_block_length("atoms_frac", found, i_temp) 4598 if (found) then 4599 keyword = "atoms_frac" 4600 frac = .true. 4601 end if 4602 4603 found_s = .false. 4604 found_e = .false. 4605 4606 start_st = 'begin '//trim(keyword) 4607 end_st = 'end '//trim(keyword) 4608 4609 do loop = 1, num_lines 4610 ins = index(in_data(loop), trim(keyword)) 4611 if (ins == 0) cycle 4612 in = index(in_data(loop), 'begin') 4613 if (in == 0 .or. in > 1) cycle 4614 line_s = loop 4615 if (found_s) then 4616 call io_error('Error: Found '//trim(start_st)//' more than once in input file') 4617 endif 4618 found_s = .true. 4619 end do 4620 4621 do loop = 1, num_lines 4622 ine = index(in_data(loop), trim(keyword)) 4623 if (ine == 0) cycle 4624 in = index(in_data(loop), 'end') 4625 if (in == 0 .or. in > 1) cycle 4626 line_e = loop 4627 if (found_e) then 4628 call io_error('Error: Found '//trim(end_st)//' more than once in input file') 4629 endif 4630 found_e = .true. 4631 end do 4632 4633 if (.not. found_e) then 4634 call io_error('Error: Found '//trim(start_st)//' but no '//trim(end_st)//' in input file') 4635 end if 4636 4637 if (line_e <= line_s) then 4638 call io_error('Error: '//trim(end_st)//' comes before '//trim(start_st)//' in input file') 4639 end if 4640 4641 lconvert = .false. 4642 if (lunits) then 4643 dummy = in_data(line_s + 1) 4644 if (index(dummy, 'ang') .ne. 0) then 4645 lconvert = .false. 4646 elseif (index(dummy, 'bohr') .ne. 0) then 4647 lconvert = .true. 4648 else 4649 call io_error('Error: Units in block atoms_cart not recognised in param_get_atoms') 4650 endif 4651 in_data(line_s) (1:maxlen) = ' ' 4652 line_s = line_s + 1 4653 endif 4654 4655 counter = 0 4656 do loop = line_s + 1, line_e - 1 4657 dummy = in_data(loop) 4658 counter = counter + 1 4659 if (frac) then 4660 read (dummy, *, err=240, end=240) atoms_label_tmp(counter), (atoms_pos_frac_tmp(i, counter), i=1, 3) 4661 else 4662 read (dummy, *, err=240, end=240) atoms_label_tmp(counter), (atoms_pos_cart_tmp(i, counter), i=1, 3) 4663 end if 4664 end do 4665 4666 if (lconvert) atoms_pos_cart_tmp = atoms_pos_cart_tmp*bohr 4667 4668 in_data(line_s:line_e) (1:maxlen) = ' ' 4669 4670 if (frac) then 4671 do loop = 1, num_atoms 4672 call utility_frac_to_cart(atoms_pos_frac_tmp(:, loop), atoms_pos_cart_tmp(:, loop), real_lattice) 4673 end do 4674 else 4675 do loop = 1, num_atoms 4676 call utility_cart_to_frac(atoms_pos_cart_tmp(:, loop), atoms_pos_frac_tmp(:, loop), recip_lattice) 4677 end do 4678 end if 4679 4680 ! Now we sort the data into the proper structures 4681 num_species = 1 4682 ctemp(1) = atoms_label_tmp(1) 4683 do loop = 2, num_atoms 4684 do loop2 = 1, loop - 1 4685 if (trim(atoms_label_tmp(loop)) == trim(atoms_label_tmp(loop2))) exit 4686 if (loop2 == loop - 1) then 4687 num_species = num_species + 1 4688 ctemp(num_species) = atoms_label_tmp(loop) 4689 end if 4690 end do 4691 end do 4692 4693 allocate (atoms_species_num(num_species), stat=ierr) 4694 if (ierr /= 0) call io_error('Error allocating atoms_species_num in param_get_atoms') 4695 allocate (atoms_label(num_species), stat=ierr) 4696 if (ierr /= 0) call io_error('Error allocating atoms_label in param_get_atoms') 4697 allocate (atoms_symbol(num_species), stat=ierr) 4698 if (ierr /= 0) call io_error('Error allocating atoms_symbol in param_get_atoms') 4699 atoms_species_num(:) = 0 4700 4701 do loop = 1, num_species 4702 atoms_label(loop) = ctemp(loop) 4703 do loop2 = 1, num_atoms 4704 if (trim(atoms_label(loop)) == trim(atoms_label_tmp(loop2))) then 4705 atoms_species_num(loop) = atoms_species_num(loop) + 1 4706 end if 4707 end do 4708 end do 4709 4710 max_sites = maxval(atoms_species_num) 4711 allocate (atoms_pos_frac(3, max_sites, num_species), stat=ierr) 4712 if (ierr /= 0) call io_error('Error allocating atoms_pos_frac in param_get_atoms') 4713 allocate (atoms_pos_cart(3, max_sites, num_species), stat=ierr) 4714 if (ierr /= 0) call io_error('Error allocating atoms_pos_cart in param_get_atoms') 4715 4716 do loop = 1, num_species 4717 counter = 0 4718 do loop2 = 1, num_atoms 4719 if (trim(atoms_label(loop)) == trim(atoms_label_tmp(loop2))) then 4720 counter = counter + 1 4721 atoms_pos_frac(:, counter, loop) = atoms_pos_frac_tmp(:, loop2) 4722 atoms_pos_cart(:, counter, loop) = atoms_pos_cart_tmp(:, loop2) 4723 end if 4724 end do 4725 end do 4726 4727 ! Strip any numeric characters from atoms_label to get atoms_symbol 4728 do loop = 1, num_species 4729 atoms_symbol(loop) (1:2) = atoms_label(loop) (1:2) 4730 ic = ichar(atoms_symbol(loop) (2:2)) 4731 if ((ic .lt. ichar('a')) .or. (ic .gt. ichar('z'))) & 4732 atoms_symbol(loop) (2:2) = ' ' 4733 end do 4734 4735 return 4736 4737240 call io_error('Error: Problem reading block keyword '//trim(keyword)) 4738 4739 end subroutine param_get_atoms 4740 4741!=====================================================! 4742 subroutine param_lib_set_atoms(atoms_label_tmp, atoms_pos_cart_tmp) 4743 !=====================================================! 4744 ! ! 4745 !! Fills the atom data block during a library call 4746 ! ! 4747 !=====================================================! 4748 4749 use w90_utility, only: utility_cart_to_frac, utility_lowercase 4750 use w90_io, only: io_error 4751 4752 implicit none 4753 4754 character(len=*), intent(in) :: atoms_label_tmp(num_atoms) 4755 !! Atom labels 4756 real(kind=dp), intent(in) :: atoms_pos_cart_tmp(3, num_atoms) 4757 !! Atom positions 4758 4759 real(kind=dp) :: atoms_pos_frac_tmp(3, num_atoms) 4760 integer :: loop2, max_sites, ierr, ic, loop, counter 4761 character(len=maxlen) :: ctemp(num_atoms) 4762 character(len=maxlen) :: tmp_string 4763 4764 do loop = 1, num_atoms 4765 call utility_cart_to_frac(atoms_pos_cart_tmp(:, loop), & 4766 atoms_pos_frac_tmp(:, loop), recip_lattice) 4767 enddo 4768 4769 ! Now we sort the data into the proper structures 4770 num_species = 1 4771 ctemp(1) = atoms_label_tmp(1) 4772 do loop = 2, num_atoms 4773 do loop2 = 1, loop - 1 4774 if (trim(atoms_label_tmp(loop)) == trim(atoms_label_tmp(loop2))) exit 4775 if (loop2 == loop - 1) then 4776 num_species = num_species + 1 4777 ctemp(num_species) = atoms_label_tmp(loop) 4778 end if 4779 end do 4780 end do 4781 4782 allocate (atoms_species_num(num_species), stat=ierr) 4783 if (ierr /= 0) call io_error('Error allocating atoms_species_num in param_lib_set_atoms') 4784 allocate (atoms_label(num_species), stat=ierr) 4785 if (ierr /= 0) call io_error('Error allocating atoms_label in param_lib_set_atoms') 4786 allocate (atoms_symbol(num_species), stat=ierr) 4787 if (ierr /= 0) call io_error('Error allocating atoms_symbol in param_lib_set_atoms') 4788 atoms_species_num(:) = 0 4789 4790 do loop = 1, num_species 4791 atoms_label(loop) = ctemp(loop) 4792 do loop2 = 1, num_atoms 4793 if (trim(atoms_label(loop)) == trim(atoms_label_tmp(loop2))) then 4794 atoms_species_num(loop) = atoms_species_num(loop) + 1 4795 end if 4796 end do 4797 end do 4798 4799 max_sites = maxval(atoms_species_num) 4800 allocate (atoms_pos_frac(3, max_sites, num_species), stat=ierr) 4801 if (ierr /= 0) call io_error('Error allocating atoms_pos_frac in param_lib_set_atoms') 4802 allocate (atoms_pos_cart(3, max_sites, num_species), stat=ierr) 4803 if (ierr /= 0) call io_error('Error allocating atoms_pos_cart in param_lib_set_atoms') 4804 4805 do loop = 1, num_species 4806 counter = 0 4807 do loop2 = 1, num_atoms 4808 if (trim(atoms_label(loop)) == trim(atoms_label_tmp(loop2))) then 4809 counter = counter + 1 4810 atoms_pos_frac(:, counter, loop) = atoms_pos_frac_tmp(:, loop2) 4811 atoms_pos_cart(:, counter, loop) = atoms_pos_cart_tmp(:, loop2) 4812 end if 4813 end do 4814 end do 4815 4816 ! Strip any numeric characters from atoms_label to get atoms_symbol 4817 do loop = 1, num_species 4818 atoms_symbol(loop) (1:2) = atoms_label(loop) (1:2) 4819 ic = ichar(atoms_symbol(loop) (2:2)) 4820 if ((ic .lt. ichar('a')) .or. (ic .gt. ichar('z'))) & 4821 atoms_symbol(loop) (2:2) = ' ' 4822 tmp_string = trim(adjustl(utility_lowercase(atoms_symbol(loop)))) 4823 atoms_symbol(loop) (1:2) = tmp_string(1:2) 4824 tmp_string = trim(adjustl(utility_lowercase(atoms_label(loop)))) 4825 atoms_label(loop) (1:2) = tmp_string(1:2) 4826 end do 4827 4828 return 4829 4830 end subroutine param_lib_set_atoms 4831 4832!====================================================================! 4833 subroutine param_get_range_vector(keyword, found, length, lcount, i_value) 4834 !====================================================================! 4835 !! Read a range vector eg. 1,2,3,4-10 or 1 3 400:100 4836 !! if(lcount) we return the number of states in length 4837 !====================================================================! 4838 use w90_io, only: io_error 4839 4840 implicit none 4841 4842 character(*), intent(in) :: keyword 4843 !! Keyword to examine 4844 logical, intent(out) :: found 4845 !! Is keyword found 4846 integer, intent(inout) :: length 4847 !! Number of states 4848 logical, intent(in) :: lcount 4849 !! If T only count states 4850 integer, optional, intent(out) :: i_value(length) 4851 !! States specified in range vector 4852 4853 integer :: kl, in, loop, num1, num2, i_punc 4854 integer :: counter, i_digit, loop_r, range_size 4855 character(len=maxlen) :: dummy 4856 character(len=10), parameter :: c_digit = "0123456789" 4857 character(len=2), parameter :: c_range = "-:" 4858 character(len=3), parameter :: c_sep = " ,;" 4859 character(len=5), parameter :: c_punc = " ,;-:" 4860 character(len=5) :: c_num1, c_num2 4861 4862 if (lcount .and. present(i_value)) call io_error('param_get_range_vector: incorrect call') 4863 4864 kl = len_trim(keyword) 4865 4866 found = .false. 4867 4868 do loop = 1, num_lines 4869 in = index(in_data(loop), trim(keyword)) 4870 if (in == 0 .or. in > 1) cycle 4871 if (found) then 4872 call io_error('Error: Found keyword '//trim(keyword)//' more than once in input file') 4873 endif 4874 found = .true. 4875 dummy = in_data(loop) (kl + 1:) 4876 dummy = adjustl(dummy) 4877 if (.not. lcount) in_data(loop) (1:maxlen) = ' ' 4878 if (dummy(1:1) == '=' .or. dummy(1:1) == ':') then 4879 dummy = dummy(2:) 4880 dummy = adjustl(dummy) 4881 end if 4882 end do 4883 4884 if (.not. found) return 4885 4886 counter = 0 4887 if (len_trim(dummy) == 0) call io_error('Error: keyword '//trim(keyword)//' is blank') 4888 dummy = adjustl(dummy) 4889 do 4890 i_punc = scan(dummy, c_punc) 4891 if (i_punc == 0) call io_error('Error parsing keyword '//trim(keyword)) 4892 c_num1 = dummy(1:i_punc - 1) 4893 read (c_num1, *, err=101, end=101) num1 4894 dummy = adjustl(dummy(i_punc:)) 4895 !look for range 4896 if (scan(dummy, c_range) == 1) then 4897 i_digit = scan(dummy, c_digit) 4898 dummy = adjustl(dummy(i_digit:)) 4899 i_punc = scan(dummy, c_punc) 4900 c_num2 = dummy(1:i_punc - 1) 4901 read (c_num2, *, err=101, end=101) num2 4902 dummy = adjustl(dummy(i_punc:)) 4903 range_size = abs(num2 - num1) + 1 4904 do loop_r = 1, range_size 4905 counter = counter + 1 4906 if (.not. lcount) i_value(counter) = min(num1, num2) + loop_r - 1 4907 end do 4908 else 4909 counter = counter + 1 4910 if (.not. lcount) i_value(counter) = num1 4911 end if 4912 4913 if (scan(dummy, c_sep) == 1) dummy = adjustl(dummy(2:)) 4914 if (scan(dummy, c_range) == 1) call io_error('Error parsing keyword '//trim(keyword)//' incorrect range') 4915 if (index(dummy, ' ') == 1) exit 4916 end do 4917 4918 if (lcount) length = counter 4919 if (.not. lcount) then 4920 do loop = 1, counter - 1 4921 do loop_r = loop + 1, counter 4922 if (i_value(loop) == i_value(loop_r)) & 4923 call io_error('Error parsing keyword '//trim(keyword)//' duplicate values') 4924 end do 4925 end do 4926 end if 4927 4928 return 4929 4930101 call io_error('Error parsing keyword '//trim(keyword)) 4931 4932 end subroutine param_get_range_vector 4933 4934 subroutine param_get_centre_constraints 4935 !=============================================================================! 4936 ! ! 4937 !! assigns projection centres as default centre constraints and global 4938 !! Lagrange multiplier as individual Lagrange multipliers then reads 4939 !! the centre_constraints block for individual centre constraint parameters 4940 ! ! 4941 !=============================================================================! 4942 use w90_io, only: io_error 4943 use w90_utility, only: utility_frac_to_cart 4944 integer :: loop1, index1, constraint_num, index2, loop2 4945 integer :: column, start, finish, wann, ierr 4946 !logical :: found 4947 character(len=maxlen) :: dummy 4948 4949 do loop1 = 1, num_wann 4950 do loop2 = 1, 3 4951 ccentres_frac(loop1, loop2) = proj_site(loop2, loop1) 4952 end do 4953 end do 4954 4955 constraint_num = 0 4956 do loop1 = 1, num_lines 4957 dummy = in_data(loop1) 4958 if (constraint_num > 0) then 4959 if (trim(dummy) == '') cycle 4960 index1 = index(dummy, 'begin') 4961 if (index1 > 0) call io_error("slwf_centres block hasn't ended yet") 4962 index1 = index(dummy, 'end') 4963 if (index1 > 0) then 4964 index1 = index(dummy, 'slwf_centres') 4965 if (index1 == 0) call io_error('Wrong ending of block (need to end slwf_centres)') 4966 in_data(loop1) (1:maxlen) = ' ' 4967 exit 4968 end if 4969 column = 0 4970 start = 1 4971 finish = 1 4972 do loop2 = 1, len_trim(dummy) 4973 if (start == loop2 .and. dummy(loop2:loop2) == ' ') then 4974 start = loop2 + 1 4975 end if 4976 if (start < loop2) then 4977 if (dummy(loop2:loop2) == ' ') then 4978 finish = loop2 - 1 4979 call param_get_centre_constraint_from_column(column, start, finish, wann, dummy) 4980 start = loop2 + 1 4981 finish = start 4982 end if 4983 end if 4984 if (loop2 == len_trim(dummy) .and. dummy(loop2:loop2) /= ' ') then 4985 finish = loop2 4986 call param_get_centre_constraint_from_column(column, start, finish, wann, dummy) 4987 start = loop2 + 1 4988 finish = start 4989 end if 4990 end do 4991 in_data(loop1) (1:maxlen) = ' ' 4992 constraint_num = constraint_num + 1 4993 end if 4994 index1 = index(dummy, 'slwf_centres') 4995 if (index1 > 0) then 4996 index1 = index(dummy, 'begin') 4997 if (index1 > 0) then 4998 constraint_num = 1 4999 in_data(loop1) (1:maxlen) = ' ' 5000 end if 5001 end if 5002 end do 5003 do loop1 = 1, num_wann 5004 call utility_frac_to_cart(ccentres_frac(loop1, :), ccentres_cart(loop1, :), real_lattice) 5005 end do 5006 end subroutine param_get_centre_constraints 5007 5008 subroutine param_get_centre_constraint_from_column(column, start, finish, wann, dummy) 5009 !===================================! 5010 ! ! 5011 !! assigns value read to constraint 5012 !! parameters based on column 5013 ! ! 5014 !===================================! 5015 use w90_io, only: io_error 5016 integer, intent(inout):: column, start, finish, wann 5017 character(len=maxlen), intent(inout):: dummy 5018 if (column == 0) then 5019 read (dummy(start:finish), '(i3)') wann 5020 end if 5021 if (column > 0) then 5022 if (column > 4) call io_error("Didn't expect anything else after Lagrange multiplier") 5023 if (column < 4) read (dummy(start:finish), '(f10.10)') ccentres_frac(wann, column) 5024 end if 5025 column = column + 1 5026 end subroutine param_get_centre_constraint_from_column 5027 5028!===================================! 5029 subroutine param_get_projections(num_proj, lcount) 5030 !===================================! 5031 ! ! 5032 !! Fills the projection data block 5033 ! ! 5034 !===================================! 5035 5036 use w90_constants, only: bohr, eps6, eps2 5037 use w90_utility, only: utility_cart_to_frac, & 5038 utility_string_to_coord, utility_strip 5039 use w90_io, only: io_error 5040 5041 implicit none 5042 5043 integer, intent(inout) :: num_proj 5044 logical, intent(in) :: lcount 5045 5046 real(kind=dp) :: pos_frac(3) 5047 real(kind=dp) :: pos_cart(3) 5048 character(len=20) :: keyword 5049 integer :: in, ins, ine, loop, line_e, line_s, counter 5050 integer :: sites, species, line, pos1, pos2, pos3, m_tmp, l_tmp, mstate 5051 integer :: loop_l, loop_m, loop_sites, ierr, loop_s, spn_counter 5052 logical :: found_e, found_s 5053 character(len=maxlen) :: dummy, end_st, start_st 5054 character(len=maxlen) :: ctemp, ctemp2, ctemp3, ctemp4, ctemp5, m_string 5055 ! 5056 integer, parameter :: min_l = -5 5057 integer, parameter :: max_l = 3 5058 integer, parameter :: min_m = 1 5059 integer, parameter :: max_m = 7 5060 integer :: ang_states(min_m:max_m, min_l:max_l) 5061 ! default values for the optional part of the projection definitions 5062 real(kind=dp), parameter :: proj_z_def(3) = (/0.0_dp, 0.0_dp, 1.0_dp/) 5063 real(kind=dp), parameter :: proj_x_def(3) = (/1.0_dp, 0.0_dp, 0.0_dp/) 5064 real(kind=dp), parameter :: proj_s_qaxis_def(3) = (/0.0_dp, 0.0_dp, 1.0_dp/) 5065 real(kind=dp), parameter :: proj_zona_def = 1.0_dp 5066 integer, parameter :: proj_radial_def = 1 5067 ! 5068 real(kind=dp) :: proj_z_tmp(3) 5069 real(kind=dp) :: proj_x_tmp(3) 5070 real(kind=dp) :: proj_s_qaxis_tmp(3) 5071 real(kind=dp) :: proj_zona_tmp 5072 integer :: proj_radial_tmp 5073 logical :: lconvert, lrandom, proj_u_tmp, proj_d_tmp 5074 logical :: lpartrandom 5075 ! 5076 real(kind=dp) :: xnorm, znorm, cosphi, sinphi, xnorm_new, cosphi_new 5077 5078 keyword = "projections" 5079 5080 found_s = .false. 5081 found_e = .false. 5082 5083 start_st = 'begin '//trim(keyword) 5084 end_st = 'end '//trim(keyword) 5085 5086! if(spinors) num_proj=num_wann/2 5087 5088 if (.not. lcount) then 5089 allocate (input_proj_site(3, num_proj), stat=ierr) 5090 if (ierr /= 0) call io_error('Error allocating input_proj_site in param_get_projections') 5091 allocate (input_proj_l(num_proj), stat=ierr) 5092 if (ierr /= 0) call io_error('Error allocating input_proj_l in param_get_projections') 5093 allocate (input_proj_m(num_proj), stat=ierr) 5094 if (ierr /= 0) call io_error('Error allocating input_proj_m in param_get_projections') 5095 allocate (input_proj_z(3, num_proj), stat=ierr) 5096 if (ierr /= 0) call io_error('Error allocating input_proj_z in param_get_projections') 5097 allocate (input_proj_x(3, num_proj), stat=ierr) 5098 if (ierr /= 0) call io_error('Error allocating input_proj_x in param_get_projections') 5099 allocate (input_proj_radial(num_proj), stat=ierr) 5100 if (ierr /= 0) call io_error('Error allocating input_proj_radial in param_get_projections') 5101 allocate (input_proj_zona(num_proj), stat=ierr) 5102 if (ierr /= 0) call io_error('Error allocating input_proj_zona in param_get_projections') 5103 if (spinors) then 5104 allocate (input_proj_s(num_proj), stat=ierr) 5105 if (ierr /= 0) call io_error('Error allocating input_proj_s in param_get_projections') 5106 allocate (input_proj_s_qaxis(3, num_proj), stat=ierr) 5107 if (ierr /= 0) call io_error('Error allocating input_proj_s_qaxis in param_get_projections') 5108 endif 5109 5110 allocate (proj_site(3, num_wann), stat=ierr) 5111 if (ierr /= 0) call io_error('Error allocating proj_site in param_get_projections') 5112 allocate (proj_l(num_wann), stat=ierr) 5113 if (ierr /= 0) call io_error('Error allocating proj_l in param_get_projections') 5114 allocate (proj_m(num_wann), stat=ierr) 5115 if (ierr /= 0) call io_error('Error allocating proj_m in param_get_projections') 5116 allocate (proj_z(3, num_wann), stat=ierr) 5117 if (ierr /= 0) call io_error('Error allocating proj_z in param_get_projections') 5118 allocate (proj_x(3, num_wann), stat=ierr) 5119 if (ierr /= 0) call io_error('Error allocating proj_x in param_get_projections') 5120 allocate (proj_radial(num_wann), stat=ierr) 5121 if (ierr /= 0) call io_error('Error allocating proj_radial in param_get_projections') 5122 allocate (proj_zona(num_wann), stat=ierr) 5123 if (ierr /= 0) call io_error('Error allocating proj_zona in param_get_projections') 5124 if (spinors) then 5125 allocate (proj_s(num_wann), stat=ierr) 5126 if (ierr /= 0) call io_error('Error allocating proj_s in param_get_projections') 5127 allocate (proj_s_qaxis(3, num_wann), stat=ierr) 5128 if (ierr /= 0) call io_error('Error allocating proj_s_qaxis in param_get_projections') 5129 endif 5130 endif 5131 5132 do loop = 1, num_lines 5133 ins = index(in_data(loop), trim(keyword)) 5134 if (ins == 0) cycle 5135 in = index(in_data(loop), 'begin') 5136 if (in == 0 .or. in > 1) cycle 5137 line_s = loop 5138 if (found_s) then 5139 call io_error('Error: Found '//trim(start_st)//' more than once in input file') 5140 endif 5141 found_s = .true. 5142 end do 5143 5144 do loop = 1, num_lines 5145 ine = index(in_data(loop), trim(keyword)) 5146 if (ine == 0) cycle 5147 in = index(in_data(loop), 'end') 5148 if (in == 0 .or. in > 1) cycle 5149 line_e = loop 5150 if (found_e) then 5151 call io_error('param_get_projections: Found '//trim(end_st)//' more than once in input file') 5152 endif 5153 found_e = .true. 5154 end do 5155 5156 if (.not. found_e) then 5157 call io_error('param_get_projections: Found '//trim(start_st)//' but no '//trim(end_st)//' in input file') 5158 end if 5159 5160 if (line_e <= line_s) then 5161 call io_error('param_get_projections: '//trim(end_st)//' comes before '//trim(start_st)//' in input file') 5162 end if 5163 5164 dummy = in_data(line_s + 1) 5165 lconvert = .false. 5166 lrandom = .false. 5167 lpartrandom = .false. 5168 if (index(dummy, 'ang') .ne. 0) then 5169 if (.not. lcount) in_data(line_s) (1:maxlen) = ' ' 5170 line_s = line_s + 1 5171 elseif (index(dummy, 'bohr') .ne. 0) then 5172 if (.not. lcount) in_data(line_s) (1:maxlen) = ' ' 5173 line_s = line_s + 1 5174 lconvert = .true. 5175 elseif (index(dummy, 'random') .ne. 0) then 5176 if (.not. lcount) in_data(line_s) (1:maxlen) = ' ' 5177 line_s = line_s + 1 5178 if (index(in_data(line_s + 1), end_st) .ne. 0) then 5179 lrandom = .true. ! all projections random 5180 else 5181 lpartrandom = .true. ! only some projections random 5182 if (index(in_data(line_s + 1), 'ang') .ne. 0) then 5183 if (.not. lcount) in_data(line_s) (1:maxlen) = ' ' 5184 line_s = line_s + 1 5185 elseif (index(in_data(line_s + 1), 'bohr') .ne. 0) then 5186 if (.not. lcount) in_data(line_s) (1:maxlen) = ' ' 5187 line_s = line_s + 1 5188 lconvert = .true. 5189 endif 5190 endif 5191 endif 5192 5193 counter = 0 5194 if (.not. lrandom) then 5195 do line = line_s + 1, line_e - 1 5196 ang_states = 0 5197 !Assume the default values 5198 proj_z_tmp = proj_z_def 5199 proj_x_tmp = proj_x_def 5200 proj_zona_tmp = proj_zona_def 5201 proj_radial_tmp = proj_radial_def 5202 if (spinors) then 5203 proj_s_qaxis_tmp = proj_s_qaxis_def 5204 spn_counter = 2 5205 proj_u_tmp = .true. 5206 proj_d_tmp = .true. 5207 else 5208 spn_counter = 1 5209 endif 5210 ! Strip input line of all spaces 5211 dummy = utility_strip(in_data(line)) 5212 dummy = adjustl(dummy) 5213 pos1 = index(dummy, ':') 5214 if (pos1 == 0) & 5215 call io_error('param_read_projection: malformed projection definition: '//trim(dummy)) 5216 sites = 0 5217 ctemp = dummy(:pos1 - 1) 5218 ! Read the atomic site 5219 if (index(ctemp, 'c=') > 0) then 5220 sites = -1 5221 ctemp = ctemp(3:) 5222 call utility_string_to_coord(ctemp, pos_cart) 5223 if (lconvert) pos_cart = pos_cart*bohr 5224 call utility_cart_to_frac(pos_cart(:), pos_frac(:), recip_lattice) 5225 elseif (index(ctemp, 'f=') > 0) then 5226 sites = -1 5227 ctemp = ctemp(3:) 5228 call utility_string_to_coord(ctemp, pos_frac) 5229 else 5230 if (num_species == 0) & 5231 call io_error('param_get_projection: Atom centred projection requested but no atoms defined') 5232 do loop = 1, num_species 5233 if (trim(ctemp) == atoms_label(loop)) then 5234 species = loop 5235 sites = atoms_species_num(loop) 5236 exit 5237 end if 5238 if (loop == num_species) call io_error('param_get_projection: Atom site not recognised '//trim(ctemp)) 5239 end do 5240 end if 5241 5242 dummy = dummy(pos1 + 1:) 5243 5244 ! scan for quantisation direction 5245 pos1 = index(dummy, '[') 5246 if (spinors) then 5247 if (pos1 > 0) then 5248 ctemp = (dummy(pos1 + 1:)) 5249 pos2 = index(ctemp, ']') 5250 if (pos2 == 0) call io_error & 5251 ('param_get_projections: no closing square bracket for spin quantisation dir') 5252 ctemp = ctemp(:pos2 - 1) 5253 call utility_string_to_coord(ctemp, proj_s_qaxis_tmp) 5254 dummy = dummy(:pos1 - 1) ! remove [ ] section 5255 endif 5256 else 5257 if (pos1 > 0) call io_error('param_get_projections: spin qdir is defined but spinors=.false.') 5258 endif 5259 5260 ! scan for up or down 5261 pos1 = index(dummy, '(') 5262 if (spinors) then 5263 if (pos1 > 0) then 5264 proj_u_tmp = .false.; proj_d_tmp = .false. 5265 ctemp = (dummy(pos1 + 1:)) 5266 pos2 = index(ctemp, ')') 5267 if (pos2 == 0) call io_error('param_get_projections: no closing bracket for spin') 5268 ctemp = ctemp(:pos2 - 1) 5269 if (index(ctemp, 'u') > 0) proj_u_tmp = .true. 5270 if (index(ctemp, 'd') > 0) proj_d_tmp = .true. 5271 if (proj_u_tmp .and. proj_d_tmp) then 5272 spn_counter = 2 5273 elseif (.not. proj_u_tmp .and. .not. proj_d_tmp) then 5274 call io_error('param_get_projections: found brackets but neither u or d') 5275 else 5276 spn_counter = 1 5277 endif 5278 dummy = dummy(:pos1 - 1) ! remove ( ) section 5279 endif 5280 else 5281 if (pos1 > 0) call io_error('param_get_projections: spin is defined but spinors=.false.') 5282 endif 5283 5284 !Now we know the sites for this line. Get the angular momentum states 5285 pos1 = index(dummy, ':') 5286 if (pos1 > 0) then 5287 ctemp = dummy(:pos1 - 1) 5288 else 5289 ctemp = dummy 5290 end if 5291 ctemp2 = ctemp 5292 do 5293 pos2 = index(ctemp2, ';') 5294 if (pos2 == 0) then 5295 ctemp3 = ctemp2 5296 else 5297 ctemp3 = ctemp2(:pos2 - 1) 5298 endif 5299 if (index(ctemp3, 'l=') == 1) then 5300 mstate = index(ctemp3, ',') 5301 if (mstate > 0) then 5302 read (ctemp3(3:mstate - 1), *, err=101, end=101) l_tmp 5303 else 5304 read (ctemp3(3:), *, err=101, end=101) l_tmp 5305 end if 5306 if (l_tmp < -5 .or. l_tmp > 3) call io_error('param_get_projection: Incorrect l state requested') 5307 if (mstate == 0) then 5308 if (l_tmp >= 0) then 5309 do loop_m = 1, 2*l_tmp + 1 5310 ang_states(loop_m, l_tmp) = 1 5311 end do 5312 elseif (l_tmp == -1) then !sp 5313 ang_states(1:2, l_tmp) = 1 5314 elseif (l_tmp == -2) then !sp2 5315 ang_states(1:3, l_tmp) = 1 5316 elseif (l_tmp == -3) then !sp3 5317 ang_states(1:4, l_tmp) = 1 5318 elseif (l_tmp == -4) then !sp3d 5319 ang_states(1:5, l_tmp) = 1 5320 elseif (l_tmp == -5) then !sp3d2 5321 ang_states(1:6, l_tmp) = 1 5322 endif 5323 else 5324 if (index(ctemp3, 'mr=') /= mstate + 1) & 5325 call io_error('param_get_projection: Problem reading m state') 5326 ctemp4 = ctemp3(mstate + 4:) 5327 do 5328 pos3 = index(ctemp4, ',') 5329 if (pos3 == 0) then 5330 ctemp5 = ctemp4 5331 else 5332 ctemp5 = ctemp4(:pos3 - 1) 5333 endif 5334 read (ctemp5(1:), *, err=102, end=102) m_tmp 5335 if (l_tmp >= 0) then 5336 if ((m_tmp > 2*l_tmp + 1) .or. (m_tmp <= 0)) call io_error('param_get_projection: m is > l !') 5337 elseif (l_tmp == -1 .and. (m_tmp > 2 .or. m_tmp <= 0)) then 5338 call io_error('param_get_projection: m has incorrect value (1)') 5339 elseif (l_tmp == -2 .and. (m_tmp > 3 .or. m_tmp <= 0)) then 5340 call io_error('param_get_projection: m has incorrect value (2)') 5341 elseif (l_tmp == -3 .and. (m_tmp > 4 .or. m_tmp <= 0)) then 5342 call io_error('param_get_projection: m has incorrect value (3)') 5343 elseif (l_tmp == -4 .and. (m_tmp > 5 .or. m_tmp <= 0)) then 5344 call io_error('param_get_projection: m has incorrect value (4)') 5345 elseif (l_tmp == -5 .and. (m_tmp > 6 .or. m_tmp <= 0)) then 5346 call io_error('param_get_projection: m has incorrect value (5)') 5347 endif 5348 ang_states(m_tmp, l_tmp) = 1 5349 if (pos3 == 0) exit 5350 ctemp4 = ctemp4(pos3 + 1:) 5351 enddo 5352 end if 5353 else 5354 do 5355 pos3 = index(ctemp3, ',') 5356 if (pos3 == 0) then 5357 ctemp4 = ctemp3 5358 else 5359 ctemp4 = ctemp3(:pos3 - 1) 5360 endif 5361 read (ctemp4(1:), *, err=106, end=106) m_string 5362 select case (trim(adjustl(m_string))) 5363 case ('s') 5364 ang_states(1, 0) = 1 5365 case ('p') 5366 ang_states(1:3, 1) = 1 5367 case ('pz') 5368 ang_states(1, 1) = 1 5369 case ('px') 5370 ang_states(2, 1) = 1 5371 case ('py') 5372 ang_states(3, 1) = 1 5373 case ('d') 5374 ang_states(1:5, 2) = 1 5375 case ('dz2') 5376 ang_states(1, 2) = 1 5377 case ('dxz') 5378 ang_states(2, 2) = 1 5379 case ('dyz') 5380 ang_states(3, 2) = 1 5381 case ('dx2-y2') 5382 ang_states(4, 2) = 1 5383 case ('dxy') 5384 ang_states(5, 2) = 1 5385 case ('f') 5386 ang_states(1:7, 3) = 1 5387 case ('fz3') 5388 ang_states(1, 3) = 1 5389 case ('fxz2') 5390 ang_states(2, 3) = 1 5391 case ('fyz2') 5392 ang_states(3, 3) = 1 5393 case ('fxyz') 5394 ang_states(4, 3) = 1 5395 case ('fz(x2-y2)') 5396 ang_states(5, 3) = 1 5397 case ('fx(x2-3y2)') 5398 ang_states(6, 3) = 1 5399 case ('fy(3x2-y2)') 5400 ang_states(7, 3) = 1 5401 case ('sp') 5402 ang_states(1:2, -1) = 1 5403 case ('sp-1') 5404 ang_states(1, -1) = 1 5405 case ('sp-2') 5406 ang_states(2, -1) = 1 5407 case ('sp2') 5408 ang_states(1:3, -2) = 1 5409 case ('sp2-1') 5410 ang_states(1, -2) = 1 5411 case ('sp2-2') 5412 ang_states(2, -2) = 1 5413 case ('sp2-3') 5414 ang_states(3, -2) = 1 5415 case ('sp3') 5416 ang_states(1:4, -3) = 1 5417 case ('sp3-1') 5418 ang_states(1, -3) = 1 5419 case ('sp3-2') 5420 ang_states(2, -3) = 1 5421 case ('sp3-3') 5422 ang_states(3, -3) = 1 5423 case ('sp3-4') 5424 ang_states(4, -3) = 1 5425 case ('sp3d') 5426 ang_states(1:5, -4) = 1 5427 case ('sp3d-1') 5428 ang_states(1, -4) = 1 5429 case ('sp3d-2') 5430 ang_states(2, -4) = 1 5431 case ('sp3d-3') 5432 ang_states(3, -4) = 1 5433 case ('sp3d-4') 5434 ang_states(4, -4) = 1 5435 case ('sp3d-5') 5436 ang_states(5, -4) = 1 5437 case ('sp3d2') 5438 ang_states(1:6, -5) = 1 5439 case ('sp3d2-1') 5440 ang_states(1, -5) = 1 5441 case ('sp3d2-2') 5442 ang_states(2, -5) = 1 5443 case ('sp3d2-3') 5444 ang_states(3, -5) = 1 5445 case ('sp3d2-4') 5446 ang_states(4, -5) = 1 5447 case ('sp3d2-5') 5448 ang_states(5, -5) = 1 5449 case ('sp3d2-6') 5450 ang_states(6, -5) = 1 5451 case default 5452 call io_error('param_get_projection: Problem reading l state '//trim(ctemp3)) 5453 end select 5454 if (pos3 == 0) exit 5455 ctemp3 = ctemp3(pos3 + 1:) 5456 enddo 5457 endif 5458 if (pos2 == 0) exit 5459 ctemp2 = ctemp2(pos2 + 1:) 5460 enddo 5461 ! check for non-default values 5462 if (pos1 > 0) then 5463 dummy = dummy(pos1 + 1:) 5464 ! z axis 5465 pos1 = index(dummy, 'z=') 5466 if (pos1 > 0) then 5467 ctemp = (dummy(pos1 + 2:)) 5468 pos2 = index(ctemp, ':') 5469 if (pos2 > 0) ctemp = ctemp(:pos2 - 1) 5470 call utility_string_to_coord(ctemp, proj_z_tmp) 5471 endif 5472 ! x axis 5473 pos1 = index(dummy, 'x=') 5474 if (pos1 > 0) then 5475 ctemp = (dummy(pos1 + 2:)) 5476 pos2 = index(ctemp, ':') 5477 if (pos2 > 0) ctemp = ctemp(:pos2 - 1) 5478 call utility_string_to_coord(ctemp, proj_x_tmp) 5479 endif 5480 ! diffusivity of orbital 5481 pos1 = index(dummy, 'zona=') 5482 if (pos1 > 0) then 5483 ctemp = (dummy(pos1 + 5:)) 5484 pos2 = index(ctemp, ':') 5485 if (pos2 > 0) ctemp = ctemp(:pos2 - 1) 5486 read (ctemp, *, err=104, end=104) proj_zona_tmp 5487 endif 5488 ! nodes for the radial part 5489 pos1 = index(dummy, 'r=') 5490 if (pos1 > 0) then 5491 ctemp = (dummy(pos1 + 2:)) 5492 pos2 = index(ctemp, ':') 5493 if (pos2 > 0) ctemp = ctemp(:pos2 - 1) 5494 read (ctemp, *, err=105, end=105) proj_radial_tmp 5495 endif 5496 end if 5497 ! if (sites == -1) then 5498 ! if (counter + spn_counter*sum(ang_states) > num_proj) & 5499 ! call io_error('param_get_projection: too many projections defined') 5500 ! else 5501 ! if (counter + spn_counter*sites*sum(ang_states) > num_proj) & 5502 ! call io_error('param_get_projection: too many projections defined') 5503 ! end if 5504 ! 5505 if (sites == -1) then 5506 do loop_l = min_l, max_l 5507 do loop_m = min_m, max_m 5508 if (ang_states(loop_m, loop_l) == 1) then 5509 do loop_s = 1, spn_counter 5510 counter = counter + 1 5511 if (lcount) cycle 5512 input_proj_site(:, counter) = pos_frac 5513 input_proj_l(counter) = loop_l 5514 input_proj_m(counter) = loop_m 5515 input_proj_z(:, counter) = proj_z_tmp 5516 input_proj_x(:, counter) = proj_x_tmp 5517 input_proj_radial(counter) = proj_radial_tmp 5518 input_proj_zona(counter) = proj_zona_tmp 5519 if (spinors) then 5520 if (spn_counter == 1) then 5521 if (proj_u_tmp) input_proj_s(counter) = 1 5522 if (proj_d_tmp) input_proj_s(counter) = -1 5523 else 5524 if (loop_s == 1) input_proj_s(counter) = 1 5525 if (loop_s == 2) input_proj_s(counter) = -1 5526 endif 5527 input_proj_s_qaxis(:, counter) = proj_s_qaxis_tmp 5528 endif 5529 end do 5530 endif 5531 end do 5532 end do 5533 else 5534 do loop_sites = 1, sites 5535 do loop_l = min_l, max_l 5536 do loop_m = min_m, max_m 5537 if (ang_states(loop_m, loop_l) == 1) then 5538 do loop_s = 1, spn_counter 5539 counter = counter + 1 5540 if (lcount) cycle 5541 input_proj_site(:, counter) = atoms_pos_frac(:, loop_sites, species) 5542 input_proj_l(counter) = loop_l 5543 input_proj_m(counter) = loop_m 5544 input_proj_z(:, counter) = proj_z_tmp 5545 input_proj_x(:, counter) = proj_x_tmp 5546 input_proj_radial(counter) = proj_radial_tmp 5547 input_proj_zona(counter) = proj_zona_tmp 5548 if (spinors) then 5549 if (spn_counter == 1) then 5550 if (proj_u_tmp) input_proj_s(counter) = 1 5551 if (proj_d_tmp) input_proj_s(counter) = -1 5552 else 5553 if (loop_s == 1) input_proj_s(counter) = 1 5554 if (loop_s == 2) input_proj_s(counter) = -1 5555 endif 5556 input_proj_s_qaxis(:, counter) = proj_s_qaxis_tmp 5557 endif 5558 end do 5559 end if 5560 end do 5561 end do 5562 end do 5563 end if 5564 5565 end do !end loop over projection block 5566 5567 ! check there are enough projections and add random projections if required 5568 if (.not. lpartrandom) then 5569 if (counter .lt. num_wann) call io_error( & 5570 'param_get_projections: too few projection functions defined') 5571 end if 5572 end if ! .not. lrandom 5573 5574 if (lcount) then 5575 if (counter .lt. num_wann) then 5576 num_proj = num_wann 5577 else 5578 num_proj = counter 5579 endif 5580 return 5581 endif 5582 5583 if (lpartrandom .or. lrandom) then 5584 call random_seed() ! comment out this line for reproducible random positions! 5585 do loop = counter + 1, num_wann 5586 call random_number(input_proj_site(:, loop)) 5587 input_proj_l(loop) = 0 5588 input_proj_m(loop) = 1 5589 input_proj_z(:, loop) = proj_z_def 5590 input_proj_x(:, loop) = proj_x_def 5591 input_proj_zona(loop) = proj_zona_def 5592 input_proj_radial(loop) = proj_radial_def 5593 if (spinors) then 5594 if (modulo(loop, 2) == 1) then 5595 input_proj_s(loop) = 1 5596 else 5597 input_proj_s(loop) = -1 5598 end if 5599 input_proj_s_qaxis(1, loop) = 0. 5600 input_proj_s_qaxis(2, loop) = 0. 5601 input_proj_s_qaxis(3, loop) = 1. 5602 end if 5603 enddo 5604 endif 5605 5606 ! I shouldn't get here, but just in case 5607 if (.not. lcount) in_data(line_s:line_e) (1:maxlen) = ' ' 5608 5609!~ ! Check 5610!~ do loop=1,num_wann 5611!~ if ( abs(sum(proj_z(:,loop)*proj_x(:,loop))).gt.1.0e-6_dp ) then 5612!~ write(stdout,*) ' Projection:',loop 5613!~ call io_error(' Error in projections: z and x axes are not orthogonal') 5614!~ endif 5615!~ enddo 5616 5617 ! Normalise z-axis and x-axis and check/fix orthogonality 5618 do loop = 1, num_proj 5619 5620 znorm = sqrt(sum(input_proj_z(:, loop)*input_proj_z(:, loop))) 5621 xnorm = sqrt(sum(input_proj_x(:, loop)*input_proj_x(:, loop))) 5622 input_proj_z(:, loop) = input_proj_z(:, loop)/znorm ! normalise z 5623 input_proj_x(:, loop) = input_proj_x(:, loop)/xnorm ! normalise x 5624 cosphi = sum(input_proj_z(:, loop)*input_proj_x(:, loop)) 5625 5626 ! Check whether z-axis and z-axis are orthogonal 5627 if (abs(cosphi) .gt. eps6) then 5628 5629 ! Special case of circularly symmetric projections (pz, dz2, fz3) 5630 ! just choose an x-axis that is perpendicular to the given z-axis 5631 if ((input_proj_l(loop) .ge. 0) .and. (input_proj_m(loop) .eq. 1)) then 5632 proj_x_tmp(:) = input_proj_x(:, loop) ! copy of original x-axis 5633 call random_seed() 5634 call random_number(proj_z_tmp(:)) ! random vector 5635 ! calculate new x-axis as the cross (vector) product of random vector with z-axis 5636 input_proj_x(1, loop) = proj_z_tmp(2)*input_proj_z(3, loop) - proj_z_tmp(3)*input_proj_z(2, loop) 5637 input_proj_x(2, loop) = proj_z_tmp(3)*input_proj_z(1, loop) - proj_z_tmp(1)*input_proj_z(3, loop) 5638 input_proj_x(3, loop) = proj_z_tmp(1)*input_proj_z(2, loop) - proj_z_tmp(2)*input_proj_z(1, loop) 5639 xnorm_new = sqrt(sum(input_proj_x(:, loop)*input_proj_x(:, loop))) 5640 input_proj_x(:, loop) = input_proj_x(:, loop)/xnorm_new ! normalise 5641 goto 555 5642 endif 5643 5644 ! If projection axes non-orthogonal enough, then 5645 ! user may have made a mistake and should check 5646 if (abs(cosphi) .gt. eps2) then 5647 write (stdout, *) ' Projection:', loop 5648 call io_error(' Error in projections: z and x axes are not orthogonal') 5649 endif 5650 5651 ! If projection axes are "reasonably orthogonal", project x-axis 5652 ! onto plane perpendicular to z-axis to make them more so 5653 sinphi = sqrt(1 - cosphi*cosphi) 5654 proj_x_tmp(:) = input_proj_x(:, loop) ! copy of original x-axis 5655 ! calculate new x-axis: 5656 ! x = z \cross (x_tmp \cross z) / sinphi = ( x_tmp - z(z.x_tmp) ) / sinphi 5657 input_proj_x(:, loop) = (proj_x_tmp(:) - cosphi*input_proj_z(:, loop))/sinphi 5658 5659 ! Final check 5660555 cosphi_new = sum(input_proj_z(:, loop)*input_proj_x(:, loop)) 5661 if (abs(cosphi_new) .gt. eps6) then 5662 write (stdout, *) ' Projection:', loop 5663 call io_error(' Error: z and x axes are still not orthogonal after projection') 5664 endif 5665 5666 endif 5667 5668 enddo 5669 5670 do loop = 1, num_proj 5671 if (proj2wann_map(loop) < 0) cycle 5672 proj_site(:, proj2wann_map(loop)) = input_proj_site(:, loop) 5673 proj_l(proj2wann_map(loop)) = input_proj_l(loop) 5674 proj_m(proj2wann_map(loop)) = input_proj_m(loop) 5675 proj_z(:, proj2wann_map(loop)) = input_proj_z(:, loop) 5676 proj_x(:, proj2wann_map(loop)) = input_proj_x(:, loop) 5677 proj_radial(proj2wann_map(loop)) = input_proj_radial(loop) 5678 proj_zona(proj2wann_map(loop)) = input_proj_zona(loop) 5679 enddo 5680 5681 if (spinors) then 5682 do loop = 1, num_proj 5683 if (proj2wann_map(loop) < 0) cycle 5684 proj_s(proj2wann_map(loop)) = input_proj_s(loop) 5685 proj_s_qaxis(:, proj2wann_map(loop)) = input_proj_s_qaxis(:, loop) 5686 enddo 5687 endif 5688 5689 return 5690 5691101 call io_error('param_get_projection: Problem reading l state into integer '//trim(ctemp3)) 5692102 call io_error('param_get_projection: Problem reading m state into integer '//trim(ctemp3)) 5693104 call io_error('param_get_projection: Problem reading zona into real '//trim(ctemp)) 5694105 call io_error('param_get_projection: Problem reading radial state into integer '//trim(ctemp)) 5695106 call io_error('param_get_projection: Problem reading m state into string '//trim(ctemp3)) 5696 5697 end subroutine param_get_projections 5698 5699!===================================! 5700 subroutine param_get_keyword_kpath 5701 !===================================! 5702 ! ! 5703 !! Fills the kpath data block 5704 ! ! 5705 !===================================! 5706 use w90_io, only: io_error 5707 5708 implicit none 5709 5710 character(len=20) :: keyword 5711 integer :: in, ins, ine, loop, i, line_e, line_s, counter 5712 logical :: found_e, found_s 5713 character(len=maxlen) :: dummy, end_st, start_st 5714 5715 keyword = "kpoint_path" 5716 5717 found_s = .false. 5718 found_e = .false. 5719 5720 start_st = 'begin '//trim(keyword) 5721 end_st = 'end '//trim(keyword) 5722 5723 do loop = 1, num_lines 5724 ins = index(in_data(loop), trim(keyword)) 5725 if (ins == 0) cycle 5726 in = index(in_data(loop), 'begin') 5727 if (in == 0 .or. in > 1) cycle 5728 line_s = loop 5729 if (found_s) then 5730 call io_error('Error: Found '//trim(start_st)//' more than once in input file') 5731 endif 5732 found_s = .true. 5733 end do 5734 5735 do loop = 1, num_lines 5736 ine = index(in_data(loop), trim(keyword)) 5737 if (ine == 0) cycle 5738 in = index(in_data(loop), 'end') 5739 if (in == 0 .or. in > 1) cycle 5740 line_e = loop 5741 if (found_e) then 5742 call io_error('Error: Found '//trim(end_st)//' more than once in input file') 5743 endif 5744 found_e = .true. 5745 end do 5746 5747 if (.not. found_e) then 5748 call io_error('Error: Found '//trim(start_st)//' but no '//trim(end_st)//' in input file') 5749 end if 5750 5751 if (line_e <= line_s) then 5752 call io_error('Error: '//trim(end_st)//' comes before '//trim(start_st)//' in input file') 5753 end if 5754 5755 counter = 0 5756 do loop = line_s + 1, line_e - 1 5757 5758 counter = counter + 2 5759 dummy = in_data(loop) 5760 read (dummy, *, err=240, end=240) bands_label(counter - 1), (bands_spec_points(i, counter - 1), i=1, 3) & 5761 , bands_label(counter), (bands_spec_points(i, counter), i=1, 3) 5762 end do 5763 5764 in_data(line_s:line_e) (1:maxlen) = ' ' 5765 5766 return 5767 5768240 call io_error('param_get_keyword_kpath: Problem reading kpath '//trim(dummy)) 5769 5770 end subroutine param_get_keyword_kpath 5771 5772!===========================================! 5773 subroutine param_memory_estimate 5774 !===========================================! 5775 ! ! 5776 !! Estimate how much memory we will allocate 5777 ! ! 5778 !===========================================! 5779 5780 use w90_comms, only: on_root 5781 5782 implicit none 5783 5784 real(kind=dp), parameter :: size_log = 1.0_dp 5785 real(kind=dp), parameter :: size_int = 4.0_dp 5786 real(kind=dp), parameter :: size_real = 8.0_dp 5787 real(kind=dp), parameter :: size_cmplx = 16.0_dp 5788 real(kind=dp) :: mem_wan, mem_wan1, mem_param, mem_dis, mem_dis2, mem_dis1 5789 real(kind=dp) :: mem_bw 5790 integer :: NumPoints1, NumPoints2, NumPoints3, ndim 5791 real(kind=dp) :: TDF_exceeding_energy 5792 5793 mem_param = 0 5794 mem_dis = 0 5795 mem_dis1 = 0 5796 mem_dis2 = 0 5797 mem_wan = 0 5798 mem_wan1 = 0 5799 mem_bw = 0 5800 5801 ! First the data stored in the parameters module 5802 mem_param = mem_param + num_wann*num_wann*num_kpts*size_cmplx !u_matrix 5803 if (.not. disentanglement) & 5804 mem_param = mem_param + num_wann*num_wann*nntot*num_kpts*size_cmplx !m_matrix 5805 5806 if (disentanglement) then 5807 mem_param = mem_param + num_bands*num_wann*num_kpts*size_cmplx ! u_matrix_opt 5808 endif 5809 5810 if (allocated(atoms_species_num)) then 5811 mem_param = mem_param + (num_species)*size_int !atoms_species_num 5812 mem_param = mem_param + (num_species)*size_real !atoms_label 5813 mem_param = mem_param + (num_species)*size_real !atoms_symbol 5814 mem_param = mem_param + (3*maxval(atoms_species_num)*num_species)*size_real !atoms_pos_frac 5815 mem_param = mem_param + (3*maxval(atoms_species_num)*num_species)*size_real !atoms_pos_cart 5816 endif 5817 5818 if (allocated(input_proj_site)) then 5819 mem_param = mem_param + (3*num_proj)*size_real !input_proj_site 5820 mem_param = mem_param + (num_proj)*size_int !input_proj_l 5821 mem_param = mem_param + (num_proj)*size_int !input_proj_m 5822 mem_param = mem_param + (3*num_proj)*size_real !input_proj_z 5823 mem_param = mem_param + (3*num_proj)*size_real !input_proj_x 5824 mem_param = mem_param + (num_proj)*size_real !input_proj_radial 5825 mem_param = mem_param + (num_proj)*size_real !input_proj_zona 5826 endif 5827 5828 if (allocated(proj_site)) then 5829 mem_param = mem_param + (3*num_wann)*size_real !proj_site 5830 mem_param = mem_param + (num_wann)*size_int !proj_l 5831 mem_param = mem_param + (num_wann)*size_int !proj_m 5832 mem_param = mem_param + (3*num_wann)*size_real !proj_z 5833 mem_param = mem_param + (3*num_wann)*size_real !proj_x 5834 mem_param = mem_param + (num_wann)*size_real !proj_radial 5835 mem_param = mem_param + (num_wann)*size_real !proj_zona 5836 endif 5837 5838 mem_param = mem_param + num_kpts*nntot*size_int !nnlist 5839 mem_param = mem_param + num_kpts*nntot/2*size_int !neigh 5840 mem_param = mem_param + 3*num_kpts*nntot*size_int !nncell 5841 mem_param = mem_param + nntot*size_real !wb 5842 mem_param = mem_param + 3*nntot/2*size_real !bka 5843 mem_param = mem_param + 3*nntot*num_kpts*size_real !bk 5844 5845 mem_param = mem_param + num_bands*num_kpts*size_real !eigval 5846 mem_param = mem_param + 3*num_kpts*size_real !kpt_cart 5847 mem_param = mem_param + 3*num_kpts*size_real !kpt_latt 5848 if (disentanglement) then 5849 mem_param = mem_param + num_kpts*size_int !ndimwin 5850 mem_param = mem_param + num_bands*num_kpts*size_log !lwindow 5851 endif 5852 mem_param = mem_param + 3*num_wann*size_real !wannier_centres 5853 mem_param = mem_param + num_wann*size_real !wannier_spreads 5854 5855 if (disentanglement) then 5856 ! Module vars 5857 mem_dis = mem_dis + num_bands*num_kpts*size_real !eigval_opt 5858 mem_dis = mem_dis + num_kpts*size_int !nfirstwin 5859 mem_dis = mem_dis + num_kpts*size_int !ndimfroz 5860 mem_dis = mem_dis + num_bands*num_kpts*size_int !indxfroz 5861 mem_dis = mem_dis + num_bands*num_kpts*size_int !indxnfroz 5862 mem_dis = mem_dis + num_bands*num_kpts*size_log !lfrozen 5863 5864 !the memory high-water wiil occur in dis_extract or when we allocate m_matrix 5865 5866 mem_dis1 = mem_dis1 + num_wann*num_bands*size_cmplx !cwb 5867 mem_dis1 = mem_dis1 + num_wann*num_wann*size_cmplx !cww 5868 mem_dis1 = mem_dis1 + num_bands*num_wann*size_cmplx !cbw 5869 mem_dis1 = mem_dis1 + 5*num_bands*size_int !iwork 5870 mem_dis1 = mem_dis1 + num_bands*size_int !ifail 5871 mem_dis1 = mem_dis1 + num_bands*size_real !w 5872 if (gamma_only) then 5873 mem_dis1 = mem_dis1 + (num_bands*(num_bands + 1))/2*size_real !cap_r 5874 mem_dis1 = mem_dis1 + 8*num_bands*size_real !work 5875 mem_dis1 = mem_dis1 + num_bands*num_bands*size_real !rz 5876 else 5877 mem_dis1 = mem_dis1 + 7*num_bands*size_real !rwork 5878 mem_dis1 = mem_dis1 + (num_bands*(num_bands + 1))/2*size_cmplx !cap 5879 mem_dis1 = mem_dis1 + 2*num_bands*size_cmplx !cwork 5880 mem_dis1 = mem_dis1 + num_bands*num_bands*size_cmplx !cz 5881 end if 5882 mem_dis1 = mem_dis1 + num_kpts*size_real !wkomegai1 5883 mem_dis1 = mem_dis1 + num_bands*num_bands*num_kpts*size_cmplx !ceamp 5884 mem_dis1 = mem_dis1 + num_bands*num_bands*num_kpts*size_cmplx !cham 5885 mem_dis2 = mem_dis2 + num_wann*num_wann*nntot*num_kpts*size_cmplx!m_matrix 5886 5887 if (optimisation <= 0) then 5888 mem_dis = mem_dis + mem_dis1 5889 else 5890 mem_dis = mem_dis + max(mem_dis1, mem_dis2) 5891 endif 5892 5893 mem_dis = mem_dis + num_bands*num_bands*nntot*num_kpts*size_cmplx ! m_matrix_orig 5894 mem_dis = mem_dis + num_bands*num_wann*num_kpts*size_cmplx ! a_matrix 5895 5896 endif 5897 5898 !Wannierise 5899 5900 mem_wan1 = mem_wan1 + (num_wann*num_wann*nntot*num_kpts)*size_cmplx ! 'm0' 5901 if (optimisation > 0) then 5902 mem_wan = mem_wan + mem_wan1 5903 endif 5904 mem_wan = mem_wan + (num_wann*num_wann*num_kpts)*size_cmplx ! 'u0' 5905 mem_wan = mem_wan + (num_wann*nntot*num_kpts)*size_real ! 'rnkb' 5906 mem_wan = mem_wan + (num_wann*nntot*num_kpts)*size_real ! 'ln_tmp' 5907 mem_wan = mem_wan + (num_wann*nntot*num_kpts)*size_cmplx ! 'csheet' 5908 mem_wan = mem_wan + (num_wann*nntot*num_kpts)*size_real ! 'sheet' 5909 mem_wan = mem_wan + (3*num_wann)*size_real ! 'rave' 5910 mem_wan = mem_wan + (num_wann)*size_real ! 'r2ave' 5911 mem_wan = mem_wan + (num_wann)*size_real ! 'rave2' 5912 mem_wan = mem_wan + (3*num_wann)*size_real ! 'rguide' 5913 mem_wan = mem_wan + (num_wann*num_wann)*size_cmplx ! 'cz' 5914 if (gamma_only) then 5915 mem_wan = mem_wan + num_wann*num_wann*nntot*2*size_cmplx ! m_w 5916 mem_wan = mem_wan + num_wann*num_wann*size_cmplx ! uc_rot 5917 mem_wan = mem_wan + num_wann*num_wann*size_real ! ur_rot 5918 !internal_svd_omega_i 5919 mem_wan = mem_wan + 10*num_wann*size_cmplx ! cw1 5920 mem_wan = mem_wan + 10*num_wann*size_cmplx ! cw2 5921 mem_wan = mem_wan + num_wann*num_wann*size_cmplx ! cv1 5922 mem_wan = mem_wan + num_wann*num_wann*size_cmplx ! cv2 5923 mem_wan = mem_wan + num_wann*num_wann*size_real ! cpad1 5924 mem_wan = mem_wan + num_wann*size_cmplx ! singvd 5925 else 5926 mem_wan = mem_wan + (num_wann)*size_cmplx ! 'cwschur1' 5927 mem_wan = mem_wan + (10*num_wann)*size_cmplx ! 'cwschur2' 5928 mem_wan = mem_wan + (num_wann)*size_cmplx ! 'cwschur3' 5929 mem_wan = mem_wan + (num_wann)*size_cmplx ! 'cwschur4' 5930 mem_wan = mem_wan + (num_wann*num_wann*num_kpts)*size_cmplx ! 'cdq' 5931 mem_wan = mem_wan + (num_wann*num_wann)*size_cmplx ! 'cmtmp' 5932 mem_wan = mem_wan + (num_wann*num_wann*num_kpts)*size_cmplx ! 'cdqkeep' 5933 mem_wan = mem_wan + (num_wann*num_wann)*size_cmplx ! 'tmp_cdq' 5934 mem_wan = mem_wan + (num_wann)*size_real ! 'evals' 5935 mem_wan = mem_wan + (4*num_wann)*size_cmplx ! 'cwork' 5936 mem_wan = mem_wan + (3*num_wann - 2)*size_real ! 'rwork' 5937 !d_omega 5938 mem_wan = mem_wan + (num_wann*num_wann)*size_cmplx ! 'cr' 5939 mem_wan = mem_wan + (num_wann*num_wann)*size_cmplx ! 'crt' 5940 end if 5941 5942 if (ispostw90) then 5943 if (boltzwann) then 5944 if (spin_decomp) then 5945 ndim = 3 5946 else 5947 ndim = 1 5948 end if 5949 5950 ! I set a big value to have a rough estimate 5951 TDF_exceeding_energy = 2._dp 5952 NumPoints1 = int(floor((boltz_temp_max - boltz_temp_min)/boltz_temp_step)) + 1 ! temperature array 5953 NumPoints2 = int(floor((boltz_mu_max - boltz_mu_min)/boltz_mu_step)) + 1 ! mu array 5954 NumPoints3 = int(floor((dis_win_max - dis_win_min + 2._dp*TDF_exceeding_energy)/boltz_tdf_energy_step)) + 1 ! tdfenergyarray 5955 mem_bw = mem_bw + NumPoints1*size_real !TempArray 5956 mem_bw = mem_bw + NumPoints1*size_real !KTArray 5957 mem_bw = mem_bw + NumPoints2*size_real !MuArray 5958 mem_bw = mem_bw + NumPoints3*size_real !TDFEnergyArray 5959 mem_bw = mem_bw + 6*NumPoints3*ndim*size_real !TDFArray 5960 mem_bw = mem_bw + 6*NumPoints3*size_real !IntegrandArray 5961 mem_bw = mem_bw + (9*4 + 6)*size_real 5962 !ElCondTimesSeebeckFP,ThisElCond,ElCondInverse,ThisSeebeck,ElCondTimesSeebeck 5963 mem_bw = mem_bw + 6*NumPoints1*NumPoints2*size_real !ElCond 5964 mem_bw = mem_bw + 6*NumPoints1*NumPoints2*size_real !Seebeck 5965 mem_bw = mem_bw + 6*NumPoints1*NumPoints2*size_real !ThermCond 5966 ! I put a upper bound here below (as if there was only 1 node), because I do not have any knowledge at this point 5967 ! of the number of processors, so I cannot have a correct estimate 5968 mem_bw = mem_bw + 6*NumPoints1*NumPoints2*size_real !LocalElCond 5969 mem_bw = mem_bw + 6*NumPoints1*NumPoints2*size_real !LocalSeebeck 5970 mem_bw = mem_bw + 6*NumPoints1*NumPoints2*size_real !LocalThermCond 5971 5972 mem_bw = mem_bw + num_wann*num_wann*size_cmplx !HH 5973 mem_bw = mem_bw + 3*num_wann*num_wann*size_cmplx !delHH 5974 mem_bw = mem_bw + num_wann*num_wann*size_cmplx !UU 5975 mem_bw = mem_bw + 3*num_wann*size_real !del_eig 5976 mem_bw = mem_bw + num_wann*size_real !eig 5977 mem_bw = mem_bw + num_wann*size_real !levelspacing_k 5978 5979 NumPoints1 = int(floor((boltz_dos_energy_max - boltz_dos_energy_min)/boltz_dos_energy_step)) + 1!dosnumpoints 5980 mem_bw = mem_bw + NumPoints1*size_real !DOS_EnergyArray 5981 mem_bw = mem_bw + 6*ndim*NumPoints3*size_real !TDF_k 5982 mem_bw = mem_bw + ndim*NumPoints1*size_real !DOS_k 5983 mem_bw = mem_bw + ndim*NumPoints1*size_real !DOS_all 5984 end if 5985 end if 5986 5987 if (disentanglement) & 5988 mem_wan = mem_wan + num_wann*num_wann*nntot*num_kpts*size_cmplx !m_matrix 5989 5990 if (on_root) then 5991 write (stdout, '(1x,a)') '*============================================================================*' 5992 write (stdout, '(1x,a)') '| MEMORY ESTIMATE |' 5993 write (stdout, '(1x,a)') '| Maximum RAM allocated during each phase of the calculation |' 5994 write (stdout, '(1x,a)') '*============================================================================*' 5995 if (disentanglement) & 5996 write (stdout, '(1x,"|",24x,a15,f16.2,a,18x,"|")') 'Disentanglement:', (mem_param + mem_dis)/(1024**2), ' Mb' 5997 write (stdout, '(1x,"|",24x,a15,f16.2,a,18x,"|")') 'Wannierise:', (mem_param + mem_wan)/(1024**2), ' Mb' 5998 if (optimisation > 0 .and. iprint > 1) then 5999 write (stdout, '(1x,a)') '| |' 6000 write (stdout, '(1x,a)') '| N.B. by setting optimisation=0 memory usage will be reduced to: |' 6001 if (disentanglement) & 6002 write (stdout, '(1x,"|",24x,a15,f16.2,a,18x,"|")') 'Disentanglement:', & 6003 (mem_param + mem_dis - max(mem_dis1, mem_dis2) + mem_dis1)/(1024**2), ' Mb' 6004 if (gamma_only) then 6005 write (stdout, '(1x,"|",24x,a15,f16.2,a,18x,"|")') 'Wannierise:', (mem_param + mem_wan)/(1024**2), ' Mb' 6006 else 6007 write (stdout, '(1x,"|",24x,a15,f16.2,a,18x,"|")') 'Wannierise:', & 6008 (mem_param + mem_wan - mem_wan1)/(1024**2), ' Mb' 6009 end if 6010 write (stdout, '(1x,a)') '| However, this will result in more i/o and slow down the calculation |' 6011 endif 6012 6013 if (ispostw90) then 6014 if (boltzwann) & 6015 write (stdout, '(1x,"|",24x,a15,f16.2,a,18x,"|")') 'BoltzWann:', (mem_param + mem_bw)/(1024**2), ' Mb' 6016 end if 6017 6018 write (stdout, '(1x,"|",24x,a15,f16.2,a,18x,"|")') 'plot_wannier:', (mem_param + mem_wan)/(1024**2), ' Mb' 6019 write (stdout, '(1x,a)') '*----------------------------------------------------------------------------*' 6020 write (stdout, *) ' ' 6021 endif 6022 6023! if(disentanglement) then 6024! write(*,'(a12,f12.4,a)') 'Disentangle',(mem_param+mem_dis)/(1024**2),' Mb' 6025! end if 6026! write(*,'(a12,f12.4,a)') 'Wannierise ',(mem_wan+mem_param)/(1024**2),' Mb' 6027! write(*,'(a12,f12.4,a)') 'Module',(mem_param)/(1024**2),' Mb' 6028 6029 return 6030 end subroutine param_memory_estimate 6031 6032!===========================================================! 6033 subroutine param_dist 6034 !===========================================================! 6035 ! ! 6036 !! distribute the parameters across processors ! 6037 ! ! 6038 !===========================================================! 6039 6040 use w90_constants, only: dp, cmplx_0, cmplx_i, twopi 6041 use w90_io, only: io_error, io_file_unit, io_date, io_time, & 6042 io_stopwatch 6043 use w90_comms, only: comms_bcast, on_root 6044 6045 integer :: ierr 6046 6047 call comms_bcast(effective_model, 1) 6048 call comms_bcast(eig_found, 1) 6049 call comms_bcast(postproc_setup, 1) 6050 if (.not. effective_model) then 6051 call comms_bcast(mp_grid(1), 3) 6052 call comms_bcast(num_kpts, 1) 6053 call comms_bcast(num_bands, 1) 6054 endif 6055 call comms_bcast(num_wann, 1) 6056 call comms_bcast(timing_level, 1) 6057 call comms_bcast(iprint, 1) 6058 call comms_bcast(energy_unit, 1) 6059 call comms_bcast(length_unit, 1) 6060 call comms_bcast(wvfn_formatted, 1) 6061 call comms_bcast(spn_formatted, 1) 6062 call comms_bcast(uHu_formatted, 1) 6063 call comms_bcast(berry_uHu_formatted, 1) 6064 call comms_bcast(spin, 1) 6065 call comms_bcast(num_dump_cycles, 1) 6066 call comms_bcast(num_print_cycles, 1) 6067 call comms_bcast(num_atoms, 1) ! Ivo: not used in postw90, right? 6068 call comms_bcast(num_species, 1) ! Ivo: not used in postw90, right? 6069 call comms_bcast(real_lattice(1, 1), 9) 6070 call comms_bcast(recip_lattice(1, 1), 9) 6071 call comms_bcast(real_metric(1, 1), 9) 6072 call comms_bcast(recip_metric(1, 1), 9) 6073 call comms_bcast(cell_volume, 1) 6074 call comms_bcast(dos_energy_step, 1) 6075 call comms_bcast(dos_adpt_smr, 1) 6076 call comms_bcast(dos_smr_index, 1) 6077 call comms_bcast(dos_kmesh_spacing, 1) 6078 call comms_bcast(dos_kmesh(1), 3) 6079 call comms_bcast(dos_adpt_smr_max, 1) 6080 call comms_bcast(dos_smr_fixed_en_width, 1) 6081 call comms_bcast(dos_adpt_smr_fac, 1) 6082 call comms_bcast(num_dos_project, 1) 6083 call comms_bcast(num_exclude_bands, 1) 6084 if (num_exclude_bands > 0) then 6085 if (.not. on_root) then 6086 allocate (exclude_bands(num_exclude_bands), stat=ierr) 6087 if (ierr /= 0) & 6088 call io_error('Error in allocating exclude_bands in param_dist') 6089 endif 6090 call comms_bcast(exclude_bands(1), num_exclude_bands) 6091 end if 6092 6093 call comms_bcast(gamma_only, 1) 6094 call comms_bcast(dis_win_min, 1) 6095 call comms_bcast(dis_win_max, 1) 6096 call comms_bcast(dis_froz_min, 1) 6097 call comms_bcast(dis_froz_max, 1) 6098 call comms_bcast(dis_num_iter, 1) 6099 call comms_bcast(dis_mix_ratio, 1) 6100 call comms_bcast(dis_conv_tol, 1) 6101 call comms_bcast(dis_conv_window, 1) 6102 call comms_bcast(dis_spheres_first_wann, 1) 6103 call comms_bcast(dis_spheres_num, 1) 6104 if (dis_spheres_num > 0) then 6105 if (.not. on_root) then 6106 allocate (dis_spheres(4, dis_spheres_num), stat=ierr) 6107 if (ierr /= 0) & 6108 call io_error('Error in allocating dis_spheres in param_dist') 6109 endif 6110 call comms_bcast(dis_spheres(1, 1), 4*dis_spheres_num) 6111 end if 6112 call comms_bcast(num_iter, 1) 6113 call comms_bcast(num_cg_steps, 1) 6114 call comms_bcast(conv_tol, 1) 6115 call comms_bcast(conv_window, 1) 6116 call comms_bcast(guiding_centres, 1) 6117 call comms_bcast(wannier_plot, 1) 6118 call comms_bcast(num_wannier_plot, 1) 6119 if (num_wannier_plot > 0) then 6120 if (.not. on_root) then 6121 allocate (wannier_plot_list(num_wannier_plot), stat=ierr) 6122 if (ierr /= 0) & 6123 call io_error('Error in allocating wannier_plot_list in param_dist') 6124 endif 6125 call comms_bcast(wannier_plot_list(1), num_wannier_plot) 6126 end if 6127 call comms_bcast(wannier_plot_supercell(1), 3) 6128 call comms_bcast(wannier_plot_format, len(wannier_plot_format)) 6129 call comms_bcast(wannier_plot_mode, len(wannier_plot_mode)) 6130 call comms_bcast(wannier_plot_spinor_mode, len(wannier_plot_spinor_mode)) 6131 call comms_bcast(write_u_matrices, 1) 6132 call comms_bcast(bands_plot, 1) 6133 call comms_bcast(write_bvec, 1) 6134 call comms_bcast(bands_num_points, 1) 6135 call comms_bcast(bands_plot_format, len(bands_plot_format)) 6136 call comms_bcast(bands_plot_mode, len(bands_plot_mode)) 6137 call comms_bcast(num_bands_project, 1) 6138 6139 if (num_bands_project > 0) then 6140 if (.not. on_root) then 6141 allocate (bands_plot_project(num_bands_project), stat=ierr) 6142 if (ierr /= 0) & 6143 call io_error('Error in allocating bands_plot_project in param_dist') 6144 endif 6145 call comms_bcast(bands_plot_project(1), num_bands_project) 6146 end if 6147 call comms_bcast(bands_plot_dim, 1) 6148 call comms_bcast(write_hr, 1) 6149 call comms_bcast(write_rmn, 1) 6150 call comms_bcast(write_tb, 1) 6151 call comms_bcast(hr_cutoff, 1) 6152 call comms_bcast(dist_cutoff, 1) 6153 call comms_bcast(dist_cutoff_mode, len(dist_cutoff_mode)) 6154 call comms_bcast(dist_cutoff_hc, 1) 6155 call comms_bcast(one_dim_axis, len(one_dim_axis)) 6156 call comms_bcast(use_ws_distance, 1) 6157 call comms_bcast(ws_distance_tol, 1) 6158 call comms_bcast(ws_search_size(1), 3) 6159 call comms_bcast(fermi_surface_plot, 1) 6160 call comms_bcast(fermi_surface_num_points, 1) 6161 call comms_bcast(fermi_surface_plot_format, len(fermi_surface_plot_format)) 6162 call comms_bcast(fermi_energy, 1) !! used? 6163 6164 call comms_bcast(berry, 1) 6165 call comms_bcast(berry_task, len(berry_task)) 6166 call comms_bcast(berry_kmesh_spacing, 1) 6167 call comms_bcast(berry_kmesh(1), 3) 6168 call comms_bcast(berry_curv_adpt_kmesh, 1) 6169 call comms_bcast(berry_curv_adpt_kmesh_thresh, 1) 6170 call comms_bcast(berry_curv_unit, len(berry_curv_unit)) 6171! Stepan Tsirkin 6172 call comms_bcast(gyrotropic, 1) 6173 call comms_bcast(gyrotropic_task, len(gyrotropic_task)) 6174 call comms_bcast(gyrotropic_kmesh_spacing, 1) 6175 call comms_bcast(gyrotropic_kmesh(1), 3) 6176 call comms_bcast(gyrotropic_smr_fixed_en_width, 1) 6177 call comms_bcast(gyrotropic_smr_index, 1) 6178 call comms_bcast(gyrotropic_eigval_max, 1) 6179 call comms_bcast(gyrotropic_nfreq, 1) 6180 call comms_bcast(gyrotropic_degen_thresh, 1) 6181 call comms_bcast(gyrotropic_num_bands, 1) 6182 call comms_bcast(gyrotropic_box(1, 1), 9) 6183 call comms_bcast(gyrotropic_box_corner(1), 3) 6184 call comms_bcast(gyrotropic_smr_max_arg, 1) 6185 call comms_bcast(gyrotropic_smr_fixed_en_width, 1) 6186 call comms_bcast(gyrotropic_smr_index, 1) 6187 6188 call comms_bcast(kubo_adpt_smr, 1) 6189 call comms_bcast(kubo_adpt_smr_fac, 1) 6190 call comms_bcast(kubo_adpt_smr_max, 1) 6191 call comms_bcast(kubo_smr_fixed_en_width, 1) 6192 call comms_bcast(kubo_smr_index, 1) 6193 call comms_bcast(kubo_eigval_max, 1) 6194 call comms_bcast(kubo_nfreq, 1) 6195 call comms_bcast(nfermi, 1) 6196 call comms_bcast(dos_energy_min, 1) 6197 call comms_bcast(dos_energy_max, 1) 6198 call comms_bcast(spin_kmesh_spacing, 1) 6199 call comms_bcast(spin_kmesh(1), 3) 6200 call comms_bcast(wanint_kpoint_file, 1) 6201! Junfeng Qiao 6202 call comms_bcast(shc_freq_scan, 1) 6203 call comms_bcast(shc_alpha, 1) 6204 call comms_bcast(shc_beta, 1) 6205 call comms_bcast(shc_gamma, 1) 6206 call comms_bcast(shc_bandshift, 1) 6207 call comms_bcast(shc_bandshift_firstband, 1) 6208 call comms_bcast(shc_bandshift_energyshift, 1) 6209 6210 call comms_bcast(devel_flag, len(devel_flag)) 6211 call comms_bcast(spin_moment, 1) 6212 call comms_bcast(spin_axis_polar, 1) 6213 call comms_bcast(spin_axis_azimuth, 1) 6214 call comms_bcast(spin_decomp, 1) 6215 call comms_bcast(use_degen_pert, 1) 6216 call comms_bcast(degen_thr, 1) 6217 call comms_bcast(num_valence_bands, 1) 6218 call comms_bcast(dos, 1) 6219 call comms_bcast(dos_task, len(dos_task)) 6220 call comms_bcast(kpath, 1) 6221 call comms_bcast(kpath_task, len(kpath_task)) 6222 call comms_bcast(kpath_bands_colour, len(kpath_bands_colour)) 6223 call comms_bcast(kslice, 1) 6224 call comms_bcast(kslice_task, len(kslice_task)) 6225 call comms_bcast(transl_inv, 1) 6226 call comms_bcast(num_elec_per_state, 1) 6227 call comms_bcast(scissors_shift, 1) 6228 ! 6229 6230! ---------------------------------------------- 6231 call comms_bcast(geninterp, 1) 6232 call comms_bcast(geninterp_alsofirstder, 1) 6233 call comms_bcast(geninterp_single_file, 1) 6234 ! [gp-begin, Apr 12, 2012] 6235 ! BoltzWann variables 6236 call comms_bcast(boltzwann, 1) 6237 call comms_bcast(boltz_calc_also_dos, 1) 6238 call comms_bcast(boltz_2d_dir_num, 1) 6239 call comms_bcast(boltz_dos_energy_step, 1) 6240 call comms_bcast(boltz_dos_energy_min, 1) 6241 call comms_bcast(boltz_dos_energy_max, 1) 6242 call comms_bcast(boltz_dos_adpt_smr, 1) 6243 call comms_bcast(boltz_dos_smr_fixed_en_width, 1) 6244 call comms_bcast(boltz_dos_adpt_smr_fac, 1) 6245 call comms_bcast(boltz_dos_adpt_smr_max, 1) 6246 call comms_bcast(boltz_mu_min, 1) 6247 call comms_bcast(boltz_mu_max, 1) 6248 call comms_bcast(boltz_mu_step, 1) 6249 call comms_bcast(boltz_temp_min, 1) 6250 call comms_bcast(boltz_temp_max, 1) 6251 call comms_bcast(boltz_temp_step, 1) 6252 call comms_bcast(boltz_kmesh_spacing, 1) 6253 call comms_bcast(boltz_kmesh(1), 3) 6254 call comms_bcast(boltz_tdf_energy_step, 1) 6255 call comms_bcast(boltz_relax_time, 1) 6256 call comms_bcast(boltz_TDF_smr_fixed_en_width, 1) 6257 call comms_bcast(boltz_TDF_smr_index, 1) 6258 call comms_bcast(boltz_dos_smr_index, 1) 6259 call comms_bcast(boltz_bandshift, 1) 6260 call comms_bcast(boltz_bandshift_firstband, 1) 6261 call comms_bcast(boltz_bandshift_energyshift, 1) 6262 ! [gp-end] 6263 call comms_bcast(use_ws_distance, 1) 6264 call comms_bcast(disentanglement, 1) 6265 6266 call comms_bcast(transport, 1) 6267 call comms_bcast(tran_easy_fix, 1) 6268 call comms_bcast(transport_mode, len(transport_mode)) 6269 call comms_bcast(tran_win_min, 1) 6270 call comms_bcast(tran_win_max, 1) 6271 call comms_bcast(tran_energy_step, 1) 6272 call comms_bcast(tran_num_bb, 1) 6273 call comms_bcast(tran_num_ll, 1) 6274 call comms_bcast(tran_num_rr, 1) 6275 call comms_bcast(tran_num_cc, 1) 6276 call comms_bcast(tran_num_lc, 1) 6277 call comms_bcast(tran_num_cr, 1) 6278 call comms_bcast(tran_num_bandc, 1) 6279 call comms_bcast(tran_write_ht, 1) 6280 call comms_bcast(tran_read_ht, 1) 6281 call comms_bcast(tran_use_same_lead, 1) 6282 call comms_bcast(tran_num_cell_ll, 1) 6283 call comms_bcast(tran_num_cell_rr, 1) 6284 call comms_bcast(tran_group_threshold, 1) 6285 call comms_bcast(translation_centre_frac(1), 3) 6286 call comms_bcast(num_shells, 1) 6287 call comms_bcast(skip_B1_tests, 1) 6288 call comms_bcast(explicit_nnkpts, 1) 6289 6290 call comms_bcast(calc_only_A, 1) 6291 call comms_bcast(use_bloch_phases, 1) 6292 call comms_bcast(restart, len(restart)) 6293 call comms_bcast(write_r2mn, 1) 6294 call comms_bcast(num_guide_cycles, 1) 6295 call comms_bcast(num_no_guide_iter, 1) 6296 call comms_bcast(fixed_step, 1) 6297 call comms_bcast(trial_step, 1) 6298 call comms_bcast(precond, 1) 6299 call comms_bcast(write_proj, 1) 6300 call comms_bcast(timing_level, 1) 6301 call comms_bcast(spinors, 1) 6302 call comms_bcast(num_elec_per_state, 1) 6303 call comms_bcast(translate_home_cell, 1) 6304 call comms_bcast(write_xyz, 1) 6305 call comms_bcast(write_hr_diag, 1) 6306 call comms_bcast(conv_noise_amp, 1) 6307 call comms_bcast(conv_noise_num, 1) 6308 call comms_bcast(wannier_plot_radius, 1) 6309 call comms_bcast(wannier_plot_scale, 1) 6310 call comms_bcast(kmesh_tol, 1) 6311 call comms_bcast(optimisation, 1) 6312 call comms_bcast(write_vdw_data, 1) 6313 call comms_bcast(lenconfac, 1) 6314 call comms_bcast(lfixstep, 1) 6315 call comms_bcast(lsitesymmetry, 1) 6316 call comms_bcast(frozen_states, 1) 6317 call comms_bcast(symmetrize_eps, 1) 6318 6319 !vv: Constrained centres 6320 call comms_bcast(slwf_num, 1) 6321 call comms_bcast(slwf_constrain, 1) 6322 call comms_bcast(slwf_lambda, 1) 6323 call comms_bcast(selective_loc, 1) 6324 if (selective_loc .and. slwf_constrain) then 6325 if (.not. on_root) then 6326 allocate (ccentres_frac(num_wann, 3), stat=ierr) 6327 if (ierr /= 0) call io_error('Error allocating ccentres_frac in param_get_centre_constraints') 6328 allocate (ccentres_cart(num_wann, 3), stat=ierr) 6329 if (ierr /= 0) call io_error('Error allocating ccentres_cart in param_get_centre_constraints') 6330 endif 6331 call comms_bcast(ccentres_frac(1, 1), 3*num_wann) 6332 call comms_bcast(ccentres_cart(1, 1), 3*num_wann) 6333 end if 6334 6335 ! vv: automatic projections 6336 call comms_bcast(auto_projections, 1) 6337 6338 call comms_bcast(num_proj, 1) 6339 call comms_bcast(lhasproj, 1) 6340 if (lhasproj) then 6341 if (.not. on_root) then 6342 allocate (input_proj_site(3, num_proj), stat=ierr) 6343 if (ierr /= 0) call io_error('Error allocating input_proj_site in param_dist') 6344 allocate (proj_site(3, num_wann), stat=ierr) 6345 if (ierr /= 0) call io_error('Error allocating proj_site in param_dist') 6346 endif 6347 call comms_bcast(input_proj_site(1, 1), 3*num_proj) 6348 call comms_bcast(proj_site(1, 1), 3*num_wann) 6349 endif 6350 6351 ! These variables are different from the ones above in that they are 6352 ! allocatable, and in param_read they were allocated on the root node only 6353 ! 6354 if (.not. on_root) then 6355 allocate (fermi_energy_list(nfermi), stat=ierr) 6356 if (ierr /= 0) call io_error( & 6357 'Error allocating fermi_energy_read in postw90_param_dist') 6358 allocate (kubo_freq_list(kubo_nfreq), stat=ierr) 6359 if (ierr /= 0) call io_error( & 6360 'Error allocating kubo_freq_list in postw90_param_dist') 6361 allocate (dos_project(num_dos_project), stat=ierr) 6362 if (ierr /= 0) & 6363 call io_error('Error allocating dos_project in postw90_param_dist') 6364 if (.not. effective_model) then 6365 if (eig_found) then 6366 allocate (eigval(num_bands, num_kpts), stat=ierr) 6367 if (ierr /= 0) & 6368 call io_error('Error allocating eigval in postw90_param_dist') 6369 end if 6370 allocate (kpt_latt(3, num_kpts), stat=ierr) 6371 if (ierr /= 0) & 6372 call io_error('Error allocating kpt_latt in postw90_param_dist') 6373 endif 6374 allocate (gyrotropic_band_list(gyrotropic_num_bands), stat=ierr) 6375 if (ierr /= 0) call io_error( & 6376 'Error allocating gyrotropic_num_bands in postw90_param_dist') 6377 allocate (gyrotropic_freq_list(gyrotropic_nfreq), stat=ierr) 6378 if (ierr /= 0) call io_error( & 6379 'Error allocating gyrotropic_freq_list in postw90_param_dist') 6380 end if 6381 6382 if (nfermi > 0) call comms_bcast(fermi_energy_list(1), nfermi) 6383 if (kubo_nfreq > 0) call comms_bcast(kubo_freq_list(1), kubo_nfreq) 6384 call comms_bcast(gyrotropic_freq_list(1), gyrotropic_nfreq) 6385 call comms_bcast(gyrotropic_band_list(1), gyrotropic_num_bands) 6386 if (num_dos_project > 0) call comms_bcast(dos_project(1), num_dos_project) 6387 if (.not. effective_model) then 6388 if (eig_found) then 6389 call comms_bcast(eigval(1, 1), num_bands*num_kpts) 6390 end if 6391 call comms_bcast(kpt_latt(1, 1), 3*num_kpts) 6392 endif 6393 6394 if (.not. effective_model .and. .not. explicit_nnkpts) then 6395 6396 call comms_bcast(nnh, 1) 6397 call comms_bcast(nntot, 1) 6398 call comms_bcast(wbtot, 1) 6399 6400 if (.not. on_root) then 6401 allocate (nnlist(num_kpts, nntot), stat=ierr) 6402 if (ierr /= 0) & 6403 call io_error('Error in allocating nnlist in param_dist') 6404 allocate (neigh(num_kpts, nntot/2), stat=ierr) 6405 if (ierr /= 0) & 6406 call io_error('Error in allocating neigh in param_dist') 6407 allocate (nncell(3, num_kpts, nntot), stat=ierr) 6408 if (ierr /= 0) & 6409 call io_error('Error in allocating nncell in param_dist') 6410 allocate (wb(nntot), stat=ierr) 6411 if (ierr /= 0) & 6412 call io_error('Error in allocating wb in param_dist') 6413 allocate (bka(3, nntot/2), stat=ierr) 6414 if (ierr /= 0) & 6415 call io_error('Error in allocating bka in param_dist') 6416 allocate (bk(3, nntot, num_kpts), stat=ierr) 6417 if (ierr /= 0) & 6418 call io_error('Error in allocating bk in param_dist') 6419 end if 6420 6421 call comms_bcast(nnlist(1, 1), num_kpts*nntot) 6422 call comms_bcast(neigh(1, 1), num_kpts*nntot/2) 6423 call comms_bcast(nncell(1, 1, 1), 3*num_kpts*nntot) 6424 call comms_bcast(wb(1), nntot) 6425 call comms_bcast(bka(1, 1), 3*nntot/2) 6426 call comms_bcast(bk(1, 1, 1), 3*nntot*num_kpts) 6427 6428 endif 6429 6430 call comms_bcast(omega_total, 1) 6431 call comms_bcast(omega_tilde, 1) 6432 call comms_bcast(omega_invariant, 1) 6433 call comms_bcast(have_disentangled, 1) 6434 6435 if (.not. on_root) then 6436 allocate (wannier_centres(3, num_wann), stat=ierr) 6437 if (ierr /= 0) call io_error('Error allocating wannier_centres in param_dist') 6438 wannier_centres = 0.0_dp 6439 allocate (wannier_spreads(num_wann), stat=ierr) 6440 if (ierr /= 0) call io_error('Error in allocating wannier_spreads in param_dist') 6441 wannier_spreads = 0.0_dp 6442 if (disentanglement) then 6443 allocate (ndimwin(num_kpts), stat=ierr) 6444 if (ierr /= 0) call io_error('Error allocating ndimwin in param_dist') 6445 allocate (lwindow(num_bands, num_kpts), stat=ierr) 6446 if (ierr /= 0) call io_error('Error allocating lwindow in param_dist') 6447 endif 6448 endif 6449 6450 end subroutine param_dist 6451 6452 subroutine parameters_gyro_write_task(task, key, comment) 6453 use w90_io, only: stdout 6454 6455 character(len=*), intent(in) :: task, key, comment 6456 character(len=42) :: comment1 6457 6458 comment1 = comment 6459 if ((index(task, key) > 0) .or. (index(task, 'all') > 0)) then 6460 write (stdout, '(1x,a2,a42,a2,10x,a8,13x,a1)') '| ', comment1, ' :', ' T', '|' 6461 else 6462 write (stdout, '(1x,a2,a42,a2,10x,a8,13x,a1)') '| ', comment1, ' :', ' F', '|' 6463 endif 6464 end subroutine parameters_gyro_write_task 6465 6466end module w90_parameters 6467