(git:f8a708f)
Loading...
Searching...
No Matches
qs_kind_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Define the quickstep kind type and their sub types
10!> \author Ole Schuett
11!>
12!> <b>Modification history:</b>
13!> - 01.2002 creation [MK]
14!> - 04.2002 added pao [fawzi]
15!> - 09.2002 adapted for POL/KG use [GT]
16!> - 02.2004 flexible normalization of basis sets [jgh]
17!> - 03.2004 attach/detach routines [jgh]
18!> - 10.2004 removed pao [fawzi]
19!> - 08.2014 separated qs-related stuff from atomic_kind_types.F [Ole Schuett]
20!> - 07.2015 new container for basis sets [jgh]
21!> - 04.2021 init dft_plus_u_type [MK]
22! **************************************************************************************************
23MODULE qs_kind_types
24 USE atom_sgp, ONLY: atom_sgp_potential_type,&
25 atom_sgp_release,&
26 sgp_construction
27 USE atom_types, ONLY: atom_ecppot_type,&
28 lmat,&
29 read_ecp_potential
30 USE atom_upf, ONLY: atom_read_upf,&
31 atom_release_upf,&
32 atom_upfpot_type
33 USE atomic_kind_types, ONLY: atomic_kind_type,&
34 get_atomic_kind
35 USE basis_set_container_types, ONLY: add_basis_set_to_container,&
36 basis_set_container_type,&
37 get_basis_from_container,&
38 remove_basis_from_container,&
39 remove_basis_set_container
40 USE basis_set_types, ONLY: &
41 allocate_gto_basis_set, allocate_sto_basis_set, combine_basis_sets, &
42 create_gto_from_sto_basis, deallocate_sto_basis_set, get_gto_basis_set, &
43 gto_basis_set_type, init_aux_basis_set, init_orb_basis_set, read_gto_basis_set, &
44 read_sto_basis_set, sto_basis_set_type, write_gto_basis_set, write_orb_basis_set
45 USE cp_control_types, ONLY: dft_control_type,&
46 qs_control_type,&
47 xtb_control_type
48 USE cp_log_handling, ONLY: cp_get_default_logger,&
49 cp_logger_get_default_io_unit,&
50 cp_logger_type
51 USE cp_output_handling, ONLY: cp_p_file,&
52 cp_print_key_finished_output,&
53 cp_print_key_should_output,&
54 cp_print_key_unit_nr
55 USE external_potential_types, ONLY: &
56 all_potential_type, allocate_potential, deallocate_potential, get_potential, &
57 gth_potential_type, init_potential, local_potential_type, read_potential, &
58 set_default_all_potential, set_potential, sgp_potential_type, write_potential
59 USE gapw_1c_basis_set, ONLY: create_1c_basis
60 USE input_constants, ONLY: &
61 do_method_am1, do_method_dftb, do_method_mndo, do_method_mndod, do_method_pdg, &
62 do_method_pm3, do_method_pm6, do_method_pm6fm, do_method_pnnl, do_method_pw, &
63 do_method_rm1, do_method_xtb, do_qs, do_sirius, gapw_1c_large, gapw_1c_medium, &
64 gapw_1c_orb, gapw_1c_small, gapw_1c_very_large, plus_u_lowdin, plus_u_tensorial
65 USE input_section_types, ONLY: section_vals_get,&
66 section_vals_get_subs_vals,&
67 section_vals_get_subs_vals2,&
68 section_vals_type,&
69 section_vals_val_get
70 USE kinds, ONLY: default_path_length,&
71 default_string_length,&
72 dp
73 USE mathconstants, ONLY: pi
74 USE message_passing, ONLY: mp_para_env_type
75 USE orbital_pointers, ONLY: init_orbital_pointers,&
76 nco,&
77 ncoset
78 USE paw_proj_set_types, ONLY: allocate_paw_proj_set,&
79 deallocate_paw_proj_set,&
80 get_paw_proj_set,&
81 paw_proj_set_type,&
82 projectors
83 USE periodic_table, ONLY: get_ptable_info,&
84 ptable
85 USE physcon, ONLY: angstrom,&
86 bohr,&
87 evolt
88 USE qs_cneo_types, ONLY: allocate_cneo_potential,&
89 cneo_potential_type,&
90 deallocate_cneo_potential,&
91 get_cneo_potential,&
92 set_cneo_potential,&
93 write_cneo_potential
94 USE qs_dftb_types, ONLY: qs_dftb_atom_type
95 USE qs_dftb_utils, ONLY: deallocate_dftb_atom_param,&
96 get_dftb_atom_param,&
97 write_dftb_atom_param
98 USE qs_dispersion_types, ONLY: qs_atom_dispersion_type
99 USE qs_grid_atom, ONLY: allocate_grid_atom,&
100 deallocate_grid_atom,&
101 grid_atom_type
102 USE qs_harmonics_atom, ONLY: allocate_harmonics_atom,&
103 deallocate_harmonics_atom,&
104 harmonics_atom_type
105 USE semi_empirical_types, ONLY: get_se_param,&
106 semi_empirical_create,&
107 semi_empirical_release,&
108 semi_empirical_type,&
109 write_se_param
110 USE semi_empirical_utils, ONLY: init_se_param,&
111 se_param_set_default
112 USE soft_basis_set, ONLY: create_soft_basis
113 USE string_utilities, ONLY: uppercase
114 USE xc_input_constants, ONLY: skala_gapw_cp2k_default,&
115 skala_gapw_direct_valence,&
116 skala_gapw_paw_one_center,&
117 skala_gapw_paw_one_center_split
118 USE xtb_parameters, ONLY: xtb_set_kab
119 USE xtb_types, ONLY: deallocate_xtb_atom_param,&
120 get_xtb_atom_param,&
121 write_xtb_atom_param,&
122 xtb_atom_type
123#include "./base/base_uses.f90"
124
125 IMPLICIT NONE
126
127 PRIVATE
128
129 ! Global parameters (only in this module)
130
131 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_kind_types'
132
133! **************************************************************************************************
134!> \brief Input parameters for the DFT+U method
135! **************************************************************************************************
136 TYPE dft_plus_u_type
137 INTEGER :: l = -1
138 INTEGER :: n = -1
139 INTEGER :: max_scf = -1
140 INTEGER :: lr_atom = -1
141 REAL(KIND=dp) :: eps_u_ramping = 0.0_dp
142 REAL(KIND=dp) :: eps_scf = huge(0.0_dp)
143 REAL(KIND=dp) :: u_minus_j_target = 0.0_dp
144 REAL(KIND=dp) :: u_minus_j = 0.0_dp
145 REAL(KIND=dp) :: hund_j = 0.0_dp
146 REAL(KIND=dp) :: u_ramping = 0.0_dp
147 REAL(KIND=dp) :: u = 0.0_dp
148 REAL(KIND=dp) :: j = 0.0_dp
149 REAL(KIND=dp) :: alpha = 0.0_dp
150 REAL(KIND=dp) :: beta = 0.0_dp
151 REAL(KIND=dp) :: j0 = 0.0_dp
152 REAL(KIND=dp) :: occupation = -1.0_dp
153 REAL(KIND=dp) :: proj_shell_charge(4) = 0.0_dp
154 REAL(KIND=dp), DIMENSION(:), &
155 ALLOCATABLE :: perturbation_strength
156 REAL(KIND=dp), DIMENSION(:), POINTER :: ao_coef => null()
157 INTEGER, DIMENSION(:), POINTER :: orbitals => null()
158 LOGICAL :: init_u_ramping_each_scf = .false.
159 LOGICAL :: smear = .false.
160 LOGICAL :: do_mtlr = .false.
161 LOGICAL :: u_j_loop = .false.
162 REAL(KIND=dp), DIMENSION(:), POINTER :: nelec => null()
163 END TYPE dft_plus_u_type
164
165! **************************************************************************************************
166!> \brief Holds information about a PAO potential
167! **************************************************************************************************
168 TYPE pao_potential_type
169 INTEGER :: maxl = -1
170 REAL(kind=dp) :: beta = 0.0_dp
171 REAL(kind=dp) :: weight = 0.0_dp
172 INTEGER :: max_projector = -1
173 REAL(kind=dp) :: beta_radius = huge(dp)
174 END TYPE pao_potential_type
175
176! **************************************************************************************************
177!> \brief Holds information about a PAO descriptor
178! **************************************************************************************************
179 TYPE pao_descriptor_type
180 REAL(kind=dp) :: beta = 0.0_dp
181 REAL(kind=dp) :: beta_radius = huge(dp)
182 REAL(kind=dp) :: weight = 0.0_dp
183 REAL(kind=dp) :: screening = 0.0_dp
184 REAL(kind=dp) :: screening_radius = huge(dp)
185 END TYPE pao_descriptor_type
186
187! **************************************************************************************************
188!> \brief Provides all information about a quickstep kind
189! **************************************************************************************************
190 TYPE qs_kind_type
191 CHARACTER(LEN=default_string_length) :: name = ""
192 CHARACTER(LEN=2) :: element_symbol = ""
193 INTEGER :: natom = -1
194 TYPE(all_potential_type), POINTER :: all_potential => null()
195 TYPE(local_potential_type), POINTER :: tnadd_potential => null()
196 TYPE(gth_potential_type), POINTER :: gth_potential => null()
197 TYPE(sgp_potential_type), POINTER :: sgp_potential => null()
198 TYPE(semi_empirical_type), POINTER :: se_parameter => null()
199 TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter => null()
200 TYPE(xtb_atom_type), POINTER :: xtb_parameter => null()
201 !
202 TYPE(atom_upfpot_type), POINTER :: upf_potential => null()
203 TYPE(cneo_potential_type), POINTER :: cneo_potential => null()
204 !
205 TYPE(basis_set_container_type), &
206 DIMENSION(20) :: basis_sets = basis_set_container_type()
207 ! Atomic radii
208 REAL(kind=dp) :: covalent_radius = 0.0_dp
209 REAL(kind=dp) :: vdw_radius = 0.0_dp
210 ! GAPW specific data
211 TYPE(paw_proj_set_type), POINTER :: paw_proj_set => null()
212 REAL(kind=dp) :: hard_radius = 0.8_dp*bohr ! for hard and soft exp
213 REAL(kind=dp) :: hard0_radius = 0.8_dp*bohr ! for hard exp of rho0
214 REAL(kind=dp) :: max_rad_local = 13.2_dp*bohr ! max GTO radius used in GAPW
215 LOGICAL :: paw_atom = .false. ! needs atomic rho1
216 LOGICAL :: gpw_type_forced = .false. ! gpw atom even if with hard exponents
217 !
218 LOGICAL :: ghost = .false.
219 LOGICAL :: monovalent = .false.
220 LOGICAL :: floating = .false.
221 INTEGER :: lmax_dftb = -1
222 REAL(kind=dp) :: dudq_dftb3 = 0.0_dp
223 REAL(kind=dp) :: magnetization = 0.0_dp
224 INTEGER, DIMENSION(:, :), POINTER :: addel => null()
225 INTEGER, DIMENSION(:, :), POINTER :: laddel => null()
226 INTEGER, DIMENSION(:, :), POINTER :: naddel => null()
227 TYPE(harmonics_atom_type), POINTER :: harmonics => null()
228 TYPE(grid_atom_type), POINTER :: grid_atom => null()
229 INTEGER :: ngrid_rad = 50
230 INTEGER :: ngrid_ang = 50
231 INTEGER :: lmax_rho0 = 0
232 INTEGER :: mao = -1
233 INTEGER, DIMENSION(:), POINTER :: elec_conf => null() ! used to set up the initial atomic guess
234 LOGICAL :: bs_occupation = .false.
235 TYPE(dft_plus_u_type), POINTER :: dft_plus_u => null()
236 LOGICAL :: no_optimize = .true.
237 !
238 REAL(kind=dp), DIMENSION(:, :), POINTER :: nlcc_pot => null()
239 !
240 TYPE(qs_atom_dispersion_type), POINTER :: dispersion => null()
241 REAL(kind=dp), DIMENSION(:, :), POINTER :: reltmat => null()
242 INTEGER :: pao_basis_size = -1
243 CHARACTER(LEN=default_path_length) :: pao_model_file = ""
244 TYPE(pao_potential_type), DIMENSION(:), POINTER :: pao_potentials => null()
245 TYPE(pao_descriptor_type), DIMENSION(:), POINTER :: pao_descriptors => null()
246 END TYPE qs_kind_type
247
248 ! Public subroutines
249
250 PUBLIC :: check_qs_kind_set, &
251 deallocate_qs_kind_set, &
252 get_qs_kind, &
253 get_qs_kind_set, &
254 has_nlcc, &
255 init_qs_kind_set, &
256 init_gapw_basis_set, &
257 init_gapw_nlcc, &
258 create_qs_kind_set, &
259 set_qs_kind, &
260 write_qs_kind_set, &
261 write_gto_basis_sets, &
262 init_atom_electronic_state, set_pseudo_state, &
263 init_cneo_basis_set
264
265 ! Public data types
266 PUBLIC :: qs_kind_type, pao_potential_type, pao_descriptor_type
267
268CONTAINS
269
270! **************************************************************************************************
271!> \brief Destructor routine for a set of qs kinds
272!> \param qs_kind_set ...
273!> \date 02.01.2002
274!> \author Matthias Krack (MK)
275!> \version 2.0
276! **************************************************************************************************
277 SUBROUTINE deallocate_qs_kind_set(qs_kind_set)
278
279 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
280
281 INTEGER :: ikind, nkind
282
283 IF (ASSOCIATED(qs_kind_set)) THEN
284
285 nkind = SIZE(qs_kind_set)
286
287 DO ikind = 1, nkind
288 IF (ASSOCIATED(qs_kind_set(ikind)%all_potential)) THEN
289 CALL deallocate_potential(qs_kind_set(ikind)%all_potential)
290 END IF
291 IF (ASSOCIATED(qs_kind_set(ikind)%tnadd_potential)) THEN
292 CALL deallocate_potential(qs_kind_set(ikind)%tnadd_potential)
293 END IF
294 IF (ASSOCIATED(qs_kind_set(ikind)%gth_potential)) THEN
295 CALL deallocate_potential(qs_kind_set(ikind)%gth_potential)
296 END IF
297 IF (ASSOCIATED(qs_kind_set(ikind)%sgp_potential)) THEN
298 CALL deallocate_potential(qs_kind_set(ikind)%sgp_potential)
299 END IF
300 IF (ASSOCIATED(qs_kind_set(ikind)%upf_potential)) THEN
301 CALL atom_release_upf(qs_kind_set(ikind)%upf_potential)
302 DEALLOCATE (qs_kind_set(ikind)%upf_potential)
303 END IF
304 IF (ASSOCIATED(qs_kind_set(ikind)%cneo_potential)) THEN
305 CALL deallocate_cneo_potential(qs_kind_set(ikind)%cneo_potential)
306 END IF
307 IF (ASSOCIATED(qs_kind_set(ikind)%se_parameter)) THEN
308 CALL semi_empirical_release(qs_kind_set(ikind)%se_parameter)
309 END IF
310 IF (ASSOCIATED(qs_kind_set(ikind)%dftb_parameter)) THEN
311 CALL deallocate_dftb_atom_param(qs_kind_set(ikind)%dftb_parameter)
312 END IF
313 IF (ASSOCIATED(qs_kind_set(ikind)%xtb_parameter)) THEN
314 CALL deallocate_xtb_atom_param(qs_kind_set(ikind)%xtb_parameter)
315 END IF
316 IF (ASSOCIATED(qs_kind_set(ikind)%paw_proj_set)) THEN
317 CALL deallocate_paw_proj_set(qs_kind_set(ikind)%paw_proj_set)
318 END IF
319 IF (ASSOCIATED(qs_kind_set(ikind)%harmonics)) THEN
320 CALL deallocate_harmonics_atom(qs_kind_set(ikind)%harmonics)
321 END IF
322 IF (ASSOCIATED(qs_kind_set(ikind)%grid_atom)) THEN
323 CALL deallocate_grid_atom(qs_kind_set(ikind)%grid_atom)
324 END IF
325 IF (ASSOCIATED(qs_kind_set(ikind)%elec_conf)) THEN
326 DEALLOCATE (qs_kind_set(ikind)%elec_conf)
327 END IF
328
329 IF (ASSOCIATED(qs_kind_set(ikind)%dft_plus_u)) THEN
330 IF (ASSOCIATED(qs_kind_set(ikind)%dft_plus_u%orbitals)) THEN
331 DEALLOCATE (qs_kind_set(ikind)%dft_plus_u%orbitals)
332 END IF
333 IF (ASSOCIATED(qs_kind_set(ikind)%dft_plus_u%nelec)) THEN
334 DEALLOCATE (qs_kind_set(ikind)%dft_plus_u%nelec)
335 END IF
336 IF (ASSOCIATED(qs_kind_set(ikind)%dft_plus_u%ao_coef)) THEN
337 DEALLOCATE (qs_kind_set(ikind)%dft_plus_u%ao_coef)
338 END IF
339 DEALLOCATE (qs_kind_set(ikind)%dft_plus_u)
340 END IF
341
342 IF (ASSOCIATED(qs_kind_set(ikind)%nlcc_pot)) THEN
343 DEALLOCATE (qs_kind_set(ikind)%nlcc_pot)
344 END IF
345
346 IF (ASSOCIATED(qs_kind_set(ikind)%dispersion)) THEN
347 DEALLOCATE (qs_kind_set(ikind)%dispersion)
348 END IF
349 IF (ASSOCIATED(qs_kind_set(ikind)%addel)) THEN
350 DEALLOCATE (qs_kind_set(ikind)%addel)
351 END IF
352 IF (ASSOCIATED(qs_kind_set(ikind)%naddel)) THEN
353 DEALLOCATE (qs_kind_set(ikind)%naddel)
354 END IF
355 IF (ASSOCIATED(qs_kind_set(ikind)%laddel)) THEN
356 DEALLOCATE (qs_kind_set(ikind)%laddel)
357 END IF
358 IF (ASSOCIATED(qs_kind_set(ikind)%reltmat)) THEN
359 DEALLOCATE (qs_kind_set(ikind)%reltmat)
360 END IF
361
362 IF (ASSOCIATED(qs_kind_set(ikind)%pao_potentials)) THEN
363 DEALLOCATE (qs_kind_set(ikind)%pao_potentials)
364 END IF
365 IF (ASSOCIATED(qs_kind_set(ikind)%pao_descriptors)) THEN
366 DEALLOCATE (qs_kind_set(ikind)%pao_descriptors)
367 END IF
368
369 CALL remove_basis_set_container(qs_kind_set(ikind)%basis_sets)
370
371 END DO
372 DEALLOCATE (qs_kind_set)
373 ELSE
374 CALL cp_abort(__location__, &
375 "The pointer qs_kind_set is not associated and "// &
376 "cannot be deallocated")
377 END IF
378
379 END SUBROUTINE deallocate_qs_kind_set
380
381! **************************************************************************************************
382!> \brief Get attributes of an atomic kind.
383!> \param qs_kind ...
384!> \param basis_set ...
385!> \param basis_type ...
386!> \param ncgf ...
387!> \param nsgf ...
388!> \param all_potential ...
389!> \param tnadd_potential ...
390!> \param gth_potential ...
391!> \param sgp_potential ...
392!> \param upf_potential ...
393!> \param cneo_potential ...
394!> \param se_parameter ...
395!> \param dftb_parameter ...
396!> \param xtb_parameter ...
397!> \param dftb3_param ...
398!> \param zatom ...
399!> \param zeff ...
400!> \param elec_conf ...
401!> \param mao ...
402!> \param lmax_dftb ...
403!> \param alpha_core_charge ...
404!> \param ccore_charge ...
405!> \param core_charge ...
406!> \param core_charge_radius ...
407!> \param paw_proj_set ...
408!> \param paw_atom ...
409!> \param hard_radius ...
410!> \param hard0_radius ...
411!> \param max_rad_local ...
412!> \param covalent_radius ...
413!> \param vdw_radius ...
414!> \param gpw_type_forced ...
415!> \param harmonics ...
416!> \param max_iso_not0 ...
417!> \param max_s_harm ...
418!> \param grid_atom ...
419!> \param ngrid_ang ...
420!> \param ngrid_rad ...
421!> \param lmax_rho0 ...
422!> \param dft_plus_u_atom ...
423!> \param l_of_dft_plus_u ...
424!> \param n_of_dft_plus_u ...
425!> \param u_minus_j ...
426!> \param hund_j ...
427!> \param U_of_dft_plus_u ...
428!> \param J_of_dft_plus_u ...
429!> \param alpha_of_dft_plus_u ...
430!> \param beta_of_dft_plus_u ...
431!> \param J0_of_dft_plus_u ...
432!> \param occupation_of_dft_plus_u ...
433!> \param dispersion ...
434!> \param bs_occupation ...
435!> \param magnetization ...
436!> \param no_optimize ...
437!> \param addel ...
438!> \param laddel ...
439!> \param naddel ...
440!> \param orbitals ...
441!> \param max_scf ...
442!> \param eps_scf ...
443!> \param smear ...
444!> \param u_ramping ...
445!> \param u_minus_j_target ...
446!> \param eps_u_ramping ...
447!> \param proj_shell_charge ...
448!> \param lr_atom ...
449!> \param do_mtlr ...
450!> \param u_j_loop ...
451!> \param ao_coef ...
452!> \param init_u_ramping_each_scf ...
453!> \param reltmat ...
454!> \param ghost ...
455!> \param monovalent ...
456!> \param floating ...
457!> \param name ...
458!> \param element_symbol ...
459!> \param pao_basis_size ...
460!> \param pao_model_file ...
461!> \param pao_potentials ...
462!> \param pao_descriptors ...
463!> \param nelec ...
464! **************************************************************************************************
465 SUBROUTINE get_qs_kind(qs_kind, &
466 basis_set, basis_type, ncgf, nsgf, &
467 all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, &
468 cneo_potential, se_parameter, dftb_parameter, xtb_parameter, &
469 dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, &
470 alpha_core_charge, ccore_charge, core_charge, core_charge_radius, &
471 paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, &
472 covalent_radius, vdw_radius, &
473 gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, &
474 ngrid_ang, ngrid_rad, lmax_rho0, &
475 dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, &
476 u_minus_j, hund_j, U_of_dft_plus_u, J_of_dft_plus_u, &
477 alpha_of_dft_plus_u, beta_of_dft_plus_u, J0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, &
478 bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, &
479 max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, proj_shell_charge, &
480 lr_atom, do_mtlr, u_j_loop, ao_coef, &
481 init_u_ramping_each_scf, reltmat, ghost, monovalent, floating, name, element_symbol, &
482 pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
483
484 TYPE(qs_kind_type) :: qs_kind
485 TYPE(gto_basis_set_type), OPTIONAL, POINTER :: basis_set
486 CHARACTER(len=*), OPTIONAL :: basis_type
487 INTEGER, INTENT(OUT), OPTIONAL :: ncgf, nsgf
488 TYPE(all_potential_type), OPTIONAL, POINTER :: all_potential
489 TYPE(local_potential_type), OPTIONAL, POINTER :: tnadd_potential
490 TYPE(gth_potential_type), OPTIONAL, POINTER :: gth_potential
491 TYPE(sgp_potential_type), OPTIONAL, POINTER :: sgp_potential
492 TYPE(atom_upfpot_type), OPTIONAL, POINTER :: upf_potential
493 TYPE(cneo_potential_type), OPTIONAL, POINTER :: cneo_potential
494 TYPE(semi_empirical_type), OPTIONAL, POINTER :: se_parameter
495 TYPE(qs_dftb_atom_type), OPTIONAL, POINTER :: dftb_parameter
496 TYPE(xtb_atom_type), OPTIONAL, POINTER :: xtb_parameter
497 REAL(kind=dp), INTENT(OUT), OPTIONAL :: dftb3_param
498 INTEGER, INTENT(OUT), OPTIONAL :: zatom
499 REAL(kind=dp), INTENT(OUT), OPTIONAL :: zeff
500 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: elec_conf
501 INTEGER, INTENT(OUT), OPTIONAL :: mao, lmax_dftb
502 REAL(kind=dp), INTENT(OUT), OPTIONAL :: alpha_core_charge, ccore_charge, &
503 core_charge, core_charge_radius
504 TYPE(paw_proj_set_type), OPTIONAL, POINTER :: paw_proj_set
505 LOGICAL, INTENT(OUT), OPTIONAL :: paw_atom
506 REAL(kind=dp), INTENT(OUT), OPTIONAL :: hard_radius, hard0_radius, &
507 max_rad_local, covalent_radius, &
508 vdw_radius
509 LOGICAL, INTENT(OUT), OPTIONAL :: gpw_type_forced
510 TYPE(harmonics_atom_type), OPTIONAL, POINTER :: harmonics
511 INTEGER, INTENT(OUT), OPTIONAL :: max_iso_not0, max_s_harm
512 TYPE(grid_atom_type), OPTIONAL, POINTER :: grid_atom
513 INTEGER, INTENT(OUT), OPTIONAL :: ngrid_ang, ngrid_rad, lmax_rho0
514 LOGICAL, INTENT(OUT), OPTIONAL :: dft_plus_u_atom
515 INTEGER, INTENT(OUT), OPTIONAL :: l_of_dft_plus_u, n_of_dft_plus_u
516 REAL(kind=dp), INTENT(OUT), OPTIONAL :: u_minus_j, hund_j, u_of_dft_plus_u, j_of_dft_plus_u, &
517 alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u
518 TYPE(qs_atom_dispersion_type), OPTIONAL, POINTER :: dispersion
519 LOGICAL, INTENT(OUT), OPTIONAL :: bs_occupation
520 REAL(kind=dp), INTENT(OUT), OPTIONAL :: magnetization
521 LOGICAL, INTENT(OUT), OPTIONAL :: no_optimize
522 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: addel, laddel, naddel
523 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: orbitals
524 INTEGER, OPTIONAL :: max_scf
525 REAL(kind=dp), OPTIONAL :: eps_scf
526 LOGICAL, OPTIONAL :: smear
527 REAL(kind=dp), INTENT(OUT), OPTIONAL :: u_ramping, u_minus_j_target, &
528 eps_u_ramping, proj_shell_charge(4)
529 INTEGER, OPTIONAL :: lr_atom
530 LOGICAL, INTENT(OUT), OPTIONAL :: do_mtlr, u_j_loop
531 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: ao_coef
532 LOGICAL, OPTIONAL :: init_u_ramping_each_scf
533 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: reltmat
534 LOGICAL, OPTIONAL :: ghost
535 LOGICAL, INTENT(OUT), OPTIONAL :: monovalent
536 LOGICAL, OPTIONAL :: floating
537 CHARACTER(LEN=default_string_length), &
538 INTENT(OUT), OPTIONAL :: name
539 CHARACTER(LEN=2), INTENT(OUT), OPTIONAL :: element_symbol
540 INTEGER, INTENT(OUT), OPTIONAL :: pao_basis_size
541 CHARACTER(LEN=default_path_length), INTENT(OUT), &
542 OPTIONAL :: pao_model_file
543 TYPE(pao_potential_type), DIMENSION(:), OPTIONAL, &
544 POINTER :: pao_potentials
545 TYPE(pao_descriptor_type), DIMENSION(:), &
546 OPTIONAL, POINTER :: pao_descriptors
547 REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: nelec
548
549 CHARACTER(LEN=default_string_length) :: my_basis_type
550 INTEGER :: l
551 LOGICAL :: found
552 TYPE(gto_basis_set_type), POINTER :: tmp_basis_set
553
554 ! Retrieve basis set from the kind container
555 IF (PRESENT(basis_type)) THEN
556 my_basis_type = basis_type
557 ELSE
558 my_basis_type = "ORB"
559 END IF
560
561 IF (PRESENT(basis_set)) THEN
562 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=basis_set, &
563 basis_type=my_basis_type)
564 END IF
565
566 IF (PRESENT(ncgf)) THEN
567 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis_set, &
568 basis_type=my_basis_type)
569 IF (ASSOCIATED(tmp_basis_set)) THEN
570 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, ncgf=ncgf)
571 ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN
572 l = qs_kind%dftb_parameter%lmax
573 ncgf = ((l + 1)*(l + 2)*(l + 3))/6
574 ELSE
575 ncgf = 0
576 END IF
577 END IF
578
579 IF (PRESENT(nsgf)) THEN
580 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis_set, &
581 basis_type=my_basis_type)
582 IF (ASSOCIATED(tmp_basis_set)) THEN
583 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nsgf=nsgf)
584 ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN
585 nsgf = qs_kind%dftb_parameter%natorb
586 ELSE
587 nsgf = 0
588 END IF
589 END IF
590
591 IF (PRESENT(all_potential)) all_potential => qs_kind%all_potential
592 IF (PRESENT(tnadd_potential)) tnadd_potential => qs_kind%tnadd_potential
593 IF (PRESENT(gth_potential)) gth_potential => qs_kind%gth_potential
594 IF (PRESENT(sgp_potential)) sgp_potential => qs_kind%sgp_potential
595 IF (PRESENT(upf_potential)) upf_potential => qs_kind%upf_potential
596 IF (PRESENT(cneo_potential)) cneo_potential => qs_kind%cneo_potential
597 IF (PRESENT(se_parameter)) se_parameter => qs_kind%se_parameter
598 IF (PRESENT(dftb_parameter)) dftb_parameter => qs_kind%dftb_parameter
599 IF (PRESENT(xtb_parameter)) xtb_parameter => qs_kind%xtb_parameter
600 IF (PRESENT(element_symbol)) element_symbol = qs_kind%element_symbol
601 IF (PRESENT(name)) name = qs_kind%name
602 IF (PRESENT(dftb3_param)) dftb3_param = qs_kind%dudq_dftb3
603 IF (PRESENT(elec_conf)) elec_conf => qs_kind%elec_conf
604 IF (PRESENT(alpha_core_charge)) THEN
605 IF (ASSOCIATED(qs_kind%all_potential)) THEN
606 CALL get_potential(potential=qs_kind%all_potential, &
607 alpha_core_charge=alpha_core_charge)
608 ELSE IF (ASSOCIATED(qs_kind%gth_potential)) THEN
609 CALL get_potential(potential=qs_kind%gth_potential, &
610 alpha_core_charge=alpha_core_charge)
611 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
612 CALL get_potential(potential=qs_kind%sgp_potential, &
613 alpha_core_charge=alpha_core_charge)
614 ELSE IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
615 cpabort("CNEO ALPHA CORE CHARGE NOT AVAILABLE")
616 ELSE
617 alpha_core_charge = 1.0_dp
618 END IF
619 END IF
620 IF (PRESENT(ccore_charge)) THEN
621 IF (ASSOCIATED(qs_kind%all_potential)) THEN
622 CALL get_potential(potential=qs_kind%all_potential, &
623 ccore_charge=ccore_charge)
624 ELSE IF (ASSOCIATED(qs_kind%gth_potential)) THEN
625 CALL get_potential(potential=qs_kind%gth_potential, &
626 ccore_charge=ccore_charge)
627 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
628 CALL get_potential(potential=qs_kind%sgp_potential, &
629 ccore_charge=ccore_charge)
630 ELSE IF (ASSOCIATED(qs_kind%upf_potential)) THEN
631 cpabort("UPF CCORE CHARGE NOT AVAILABLE")
632 ELSE IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
633 cpabort("CNEO CCORE CHARGE NOT AVAILABLE")
634 ELSE
635 ccore_charge = 0.0_dp
636 END IF
637 END IF
638 IF (PRESENT(core_charge_radius)) THEN
639 IF (ASSOCIATED(qs_kind%all_potential)) THEN
640 CALL get_potential(potential=qs_kind%all_potential, &
641 core_charge_radius=core_charge_radius)
642 ELSE IF (ASSOCIATED(qs_kind%gth_potential)) THEN
643 CALL get_potential(potential=qs_kind%gth_potential, &
644 core_charge_radius=core_charge_radius)
645 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
646 CALL get_potential(potential=qs_kind%sgp_potential, &
647 core_charge_radius=core_charge_radius)
648 ELSE IF (ASSOCIATED(qs_kind%upf_potential)) THEN
649 cpabort("UPF CORE CHARGE RADIUS NOT AVAILABLE")
650 ELSE IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
651 cpabort("CNEO CORE CHARGE RADIUS NOT AVAILABLE")
652 ELSE
653 core_charge_radius = 0.0_dp
654 END IF
655 END IF
656 IF (PRESENT(core_charge)) THEN
657 IF (ASSOCIATED(qs_kind%all_potential)) THEN
658 CALL get_potential(potential=qs_kind%all_potential, &
659 zeff=core_charge)
660 ELSE IF (ASSOCIATED(qs_kind%gth_potential)) THEN
661 CALL get_potential(potential=qs_kind%gth_potential, &
662 zeff=core_charge)
663 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
664 CALL get_potential(potential=qs_kind%sgp_potential, &
665 zeff=core_charge)
666 ELSE IF (ASSOCIATED(qs_kind%upf_potential)) THEN
667 cpabort("UPF CORE CHARGE NOT AVAILABLE")
668 ELSE IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
669 CALL get_cneo_potential(potential=qs_kind%cneo_potential, &
670 zeff=core_charge)
671 ELSE
672 core_charge = 0.0_dp
673 END IF
674 END IF
675
676 IF (PRESENT(zatom)) THEN
677 ! Retrieve information on element
678 CALL get_ptable_info(qs_kind%element_symbol, ielement=zatom, found=found)
679 cpassert(found)
680 END IF
681
682 IF (PRESENT(zeff)) THEN
683 IF (ASSOCIATED(qs_kind%all_potential)) THEN
684 CALL get_potential(potential=qs_kind%all_potential, zeff=zeff)
685 ELSE IF (ASSOCIATED(qs_kind%gth_potential)) THEN
686 CALL get_potential(potential=qs_kind%gth_potential, zeff=zeff)
687 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
688 CALL get_potential(potential=qs_kind%sgp_potential, zeff=zeff)
689 ELSE IF (ASSOCIATED(qs_kind%upf_potential)) THEN
690 zeff = qs_kind%upf_potential%zion
691 ELSE IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
692 CALL get_cneo_potential(potential=qs_kind%cneo_potential, zeff=zeff)
693 ELSE
694 zeff = 0.0_dp
695 END IF
696 END IF
697
698 IF (PRESENT(covalent_radius)) covalent_radius = qs_kind%covalent_radius
699 IF (PRESENT(vdw_radius)) vdw_radius = qs_kind%vdw_radius
700
701 IF (PRESENT(paw_proj_set)) paw_proj_set => qs_kind%paw_proj_set
702 IF (PRESENT(paw_atom)) paw_atom = qs_kind%paw_atom
703 IF (PRESENT(gpw_type_forced)) gpw_type_forced = qs_kind%gpw_type_forced
704 IF (PRESENT(hard_radius)) hard_radius = qs_kind%hard_radius
705 IF (PRESENT(hard0_radius)) hard0_radius = qs_kind%hard0_radius
706 IF (PRESENT(max_rad_local)) max_rad_local = qs_kind%max_rad_local
707 IF (PRESENT(harmonics)) harmonics => qs_kind%harmonics
708 IF (PRESENT(max_s_harm)) THEN
709 IF (ASSOCIATED(qs_kind%harmonics)) THEN
710 max_s_harm = qs_kind%harmonics%max_s_harm
711 ELSE
712 max_s_harm = 0
713 END IF
714 END IF
715 IF (PRESENT(max_iso_not0)) THEN
716 IF (ASSOCIATED(qs_kind%harmonics)) THEN
717 max_iso_not0 = qs_kind%harmonics%max_iso_not0
718 ELSE
719 max_iso_not0 = 0
720 END IF
721 END IF
722 IF (PRESENT(grid_atom)) grid_atom => qs_kind%grid_atom
723 IF (PRESENT(ngrid_ang)) ngrid_ang = qs_kind%ngrid_ang
724 IF (PRESENT(ngrid_rad)) ngrid_rad = qs_kind%ngrid_rad
725 IF (PRESENT(lmax_rho0)) lmax_rho0 = qs_kind%lmax_rho0
726 IF (PRESENT(ghost)) ghost = qs_kind%ghost
727 IF (PRESENT(monovalent)) monovalent = qs_kind%monovalent
728 IF (PRESENT(floating)) floating = qs_kind%floating
729 IF (PRESENT(dft_plus_u_atom)) dft_plus_u_atom = ASSOCIATED(qs_kind%dft_plus_u)
730 IF (PRESENT(do_mtlr)) THEN
731 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
732 do_mtlr = qs_kind%dft_plus_u%do_mtlr
733 ELSE
734 do_mtlr = .false.
735 END IF
736 END IF
737 IF (PRESENT(l_of_dft_plus_u)) THEN
738 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
739 l_of_dft_plus_u = qs_kind%dft_plus_u%l
740 ELSE
741 l_of_dft_plus_u = -1
742 END IF
743 END IF
744 IF (PRESENT(n_of_dft_plus_u)) THEN
745 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
746 n_of_dft_plus_u = qs_kind%dft_plus_u%n
747 ELSE
748 n_of_dft_plus_u = -1
749 END IF
750 END IF
751 IF (PRESENT(u_minus_j)) THEN
752 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
753 u_minus_j = qs_kind%dft_plus_u%u_minus_j
754 ELSE
755 u_minus_j = 0.0_dp
756 END IF
757 END IF
758 IF (PRESENT(u_minus_j_target)) THEN
759 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
760 u_minus_j_target = qs_kind%dft_plus_u%u_minus_j_target
761 ELSE
762 u_minus_j_target = 0.0_dp
763 END IF
764 END IF
765 IF (PRESENT(hund_j)) THEN
766 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
767 hund_j = qs_kind%dft_plus_u%hund_j
768 ELSE
769 hund_j = 0.0_dp
770 END IF
771 END IF
772 IF (PRESENT(u_of_dft_plus_u)) THEN
773 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
774 u_of_dft_plus_u = qs_kind%dft_plus_u%U
775 ELSE
776 u_of_dft_plus_u = 0.0_dp
777 END IF
778 END IF
779 IF (PRESENT(j_of_dft_plus_u)) THEN
780 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
781 j_of_dft_plus_u = qs_kind%dft_plus_u%J
782 ELSE
783 j_of_dft_plus_u = 0.0_dp
784 END IF
785 END IF
786 IF (PRESENT(alpha_of_dft_plus_u)) THEN
787 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
788 alpha_of_dft_plus_u = qs_kind%dft_plus_u%alpha
789 ELSE
790 alpha_of_dft_plus_u = 0.0_dp
791 END IF
792 END IF
793 IF (PRESENT(beta_of_dft_plus_u)) THEN
794 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
795 beta_of_dft_plus_u = qs_kind%dft_plus_u%beta
796 ELSE
797 beta_of_dft_plus_u = 0.0_dp
798 END IF
799 END IF
800 IF (PRESENT(j0_of_dft_plus_u)) THEN
801 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
802 j0_of_dft_plus_u = qs_kind%dft_plus_u%J0
803 ELSE
804 j0_of_dft_plus_u = 0.0_dp
805 END IF
806 END IF
807 IF (PRESENT(occupation_of_dft_plus_u)) THEN
808 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
809 occupation_of_dft_plus_u = qs_kind%dft_plus_u%occupation
810 ELSE
811 occupation_of_dft_plus_u = -1.0_dp
812 END IF
813 END IF
814
815 IF (PRESENT(init_u_ramping_each_scf)) THEN
816 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
817 init_u_ramping_each_scf = qs_kind%dft_plus_u%init_u_ramping_each_scf
818 ELSE
819 init_u_ramping_each_scf = .false.
820 END IF
821 END IF
822 IF (PRESENT(u_ramping)) THEN
823 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
824 u_ramping = qs_kind%dft_plus_u%u_ramping
825 ELSE
826 u_ramping = 0.0_dp
827 END IF
828 END IF
829 IF (PRESENT(eps_u_ramping)) THEN
830 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
831 eps_u_ramping = qs_kind%dft_plus_u%eps_u_ramping
832 ELSE
833 eps_u_ramping = 1.0e-5_dp
834 END IF
835 END IF
836 IF (PRESENT(lr_atom)) THEN
837 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
838 lr_atom = qs_kind%dft_plus_u%lr_atom
839 ELSE
840 lr_atom = -1
841 END IF
842 END IF
843 IF (PRESENT(u_j_loop)) THEN
844 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
845 u_j_loop = qs_kind%dft_plus_u%u_j_loop
846 ELSE
847 u_j_loop = .false.
848 END IF
849 END IF
850 IF (PRESENT(proj_shell_charge)) THEN
851 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
852 proj_shell_charge = qs_kind%dft_plus_u%proj_shell_charge
853 ELSE
854 proj_shell_charge = 0.0_dp
855 END IF
856 END IF
857 IF (PRESENT(nelec)) THEN
858 NULLIFY (nelec)
859 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
860 IF (ASSOCIATED(qs_kind%dft_plus_u%nelec)) THEN
861 nelec => qs_kind%dft_plus_u%nelec
862 END IF
863 END IF
864 END IF
865 IF (PRESENT(orbitals)) THEN
866 NULLIFY (orbitals)
867 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
868 IF (ASSOCIATED(qs_kind%dft_plus_u%orbitals)) THEN
869 orbitals => qs_kind%dft_plus_u%orbitals
870 END IF
871 END IF
872 END IF
873 IF (PRESENT(eps_scf)) THEN
874 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
875 eps_scf = qs_kind%dft_plus_u%eps_scf
876 ELSE
877 eps_scf = 1.0e30_dp
878 END IF
879 END IF
880 IF (PRESENT(max_scf)) THEN
881 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
882 max_scf = qs_kind%dft_plus_u%max_scf
883 ELSE
884 max_scf = -1
885 END IF
886 END IF
887 IF (PRESENT(smear)) THEN
888 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
889 smear = qs_kind%dft_plus_u%smear
890 ELSE
891 smear = .false.
892 END IF
893 END IF
894 IF (PRESENT(dispersion)) dispersion => qs_kind%dispersion
895 IF (PRESENT(bs_occupation)) bs_occupation = qs_kind%bs_occupation
896 IF (PRESENT(addel)) addel => qs_kind%addel
897 IF (PRESENT(laddel)) laddel => qs_kind%laddel
898 IF (PRESENT(naddel)) naddel => qs_kind%naddel
899
900 IF (PRESENT(magnetization)) magnetization = qs_kind%magnetization
901
902 IF (PRESENT(no_optimize)) no_optimize = qs_kind%no_optimize
903
904 IF (PRESENT(reltmat)) reltmat => qs_kind%reltmat
905
906 IF (PRESENT(ao_coef)) THEN
907 NULLIFY (ao_coef)
908 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
909 IF (ASSOCIATED(qs_kind%dft_plus_u%ao_coef)) THEN
910 ao_coef => qs_kind%dft_plus_u%ao_coef
911 END IF
912 END IF
913 END IF
914
915 IF (PRESENT(mao)) mao = qs_kind%mao
916
917 IF (PRESENT(lmax_dftb)) lmax_dftb = qs_kind%lmax_dftb
918
919 IF (PRESENT(pao_basis_size)) pao_basis_size = qs_kind%pao_basis_size
920 IF (PRESENT(pao_model_file)) pao_model_file = qs_kind%pao_model_file
921 IF (PRESENT(pao_potentials)) pao_potentials => qs_kind%pao_potentials
922 IF (PRESENT(pao_descriptors)) pao_descriptors => qs_kind%pao_descriptors
923 END SUBROUTINE get_qs_kind
924
925! **************************************************************************************************
926!> \brief Get attributes of an atomic kind set.
927!> \param qs_kind_set ...
928!> \param all_potential_present ...
929!> \param tnadd_potential_present ...
930!> \param gth_potential_present ...
931!> \param sgp_potential_present ...
932!> \param paw_atom_present ...
933!> \param dft_plus_u_atom_present ...
934!> \param maxcgf ...
935!> \param maxsgf ...
936!> \param maxco ...
937!> \param maxco_proj ...
938!> \param maxgtops ...
939!> \param maxlgto ...
940!> \param maxlprj ...
941!> \param maxnset ...
942!> \param maxsgf_set ...
943!> \param ncgf ...
944!> \param npgf ...
945!> \param nset ...
946!> \param nsgf ...
947!> \param nshell ...
948!> \param maxpol ...
949!> \param maxlppl ...
950!> \param maxlppnl ...
951!> \param maxppnl ...
952!> \param nelectron ...
953!> \param maxder ...
954!> \param max_ngrid_rad ...
955!> \param max_sph_harm ...
956!> \param maxg_iso_not0 ...
957!> \param lmax_rho0 ...
958!> \param basis_rcut ...
959!> \param do_mtlr_present ...
960!> \param basis_type ...
961!> \param total_zeff_corr ... [SGh]
962!> \param npgf_seg total number of primitive GTOs in "segmented contraction format"
963!> \param cneo_potential_present ...
964!> \param nkind_q ...
965!> \param natom_q ...
966! **************************************************************************************************
967 SUBROUTINE get_qs_kind_set(qs_kind_set, &
968 all_potential_present, tnadd_potential_present, gth_potential_present, &
969 sgp_potential_present, paw_atom_present, dft_plus_u_atom_present, &
970 maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, maxlprj, maxnset, maxsgf_set, &
971 ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, maxppnl, &
972 nelectron, maxder, max_ngrid_rad, max_sph_harm, maxg_iso_not0, lmax_rho0, &
973 basis_rcut, do_mtlr_present, &
974 basis_type, total_zeff_corr, npgf_seg, &
975 cneo_potential_present, nkind_q, natom_q)
976
977 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
978 LOGICAL, INTENT(OUT), OPTIONAL :: all_potential_present, tnadd_potential_present, &
979 gth_potential_present, sgp_potential_present, paw_atom_present, dft_plus_u_atom_present
980 INTEGER, INTENT(OUT), OPTIONAL :: maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, &
981 maxlprj, maxnset, maxsgf_set, ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, &
982 maxppnl, nelectron
983 INTEGER, INTENT(IN), OPTIONAL :: maxder
984 INTEGER, INTENT(OUT), OPTIONAL :: max_ngrid_rad, max_sph_harm, &
985 maxg_iso_not0, lmax_rho0
986 REAL(kind=dp), INTENT(OUT), OPTIONAL :: basis_rcut
987 LOGICAL, INTENT(OUT), OPTIONAL :: do_mtlr_present
988 CHARACTER(len=*), OPTIONAL :: basis_type
989 REAL(kind=dp), INTENT(OUT), OPTIONAL :: total_zeff_corr
990 INTEGER, INTENT(OUT), OPTIONAL :: npgf_seg
991 LOGICAL, INTENT(OUT), OPTIONAL :: cneo_potential_present
992 INTEGER, INTENT(OUT), OPTIONAL :: nkind_q, natom_q
993
994 CHARACTER(len=default_string_length) :: my_basis_type
995 INTEGER :: ikind, imax, lmax_rho0_kind, &
996 max_iso_not0, max_s_harm, n, &
997 ngrid_rad, nkind, nrloc(10), &
998 nrpot(1:15, 0:10)
999 LOGICAL :: dft_plus_u_atom, do_mtlr, &
1000 ecp_semi_local, paw_atom
1001 REAL(kind=dp) :: brcut, zeff, zeff_correction
1002 TYPE(all_potential_type), POINTER :: all_potential
1003 TYPE(cneo_potential_type), POINTER :: cneo_potential
1004 TYPE(gth_potential_type), POINTER :: gth_potential
1005 TYPE(gto_basis_set_type), POINTER :: tmp_basis_set
1006 TYPE(local_potential_type), POINTER :: tnadd_potential
1007 TYPE(paw_proj_set_type), POINTER :: paw_proj_set
1008 TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter
1009 TYPE(qs_kind_type), POINTER :: qs_kind
1010 TYPE(sgp_potential_type), POINTER :: sgp_potential
1011
1012 IF (PRESENT(basis_type)) THEN
1013 my_basis_type = basis_type
1014 ELSE
1015 my_basis_type = "ORB"
1016 END IF
1017
1018 IF (ASSOCIATED(qs_kind_set)) THEN
1019
1020 IF (PRESENT(maxcgf)) maxcgf = 0
1021 IF (PRESENT(maxco)) maxco = 0
1022 IF (PRESENT(maxco_proj)) maxco_proj = 0
1023 IF (PRESENT(maxg_iso_not0)) maxg_iso_not0 = 0
1024 IF (PRESENT(maxgtops)) maxgtops = 0
1025 IF (PRESENT(maxlgto)) maxlgto = -1
1026 IF (PRESENT(maxlppl)) maxlppl = -1
1027 IF (PRESENT(maxlppnl)) maxlppnl = -1
1028 IF (PRESENT(maxpol)) maxpol = -1
1029 IF (PRESENT(maxlprj)) maxlprj = -1
1030 IF (PRESENT(maxnset)) maxnset = 0
1031 IF (PRESENT(maxppnl)) maxppnl = 0
1032 IF (PRESENT(maxsgf)) maxsgf = 0
1033 IF (PRESENT(maxsgf_set)) maxsgf_set = 0
1034 IF (PRESENT(ncgf)) ncgf = 0
1035 IF (PRESENT(nelectron)) nelectron = 0
1036 IF (PRESENT(npgf)) npgf = 0
1037 IF (PRESENT(nset)) nset = 0
1038 IF (PRESENT(nsgf)) nsgf = 0
1039 IF (PRESENT(nshell)) nshell = 0
1040 IF (PRESENT(all_potential_present)) all_potential_present = .false.
1041 IF (PRESENT(tnadd_potential_present)) tnadd_potential_present = .false.
1042 IF (PRESENT(gth_potential_present)) gth_potential_present = .false.
1043 IF (PRESENT(sgp_potential_present)) sgp_potential_present = .false.
1044 IF (PRESENT(cneo_potential_present)) cneo_potential_present = .false.
1045 IF (PRESENT(nkind_q)) nkind_q = 0
1046 IF (PRESENT(natom_q)) natom_q = 0
1047 IF (PRESENT(paw_atom_present)) paw_atom_present = .false.
1048 IF (PRESENT(max_ngrid_rad)) max_ngrid_rad = 0
1049 IF (PRESENT(max_sph_harm)) max_sph_harm = 0
1050 IF (PRESENT(lmax_rho0)) lmax_rho0 = 0
1051 IF (PRESENT(basis_rcut)) basis_rcut = 0.0_dp
1052 IF (PRESENT(total_zeff_corr)) total_zeff_corr = 0.0_dp
1053 IF (PRESENT(npgf_seg)) npgf_seg = 0
1054 IF (PRESENT(do_mtlr_present)) do_mtlr_present = .false.
1055
1056 nkind = SIZE(qs_kind_set)
1057 DO ikind = 1, nkind
1058 qs_kind => qs_kind_set(ikind)
1059 CALL get_qs_kind(qs_kind=qs_kind, &
1060 all_potential=all_potential, &
1061 tnadd_potential=tnadd_potential, &
1062 gth_potential=gth_potential, &
1063 sgp_potential=sgp_potential, &
1064 cneo_potential=cneo_potential, &
1065 paw_proj_set=paw_proj_set, &
1066 dftb_parameter=dftb_parameter, &
1067 ngrid_rad=ngrid_rad, &
1068 max_s_harm=max_s_harm, &
1069 max_iso_not0=max_iso_not0, &
1070 paw_atom=paw_atom, &
1071 dft_plus_u_atom=dft_plus_u_atom, &
1072 do_mtlr=do_mtlr, &
1073 lmax_rho0=lmax_rho0_kind)
1074
1075 IF (PRESENT(maxlppl) .AND. ASSOCIATED(gth_potential)) THEN
1076 CALL get_potential(potential=gth_potential, nexp_ppl=n)
1077 maxlppl = max(maxlppl, 2*(n - 1))
1078 ELSE IF (PRESENT(maxlppl) .AND. ASSOCIATED(sgp_potential)) THEN
1079 CALL get_potential(potential=sgp_potential, nrloc=nrloc, ecp_semi_local=ecp_semi_local)
1080 n = maxval(nrloc) - 2
1081 maxlppl = max(maxlppl, 2*(n - 1))
1082 IF (ecp_semi_local) THEN
1083 CALL get_potential(potential=sgp_potential, sl_lmax=imax, nrpot=nrpot)
1084 n = maxval(nrpot) - 2
1085 n = 2*(n - 1) + imax
1086 maxlppl = max(maxlppl, n)
1087 END IF
1088 END IF
1089
1090 IF (PRESENT(maxlppnl) .AND. ASSOCIATED(gth_potential)) THEN
1091 CALL get_potential(potential=gth_potential, lprj_ppnl_max=imax)
1092 maxlppnl = max(maxlppnl, imax)
1093 ELSE IF (PRESENT(maxlppnl) .AND. ASSOCIATED(sgp_potential)) THEN
1094 CALL get_potential(potential=sgp_potential, lmax=imax)
1095 maxlppnl = max(maxlppnl, imax)
1096 END IF
1097
1098 IF (PRESENT(maxpol) .AND. ASSOCIATED(tnadd_potential)) THEN
1099 CALL get_potential(potential=tnadd_potential, npol=n)
1100 maxpol = max(maxpol, 2*(n - 1))
1101 END IF
1102
1103 IF (PRESENT(maxco_proj) .AND. ASSOCIATED(paw_proj_set)) THEN
1104 CALL get_paw_proj_set(paw_proj_set=paw_proj_set, ncgauprj=imax)
1105 maxco_proj = max(maxco_proj, imax)
1106 END IF
1107
1108 IF (PRESENT(maxlprj) .AND. ASSOCIATED(paw_proj_set)) THEN
1109 CALL get_paw_proj_set(paw_proj_set=paw_proj_set, maxl=imax)
1110 maxlprj = max(maxlprj, imax)
1111 END IF
1112
1113 IF (PRESENT(maxppnl) .AND. ASSOCIATED(gth_potential)) THEN
1114 CALL get_potential(potential=gth_potential, nppnl=imax)
1115 maxppnl = max(maxppnl, imax)
1116 ELSE IF (PRESENT(maxppnl) .AND. ASSOCIATED(sgp_potential)) THEN
1117 CALL get_potential(potential=sgp_potential, nppnl=imax)
1118 maxppnl = max(maxppnl, imax)
1119 END IF
1120
1121 IF (my_basis_type(1:3) == "NUC" .AND. .NOT. ASSOCIATED(cneo_potential)) THEN
1122 NULLIFY (tmp_basis_set)
1123 ELSE
1124 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis_set, &
1125 basis_type=my_basis_type)
1126 END IF
1127
1128 IF (PRESENT(maxcgf)) THEN
1129 IF (ASSOCIATED(tmp_basis_set)) THEN
1130 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, ncgf=imax)
1131 maxcgf = max(maxcgf, imax)
1132 ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN
1133 CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, lmax=imax)
1134 imax = ((imax + 1)*(imax + 2)*(imax + 3))/6
1135 maxcgf = max(maxcgf, imax)
1136 END IF
1137 END IF
1138
1139 IF (PRESENT(maxco)) THEN
1140 IF (ASSOCIATED(tmp_basis_set)) THEN
1141 IF (PRESENT(maxder)) THEN
1142 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, &
1143 maxco=imax, maxder=maxder)
1144 ELSE
1145 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, maxco=imax)
1146 END IF
1147 maxco = max(maxco, imax)
1148 END IF
1149 IF (ASSOCIATED(gth_potential)) THEN
1150 CALL get_potential(potential=gth_potential, lprj_ppnl_max=imax)
1151 maxco = max(maxco, ncoset(imax))
1152 END IF
1153 IF (ASSOCIATED(sgp_potential)) THEN
1154 CALL get_potential(potential=sgp_potential, lmax=imax)
1155 maxco = max(maxco, ncoset(imax))
1156 CALL get_potential(potential=sgp_potential, sl_lmax=imax)
1157 maxco = max(maxco, ncoset(imax))
1158 END IF
1159 END IF
1160
1161 IF (PRESENT(maxgtops)) THEN
1162 IF (ASSOCIATED(tmp_basis_set)) THEN
1163 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, maxso=imax, nset=n)
1164 maxgtops = max(maxgtops, n*imax)
1165 END IF
1166 END IF
1167
1168 IF (PRESENT(maxlgto)) THEN
1169 IF (ASSOCIATED(tmp_basis_set)) THEN
1170 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, maxl=imax)
1171 maxlgto = max(maxlgto, imax)
1172 ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN
1173 CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, lmax=imax)
1174 maxlgto = max(maxlgto, imax)
1175 END IF
1176 END IF
1177
1178 IF (PRESENT(maxnset)) THEN
1179 IF (ASSOCIATED(tmp_basis_set)) THEN
1180 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nset=n)
1181 maxnset = max(maxnset, n)
1182 END IF
1183 END IF
1184
1185 IF (PRESENT(maxsgf)) THEN
1186 IF (ASSOCIATED(tmp_basis_set)) THEN
1187 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nsgf=imax)
1188 maxsgf = max(maxsgf, imax)
1189 END IF
1190 END IF
1191
1192 IF (PRESENT(maxsgf_set)) THEN
1193 IF (ASSOCIATED(tmp_basis_set)) THEN
1194 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, maxsgf_set=imax)
1195 maxsgf_set = max(maxsgf_set, imax)
1196 END IF
1197 END IF
1198
1199 IF (PRESENT(ncgf)) THEN
1200 IF (ASSOCIATED(tmp_basis_set)) THEN
1201 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, ncgf=n)
1202 ncgf = ncgf + n*qs_kind_set(ikind)%natom
1203 ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN
1204 CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, lmax=imax)
1205 n = ((imax + 1)*(imax + 2)*(imax + 3))/6
1206 ncgf = ncgf + n*qs_kind_set(ikind)%natom
1207 END IF
1208 END IF
1209
1210 IF (PRESENT(npgf)) THEN
1211 IF (ASSOCIATED(tmp_basis_set)) THEN
1212 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, npgf_sum=n)
1213 npgf = npgf + n*qs_kind_set(ikind)%natom
1214 END IF
1215 END IF
1216
1217 IF (PRESENT(nset)) THEN
1218 IF (ASSOCIATED(tmp_basis_set)) THEN
1219 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nset=n)
1220 nset = nset + n*qs_kind_set(ikind)%natom
1221 END IF
1222 END IF
1223
1224 IF (PRESENT(nsgf)) THEN
1225 IF (ASSOCIATED(tmp_basis_set)) THEN
1226 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nsgf=n)
1227 nsgf = nsgf + n*qs_kind_set(ikind)%natom
1228 ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN
1229 CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, natorb=n)
1230 nsgf = nsgf + n*qs_kind_set(ikind)%natom
1231 END IF
1232 END IF
1233
1234 IF (PRESENT(nshell)) THEN
1235 IF (ASSOCIATED(tmp_basis_set)) THEN
1236 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, nshell_sum=n)
1237 nshell = nshell + n*qs_kind_set(ikind)%natom
1238 ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN
1239 CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, lmax=n)
1240 nshell = nshell + (n + 1)*qs_kind_set(ikind)%natom
1241 END IF
1242 END IF
1243
1244 IF (PRESENT(nelectron)) THEN
1245 IF (ASSOCIATED(qs_kind%all_potential)) THEN
1246 CALL get_potential(potential=qs_kind%all_potential, &
1247 zeff=zeff, zeff_correction=zeff_correction)
1248 ELSE IF (ASSOCIATED(qs_kind%gth_potential)) THEN
1249 CALL get_potential(potential=qs_kind%gth_potential, &
1250 zeff=zeff, zeff_correction=zeff_correction)
1251 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
1252 CALL get_potential(potential=qs_kind%sgp_potential, &
1253 zeff=zeff, zeff_correction=zeff_correction)
1254 ELSE IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
1255 CALL get_cneo_potential(potential=qs_kind%cneo_potential, &
1256 zeff=zeff)
1257 zeff_correction = 0.0_dp
1258 ELSE
1259 zeff = 0.0_dp
1260 zeff_correction = 0.0_dp
1261 END IF
1262 nelectron = nelectron + qs_kind_set(ikind)%natom*nint(zeff - zeff_correction)
1263 END IF
1264
1265 IF (PRESENT(basis_rcut)) THEN
1266 IF (ASSOCIATED(tmp_basis_set)) THEN
1267 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, kind_radius=brcut)
1268 basis_rcut = max(basis_rcut, brcut)
1269 ELSE IF (ASSOCIATED(qs_kind%dftb_parameter)) THEN
1270 CALL get_dftb_atom_param(dftb_parameter=dftb_parameter, cutoff=brcut)
1271 basis_rcut = max(basis_rcut, brcut)
1272 END IF
1273 END IF
1274
1275 IF (PRESENT(total_zeff_corr)) THEN
1276 IF (ASSOCIATED(qs_kind%all_potential)) THEN
1277 CALL get_potential(potential=qs_kind%all_potential, &
1278 zeff=zeff, zeff_correction=zeff_correction)
1279 ELSE IF (ASSOCIATED(qs_kind%gth_potential)) THEN
1280 CALL get_potential(potential=qs_kind%gth_potential, &
1281 zeff=zeff, zeff_correction=zeff_correction)
1282 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
1283 CALL get_potential(potential=qs_kind%sgp_potential, &
1284 zeff=zeff, zeff_correction=zeff_correction)
1285 ELSE
1286 zeff = 0.0_dp
1287 zeff_correction = 0.0_dp
1288 END IF
1289 total_zeff_corr = total_zeff_corr + qs_kind_set(ikind)%natom*zeff_correction
1290 END IF
1291
1292 IF (PRESENT(all_potential_present)) THEN
1293 IF (ASSOCIATED(all_potential)) THEN
1294 all_potential_present = .true.
1295 END IF
1296 END IF
1297
1298 IF (PRESENT(tnadd_potential_present)) THEN
1299 IF (ASSOCIATED(tnadd_potential)) THEN
1300 tnadd_potential_present = .true.
1301 END IF
1302 END IF
1303
1304 IF (PRESENT(gth_potential_present)) THEN
1305 IF (ASSOCIATED(gth_potential)) THEN
1306 gth_potential_present = .true.
1307 END IF
1308 END IF
1309
1310 IF (PRESENT(sgp_potential_present)) THEN
1311 IF (ASSOCIATED(sgp_potential)) THEN
1312 sgp_potential_present = .true.
1313 END IF
1314 END IF
1315
1316 IF (PRESENT(cneo_potential_present)) THEN
1317 IF (ASSOCIATED(cneo_potential)) THEN
1318 cneo_potential_present = .true.
1319 END IF
1320 END IF
1321
1322 IF (PRESENT(nkind_q)) THEN
1323 IF (ASSOCIATED(cneo_potential)) THEN
1324 nkind_q = nkind_q + 1
1325 END IF
1326 END IF
1327
1328 IF (PRESENT(natom_q)) THEN
1329 IF (ASSOCIATED(cneo_potential)) THEN
1330 natom_q = natom_q + qs_kind_set(ikind)%natom
1331 END IF
1332 END IF
1333
1334 IF (PRESENT(paw_atom_present)) THEN
1335 IF (paw_atom) THEN
1336 paw_atom_present = .true.
1337 END IF
1338 END IF
1339
1340 IF (PRESENT(dft_plus_u_atom_present)) THEN
1341 IF (dft_plus_u_atom) THEN
1342 dft_plus_u_atom_present = .true.
1343 END IF
1344 END IF
1345
1346 IF (PRESENT(do_mtlr_present)) THEN
1347 IF (do_mtlr) THEN
1348 do_mtlr_present = .true.
1349 END IF
1350 END IF
1351
1352 IF (PRESENT(max_ngrid_rad)) THEN
1353 max_ngrid_rad = max(max_ngrid_rad, ngrid_rad)
1354 END IF
1355
1356 IF (PRESENT(max_sph_harm)) THEN
1357 max_sph_harm = max(max_sph_harm, max_s_harm)
1358 END IF
1359
1360 IF (PRESENT(maxg_iso_not0)) THEN
1361 maxg_iso_not0 = max(maxg_iso_not0, max_iso_not0)
1362 END IF
1363
1364 IF (PRESENT(lmax_rho0)) THEN
1365 lmax_rho0 = max(lmax_rho0, lmax_rho0_kind)
1366 END IF
1367
1368 IF (PRESENT(npgf_seg)) THEN
1369 IF (ASSOCIATED(tmp_basis_set)) THEN
1370 CALL get_gto_basis_set(gto_basis_set=tmp_basis_set, npgf_seg_sum=n)
1371 npgf_seg = npgf_seg + n*qs_kind_set(ikind)%natom
1372 END IF
1373 END IF
1374
1375 END DO
1376 ELSE
1377 cpabort("The pointer qs_kind_set is not associated")
1378 END IF
1379
1380 END SUBROUTINE get_qs_kind_set
1381
1382! **************************************************************************************************
1383!> \brief Initialise an atomic kind data set.
1384!> \param qs_kind ...
1385!> \author Creation (11.01.2002,MK)
1386!> 20.09.2002 adapted for pol/kg use, gtb
1387! **************************************************************************************************
1388 SUBROUTINE init_qs_kind(qs_kind)
1389 TYPE(qs_kind_type), POINTER :: qs_kind
1390
1391 CHARACTER(len=*), PARAMETER :: routinen = 'init_qs_kind'
1392
1393 CHARACTER(LEN=default_string_length) :: basis_type
1394 INTEGER :: handle, i
1395 TYPE(gto_basis_set_type), POINTER :: tmp_basis_set
1396
1397 CALL timeset(routinen, handle)
1398
1399 cpassert(ASSOCIATED(qs_kind))
1400
1401 IF (ASSOCIATED(qs_kind%gth_potential)) THEN
1402 CALL init_potential(qs_kind%gth_potential)
1403 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
1404 CALL init_potential(qs_kind%sgp_potential)
1405 END IF
1406
1407 DO i = 1, SIZE(qs_kind%basis_sets, 1)
1408 NULLIFY (tmp_basis_set)
1409 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis_set, &
1410 inumbas=i, basis_type=basis_type)
1411 IF (basis_type == "") cycle
1412 IF (basis_type == "AUX") THEN
1413 IF (tmp_basis_set%norm_type < 0) tmp_basis_set%norm_type = 1
1414 CALL init_aux_basis_set(tmp_basis_set)
1415 ELSE
1416 IF (tmp_basis_set%norm_type < 0) tmp_basis_set%norm_type = 2
1417 CALL init_orb_basis_set(tmp_basis_set)
1418 END IF
1419 END DO
1420
1421 CALL timestop(handle)
1422
1423 END SUBROUTINE init_qs_kind
1424
1425! **************************************************************************************************
1426!> \brief Initialise an atomic kind set data set.
1427!> \param qs_kind_set ...
1428!> \author - Creation (17.01.2002,MK)
1429!> - 20.09.2002 para_env passed (gt)
1430! **************************************************************************************************
1431 SUBROUTINE init_qs_kind_set(qs_kind_set)
1432
1433 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1434
1435 CHARACTER(len=*), PARAMETER :: routinen = 'init_qs_kind_set'
1436
1437 INTEGER :: handle, ikind
1438 TYPE(qs_kind_type), POINTER :: qs_kind
1439
1440 CALL timeset(routinen, handle)
1441
1442 IF (.NOT. ASSOCIATED(qs_kind_set)) THEN
1443 cpabort("init_qs_kind_set: The pointer qs_kind_set is not associated")
1444 END IF
1445
1446 DO ikind = 1, SIZE(qs_kind_set)
1447 qs_kind => qs_kind_set(ikind)
1448 CALL init_qs_kind(qs_kind)
1449 END DO
1450
1451 CALL timestop(handle)
1452
1453 END SUBROUTINE init_qs_kind_set
1454
1455! **************************************************************************************************
1456!> \brief Resolve the active model's pseudopotential GAPW representation.
1457!> \param force_env_section ...
1458!> \return CP2K default when no GauXC model replaces the XC functional
1459! **************************************************************************************************
1460 FUNCTION skala_gapw_representation_from_input(force_env_section) RESULT(representation)
1461 TYPE(section_vals_type), POINTER :: force_env_section
1462 INTEGER :: representation
1463
1464 CHARACTER(LEN=default_path_length) :: model_key, model_name
1465 CHARACTER(LEN=default_string_length) :: functional_key, functional_name
1466 INTEGER :: ifun
1467 TYPE(section_vals_type), POINTER :: functional, functionals
1468
1469 representation = skala_gapw_cp2k_default
1470 functionals => section_vals_get_subs_vals(force_env_section, "DFT%XC%XC_FUNCTIONAL")
1471 IF (.NOT. ASSOCIATED(functionals)) RETURN
1472
1473 ifun = 0
1474 DO
1475 ifun = ifun + 1
1476 functional => section_vals_get_subs_vals2(functionals, i_section=ifun)
1477 IF (.NOT. ASSOCIATED(functional)) EXIT
1478 IF (functional%section%name /= "GAUXC") cycle
1479
1480 CALL section_vals_val_get(functional, "MODEL", c_val=model_name)
1481 CALL section_vals_val_get(functional, "FUNCTIONAL", c_val=functional_name)
1482 model_key = adjustl(model_name)
1483 functional_key = adjustl(functional_name)
1484 CALL uppercase(model_key)
1485 CALL uppercase(functional_key)
1486 IF (trim(model_key) /= "" .AND. trim(model_key) /= "NONE" .AND. &
1487 trim(model_key) /= trim(functional_key)) THEN
1488 CALL section_vals_val_get(functional, "PSEUDOPOTENTIAL_GAPW_REPRESENTATION", &
1489 i_val=representation)
1490 END IF
1491 RETURN
1492 END DO
1493
1494 END FUNCTION skala_gapw_representation_from_input
1495
1496! **************************************************************************************************
1497!> \brief ...
1498!> \param qs_kind_set ...
1499!> \param qs_control ...
1500!> \param force_env_section ...
1501!> \param modify_qs_control whether the qs_control should be modified
1502! **************************************************************************************************
1503 SUBROUTINE init_gapw_basis_set(qs_kind_set, qs_control, force_env_section, modify_qs_control)
1504
1505 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1506 TYPE(qs_control_type), POINTER :: qs_control
1507 TYPE(section_vals_type), POINTER :: force_env_section
1508 LOGICAL, OPTIONAL :: modify_qs_control
1509
1510 CHARACTER(LEN=default_string_length) :: bsname
1511 INTEGER :: bas1c, ikind, ilevel, nkind, &
1512 representation
1513 LOGICAL :: effective_force_paw, effective_gpw, gpw, &
1514 has_pseudopotential, my_mod_control, &
1515 paw_atom
1516 REAL(dp) :: max_rad_local_type, rc
1517 TYPE(gth_potential_type), POINTER :: gth_potential
1518 TYPE(gto_basis_set_type), POINTER :: basis_1c, orb_basis, soft_basis
1519 TYPE(paw_proj_set_type), POINTER :: paw_proj
1520 TYPE(qs_kind_type), POINTER :: qs_kind
1521 TYPE(sgp_potential_type), POINTER :: sgp_potential
1522
1523 my_mod_control = .true.
1524 IF (PRESENT(modify_qs_control)) THEN
1525 my_mod_control = modify_qs_control
1526 END IF
1527 representation = skala_gapw_representation_from_input(force_env_section)
1528
1529 IF (ASSOCIATED(qs_kind_set)) THEN
1530
1531 IF (my_mod_control) qs_control%gapw_control%non_paw_atoms = .false.
1532 nkind = SIZE(qs_kind_set)
1533
1534 DO ikind = 1, nkind
1535
1536 qs_kind => qs_kind_set(ikind)
1537
1538 CALL get_qs_kind(qs_kind=qs_kind, basis_set=orb_basis)
1539 NULLIFY (gth_potential, sgp_potential)
1540 CALL get_qs_kind(qs_kind=qs_kind, hard_radius=rc, &
1541 max_rad_local=max_rad_local_type, gpw_type_forced=gpw, &
1542 gth_potential=gth_potential, sgp_potential=sgp_potential)
1543
1544 has_pseudopotential = ASSOCIATED(gth_potential) .OR. ASSOCIATED(sgp_potential)
1545 effective_gpw = gpw
1546 effective_force_paw = qs_control%gapw_control%force_paw .OR. &
1547 ASSOCIATED(qs_kind%cneo_potential)
1548 IF (has_pseudopotential) THEN
1549 SELECT CASE (representation)
1550 CASE (skala_gapw_direct_valence)
1551 effective_gpw = .true.
1552 effective_force_paw = .false.
1553 CASE (skala_gapw_paw_one_center, skala_gapw_paw_one_center_split)
1554 effective_gpw = .false.
1555 effective_force_paw = .true.
1556 CASE (skala_gapw_cp2k_default)
1557 CONTINUE
1558 CASE DEFAULT
1559 cpabort("Unknown GAUXC PSEUDOPOTENTIAL_GAPW_REPRESENTATION value")
1560 END SELECT
1561 IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
1562 effective_gpw = .false.
1563 effective_force_paw = .true.
1564 END IF
1565 qs_kind%gpw_type_forced = effective_gpw
1566 END IF
1567
1568 NULLIFY (soft_basis)
1569 CALL allocate_gto_basis_set(soft_basis)
1570 ! Quantum nuclear wave functions are very localized. Even if soft
1571 ! electronic basis is used, the atomic kind needs PAW treatment
1572 ! because the local Hartree potential is needed.
1573 CALL create_soft_basis(orb_basis, soft_basis, &
1574 qs_control%gapw_control%eps_fit, rc, paw_atom, &
1575 effective_force_paw, effective_gpw)
1576 CALL add_basis_set_to_container(qs_kind%basis_sets, soft_basis, "ORB_SOFT")
1577 CALL set_qs_kind(qs_kind=qs_kind, paw_atom=paw_atom)
1578
1579 bas1c = qs_control%gapw_control%basis_1c
1580 NULLIFY (basis_1c)
1581 SELECT CASE (bas1c)
1582 CASE (gapw_1c_orb)
1583 ilevel = 0
1584 CASE (gapw_1c_small)
1585 ilevel = 1
1586 CASE (gapw_1c_medium)
1587 ilevel = 2
1588 CASE (gapw_1c_large)
1589 ilevel = 3
1590 CASE (gapw_1c_very_large)
1591 ilevel = 4
1592 CASE DEFAULT
1593 cpabort("basis_1c type")
1594 END SELECT
1595 CALL remove_basis_from_container(qs_kind%basis_sets, basis_type="GAPW_1C")
1596 CALL create_1c_basis(orb_basis, soft_basis, basis_1c, ilevel)
1597 CALL get_gto_basis_set(gto_basis_set=orb_basis, name=bsname)
1598 basis_1c%name = trim(bsname)//"_1c"
1599 CALL add_basis_set_to_container(qs_kind%basis_sets, basis_1c, "GAPW_1C")
1600 IF (paw_atom) THEN
1601 CALL allocate_paw_proj_set(qs_kind%paw_proj_set)
1602 CALL get_qs_kind(qs_kind=qs_kind, paw_proj_set=paw_proj)
1603 CALL projectors(paw_proj, basis_1c, orb_basis, rc, qs_control, &
1604 max_rad_local_type, force_env_section)
1605 ELSE
1606 IF (my_mod_control) qs_control%gapw_control%non_paw_atoms = .true.
1607 END IF
1608
1609 ! grid_atom and harmonics are allocated even if NOT PAW_ATOM
1610 NULLIFY (qs_kind%grid_atom, qs_kind%harmonics)
1611 CALL allocate_grid_atom(qs_kind%grid_atom)
1612 CALL allocate_harmonics_atom(qs_kind%harmonics)
1613
1614 END DO
1615
1616 IF (my_mod_control) THEN
1617 IF (qs_control%gapw_control%non_paw_atoms) THEN
1618 qs_control%gapw_control%nopaw_as_gpw = .true.
1619 ELSE
1620 qs_control%gapw_control%nopaw_as_gpw = .false.
1621 END IF
1622 END IF
1623 ELSE
1624 cpabort("The pointer qs_kind_set is not associated")
1625 END IF
1626
1627 END SUBROUTINE init_gapw_basis_set
1628! **************************************************************************************************
1629!> \brief ...
1630!> \param qs_kind_set ...
1631! **************************************************************************************************
1632 SUBROUTINE init_gapw_nlcc(qs_kind_set)
1633
1634 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1635
1636 INTEGER :: i, ic, ikind, n_nlcc, nc, nexp_nlcc, &
1637 nkind, nr
1638 INTEGER, DIMENSION(:), POINTER :: nct_nlcc
1639 LOGICAL :: nlcc, nlcc_type, paw_atom
1640 REAL(dp) :: alpha, coa, cval
1641 REAL(kind=dp), DIMENSION(:), POINTER :: a_nlcc, alpha_nlcc, c_nlcc, fe, rc, rr
1642 REAL(kind=dp), DIMENSION(:, :), POINTER :: cval_nlcc, den
1643 TYPE(gth_potential_type), POINTER :: gth_potential
1644 TYPE(qs_kind_type), POINTER :: qs_kind
1645 TYPE(sgp_potential_type), POINTER :: sgp_potential
1646
1647 IF (ASSOCIATED(qs_kind_set)) THEN
1648 nlcc = has_nlcc(qs_kind_set)
1649 IF (nlcc) THEN
1650 nkind = SIZE(qs_kind_set)
1651 DO ikind = 1, nkind
1652 qs_kind => qs_kind_set(ikind)
1653 CALL get_qs_kind(qs_kind, paw_atom=paw_atom)
1654 IF (paw_atom) THEN
1655 CALL get_qs_kind(qs_kind, gth_potential=gth_potential)
1656 CALL get_qs_kind(qs_kind, sgp_potential=sgp_potential)
1657 IF (ASSOCIATED(gth_potential)) THEN
1658 CALL get_potential(potential=gth_potential, nlcc_present=nlcc_type, &
1659 nexp_nlcc=nexp_nlcc, alpha_nlcc=alpha_nlcc, nct_nlcc=nct_nlcc, cval_nlcc=cval_nlcc)
1660 IF (nlcc_type) THEN
1661 nr = qs_kind%grid_atom%nr
1662 rr => qs_kind%grid_atom%rad
1663 ALLOCATE (qs_kind%nlcc_pot(nr, 2), rc(nr), fe(nr))
1664 den => qs_kind%nlcc_pot
1665 den = 0.0_dp
1666 DO i = 1, nexp_nlcc
1667 alpha = alpha_nlcc(i)
1668 rc(:) = rr(:)/alpha
1669 fe(:) = exp(-0.5_dp*rc(:)*rc(:))
1670 nc = nct_nlcc(i)
1671 DO ic = 1, nc
1672 cval = cval_nlcc(ic, i)
1673 coa = cval/alpha
1674 den(:, 1) = den(:, 1) + fe(:)*rc**(2*ic - 2)*cval
1675 den(:, 2) = den(:, 2) - fe(:)*rc**(2*ic - 1)*coa
1676 IF (ic > 1) THEN
1677 den(:, 2) = den(:, 2) + real(2*ic - 2, dp)*fe(:)*rc**(2*ic - 3)*coa
1678 END IF
1679 END DO
1680 END DO
1681 DEALLOCATE (rc, fe)
1682 END IF
1683 ELSE IF (ASSOCIATED(sgp_potential)) THEN
1684 CALL get_potential(potential=sgp_potential, has_nlcc=nlcc_type, &
1685 n_nlcc=n_nlcc, a_nlcc=a_nlcc, c_nlcc=c_nlcc)
1686 IF (nlcc_type) THEN
1687 nr = qs_kind%grid_atom%nr
1688 rr => qs_kind%grid_atom%rad
1689 ALLOCATE (qs_kind%nlcc_pot(nr, 2), rc(nr), fe(nr))
1690 den => qs_kind%nlcc_pot
1691 den = 0.0_dp
1692 DO i = 1, n_nlcc
1693 alpha = a_nlcc(i)
1694 fe(:) = exp(-alpha*rr(:)*rr(:))
1695 cval = c_nlcc(i)
1696 den(:, 1) = den(:, 1) + cval*fe(:)
1697 den(:, 2) = den(:, 2) - 2.0_dp*alpha*cval*rr(:)*fe(:)
1698 END DO
1699 DEALLOCATE (rc, fe)
1700 END IF
1701 ELSE
1702 ! skip
1703 END IF
1704 END IF
1705 END DO
1706 END IF
1707 ELSE
1708 cpabort("The pointer qs_kind_set is not associated")
1709 END IF
1710
1711 END SUBROUTINE init_gapw_nlcc
1712
1713! **************************************************************************************************
1714!> \brief ...
1715!> \param qs_kind_set ...
1716!> \param qs_control ...
1717! **************************************************************************************************
1718 SUBROUTINE init_cneo_basis_set(qs_kind_set, qs_control)
1719
1720 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1721 TYPE(qs_control_type), POINTER :: qs_control
1722
1723 INTEGER :: ikind, nkind
1724 LOGICAL :: paw_atom
1725 REAL(dp) :: rc
1726 TYPE(gto_basis_set_type), POINTER :: orb_basis, soft_basis
1727 TYPE(qs_kind_type), POINTER :: qs_kind
1728
1729 IF (ASSOCIATED(qs_kind_set)) THEN
1730
1731 nkind = SIZE(qs_kind_set)
1732
1733 DO ikind = 1, nkind
1734
1735 qs_kind => qs_kind_set(ikind)
1736
1737 IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
1738 CALL get_qs_kind(qs_kind=qs_kind, basis_set=orb_basis, basis_type="NUC", &
1739 hard_radius=rc)
1740
1741 NULLIFY (soft_basis)
1742 CALL allocate_gto_basis_set(soft_basis)
1743 CALL create_soft_basis(orb_basis, soft_basis, &
1744 qs_control%gapw_control%eps_fit/ &
1745 sqrt(qs_kind%cneo_potential%zeff), &
1746 rc, paw_atom, .true., .false.)
1747 CALL add_basis_set_to_container(qs_kind%basis_sets, soft_basis, "NUC_SOFT")
1748 END IF
1749
1750 END DO
1751
1752 ELSE
1753 cpabort("The pointer qs_kind_set is not associated")
1754 END IF
1755
1756 END SUBROUTINE init_cneo_basis_set
1757
1758! **************************************************************************************************
1759!> \brief Select the DFT potential-file list or a per-kind override.
1760!> \param potential_file_names ...
1761!> \param dft_potential_file_names ...
1762!> \param kind_potential_file_name ...
1763! **************************************************************************************************
1764 SUBROUTINE set_potential_file_names(potential_file_names, dft_potential_file_names, &
1765 kind_potential_file_name)
1766
1767 CHARACTER(LEN=default_path_length), DIMENSION(:), &
1768 INTENT(INOUT), POINTER :: potential_file_names
1769 CHARACTER(LEN=default_path_length), DIMENSION(:), &
1770 INTENT(IN) :: dft_potential_file_names
1771 CHARACTER(LEN=*), INTENT(IN) :: kind_potential_file_name
1772
1773 IF (ASSOCIATED(potential_file_names)) DEALLOCATE (potential_file_names)
1774 IF (kind_potential_file_name == "-") THEN
1775 ALLOCATE (potential_file_names(SIZE(dft_potential_file_names)))
1776 potential_file_names(:) = dft_potential_file_names(:)
1777 ELSE
1778 ALLOCATE (potential_file_names(1))
1779 potential_file_names(1) = kind_potential_file_name
1780 END IF
1781
1782 END SUBROUTINE set_potential_file_names
1783
1784! **************************************************************************************************
1785!> \brief Read an atomic kind data set from the input file.
1786!> \param qs_kind ...
1787!> \param kind_section ...
1788!> \param para_env ...
1789!> \param force_env_section ...
1790!> \param no_fail ...
1791!> \param method_id ...
1792!> \param silent ...
1793!> \par History
1794!> - Creation (09.02.2002,MK)
1795!> - 20.09.2002,gt: adapted for POL/KG use (elp_potential)
1796!> - 05.03.2010: split elp_potential into fist_potential and kg_potential
1797! **************************************************************************************************
1798 SUBROUTINE read_qs_kind(qs_kind, kind_section, para_env, force_env_section, &
1799 no_fail, method_id, silent)
1800
1801 TYPE(qs_kind_type), INTENT(INOUT) :: qs_kind
1802 TYPE(section_vals_type), POINTER :: kind_section
1803 TYPE(mp_para_env_type), POINTER :: para_env
1804 TYPE(section_vals_type), POINTER :: force_env_section
1805 LOGICAL, INTENT(IN) :: no_fail
1806 INTEGER, INTENT(IN) :: method_id
1807 LOGICAL, INTENT(IN) :: silent
1808
1809 CHARACTER(LEN=*), PARAMETER :: routinen = 'read_qs_kind'
1810 INTEGER, PARAMETER :: maxbas = 20
1811
1812 CHARACTER(LEN=2) :: element_symbol
1813 CHARACTER(len=default_path_length) :: kg_potential_fn_kind, potential_fn_kind
1814 CHARACTER(LEN=default_path_length), DIMENSION(:), &
1815 POINTER :: dft_potential_file_names, &
1816 potential_file_names
1817 CHARACTER(LEN=default_string_length) :: akind_name, basis_type, keyword, &
1818 kgpot_name, kgpot_type, &
1819 potential_name, potential_type, tmp
1820 CHARACTER(LEN=default_string_length), DIMENSION(4) :: description
1821 CHARACTER(LEN=default_string_length), &
1822 DIMENSION(:), POINTER :: tmpstringlist
1823 CHARACTER(LEN=default_string_length), &
1824 DIMENSION(maxbas) :: basis_set_form, basis_set_name, &
1825 basis_set_type
1826 INTEGER :: handle, i, i_rep, iounit, ipaodesc, ipaopot, ipos, j, jj, k_rep, l, m, &
1827 n_potential_files, n_rep, nb_rep, nexp, ngauss, nlcc, nloc, nnl, norbitals, npaodesc, &
1828 npaopot, nppnl, nspin, nu, plus_u_method_id, z
1829 INTEGER, DIMENSION(:), POINTER :: add_el, elec_conf, orbitals
1830 LOGICAL :: check, ecp_semi_local, explicit, explicit_basis, explicit_j, explicit_kgpot, &
1831 explicit_potential, explicit_u, explicit_u_m_j, l_explicit, n_explicit, nobasis, &
1832 nobasis_nuc, section_enabled, subsection_enabled, update_input
1833 REAL(kind=dp) :: alpha, ccore, mass, r, rc, &
1834 zeff_correction
1835 REAL(kind=dp), DIMENSION(6) :: error
1836 REAL(kind=dp), DIMENSION(:), POINTER :: a_nl, aloc, anlcc, cloc, cnlcc, nelec, &
1837 proj_shell_charge, &
1838 tmp_perturbation_strength
1839 REAL(kind=dp), DIMENSION(:, :), POINTER :: h_nl
1840 REAL(kind=dp), DIMENSION(:, :, :), POINTER :: c_nl
1841 TYPE(atom_ecppot_type) :: ecppot
1842 TYPE(atom_sgp_potential_type) :: sgppot
1843 TYPE(atom_upfpot_type) :: upfpot
1844 TYPE(cp_logger_type), POINTER :: logger
1845 TYPE(gto_basis_set_type), POINTER :: orb_basis_set, sup_basis_set, &
1846 tmp_basis_set
1847 TYPE(section_vals_type), POINTER :: basis_section, bs_section, dft_plus_u_section, &
1848 dft_section, enforce_occupation_section, kgpot_section, &
1849 minimum_tracking_linear_response_section, pao_desc_section, pao_pot_section, &
1850 potential_section, spin_section, tensorial_projector_section
1851 TYPE(sto_basis_set_type), POINTER :: sto_basis_set
1852
1853 CALL timeset(routinen, handle)
1854
1855 NULLIFY (logger)
1856 logger => cp_get_default_logger()
1857 iounit = cp_logger_get_default_io_unit(logger)
1858
1859 NULLIFY (dft_potential_file_names, elec_conf, potential_file_names)
1860
1861 update_input = .true.
1862 basis_set_name(:) = ""
1863 basis_set_type(:) = ""
1864 basis_set_form(:) = ""
1865 potential_name = ""
1866 potential_type = ""
1867 kgpot_name = ""
1868 kgpot_type = ""
1869 kg_potential_fn_kind = "-"
1870 potential_fn_kind = "-"
1871 z = -1
1872 zeff_correction = 0.0_dp
1873 explicit = .false.
1874 explicit_basis = .false.
1875 explicit_j = .false.
1876 explicit_kgpot = .false.
1877 explicit_potential = .false.
1878 explicit_u = .false.
1879 explicit_u_m_j = .false.
1880
1881 dft_section => section_vals_get_subs_vals(force_env_section, "DFT")
1882 CALL section_vals_val_get(dft_section, "POTENTIAL_FILE_NAME", n_rep_val=n_potential_files)
1883 cpassert(n_potential_files > 0)
1884 ALLOCATE (dft_potential_file_names(n_potential_files))
1885 DO i = 1, n_potential_files
1886 CALL section_vals_val_get(dft_section, "POTENTIAL_FILE_NAME", i_rep_val=i, &
1887 c_val=dft_potential_file_names(i))
1888 END DO
1889 CALL section_vals_get(kind_section, n_repetition=n_rep)
1890 k_rep = -1
1891 akind_name = qs_kind%name
1892 CALL uppercase(akind_name)
1893 ! First we use the atom_name to find out the proper KIND section
1894 DO i_rep = 1, n_rep
1895 CALL section_vals_val_get(kind_section, "_SECTION_PARAMETERS_", &
1896 c_val=keyword, i_rep_section=i_rep)
1897 CALL uppercase(keyword)
1898 IF (keyword == akind_name) THEN
1899 k_rep = i_rep
1900 EXIT
1901 END IF
1902 END DO
1903 ! The search for the KIND section failed.. check for a QM/MM link atom
1904 IF (k_rep < 1) THEN
1905 ipos = index(qs_kind%name, "_")
1906 IF (((ipos == 2) .OR. (ipos == 3)) .AND. (index(qs_kind%name, "_ghost") == 0)) THEN
1907 ! If the atm_name could not match any KIND section it maybe be a QM/MM link atom.
1908 ! ghost atoms will be treated differently.
1909 akind_name = qs_kind%name(1:ipos - 1)
1910 CALL uppercase(akind_name)
1911 DO i_rep = 1, n_rep
1912 CALL section_vals_val_get(kind_section, "_SECTION_PARAMETERS_", &
1913 c_val=keyword, i_rep_section=i_rep)
1914 CALL uppercase(keyword)
1915 IF (keyword == akind_name) THEN
1916 k_rep = i_rep
1917 EXIT
1918 END IF
1919 END DO
1920 END IF
1921 END IF
1922 ! The search for the KIND section failed.. check element_symbol
1923 IF (k_rep < 1) THEN
1924 ! If it's not a link atom let's check for the element and map
1925 ! the KIND section to the element.
1926 element_symbol = qs_kind%element_symbol(1:2)
1927 CALL uppercase(element_symbol)
1928 DO i_rep = 1, n_rep
1929 CALL section_vals_val_get(kind_section, "_SECTION_PARAMETERS_", &
1930 c_val=keyword, i_rep_section=i_rep)
1931 CALL uppercase(keyword)
1932 IF (keyword == element_symbol) THEN
1933 k_rep = i_rep
1934 EXIT
1935 END IF
1936 END DO
1937 END IF
1938 ! In case it should not really match any possible KIND section
1939 ! let's look if a default one is defined..
1940 IF (k_rep < 1) THEN
1941 DO i_rep = 1, n_rep
1942 CALL section_vals_val_get(kind_section, "_SECTION_PARAMETERS_", &
1943 c_val=keyword, i_rep_section=i_rep)
1944 CALL uppercase(keyword)
1945 IF (keyword == "DEFAULT") THEN
1946 update_input = .false.
1947 k_rep = i_rep
1948 EXIT
1949 END IF
1950 END DO
1951 END IF
1952 IF (k_rep < 0 .AND. (.NOT. no_fail)) THEN
1953 CALL cp_abort(__location__, &
1954 "No &KIND section was possible to associate to the atomic kind <"// &
1955 trim(akind_name)//">. The KIND section were also scanned for the"// &
1956 " corresponding element <"//trim(qs_kind%element_symbol)//">"// &
1957 " and for the DEFAULT section but no match was found. Check your input file!")
1958 END IF
1959 ! Retrieve information on element
1960 CALL get_ptable_info(qs_kind%element_symbol, ielement=z)
1961
1962 ! Normal parsing of the KIND section
1963 IF (k_rep > 0) THEN
1964 ! new style basis set input
1965 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
1966 keyword_name="BASIS_SET", &
1967 explicit=explicit, &
1968 n_rep_val=nb_rep)
1969 IF (.NOT. explicit) nb_rep = 0
1970 cpassert(nb_rep <= maxbas)
1971 DO i = 1, nb_rep
1972 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
1973 keyword_name="BASIS_SET", i_rep_val=i, c_vals=tmpstringlist)
1974 IF (SIZE(tmpstringlist) == 1) THEN
1975 ! default is orbital type and GTO
1976 basis_set_type(i) = "ORB"
1977 basis_set_form(i) = "GTO"
1978 basis_set_name(i) = tmpstringlist(1)
1979 ELSE IF (SIZE(tmpstringlist) == 2) THEN
1980 ! default is GTO
1981 basis_set_type(i) = tmpstringlist(1)
1982 basis_set_form(i) = "GTO"
1983 basis_set_name(i) = tmpstringlist(2)
1984 ELSE IF (SIZE(tmpstringlist) == 3) THEN
1985 basis_set_type(i) = tmpstringlist(1)
1986 basis_set_form(i) = tmpstringlist(2)
1987 basis_set_name(i) = tmpstringlist(3)
1988 ELSE
1989 CALL cp_abort(__location__, &
1990 "invalid number of BASIS_SET keyword parameters: BASIS_SET [<TYPE>] [<FORM>] <NAME>")
1991 END IF
1992 ! check that we have a valid basis set form
1993 IF (basis_set_form(i) /= "GTO" .AND. basis_set_form(i) /= "STO") THEN
1994 cpabort("invalid BASIS_SET FORM parameter")
1995 END IF
1996 END DO
1997
1998 ! parse PAO keywords
1999 CALL section_vals_val_get(kind_section, keyword_name="PAO_BASIS_SIZE", i_rep_section=k_rep, &
2000 i_val=qs_kind%pao_basis_size)
2001 CALL section_vals_val_get(kind_section, keyword_name="PAO_MODEL_FILE", i_rep_section=k_rep, &
2002 explicit=explicit)
2003 IF (explicit) THEN
2004 CALL section_vals_val_get(kind_section, keyword_name="PAO_MODEL_FILE", i_rep_section=k_rep, &
2005 c_val=qs_kind%pao_model_file)
2006 END IF
2007
2008 ! parse PAO_POTENTIAL sections
2009 pao_pot_section => section_vals_get_subs_vals(kind_section, "PAO_POTENTIAL", i_rep_section=k_rep)
2010 CALL section_vals_get(pao_pot_section, n_repetition=npaopot)
2011 ALLOCATE (qs_kind%pao_potentials(npaopot))
2012 DO ipaopot = 1, npaopot
2013 CALL section_vals_val_get(pao_pot_section, keyword_name="MAXL", i_rep_section=ipaopot, &
2014 i_val=qs_kind%pao_potentials(ipaopot)%maxl)
2015 CALL section_vals_val_get(pao_pot_section, keyword_name="MAX_PROJECTOR", i_rep_section=ipaopot, &
2016 i_val=qs_kind%pao_potentials(ipaopot)%max_projector)
2017 CALL section_vals_val_get(pao_pot_section, keyword_name="BETA", i_rep_section=ipaopot, &
2018 r_val=qs_kind%pao_potentials(ipaopot)%beta)
2019 CALL section_vals_val_get(pao_pot_section, keyword_name="WEIGHT", i_rep_section=ipaopot, &
2020 r_val=qs_kind%pao_potentials(ipaopot)%weight)
2021 END DO
2022
2023 ! parse PAO_DESCRIPTOR sections
2024 pao_desc_section => section_vals_get_subs_vals(kind_section, "PAO_DESCRIPTOR", i_rep_section=k_rep)
2025 CALL section_vals_get(pao_desc_section, n_repetition=npaodesc)
2026 ALLOCATE (qs_kind%pao_descriptors(npaodesc))
2027 DO ipaodesc = 1, npaodesc
2028 CALL section_vals_val_get(pao_desc_section, keyword_name="BETA", i_rep_section=ipaodesc, &
2029 r_val=qs_kind%pao_descriptors(ipaodesc)%beta)
2030 CALL section_vals_val_get(pao_desc_section, keyword_name="SCREENING", i_rep_section=ipaodesc, &
2031 r_val=qs_kind%pao_descriptors(ipaodesc)%screening)
2032 CALL section_vals_val_get(pao_desc_section, keyword_name="WEIGHT", i_rep_section=ipaodesc, &
2033 r_val=qs_kind%pao_descriptors(ipaodesc)%weight)
2034 END DO
2035
2036 ! parse ELEC_CONF
2037 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2038 keyword_name="ELEC_CONF", n_rep_val=i)
2039 IF (i > 0) THEN
2040 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2041 keyword_name="ELEC_CONF", i_vals=elec_conf)
2042 CALL set_qs_kind(qs_kind, elec_conf=elec_conf)
2043 END IF
2044 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2045 keyword_name="CORE_CORRECTION", r_val=zeff_correction)
2046 ! parse POTENTIAL
2047 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2048 keyword_name="POTENTIAL_FILE_NAME", c_val=potential_fn_kind)
2049 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2050 keyword_name="POTENTIAL_TYPE", c_val=potential_type)
2051 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2052 explicit=explicit, keyword_name="POTENTIAL", c_vals=tmpstringlist)
2053 IF (explicit) THEN
2054 IF (SIZE(tmpstringlist) == 1) THEN
2055 ! old type of input: start of name defines type
2056 potential_name = tmpstringlist(1)
2057 IF (potential_type == "") THEN
2058 ipos = index(potential_name, "-")
2059 IF (ipos > 1) THEN
2060 potential_type = potential_name(:ipos - 1)
2061 ELSE
2062 potential_type = potential_name
2063 END IF
2064 END IF
2065 ELSE IF (SIZE(tmpstringlist) == 2) THEN
2066 potential_type = tmpstringlist(1)
2067 potential_name = tmpstringlist(2)
2068 ELSE
2069 cpabort("POTENTIAL input list is not correct")
2070 END IF
2071 END IF
2072 CALL uppercase(potential_type)
2073
2074 ! Parse KG POTENTIAL
2075 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2076 keyword_name="KG_POTENTIAL_FILE_NAME", c_val=kg_potential_fn_kind)
2077 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2078 keyword_name="KG_POTENTIAL", c_val=kgpot_name)
2079
2080 ! Semi-local vs. full nonlocal form of ECPs
2081 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2082 keyword_name="ECP_SEMI_LOCAL", l_val=ecp_semi_local)
2083
2084 ! Assign atomic covalent radius
2085 qs_kind%covalent_radius = ptable(z)%covalent_radius*bohr
2086 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2087 keyword_name="COVALENT_RADIUS", r_val=r)
2088 IF (r > 0.0_dp) qs_kind%covalent_radius = r
2089
2090 ! Assign atomic van der Waals radius
2091 qs_kind%vdw_radius = ptable(z)%vdw_radius*bohr
2092 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2093 keyword_name="VDW_RADIUS", r_val=r)
2094 IF (r > 0.0_dp) qs_kind%vdw_radius = r
2095
2096 ! Assign atom dependent defaults, only H special case
2097 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, n_rep_val=i, &
2098 keyword_name="HARD_EXP_RADIUS")
2099 IF (i == 0) THEN
2100 IF (z == 1) THEN
2101 qs_kind%hard_radius = 1.2_dp
2102 ELSE
2103 qs_kind%hard_radius = 0.8_dp*bohr
2104 END IF
2105 ELSE
2106 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2107 keyword_name="HARD_EXP_RADIUS", r_val=qs_kind%hard_radius)
2108 END IF
2109
2110 ! assign atom dependent defaults, only H special case
2111 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, n_rep_val=i, &
2112 keyword_name="RHO0_EXP_RADIUS")
2113 IF (i == 0) THEN
2114 qs_kind%hard0_radius = qs_kind%hard_radius
2115 ELSE
2116 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2117 keyword_name="RHO0_EXP_RADIUS", r_val=qs_kind%hard0_radius)
2118 END IF
2119 IF (qs_kind%hard_radius < qs_kind%hard0_radius) THEN
2120 cpabort("rc0 should be <= rc")
2121 END IF
2122
2123 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2124 keyword_name="MAX_RAD_LOCAL", r_val=qs_kind%max_rad_local)
2125 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2126 keyword_name="LEBEDEV_GRID", i_val=qs_kind%ngrid_ang)
2127 IF (qs_kind%ngrid_ang <= 0) THEN
2128 cpabort("# point lebedev grid < 0")
2129 END IF
2130 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2131 keyword_name="RADIAL_GRID", i_val=qs_kind%ngrid_rad)
2132 IF (qs_kind%ngrid_rad <= 0) THEN
2133 cpabort("# point radial grid < 0")
2134 END IF
2135 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2136 keyword_name="GPW_TYPE", l_val=qs_kind%gpw_type_forced)
2137 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2138 keyword_name="GHOST", l_val=qs_kind%ghost)
2139 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2140 keyword_name="FLOATING_BASIS_CENTER", l_val=qs_kind%floating)
2141 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2142 keyword_name="NO_OPTIMIZE", l_val=qs_kind%no_optimize)
2143
2144 ! Magnetization
2145 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2146 keyword_name="MAGNETIZATION", r_val=qs_kind%magnetization)
2147 ! DFTB3 param
2148 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2149 keyword_name="DFTB3_PARAM", r_val=qs_kind%dudq_dftb3)
2150 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2151 keyword_name="LMAX_DFTB", i_val=qs_kind%lmax_dftb)
2152
2153 ! MAOS
2154 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2155 keyword_name="MAO", i_val=qs_kind%mao)
2156
2157 ! Use monovalent pseudopotential
2158 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2159 keyword_name="MONOVALENT", l_val=qs_kind%monovalent)
2160 IF (qs_kind%monovalent .AND. trim(potential_type) /= 'GTH') THEN
2161 cpabort("Monovalent pseudopotentials currently implemented for GTH only!")
2162 END IF
2163
2164 ! Read the BS subsection of the current atomic kind, if enabled
2165 NULLIFY (bs_section)
2166 bs_section => section_vals_get_subs_vals(kind_section, "BS", &
2167 i_rep_section=k_rep)
2168 section_enabled = .false.
2169 CALL section_vals_val_get(bs_section, "_SECTION_PARAMETERS_", &
2170 l_val=section_enabled)
2171 IF (section_enabled) THEN
2172 ! test for conflict with magnetization
2173 IF (qs_kind%magnetization /= 0.0_dp) THEN
2174 CALL cp_abort(__location__, "BS Section is in conflict with non-zero magnetization "// &
2175 "for this atom kind.")
2176 END IF
2177 qs_kind%bs_occupation = .true.
2178 !Alpha spin
2179 NULLIFY (spin_section)
2180 spin_section => section_vals_get_subs_vals(bs_section, "ALPHA")
2181 CALL section_vals_get(spin_section, explicit=explicit)
2182 IF (explicit) THEN
2183 NULLIFY (add_el)
2184 CALL section_vals_val_get(spin_section, &
2185 keyword_name="NEL", i_vals=add_el)
2186 cpassert(ASSOCIATED(add_el))
2187 ALLOCATE (qs_kind%addel(SIZE(add_el), 2))
2188 qs_kind%addel = 0
2189 qs_kind%addel(1:SIZE(add_el), 1) = add_el(1:SIZE(add_el))
2190 NULLIFY (add_el)
2191 CALL section_vals_val_get(spin_section, &
2192 keyword_name="L", i_vals=add_el)
2193 cpassert(ASSOCIATED(add_el))
2194 cpassert(SIZE(add_el) == SIZE(qs_kind%addel, 1))
2195 ALLOCATE (qs_kind%laddel(SIZE(add_el), 2))
2196 qs_kind%laddel = 0
2197 qs_kind%laddel(1:SIZE(add_el), 1) = add_el(1:SIZE(add_el))
2198 ALLOCATE (qs_kind%naddel(SIZE(add_el), 2))
2199 qs_kind%naddel = 0
2200 NULLIFY (add_el)
2201 CALL section_vals_val_get(spin_section, &
2202 keyword_name="N", n_rep_val=i)
2203 IF (i > 0) THEN
2204 CALL section_vals_val_get(spin_section, &
2205 keyword_name="N", i_vals=add_el)
2206 IF (SIZE(add_el) == SIZE(qs_kind%addel, 1)) THEN
2207 qs_kind%naddel(1:SIZE(add_el), 1) = add_el(1:SIZE(add_el))
2208 END IF
2209 END IF
2210 END IF
2211 ! Beta spin
2212 NULLIFY (spin_section)
2213 spin_section => section_vals_get_subs_vals(bs_section, "BETA")
2214 CALL section_vals_get(spin_section, explicit=explicit)
2215 IF (explicit) THEN
2216 NULLIFY (add_el)
2217 CALL section_vals_val_get(spin_section, &
2218 keyword_name="NEL", i_vals=add_el)
2219 cpassert(SIZE(add_el) == SIZE(qs_kind%addel, 1))
2220 qs_kind%addel(1:SIZE(add_el), 2) = add_el(1:SIZE(add_el))
2221 qs_kind%addel(:, :) = qs_kind%addel(:, :)
2222 NULLIFY (add_el)
2223 CALL section_vals_val_get(spin_section, &
2224 keyword_name="L", i_vals=add_el)
2225 cpassert(SIZE(add_el) == SIZE(qs_kind%addel, 1))
2226 qs_kind%laddel(1:SIZE(add_el), 2) = add_el(1:SIZE(add_el))
2227
2228 CALL section_vals_val_get(spin_section, &
2229 keyword_name="N", n_rep_val=i)
2230 IF (i > 0) THEN
2231 NULLIFY (add_el)
2232 CALL section_vals_val_get(spin_section, &
2233 keyword_name="N", i_vals=add_el)
2234 IF (SIZE(add_el) == SIZE(qs_kind%addel, 1)) THEN
2235 qs_kind%naddel(1:SIZE(add_el), 2) = add_el(1:SIZE(add_el))
2236 END IF
2237 END IF
2238 END IF
2239 END IF
2240
2241 ! Read the DFT+U subsection of the current atomic kind, if enabled
2242
2243 NULLIFY (dft_plus_u_section)
2244 dft_plus_u_section => section_vals_get_subs_vals(kind_section, &
2245 subsection_name="DFT_PLUS_U", &
2246 i_rep_section=k_rep)
2247 section_enabled = .false.
2248 CALL section_vals_val_get(dft_plus_u_section, &
2249 keyword_name="_SECTION_PARAMETERS_", &
2250 l_val=section_enabled)
2251 IF (section_enabled) THEN
2252 ALLOCATE (qs_kind%dft_plus_u)
2253 NULLIFY (qs_kind%dft_plus_u%nelec)
2254 NULLIFY (qs_kind%dft_plus_u%orbitals)
2255 CALL section_vals_val_get(dft_plus_u_section, &
2256 keyword_name="L", &
2257 i_val=l)
2258 qs_kind%dft_plus_u%l = l
2259#if defined(__SIRIUS)
2260 CALL section_vals_val_get(dft_plus_u_section, &
2261 keyword_name="N", &
2262 i_val=nu)
2263 qs_kind%dft_plus_u%n = nu
2264
2265 CALL section_vals_val_get(dft_plus_u_section, &
2266 keyword_name="U", &
2267 r_val=qs_kind%dft_plus_u%U, &
2268 explicit=explicit_u)
2269
2270 CALL section_vals_val_get(dft_plus_u_section, &
2271 keyword_name="J", &
2272 r_val=qs_kind%dft_plus_u%J, &
2273 explicit=explicit_j)
2274
2275 CALL section_vals_val_get(dft_plus_u_section, &
2276 keyword_name="alpha", &
2277 r_val=qs_kind%dft_plus_u%alpha)
2278
2279 CALL section_vals_val_get(dft_plus_u_section, &
2280 keyword_name="beta", &
2281 r_val=qs_kind%dft_plus_u%beta)
2282
2283 CALL section_vals_val_get(dft_plus_u_section, &
2284 keyword_name="J0", &
2285 r_val=qs_kind%dft_plus_u%J0)
2286
2287 CALL section_vals_val_get(dft_plus_u_section, &
2288 keyword_name="occupation", &
2289 r_val=qs_kind%dft_plus_u%occupation)
2290#else
2291 nu = 0
2292#endif
2293
2294 CALL section_vals_val_get(dft_plus_u_section, &
2295 keyword_name="U_MINUS_J", &
2296 r_val=qs_kind%dft_plus_u%u_minus_j_target, &
2297 explicit=explicit_u_m_j)
2298
2299 CALL section_vals_val_get(dft_section, &
2300 keyword_name="PLUS_U_METHOD", &
2301 i_val=plus_u_method_id)
2302
2303 IF (plus_u_method_id == plus_u_tensorial .OR. plus_u_method_id == plus_u_lowdin) THEN
2304 IF (explicit_u) THEN
2305 CALL cp_abort(__location__, "Lowdin and tensorial DFT+U+J do not allow U "// &
2306 "to be specified. Use U_MINUS_J and J.")
2307 END IF
2308 ELSE
2309 IF ((explicit_u .OR. explicit_j) .AND. explicit_u_m_j) THEN
2310 cpabort("DFT+U| specifying U or J and U_MINUS_J parameters are mutually exclusive.")
2311 END IF
2312 END IF
2313
2314 ! Tensorial DFT+U+J needs N, L, J, and U_MINUS_J. Here, N, L, and J are read.
2315 l_explicit = .false.
2316 n_explicit = .false.
2317 explicit_j = .false.
2318
2319 IF (plus_u_method_id == plus_u_tensorial) THEN
2320 CALL section_vals_val_get(dft_plus_u_section, &
2321 keyword_name="L", &
2322 i_val=qs_kind%dft_plus_u%l, &
2323 explicit=l_explicit)
2324 CALL section_vals_val_get(dft_plus_u_section, &
2325 keyword_name="N", &
2326 i_val=qs_kind%dft_plus_u%n, &
2327 explicit=n_explicit)
2328 CALL section_vals_val_get(dft_plus_u_section, &
2329 keyword_name="J", &
2330 r_val=qs_kind%dft_plus_u%J, &
2331 explicit=explicit_j)
2332 qs_kind%dft_plus_u%hund_j = qs_kind%dft_plus_u%J
2333 IF (.NOT. l_explicit .OR. .NOT. n_explicit) THEN
2334 CALL cp_abort(__location__, "DFT PLUS_U_METHOD TENSORIAL requires explicit L "// &
2335 "and N keywords in every active DFT_PLUS_U section.")
2336 END IF
2337 END IF
2338
2339 IF (plus_u_method_id == plus_u_lowdin) THEN
2340 CALL section_vals_val_get(dft_plus_u_section, &
2341 keyword_name="J", &
2342 r_val=qs_kind%dft_plus_u%J, &
2343 explicit=explicit_j)
2344 qs_kind%dft_plus_u%hund_j = qs_kind%dft_plus_u%J
2345 END IF
2346
2347 CALL section_vals_val_get(dft_plus_u_section, &
2348 keyword_name="U_RAMPING", &
2349 r_val=qs_kind%dft_plus_u%u_ramping)
2350 CALL section_vals_val_get(dft_plus_u_section, &
2351 keyword_name="INIT_U_RAMPING_EACH_SCF", &
2352 l_val=qs_kind%dft_plus_u%init_u_ramping_each_scf)
2353 IF (qs_kind%dft_plus_u%u_ramping > 0.0_dp) THEN
2354 qs_kind%dft_plus_u%u_minus_j = 0.0_dp
2355 ELSE
2356 qs_kind%dft_plus_u%u_minus_j = qs_kind%dft_plus_u%u_minus_j_target
2357 END IF
2358 CALL section_vals_val_get(dft_plus_u_section, &
2359 keyword_name="EPS_U_RAMPING", &
2360 r_val=qs_kind%dft_plus_u%eps_u_ramping)
2361
2362 NULLIFY (enforce_occupation_section)
2363 enforce_occupation_section => section_vals_get_subs_vals(dft_plus_u_section, &
2364 subsection_name="ENFORCE_OCCUPATION")
2365 subsection_enabled = .false.
2366 CALL section_vals_val_get(enforce_occupation_section, &
2367 keyword_name="_SECTION_PARAMETERS_", &
2368 l_val=subsection_enabled)
2369 IF (subsection_enabled) THEN
2370 NULLIFY (nelec)
2371 CALL section_vals_val_get(enforce_occupation_section, &
2372 keyword_name="NELEC", &
2373 r_vals=nelec)
2374 nspin = SIZE(nelec)
2375 ALLOCATE (qs_kind%dft_plus_u%nelec(nspin))
2376 qs_kind%dft_plus_u%nelec(:) = nelec(:)
2377 NULLIFY (orbitals)
2378 CALL section_vals_val_get(enforce_occupation_section, &
2379 keyword_name="ORBITALS", &
2380 i_vals=orbitals)
2381 norbitals = SIZE(orbitals)
2382 IF (norbitals <= 0 .OR. norbitals > 2*l + 1) THEN
2383 CALL cp_abort(__location__, "DFT+U| Invalid number of ORBITALS specified: "// &
2384 "1 to 2*L+1 integer numbers are expected")
2385 END IF
2386 ALLOCATE (qs_kind%dft_plus_u%orbitals(norbitals))
2387 qs_kind%dft_plus_u%orbitals(:) = orbitals(:)
2388 NULLIFY (orbitals)
2389 DO m = 1, norbitals
2390 IF (qs_kind%dft_plus_u%orbitals(m) > l) THEN
2391 cpabort("DFT+U| Invalid orbital magnetic quantum number specified: m > l")
2392 END IF
2393 IF (qs_kind%dft_plus_u%orbitals(m) < -l) THEN
2394 cpabort("DFT+U| Invalid orbital magnetic quantum number specified: m < -l")
2395 END IF
2396 DO j = 1, norbitals
2397 IF (j /= m) THEN
2398 IF (qs_kind%dft_plus_u%orbitals(j) == qs_kind%dft_plus_u%orbitals(m)) THEN
2399 cpabort("DFT+U| An orbital magnetic quantum number was specified twice")
2400 END IF
2401 END IF
2402 END DO
2403 END DO
2404 CALL section_vals_val_get(enforce_occupation_section, &
2405 keyword_name="EPS_SCF", &
2406 r_val=qs_kind%dft_plus_u%eps_scf)
2407 CALL section_vals_val_get(enforce_occupation_section, &
2408 keyword_name="MAX_SCF", &
2409 i_val=i)
2410 qs_kind%dft_plus_u%max_scf = max(-1, i)
2411 CALL section_vals_val_get(enforce_occupation_section, &
2412 keyword_name="SMEAR", &
2413 l_val=qs_kind%dft_plus_u%smear)
2414 END IF ! subsection enabled
2415
2416 NULLIFY (tensorial_projector_section)
2417 tensorial_projector_section => section_vals_get_subs_vals(dft_plus_u_section, &
2418 subsection_name="ATOMIC_PROJECTOR_TENSORIAL")
2419 subsection_enabled = .false.
2420 CALL section_vals_val_get(tensorial_projector_section, &
2421 keyword_name="_SECTION_PARAMETERS_", &
2422 l_val=subsection_enabled)
2423 IF (subsection_enabled) THEN
2424 CALL section_vals_val_get(tensorial_projector_section, &
2425 keyword_name="SHELL_CHARGE", &
2426 r_vals=proj_shell_charge)
2427 qs_kind%dft_plus_u%proj_shell_charge = proj_shell_charge
2428 END IF
2429
2430 NULLIFY (minimum_tracking_linear_response_section)
2431 minimum_tracking_linear_response_section => section_vals_get_subs_vals(dft_plus_u_section, &
2432 subsection_name="MINIMUM_TRACKING_LINEAR_RESPONSE")
2433 subsection_enabled = .false.
2434 CALL section_vals_val_get(minimum_tracking_linear_response_section, &
2435 keyword_name="_SECTION_PARAMETERS_", &
2436 l_val=subsection_enabled)
2437 IF (subsection_enabled) THEN
2438 qs_kind%dft_plus_u%do_mtlr = .true.
2439 CALL section_vals_val_get(minimum_tracking_linear_response_section, &
2440 keyword_name="INDEX_PERTURBED_ATOM", &
2441 i_val=qs_kind%dft_plus_u%lr_atom)
2442 IF (qs_kind%dft_plus_u%lr_atom < 1) THEN
2443 cpabort("MTLR requires an explicit positive INDEX_PERTURBED_ATOM.")
2444 END IF
2445 NULLIFY (tmp_perturbation_strength)
2446 CALL section_vals_val_get(minimum_tracking_linear_response_section, &
2447 keyword_name="PERTURBATION_STRENGTH", &
2448 r_vals=tmp_perturbation_strength)
2449 IF (.NOT. ASSOCIATED(tmp_perturbation_strength)) THEN
2450 cpabort("MTLR perturbation strengths could not be read.")
2451 END IF
2452 IF (SIZE(tmp_perturbation_strength) < 3 .OR. SIZE(tmp_perturbation_strength) > 9) THEN
2453 CALL cp_abort(__location__, &
2454 "PERTURBATION_STRENGTH must contain between 3 and 9 values.")
2455 END IF
2456 IF (maxval(tmp_perturbation_strength) - minval(tmp_perturbation_strength) <= &
2457 100.0_dp*epsilon(1.0_dp)) THEN
2458 cpabort("MTLR perturbation strengths must contain distinct values.")
2459 END IF
2460 IF (ALLOCATED(qs_kind%dft_plus_u%perturbation_strength)) THEN
2461 DEALLOCATE (qs_kind%dft_plus_u%perturbation_strength)
2462 END IF
2463 ALLOCATE (qs_kind%dft_plus_u%perturbation_strength(SIZE(tmp_perturbation_strength)))
2464 qs_kind%dft_plus_u%perturbation_strength(:) = tmp_perturbation_strength(:)
2465 ! section_vals_val_get returns a pointer to storage owned by the
2466 ! input tree. Only the copied component above is owned here.
2467 NULLIFY (tmp_perturbation_strength)
2468 END IF
2469 END IF ! section enabled
2470
2471 END IF
2472
2473 ! Allocate and initialise the orbital basis set data set structure
2474 CALL init_orbital_pointers(5) ! debug the SUN optimizer
2475
2476 ! BASIS and POTENTIAL read only when strictly necessary otherwise, even if not used
2477 ! we just print misleading informations
2478 explicit_basis = .false.
2479 IF (k_rep > 0) THEN
2480 basis_section => section_vals_get_subs_vals(kind_section, "BASIS", i_rep_section=k_rep, &
2481 can_return_null=.true.)
2482 CALL section_vals_get(basis_section, explicit=explicit_basis)
2483 END IF
2484
2485 explicit_potential = .false.
2486 IF (k_rep > 0) THEN
2487 potential_section => section_vals_get_subs_vals(kind_section, "POTENTIAL", &
2488 i_rep_section=k_rep, can_return_null=.true.)
2489 CALL section_vals_get(potential_section, explicit=explicit_potential)
2490 END IF
2491
2492 explicit_kgpot = .false.
2493 IF (k_rep > 0) THEN
2494 kgpot_section => section_vals_get_subs_vals(kind_section, "KG_POTENTIAL", &
2495 i_rep_section=k_rep, can_return_null=.true.)
2496 CALL section_vals_get(kgpot_section, explicit=explicit_kgpot)
2497 END IF
2498
2499 CALL set_potential_file_names(potential_file_names, dft_potential_file_names, potential_fn_kind)
2500
2501 SELECT CASE (method_id)
2502 CASE (do_method_rm1, do_method_am1, do_method_mndo, do_method_pdg, do_method_pm3, do_method_pm6, &
2503 do_method_pm6fm, do_method_mndod, do_method_pnnl)
2504 ! Allocate all_potential
2505 CALL allocate_potential(qs_kind%all_potential)
2506 CALL set_default_all_potential(qs_kind%all_potential, z, zeff_correction)
2507 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2508 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2509 CALL get_potential(potential=qs_kind%all_potential, elec_conf=elec_conf)
2510 CALL set_qs_kind(qs_kind, elec_conf=elec_conf)
2511 END IF
2512 cpassert(.NOT. qs_kind%floating)
2513 IF (qs_kind%ghost) THEN
2514 CALL get_qs_kind(qs_kind=qs_kind, elec_conf=elec_conf)
2515 elec_conf(:) = 0
2516 CALL get_potential(potential=qs_kind%all_potential, &
2517 elec_conf=elec_conf)
2518 elec_conf(:) = 0
2519 CALL set_potential(potential=qs_kind%all_potential, &
2520 zeff=0.0_dp, &
2521 zeff_correction=0.0_dp)
2522 END IF
2523
2524 ! Basis set (Parameters)
2525 ! Setup proper semiempirical parameters
2526 check = .NOT. ASSOCIATED(qs_kind%se_parameter)
2527 cpassert(check)
2528 CALL semi_empirical_create(qs_kind%se_parameter)
2529 ! Check if we allow p-orbitals on H
2530 SELECT CASE (z)
2531 CASE (1)
2532 IF (k_rep > 0) THEN
2533 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2534 keyword_name="SE_P_ORBITALS_ON_H", l_val=qs_kind%se_parameter%p_orbitals_on_h)
2535 END IF
2536 CASE DEFAULT
2537 ! No special cases for other elements..
2538 END SELECT
2539 ! Set default parameters
2540 CALL section_vals_val_get(dft_section, "QS%SE%STO_NG", i_val=ngauss)
2541 CALL se_param_set_default(qs_kind%se_parameter, z, method_id)
2542 NULLIFY (tmp_basis_set)
2543 CALL init_se_param(qs_kind%se_parameter, tmp_basis_set, ngauss)
2544 CALL add_basis_set_to_container(qs_kind%basis_sets, tmp_basis_set, "ORB")
2545 CALL init_potential(qs_kind%all_potential, itype="BARE", &
2546 zeff=qs_kind%se_parameter%zeff, zeff_correction=zeff_correction)
2547 qs_kind%se_parameter%zeff = qs_kind%se_parameter%zeff - zeff_correction
2548
2549 check = ((potential_name /= '') .OR. explicit_potential) .AND. .NOT. silent
2550 IF (check) THEN
2551 CALL cp_warn(__location__, &
2552 "Information provided in the input file regarding POTENTIAL for KIND <"// &
2553 trim(qs_kind%name)//"> will be ignored!")
2554 END IF
2555
2556 check = ((k_rep > 0) .OR. explicit_basis) .AND. .NOT. silent
2557 IF (check) THEN
2558 CALL cp_warn(__location__, &
2559 "Information provided in the input file regarding BASIS for KIND <"// &
2560 trim(qs_kind%name)//"> will be ignored!")
2561 END IF
2562
2563 CASE (do_method_dftb)
2564 ! Allocate all_potential
2565 CALL allocate_potential(qs_kind%all_potential)
2566 CALL set_default_all_potential(qs_kind%all_potential, z, zeff_correction)
2567 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2568 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2569 CALL get_potential(potential=qs_kind%all_potential, elec_conf=elec_conf)
2570 CALL set_qs_kind(qs_kind, elec_conf=elec_conf)
2571 END IF
2572 cpassert(.NOT. qs_kind%floating)
2573 IF (qs_kind%ghost) THEN
2574 CALL get_qs_kind(qs_kind=qs_kind, elec_conf=elec_conf)
2575 elec_conf(:) = 0
2576 CALL get_potential(potential=qs_kind%all_potential, &
2577 elec_conf=elec_conf)
2578 elec_conf(:) = 0
2579 CALL set_potential(potential=qs_kind%all_potential, &
2580 zeff=0.0_dp, &
2581 zeff_correction=0.0_dp)
2582 END IF
2583
2584 check = ((potential_name /= '') .OR. explicit_potential) .AND. .NOT. silent
2585 IF (check) THEN
2586 CALL cp_warn(__location__, &
2587 "Information provided in the input file regarding POTENTIAL for KIND <"// &
2588 trim(qs_kind%name)//"> will be ignored!")
2589 END IF
2590
2591 check = ((k_rep > 0) .OR. explicit_basis) .AND. .NOT. silent
2592 IF (check) THEN
2593 CALL cp_warn(__location__, &
2594 "Information provided in the input file regarding BASIS for KIND <"// &
2595 trim(qs_kind%name)//"> will be ignored!")
2596 END IF
2597
2598 CASE (do_method_xtb)
2599 ! Allocate all_potential
2600 CALL allocate_potential(qs_kind%all_potential)
2601 CALL set_default_all_potential(qs_kind%all_potential, z, zeff_correction)
2602 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2603 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2604 CALL get_potential(potential=qs_kind%all_potential, elec_conf=elec_conf)
2605 CALL set_qs_kind(qs_kind, elec_conf=elec_conf)
2606 END IF
2607 cpassert(.NOT. qs_kind%floating)
2608 IF (qs_kind%ghost) THEN
2609 CALL get_qs_kind(qs_kind=qs_kind, elec_conf=elec_conf)
2610 elec_conf(:) = 0
2611 CALL get_potential(potential=qs_kind%all_potential, &
2612 elec_conf=elec_conf)
2613 elec_conf(:) = 0
2614 CALL set_potential(potential=qs_kind%all_potential, &
2615 zeff=0.0_dp, &
2616 zeff_correction=0.0_dp)
2617 END IF
2618
2619 check = ((potential_name /= '') .OR. explicit_potential) .AND. .NOT. silent
2620 IF (check) THEN
2621 CALL cp_warn(__location__, &
2622 "Information provided in the input file regarding POTENTIAL for KIND <"// &
2623 trim(qs_kind%name)//"> will be ignored!")
2624 END IF
2625
2626 check = ((k_rep > 0) .OR. explicit_basis) .AND. .NOT. silent
2627 IF (check) THEN
2628 CALL cp_warn(__location__, &
2629 "Information provided in the input file regarding BASIS for KIND <"// &
2630 trim(qs_kind%name)//"> will be ignored!")
2631 END IF
2632
2633 CASE (do_method_pw)
2634 ! PW DFT
2635 ! Allocate and initialise the potential data set structure
2636 IF (potential_name /= '') THEN
2637 SELECT CASE (trim(potential_type))
2638 CASE ("ALL", "ECP", "CNEO")
2639 CALL cp_abort(__location__, &
2640 "PW DFT calculations only with potential type UPF or GTH possible."// &
2641 " <"//trim(potential_type)//"> was specified "// &
2642 "for the atomic kind <"//trim(qs_kind%name))
2643 CASE ("GTH")
2644 CALL allocate_potential(qs_kind%gth_potential)
2645 CALL read_potential(qs_kind%element_symbol, potential_name, &
2646 qs_kind%gth_potential, zeff_correction, para_env, &
2647 potential_file_names, potential_section, update_input, &
2648 monovalent=qs_kind%monovalent)
2649 CALL set_potential(qs_kind%gth_potential, z=z)
2650 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2651 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2652 CALL get_potential(potential=qs_kind%gth_potential, elec_conf=elec_conf)
2653 CALL set_qs_kind(qs_kind, elec_conf=elec_conf)
2654 ELSE
2655 CALL set_potential(potential=qs_kind%gth_potential, elec_conf=elec_conf)
2656 END IF
2657 CASE ("UPF")
2658 ALLOCATE (qs_kind%upf_potential)
2659 qs_kind%upf_potential%zion = 0
2660 qs_kind%upf_potential%filename = adjustl(trim(potential_name))
2661 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2662 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2663 CALL set_qs_kind(qs_kind, elec_conf=qs_kind%upf_potential%econf)
2664 END IF
2665 CASE DEFAULT
2666 CALL cp_abort(__location__, &
2667 "An invalid potential type <"// &
2668 trim(potential_type)//"> was specified "// &
2669 "for the atomic kind <"// &
2670 trim(qs_kind%name))
2671 END SELECT
2672 ELSE
2673 CALL cp_abort(__location__, &
2674 "No potential type was defined for the "// &
2675 "atomic kind <"//trim(qs_kind%name)//">")
2676 END IF
2677
2678 CASE DEFAULT
2679
2680 ! set ngauss for STO expansion
2681 CALL section_vals_val_get(dft_section, "QS%STO_NG", i_val=ngauss)
2682 ! Allocate and initialise the basis set data set structure
2683 ! first external basis sets
2684 DO i = 1, nb_rep
2685 SELECT CASE (basis_set_form(i))
2686 CASE ("GTO")
2687 NULLIFY (tmp_basis_set)
2688 CALL allocate_gto_basis_set(tmp_basis_set)
2689 CALL read_gto_basis_set(qs_kind%element_symbol, basis_set_name(i), &
2690 tmp_basis_set, para_env, dft_section)
2691 CASE ("STO")
2692 NULLIFY (sto_basis_set)
2693 CALL allocate_sto_basis_set(sto_basis_set)
2694 CALL read_sto_basis_set(qs_kind%element_symbol, basis_set_name(i), &
2695 sto_basis_set, para_env, dft_section)
2696 NULLIFY (tmp_basis_set)
2697 CALL create_gto_from_sto_basis(sto_basis_set, tmp_basis_set, ngauss)
2698 CALL deallocate_sto_basis_set(sto_basis_set)
2699 CASE DEFAULT
2700 CALL cp_abort(__location__, &
2701 "Invalid basis set form "//trim(basis_set_form(i))// &
2702 "for atomic kind <"//trim(qs_kind%name)//">")
2703 END SELECT
2704 tmp = basis_set_type(i)
2705 CALL uppercase(tmp)
2706 CALL add_basis_set_to_container(qs_kind%basis_sets, tmp_basis_set, tmp)
2707 END DO
2708 ! now explicit basis sets
2709 IF (explicit_basis) THEN
2710 CALL section_vals_get(basis_section, n_repetition=nexp)
2711 DO i = 1, nexp
2712 NULLIFY (tmp_basis_set)
2713 CALL allocate_gto_basis_set(tmp_basis_set)
2714 CALL read_gto_basis_set(qs_kind%element_symbol, basis_type, &
2715 tmp_basis_set, basis_section, i, dft_section)
2716 tmp = basis_type
2717 CALL uppercase(tmp)
2718 CALL add_basis_set_to_container(qs_kind%basis_sets, tmp_basis_set, tmp)
2719 END DO
2720 END IF
2721 ! combine multiple basis sets
2722 DO i = 1, SIZE(qs_kind%basis_sets)
2723 NULLIFY (tmp_basis_set)
2724 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis_set, &
2725 inumbas=i, basis_type=basis_type)
2726 IF (basis_type == "") cycle
2727 jj = i
2728 DO j = i + 1, SIZE(qs_kind%basis_sets)
2729 jj = jj + 1
2730 NULLIFY (sup_basis_set)
2731 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=sup_basis_set, &
2732 inumbas=jj, basis_type=tmp)
2733 IF (basis_type == tmp) THEN
2734 ! we found a match, combine the basis sets and delete the second
2735 CALL combine_basis_sets(tmp_basis_set, sup_basis_set)
2736 CALL remove_basis_from_container(qs_kind%basis_sets, jj)
2737 jj = jj - 1
2738 END IF
2739 END DO
2740 NULLIFY (sup_basis_set)
2741 END DO
2742
2743 ! check that we have an orbital basis set
2744 nobasis = .true.
2745 DO i = 1, SIZE(qs_kind%basis_sets)
2746 NULLIFY (tmp_basis_set)
2747 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis_set, &
2748 inumbas=i, basis_type=basis_type)
2749 IF (basis_type == "ORB") nobasis = .false.
2750 END DO
2751 IF (nobasis) THEN
2752 CALL cp_abort(__location__, &
2753 "No basis set type was defined for the "// &
2754 "atomic kind <"//trim(qs_kind%name)//">")
2755 END IF
2756
2757 ! If Ghost atom we don't need to allocate/initialize anything connected to POTENTIAL
2758 IF (qs_kind%ghost .OR. qs_kind%floating) THEN
2759 IF (ASSOCIATED(qs_kind%elec_conf)) qs_kind%elec_conf = 0
2760 ELSE
2761 ! Allocate and initialise the potential data set structure
2762 IF ((potential_name /= '') .OR. explicit_potential) THEN
2763 SELECT CASE (trim(potential_type))
2764 CASE ("ALL")
2765 CALL allocate_potential(qs_kind%all_potential)
2766 CALL read_potential(qs_kind%element_symbol, potential_name, &
2767 qs_kind%all_potential, zeff_correction, para_env, &
2768 potential_file_names, potential_section, update_input)
2769 CALL set_potential(qs_kind%all_potential, z=z)
2770 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2771 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2772 CALL get_potential(potential=qs_kind%all_potential, elec_conf=elec_conf)
2773 CALL set_qs_kind(qs_kind, elec_conf=elec_conf)
2774 ELSE
2775 CALL set_potential(potential=qs_kind%all_potential, elec_conf=elec_conf)
2776 END IF
2777 CASE ("GTH")
2778 CALL allocate_potential(qs_kind%gth_potential)
2779 CALL read_potential(qs_kind%element_symbol, potential_name, &
2780 qs_kind%gth_potential, zeff_correction, para_env, &
2781 potential_file_names, potential_section, update_input, &
2782 monovalent=qs_kind%monovalent)
2783 CALL set_potential(qs_kind%gth_potential, z=z)
2784 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2785 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2786 CALL get_potential(potential=qs_kind%gth_potential, elec_conf=elec_conf)
2787 CALL set_qs_kind(qs_kind, elec_conf=elec_conf)
2788 ELSE
2789 CALL set_potential(potential=qs_kind%gth_potential, elec_conf=elec_conf)
2790 END IF
2791 CASE ("ECP")
2792 CALL allocate_potential(qs_kind%sgp_potential)
2793 CALL get_potential(qs_kind%sgp_potential, description=description)
2794 CALL read_ecp_potential(ptable(z)%symbol, ecppot, &
2795 potential_name, potential_file_names, potential_section)
2796 IF (ecp_semi_local) THEN
2797 description(1) = "Semi-local Gaussian pseudopotential "
2798 description(2) = "ECP "//trim(potential_name)
2799 description(3) = "LIBGRPP: A. V. Oleynichenko et al., Symmetry 15 197 2023"
2800 description(4) = " "
2801 ELSE
2802 description(4) = "ECP "//trim(potential_name)
2803 END IF
2804 CALL set_potential(qs_kind%sgp_potential, name=ecppot%pname, description=description, &
2805 zeff=ecppot%zion, z=z, ecp_local=.true., ecp_semi_local=ecp_semi_local, &
2806 nloc=ecppot%nloc, nrloc=ecppot%nrloc, aloc=ecppot%aloc, bloc=ecppot%bloc, &
2807 has_nlcc=.false.)
2808 CALL set_potential(qs_kind%sgp_potential, sl_lmax=ecppot%lmax, &
2809 npot=ecppot%npot, nrpot=ecppot%nrpot, apot=ecppot%apot, bpot=ecppot%bpot)
2810 ! convert PP
2811 IF (.NOT. ecp_semi_local) THEN
2812 cpabort("ECPs are only well tested in their semi-local form")
2813 CALL get_qs_kind(qs_kind, basis_set=orb_basis_set)
2814 CALL sgp_construction(sgp_pot=sgppot, ecp_pot=ecppot, orb_basis=orb_basis_set, error=error)
2815 IF (iounit > 0 .AND. .NOT. silent) THEN
2816 WRITE (iounit, "(/,T2,'PP Transformation for ',A)") trim(ecppot%pname)
2817 IF (sgppot%has_local) THEN
2818 WRITE (iounit, "(T8,'Accuracy for local part:',T41,F10.3,'%',T61,F20.12)") error(4), error(1)
2819 END IF
2820 IF (sgppot%has_nonlocal) THEN
2821 WRITE (iounit, "(T8,'Accuracy for nonlocal part:',T41,F10.3,'%',T61,F20.12)") error(5), error(2)
2822 END IF
2823 IF (sgppot%has_nlcc) THEN
2824 WRITE (iounit, "(T8,'Accuracy for NLCC density:',T61,F20.12)") error(3)
2825 END IF
2826 END IF
2827 END IF
2828 IF (sgppot%has_nonlocal) THEN
2829 CALL set_potential(qs_kind%sgp_potential, n_nonlocal=sgppot%n_nonlocal, lmax=sgppot%lmax, &
2830 is_nonlocal=sgppot%is_nonlocal)
2831 nnl = sgppot%n_nonlocal
2832 nppnl = 0
2833 DO l = 0, sgppot%lmax
2834 nppnl = nppnl + nnl*nco(l)
2835 END DO
2836 l = sgppot%lmax
2837 ALLOCATE (a_nl(nnl), h_nl(nnl, 0:l), c_nl(nnl, nnl, 0:l))
2838 a_nl(:) = sgppot%a_nonlocal(:)
2839 h_nl(:, :) = sgppot%h_nonlocal(:, :)
2840 c_nl(:, :, :) = sgppot%c_nonlocal(:, :, :)
2841 CALL set_potential(qs_kind%sgp_potential, nppnl=nppnl, a_nonlocal=a_nl, h_nonlocal=h_nl, c_nonlocal=c_nl)
2842 ELSE
2843 CALL set_potential(qs_kind%sgp_potential, n_nonlocal=0, lmax=-1, is_nonlocal=sgppot%is_nonlocal)
2844 CALL set_potential(qs_kind%sgp_potential, nppnl=0)
2845 END IF
2846 !
2847 cpassert(.NOT. sgppot%has_local)
2848 cpassert(.NOT. sgppot%has_nlcc)
2849 ! core
2850 rc = 0.5_dp*qs_kind%covalent_radius*angstrom
2851 rc = max(rc, 0.2_dp)
2852 rc = min(rc, 1.0_dp)
2853 alpha = 1.0_dp/(2.0_dp*rc**2)
2854 ccore = ecppot%zion*sqrt((alpha/pi)**3)
2855 CALL set_potential(qs_kind%sgp_potential, alpha_core_charge=alpha, ccore_charge=ccore, &
2856 core_charge_radius=rc)
2857 CALL atom_sgp_release(sgppot)
2858 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2859 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2860 CALL set_qs_kind(qs_kind, elec_conf=ecppot%econf)
2861 END IF
2862 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2863 CALL set_potential(qs_kind%sgp_potential, elec_conf=elec_conf)
2864 CASE ("UPF")
2865 CALL allocate_potential(qs_kind%sgp_potential)
2866 CALL get_potential(qs_kind%sgp_potential, description=description)
2867 description(4) = "UPF "//trim(potential_name)
2868 CALL atom_read_upf(upfpot, potential_name)
2869 IF (trim(upfpot%pseudo_type) == "NC") THEN
2870 ALLOCATE (qs_kind%sgp_potential%upf_data, source=upfpot)
2871 END IF
2872 CALL set_potential(qs_kind%sgp_potential, name=upfpot%pname, description=description, &
2873 zeff=upfpot%zion, z=z, has_nlcc=upfpot%core_correction)
2874 ! convert pp
2875 CALL sgp_construction(sgp_pot=sgppot, upf_pot=upfpot, error=error)
2876 IF (iounit > 0 .AND. .NOT. silent) THEN
2877 WRITE (iounit, "(/,T2,'PP Transformation for ',A)") trim(upfpot%pname)
2878 IF (sgppot%has_local) THEN
2879 WRITE (iounit, "(T8,'Auxiliary local Gaussian fit error:',T61,F20.12)") error(1)
2880 END IF
2881 IF (sgppot%has_nonlocal) THEN
2882 IF (ALLOCATED(qs_kind%sgp_potential%upf_data)) THEN
2883 WRITE (iounit, "(T8,'Unused nonlocal Gaussian fit error:',T61,F20.12)") error(2)
2884 ELSE
2885 WRITE (iounit, "(T8,'Accuracy for nonlocal part:',T61,F20.12)") error(2)
2886 END IF
2887 END IF
2888 IF (sgppot%has_nlcc) THEN
2889 WRITE (iounit, "(T8,'Accuracy for NLCC density:',T61,F20.12)") error(3)
2890 END IF
2891 END IF
2892 IF (sgppot%has_nonlocal) THEN
2893 CALL set_potential(qs_kind%sgp_potential, n_nonlocal=sgppot%n_nonlocal, lmax=sgppot%lmax, &
2894 is_nonlocal=sgppot%is_nonlocal)
2895 nnl = sgppot%n_nonlocal
2896 nppnl = 0
2897 DO l = 0, sgppot%lmax
2898 nppnl = nppnl + nnl*nco(l)
2899 END DO
2900 l = sgppot%lmax
2901 ALLOCATE (a_nl(nnl), h_nl(nnl, 0:l), c_nl(nnl, nnl, 0:l))
2902 a_nl(:) = sgppot%a_nonlocal(:)
2903 h_nl(:, :) = sgppot%h_nonlocal(:, :)
2904 c_nl(:, :, :) = sgppot%c_nonlocal(:, :, :)
2905 CALL set_potential(qs_kind%sgp_potential, nppnl=nppnl, a_nonlocal=a_nl, h_nonlocal=h_nl, c_nonlocal=c_nl)
2906 ELSE
2907 CALL set_potential(qs_kind%sgp_potential, n_nonlocal=0, lmax=-1, is_nonlocal=sgppot%is_nonlocal)
2908 CALL set_potential(qs_kind%sgp_potential, nppnl=0)
2909 END IF
2910 cpassert(sgppot%has_local)
2911 ! core
2912 rc = sgppot%ac_local
2913 alpha = 1.0_dp/(2.0_dp*rc**2)
2914 ccore = upfpot%zion*sqrt((alpha/pi)**3)
2915 CALL set_potential(qs_kind%sgp_potential, alpha_core_charge=alpha, ccore_charge=ccore, &
2916 core_charge_radius=rc)
2917 ! local potential
2918 nloc = sgppot%n_local
2919 ALLOCATE (aloc(nloc), cloc(nloc))
2920 aloc(1:nloc) = sgppot%a_local(1:nloc)
2921 cloc(1:nloc) = sgppot%c_local(1:nloc)
2922 CALL set_potential(qs_kind%sgp_potential, n_local=nloc, a_local=aloc, c_local=cloc)
2923 IF (sgppot%has_nlcc) THEN
2924 nlcc = sgppot%n_nlcc
2925 ALLOCATE (anlcc(nlcc), cnlcc(nlcc))
2926 anlcc(1:nlcc) = sgppot%a_nlcc(1:nlcc)
2927 cnlcc(1:nlcc) = sgppot%c_nlcc(1:nlcc)
2928 CALL set_potential(qs_kind%sgp_potential, has_nlcc=.true., n_nlcc=nlcc, a_nlcc=anlcc, c_nlcc=cnlcc)
2929 END IF
2930 CALL set_potential(qs_kind%sgp_potential, z=z)
2931 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2932 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2933 CALL set_qs_kind(qs_kind, elec_conf=upfpot%econf)
2934 END IF
2935 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2936 CALL set_potential(qs_kind%sgp_potential, elec_conf=elec_conf)
2937 CALL atom_release_upf(upfpot)
2938 CALL atom_sgp_release(sgppot)
2939 CASE ("CNEO")
2940 IF (zeff_correction /= 0.0_dp) THEN
2941 cpabort("CORE_CORRECTION is not compatible with CNEO")
2942 END IF
2943 CALL allocate_cneo_potential(qs_kind%cneo_potential)
2944 CALL set_cneo_potential(qs_kind%cneo_potential, z=z)
2945 mass = 0.0_dp
2946 ! Input mass is the mass of the neutral atom, not the nucleus.
2947 ! The mass of electrons will get subtracted later.
2948 ! In principle, the most abundant pure isotope mass should be used.
2949 IF (k_rep > 0) THEN
2950 CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2951 keyword_name="MASS", n_rep_val=i)
2952 IF (i > 0) CALL section_vals_val_get(kind_section, i_rep_section=k_rep, &
2953 keyword_name="MASS", r_val=mass)
2954 END IF
2955 ! Remove electron mass from atomic mass to get nuclear mass
2956 IF (mass - real(z, dp)*0.000548579909_dp > 0.0_dp) THEN
2957 mass = mass - real(z, dp)*0.000548579909_dp
2958 CALL set_cneo_potential(qs_kind%cneo_potential, mass=mass)
2959 END IF
2960 ! In case the mass is not set by user, get the default mass from z
2961 CALL get_cneo_potential(qs_kind%cneo_potential, mass=mass)
2962 ! Warn if the mass is from ptable
2963 IF (abs(mass + real(z, dp)*0.000548579909_dp - ptable(z)%amass) < 1.e-4_dp) THEN
2964 CALL cp_warn(__location__, &
2965 "Atomic mass of the atomic kind <"//trim(qs_kind%name)// &
2966 "> is very close to its average mass. Is it a pure isotope? "// &
2967 "Pure isotopes are preferable for CNEO. "// &
2968 "(e.g., mass of 1H is 1.007825, not 1.00794)")
2969 END IF
2970 CALL get_qs_kind(qs_kind, elec_conf=elec_conf)
2971 IF (.NOT. ASSOCIATED(elec_conf)) THEN
2972 CALL get_cneo_potential(potential=qs_kind%cneo_potential, elec_conf=elec_conf)
2973 CALL set_qs_kind(qs_kind, elec_conf=elec_conf)
2974 ELSE
2975 CALL set_cneo_potential(potential=qs_kind%cneo_potential, elec_conf=elec_conf)
2976 END IF
2977 CASE DEFAULT
2978 CALL cp_abort(__location__, &
2979 "An invalid potential type <"// &
2980 trim(potential_name)//"> was specified "// &
2981 "for the atomic kind <"// &
2982 trim(qs_kind%name))
2983 END SELECT
2984 ELSE
2985 CALL cp_abort(__location__, &
2986 "No potential type was defined for the "// &
2987 "atomic kind <"//trim(qs_kind%name)//">")
2988 END IF
2989
2990 CALL check_potential_basis_compatibility(qs_kind)
2991
2992 ! Allocate and initialise the potential data set structure
2993 IF ((kgpot_name /= '') .OR. explicit_kgpot) THEN
2994 ipos = index(kgpot_name, "-")
2995 IF (ipos > 1) THEN
2996 kgpot_type = kgpot_name(:ipos - 1)
2997 ELSE
2998 kgpot_type = kgpot_name
2999 END IF
3000 CALL uppercase(kgpot_type)
3001
3002 SELECT CASE (trim(kgpot_type))
3003 CASE ("TNADD")
3004 CALL set_potential_file_names(potential_file_names, dft_potential_file_names, &
3005 kg_potential_fn_kind)
3006 CALL allocate_potential(qs_kind%tnadd_potential)
3007 CALL read_potential(qs_kind%element_symbol, kgpot_name, &
3008 qs_kind%tnadd_potential, para_env, &
3009 potential_file_names, kgpot_section, update_input)
3010 CASE ("NONE")
3011 NULLIFY (qs_kind%tnadd_potential)
3012 CASE DEFAULT
3013 CALL cp_abort(__location__, &
3014 "An invalid kg_potential type <"// &
3015 trim(potential_name)//"> was specified "// &
3016 "for the atomic kind <"// &
3017 trim(qs_kind%name))
3018 END SELECT
3019 END IF
3020 END IF
3021
3022 ! check that we have a nuclear orbital basis set if CNEO is requested
3023 nobasis_nuc = ASSOCIATED(qs_kind%cneo_potential)
3024 DO i = 1, SIZE(qs_kind%basis_sets)
3025 NULLIFY (tmp_basis_set)
3026 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis_set, &
3027 inumbas=i, basis_type=basis_type)
3028 IF (basis_type == "NUC") THEN
3029 nobasis_nuc = .false.
3030 IF (.NOT. ASSOCIATED(qs_kind%cneo_potential)) THEN
3031 CALL cp_warn(__location__, &
3032 "POTENTIAL is not set to CNEO, NUC type basis set for KIND <"// &
3033 trim(qs_kind%name)//"> will be ignored!")
3034 END IF
3035 END IF
3036 END DO
3037 IF (nobasis_nuc) THEN
3038 CALL cp_abort(__location__, &
3039 "No NUC type basis set was defined for the "// &
3040 "atomic kind <"//trim(qs_kind%name)//">, which is required by "// &
3041 "POTENTIAL CNEO.")
3042 END IF
3043 END SELECT
3044
3045 DEALLOCATE (dft_potential_file_names, potential_file_names)
3046 CALL timestop(handle)
3047
3048 END SUBROUTINE read_qs_kind
3049
3050! **************************************************************************************************
3051!> \brief Ensure pseudo-potential and basis set were optimized for same number of valence electrons
3052!> \param qs_kind ...
3053!> \author Ole Schuett
3054! **************************************************************************************************
3055 SUBROUTINE check_potential_basis_compatibility(qs_kind)
3056 TYPE(qs_kind_type), INTENT(INOUT) :: qs_kind
3057
3058 CHARACTER(LEN=default_string_length) :: name
3059 INTEGER :: nbs, npp
3060 TYPE(gth_potential_type), POINTER :: gth_potential
3061 TYPE(gto_basis_set_type), POINTER :: basis_set
3062
3063 CALL get_qs_kind(qs_kind, name=name, gth_potential=gth_potential, basis_set=basis_set)
3064
3065 npp = -1; nbs = -1
3066 IF (ASSOCIATED(gth_potential)) THEN
3067 npp = parse_valence_electrons(gth_potential%aliases)
3068 END IF
3069 IF (ASSOCIATED(basis_set)) THEN
3070 nbs = parse_valence_electrons(basis_set%aliases)
3071 END IF
3072
3073 IF (npp >= 0 .AND. nbs >= 0 .AND. npp /= nbs) THEN
3074 CALL cp_abort(__location__, "Basis-set and pseudo-potential of atomic kind '"//trim(name)//"'"// &
3075 " were optimized for different valence electron numbers.")
3076 END IF
3077
3078 END SUBROUTINE check_potential_basis_compatibility
3079
3080! **************************************************************************************************
3081!> \brief Tries to parse valence eletron number using "-QXXX" notation, returns -1 if not found.
3082!> \param string ...
3083!> \return ...
3084!> \author Ole Schuett
3085! **************************************************************************************************
3086 FUNCTION parse_valence_electrons(string) RESULT(n)
3087 CHARACTER(*) :: string
3088 INTEGER :: n
3089
3090 INTEGER :: i, istat, j
3091
3092 i = index(string, "-Q", .true.)
3093 IF (i == 0) THEN
3094 n = -1
3095 ELSE
3096 j = scan(string(i + 2:), "- ")
3097 READ (string(i + 2:i + j), '(I3)', iostat=istat) n
3098 IF (istat /= 0) n = -1
3099 END IF
3100
3101 END FUNCTION parse_valence_electrons
3102
3103! **************************************************************************************************
3104!> \brief Read an atomic kind set data set from the input file.
3105!> \param qs_kind_set ...
3106!> \param atomic_kind_set ...
3107!> \param kind_section ...
3108!> \param para_env ...
3109!> \param force_env_section ...
3110!> \param silent ...
3111! **************************************************************************************************
3112 SUBROUTINE create_qs_kind_set(qs_kind_set, atomic_kind_set, kind_section, para_env, &
3113 force_env_section, silent)
3114
3115 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
3116 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
3117 TYPE(section_vals_type), POINTER :: kind_section
3118 TYPE(mp_para_env_type), POINTER :: para_env
3119 TYPE(section_vals_type), POINTER :: force_env_section
3120 LOGICAL, INTENT(IN) :: silent
3121
3122 CHARACTER(len=*), PARAMETER :: routinen = 'create_qs_kind_set'
3123
3124 INTEGER :: handle, ikind, method, nkind, qs_method
3125 LOGICAL :: no_fail
3126
3127 CALL timeset(routinen, handle)
3128
3129 IF (ASSOCIATED(qs_kind_set)) cpabort("create_qs_kind_set: qs_kind_set already associated")
3130 IF (.NOT. ASSOCIATED(atomic_kind_set)) cpabort("create_qs_kind_set: atomic_kind_set not associated")
3131
3132 no_fail = .false.
3133
3134 ! Between all methods only SE and DFTB/xTB may not need a KIND section.
3135 CALL section_vals_val_get(force_env_section, "METHOD", i_val=method)
3136 IF (method == do_qs) THEN
3137 CALL section_vals_val_get(force_env_section, "DFT%QS%METHOD", i_val=qs_method)
3138 SELECT CASE (qs_method)
3139 CASE (do_method_mndo, do_method_am1, do_method_pm3, do_method_pm6fm, do_method_pm6, &
3140 do_method_pdg, do_method_rm1, do_method_mndod, do_method_pnnl)
3141 no_fail = .true.
3142 CASE (do_method_dftb)
3143 no_fail = .true.
3144 CASE (do_method_xtb)
3145 no_fail = .true.
3146 END SELECT
3147 ELSE IF (method == do_sirius) THEN
3148 qs_method = do_method_pw
3149 ELSE
3150 qs_method = method
3151 END IF
3152
3153 nkind = SIZE(atomic_kind_set)
3154 ALLOCATE (qs_kind_set(nkind))
3155
3156 DO ikind = 1, nkind
3157 qs_kind_set(ikind)%name = atomic_kind_set(ikind)%name
3158 qs_kind_set(ikind)%element_symbol = atomic_kind_set(ikind)%element_symbol
3159 qs_kind_set(ikind)%natom = atomic_kind_set(ikind)%natom
3160 CALL read_qs_kind(qs_kind_set(ikind), kind_section, para_env, force_env_section, &
3161 no_fail, qs_method, silent)
3162 END DO
3163
3164 CALL timestop(handle)
3165
3166 END SUBROUTINE create_qs_kind_set
3167
3168! **************************************************************************************************
3169!> \brief This routines should perform only checks. no settings are allowed at
3170!> this level anymore..
3171!> \param qs_kind ...
3172!> \param dft_control ...
3173!> \param subsys_section ...
3174! **************************************************************************************************
3175 SUBROUTINE check_qs_kind(qs_kind, dft_control, subsys_section)
3176
3177 TYPE(qs_kind_type), POINTER :: qs_kind
3178 TYPE(dft_control_type), INTENT(IN) :: dft_control
3179 TYPE(section_vals_type), POINTER :: subsys_section
3180
3181 INTEGER :: gfn_type
3182 LOGICAL :: defined
3183 TYPE(qs_dftb_atom_type), POINTER :: dftb_parameter
3184 TYPE(semi_empirical_type), POINTER :: se_parameter
3185 TYPE(xtb_atom_type), POINTER :: xtb_parameter
3186
3187 IF (dft_control%qs_control%semi_empirical) THEN
3188 CALL get_qs_kind(qs_kind, se_parameter=se_parameter)
3189 cpassert(ASSOCIATED(se_parameter))
3190 CALL get_se_param(se_parameter, defined=defined)
3191 cpassert(defined)
3192 CALL write_se_param(se_parameter, subsys_section)
3193 ELSE IF (dft_control%qs_control%dftb) THEN
3194 CALL get_qs_kind(qs_kind, dftb_parameter=dftb_parameter)
3195 cpassert(ASSOCIATED(dftb_parameter))
3196 CALL get_dftb_atom_param(dftb_parameter, defined=defined)
3197 cpassert(defined)
3198 CALL write_dftb_atom_param(dftb_parameter, subsys_section)
3199 ELSE IF (dft_control%qs_control%xtb) THEN
3200 IF (.NOT. (dft_control%qs_control%xtb_control%do_tblite)) THEN
3201 CALL get_qs_kind(qs_kind, xtb_parameter=xtb_parameter)
3202 cpassert(ASSOCIATED(xtb_parameter))
3203 gfn_type = dft_control%qs_control%xtb_control%gfn_type
3204 CALL write_xtb_atom_param(xtb_parameter, gfn_type, subsys_section)
3205 END IF
3206 END IF
3207
3208 END SUBROUTINE check_qs_kind
3209
3210! **************************************************************************************************
3211!> \brief ...
3212!> \param qs_kind_set ...
3213!> \param dft_control ...
3214!> \param subsys_section ...
3215! **************************************************************************************************
3216 SUBROUTINE check_qs_kind_set(qs_kind_set, dft_control, subsys_section)
3217
3218 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
3219 TYPE(dft_control_type), INTENT(IN) :: dft_control
3220 TYPE(section_vals_type), POINTER :: subsys_section
3221
3222 CHARACTER(len=*), PARAMETER :: routinen = 'check_qs_kind_set'
3223
3224 INTEGER :: handle, ikind, nkind
3225 TYPE(qs_kind_type), POINTER :: qs_kind
3226
3227 CALL timeset(routinen, handle)
3228 IF (ASSOCIATED(qs_kind_set)) THEN
3229 nkind = SIZE(qs_kind_set)
3230 DO ikind = 1, nkind
3231 qs_kind => qs_kind_set(ikind)
3232 CALL check_qs_kind(qs_kind, dft_control, subsys_section)
3233 END DO
3234 IF (dft_control%qs_control%xtb) THEN
3235 CALL write_xtb_kab_param(qs_kind_set, subsys_section, &
3236 dft_control%qs_control%xtb_control)
3237 END IF
3238 ELSE
3239 cpabort("The pointer qs_kind_set is not associated")
3240 END IF
3241 CALL timestop(handle)
3242 END SUBROUTINE check_qs_kind_set
3243
3244! **************************************************************************************************
3245!> \brief ...
3246!> \param qs_kind_set ...
3247!> \param subsys_section ...
3248!> \param xtb_control ...
3249! **************************************************************************************************
3250 SUBROUTINE write_xtb_kab_param(qs_kind_set, subsys_section, xtb_control)
3251
3252 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
3253 TYPE(section_vals_type), POINTER :: subsys_section
3254 TYPE(xtb_control_type), POINTER :: xtb_control
3255
3256 CHARACTER(LEN=default_string_length) :: aname, bname
3257 INTEGER :: ikind, io_unit, jkind, nkind, za, zb
3258 TYPE(cp_logger_type), POINTER :: logger
3259 TYPE(qs_kind_type), POINTER :: qs_kinda, qs_kindb
3260 TYPE(xtb_atom_type), POINTER :: xtb_parameter_a, xtb_parameter_b
3261
3262 NULLIFY (logger)
3263 logger => cp_get_default_logger()
3264 IF (btest(cp_print_key_should_output(logger%iter_info, subsys_section, &
3265 "PRINT%KINDS/POTENTIAL"), cp_p_file)) THEN
3266
3267 io_unit = cp_print_key_unit_nr(logger, subsys_section, "PRINT%KINDS", extension=".Log")
3268 IF (io_unit > 0) THEN
3269
3270 WRITE (io_unit, "(/,T2,A)") "xTB| Kab parameters"
3271 nkind = SIZE(qs_kind_set)
3272 DO ikind = 1, nkind
3273 qs_kinda => qs_kind_set(ikind)
3274 CALL get_qs_kind(qs_kinda, xtb_parameter=xtb_parameter_a)
3275 CALL get_xtb_atom_param(xtb_parameter_a, aname=aname, z=za)
3276 DO jkind = ikind, nkind
3277 qs_kindb => qs_kind_set(jkind)
3278 CALL get_qs_kind(qs_kindb, xtb_parameter=xtb_parameter_b)
3279 CALL get_xtb_atom_param(xtb_parameter_b, aname=bname, z=zb)
3280 WRITE (io_unit, "(A,T10,A15,T25,A15,T71,F10.3)") &
3281 " Kab:", trim(aname), trim(bname), xtb_set_kab(za, zb, xtb_control)
3282 END DO
3283 END DO
3284 WRITE (io_unit, *)
3285
3286 END IF
3287
3288 CALL cp_print_key_finished_output(io_unit, logger, subsys_section, "PRINT%KINDS")
3289 END IF
3290
3291 END SUBROUTINE write_xtb_kab_param
3292
3293! **************************************************************************************************
3294!> \brief Set the components of an atomic kind data set.
3295!> \param qs_kind ...
3296!> \param paw_atom ...
3297!> \param ghost ...
3298!> \param floating ...
3299!> \param hard_radius ...
3300!> \param hard0_radius ...
3301!> \param covalent_radius ...
3302!> \param vdw_radius ...
3303!> \param lmax_rho0 ...
3304!> \param zeff ...
3305!> \param no_optimize ...
3306!> \param dispersion ...
3307!> \param u_minus_j ...
3308!> \param hund_j ...
3309!> \param reltmat ...
3310!> \param dftb_parameter ...
3311!> \param xtb_parameter ...
3312!> \param elec_conf ...
3313!> \param pao_basis_size ...
3314! **************************************************************************************************
3315 SUBROUTINE set_qs_kind(qs_kind, paw_atom, ghost, floating, hard_radius, hard0_radius, &
3316 covalent_radius, vdw_radius, lmax_rho0, zeff, &
3317 no_optimize, dispersion, u_minus_j, hund_j, reltmat, &
3318 dftb_parameter, xtb_parameter, &
3319 elec_conf, pao_basis_size)
3320
3321 TYPE(qs_kind_type), INTENT(INOUT) :: qs_kind
3322 LOGICAL, INTENT(IN), OPTIONAL :: paw_atom, ghost, floating
3323 REAL(kind=dp), INTENT(IN), OPTIONAL :: hard_radius, hard0_radius, &
3324 covalent_radius, vdw_radius
3325 INTEGER, INTENT(IN), OPTIONAL :: lmax_rho0
3326 REAL(kind=dp), INTENT(IN), OPTIONAL :: zeff
3327 LOGICAL, INTENT(IN), OPTIONAL :: no_optimize
3328 TYPE(qs_atom_dispersion_type), OPTIONAL, POINTER :: dispersion
3329 REAL(kind=dp), INTENT(IN), OPTIONAL :: u_minus_j, hund_j
3330 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: reltmat
3331 TYPE(qs_dftb_atom_type), OPTIONAL, POINTER :: dftb_parameter
3332 TYPE(xtb_atom_type), OPTIONAL, POINTER :: xtb_parameter
3333 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: elec_conf
3334 INTEGER, INTENT(IN), OPTIONAL :: pao_basis_size
3335
3336 IF (PRESENT(dftb_parameter)) qs_kind%dftb_parameter => dftb_parameter
3337 IF (PRESENT(xtb_parameter)) qs_kind%xtb_parameter => xtb_parameter
3338 IF (PRESENT(elec_conf)) THEN
3339 IF (ASSOCIATED(qs_kind%elec_conf)) THEN
3340 DEALLOCATE (qs_kind%elec_conf)
3341 END IF
3342 ALLOCATE (qs_kind%elec_conf(0:SIZE(elec_conf) - 1))
3343 qs_kind%elec_conf(:) = elec_conf(:)
3344 END IF
3345 IF (PRESENT(paw_atom)) qs_kind%paw_atom = paw_atom
3346 IF (PRESENT(hard_radius)) qs_kind%hard_radius = hard_radius
3347 IF (PRESENT(hard0_radius)) qs_kind%hard0_radius = hard0_radius
3348 IF (PRESENT(covalent_radius)) qs_kind%covalent_radius = covalent_radius
3349 IF (PRESENT(vdw_radius)) qs_kind%vdw_radius = vdw_radius
3350 IF (PRESENT(lmax_rho0)) qs_kind%lmax_rho0 = lmax_rho0
3351 IF (PRESENT(zeff)) THEN
3352 IF (ASSOCIATED(qs_kind%all_potential)) THEN
3353 CALL set_potential(potential=qs_kind%all_potential, zeff=zeff)
3354 ELSE IF (ASSOCIATED(qs_kind%gth_potential)) THEN
3355 CALL set_potential(potential=qs_kind%gth_potential, zeff=zeff)
3356 ELSE IF (ASSOCIATED(qs_kind%sgp_potential)) THEN
3357 CALL set_potential(potential=qs_kind%sgp_potential, zeff=zeff)
3358 ELSE IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
3359 cpabort("CNEO potential ZEFF should not be manually set")
3360 END IF
3361 END IF
3362 IF (PRESENT(ghost)) qs_kind%ghost = ghost
3363
3364 IF (PRESENT(floating)) qs_kind%floating = floating
3365
3366 IF (PRESENT(no_optimize)) qs_kind%no_optimize = no_optimize
3367
3368 IF (PRESENT(dispersion)) qs_kind%dispersion => dispersion
3369
3370 IF (PRESENT(u_minus_j)) THEN
3371 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
3372 qs_kind%dft_plus_u%u_minus_j = u_minus_j
3373 END IF
3374 END IF
3375
3376 IF (PRESENT(hund_j)) THEN
3377 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
3378 qs_kind%dft_plus_u%hund_j = hund_j
3379 END IF
3380 END IF
3381
3382 IF (PRESENT(reltmat)) qs_kind%reltmat => reltmat
3383
3384 IF (PRESENT(pao_basis_size)) qs_kind%pao_basis_size = pao_basis_size
3385
3386 END SUBROUTINE set_qs_kind
3387
3388! **************************************************************************************************
3389!> \brief Write an atomic kind data set to the output unit.
3390!> \param qs_kind ...
3391!> \param kind_number ...
3392!> \param output_unit ...
3393!> \par History
3394!> Creation (09.02.2002,MK)
3395! **************************************************************************************************
3396 SUBROUTINE write_qs_kind(qs_kind, kind_number, output_unit)
3397
3398 TYPE(qs_kind_type), POINTER :: qs_kind
3399 INTEGER, INTENT(in) :: kind_number, output_unit
3400
3401 CHARACTER(LEN=3) :: yon
3402 CHARACTER(LEN=default_string_length) :: basis_type, bstring
3403 INTEGER :: ibas
3404 LOGICAL :: do_print
3405 TYPE(gto_basis_set_type), POINTER :: tmp_basis
3406
3407 IF (output_unit > 0) THEN
3408
3409 IF (ASSOCIATED(qs_kind)) THEN
3410 WRITE (unit=output_unit, fmt="(/,T2,I2,A,T57,A,T75,I6)") &
3411 kind_number, ". Atomic kind: "//trim(qs_kind%name), &
3412 "Number of atoms: ", qs_kind%natom
3413
3414 DO ibas = 1, SIZE(qs_kind%basis_sets, 1)
3415 NULLIFY (tmp_basis)
3416 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis, &
3417 inumbas=ibas, basis_type=basis_type)
3418 do_print = .true.
3419 SELECT CASE (basis_type)
3420 CASE DEFAULT
3421 bstring = "Basis Set"
3422 do_print = .false.
3423 CASE ("ORB")
3424 bstring = "Orbital Basis Set"
3425 CASE ("ORB_SOFT")
3426 bstring = "GAPW Soft Basis Set"
3427 do_print = .false.
3428 CASE ("AUX")
3429 bstring = "Auxiliary Basis Set"
3430 CASE ("MIN")
3431 bstring = "Minimal Basis Set"
3432 CASE ("RI_AUX")
3433 bstring = "RI Auxiliary Basis Set"
3434 CASE ("AUX_FIT")
3435 bstring = "Auxiliary Fit Basis Set"
3436 CASE ("LRI_AUX")
3437 bstring = "LRI Basis Set"
3438 CASE ("P_LRI_AUX")
3439 bstring = "LRI Basis Set for TDDFPT"
3440 CASE ("RI_XAS")
3441 bstring = "RI XAS Basis Set"
3442 CASE ("RI_HFX")
3443 bstring = "RI HFX Basis Set"
3444 CASE ("NUC")
3445 bstring = "Nuclear Basis Set"
3446 do_print = .false.
3447 CASE ("NUC_SOFT")
3448 bstring = "Nuclear Soft Basis Set"
3449 do_print = .false.
3450 END SELECT
3451
3452 IF (do_print) THEN
3453 CALL write_orb_basis_set(tmp_basis, output_unit, bstring)
3454 END IF
3455
3456 END DO
3457
3458 IF (qs_kind%ghost) THEN
3459 WRITE (unit=output_unit, fmt="(/,T6,A)") &
3460 "The atoms of this atomic kind are GHOST atoms!"
3461 END IF
3462 IF (qs_kind%monovalent) THEN
3463 WRITE (unit=output_unit, fmt="(/,T6,A)") &
3464 "The atoms of this atomic kind are MONOVALENT!"
3465 END IF
3466 IF (qs_kind%floating) THEN
3467 WRITE (unit=output_unit, fmt="(/,T6,A)") &
3468 "The atoms of this atomic kind are FLOATING BASIS FUNCTIONS."
3469 END IF
3470 IF (qs_kind%covalent_radius > 0.0_dp) THEN
3471 WRITE (unit=output_unit, fmt="(/,T8,A,T71,F10.3)") &
3472 "Atomic covalent radius [Angstrom]:", &
3473 qs_kind%covalent_radius*angstrom
3474 END IF
3475 IF (qs_kind%vdw_radius > 0.0_dp) THEN
3476 WRITE (unit=output_unit, fmt="(/,T8,A,T71,F10.3)") &
3477 "Atomic van der Waals radius [Angstrom]:", &
3478 qs_kind%vdw_radius*angstrom
3479 END IF
3480 IF (qs_kind%paw_atom) THEN
3481 WRITE (unit=output_unit, fmt="(/,T6,A)") &
3482 "The atoms of this atomic kind are PAW atoms (GAPW):"
3483 WRITE (unit=output_unit, fmt="(T8,A,T71,F10.3)") &
3484 "Hard Gaussian function radius:", qs_kind%hard_radius, &
3485 "Rho0 radius:", qs_kind%hard0_radius, &
3486 "Maximum GTO radius used for PAW projector construction:", &
3487 qs_kind%max_rad_local
3488 NULLIFY (tmp_basis)
3489 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis, &
3490 basis_type="ORB_SOFT")
3491 CALL write_orb_basis_set(tmp_basis, output_unit, "GAPW Soft Basis Set")
3492 END IF
3493 ! Potentials
3494 IF (ASSOCIATED(qs_kind%all_potential)) CALL write_potential(qs_kind%all_potential, output_unit)
3495 IF (ASSOCIATED(qs_kind%gth_potential)) CALL write_potential(qs_kind%gth_potential, output_unit)
3496 IF (ASSOCIATED(qs_kind%sgp_potential)) CALL write_potential(qs_kind%sgp_potential, output_unit)
3497 IF (ASSOCIATED(qs_kind%tnadd_potential)) CALL write_potential(qs_kind%tnadd_potential, output_unit)
3498 IF (ASSOCIATED(qs_kind%dft_plus_u)) THEN
3499 WRITE (unit=output_unit, fmt="(/,T6,A,/,T8,A,T76,I5,/,T8,A,T73,F8.3,/,T8,A,T73,F8.3)") &
3500 "A DFT+U correction is applied to atoms of this atomic kind:", &
3501 "Angular quantum momentum number L:", qs_kind%dft_plus_u%l, &
3502 "U(eff) = (U - J) value in [eV]:", qs_kind%dft_plus_u%u_minus_j_target*evolt, &
3503 "Hund J value in [eV]:", qs_kind%dft_plus_u%hund_j*evolt
3504 IF (qs_kind%dft_plus_u%u_ramping > 0.0_dp) THEN
3505 IF (qs_kind%dft_plus_u%init_u_ramping_each_scf) THEN
3506 yon = "YES"
3507 ELSE
3508 yon = " NO"
3509 END IF
3510 WRITE (unit=output_unit, fmt="(T8,A,T73,F8.3,/,T8,A,T73,ES8.1,/,T8,A,T78,A3)") &
3511 "Increment for U ramping in [eV]:", qs_kind%dft_plus_u%u_ramping*evolt, &
3512 "SCF threshold value for U ramping:", qs_kind%dft_plus_u%eps_u_ramping, &
3513 "Set U ramping value to zero before each wavefunction optimisation:", yon
3514 END IF
3515 IF (ASSOCIATED(qs_kind%dft_plus_u%orbitals)) THEN
3516 WRITE (unit=output_unit, fmt="(T8,A)") &
3517 "An initial orbital occupation is requested:"
3518 IF (ASSOCIATED(qs_kind%dft_plus_u%nelec)) THEN
3519 IF (any(qs_kind%dft_plus_u%nelec(:) >= 0.5_dp)) THEN
3520 IF (SIZE(qs_kind%dft_plus_u%nelec) > 1) THEN
3521 WRITE (unit=output_unit, fmt="(T9,A,T75,F6.2)") &
3522 "Number of alpha electrons:", &
3523 qs_kind%dft_plus_u%nelec(1), &
3524 "Number of beta electrons:", &
3525 qs_kind%dft_plus_u%nelec(2)
3526 ELSE
3527 WRITE (unit=output_unit, fmt="(T9,A,T75,F6.2)") &
3528 "Number of electrons:", &
3529 qs_kind%dft_plus_u%nelec(1)
3530 END IF
3531 END IF
3532 END IF
3533 WRITE (unit=output_unit, fmt="(T9,A,(T78,I3))") &
3534 "Preferred (initial) orbital occupation order (orbital M values):", &
3535 qs_kind%dft_plus_u%orbitals(:)
3536 WRITE (unit=output_unit, fmt="(T9,A,T71,ES10.3,/,T9,A,T76,I5)") &
3537 "Threshold value for the SCF convergence criterion:", &
3538 qs_kind%dft_plus_u%eps_scf, &
3539 "Number of initial SCF iterations:", &
3540 qs_kind%dft_plus_u%max_scf
3541 IF (qs_kind%dft_plus_u%smear) THEN
3542 WRITE (unit=output_unit, fmt="(T9,A)") &
3543 "A smearing of the orbital occupations will be performed"
3544 END IF
3545 END IF
3546 END IF
3547 IF (ASSOCIATED(qs_kind%cneo_potential)) THEN
3548 WRITE (unit=output_unit, fmt="(/,T6,A)") &
3549 "The nuclei of this atomic kind are quantum mechanical (CNEO)"
3550 CALL write_cneo_potential(qs_kind%cneo_potential, output_unit)
3551 NULLIFY (tmp_basis)
3552 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis, &
3553 basis_type="NUC")
3554 CALL write_orb_basis_set(tmp_basis, output_unit, "Nuclear Basis Set")
3555 NULLIFY (tmp_basis)
3556 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis, &
3557 basis_type="NUC_SOFT")
3558 CALL write_orb_basis_set(tmp_basis, output_unit, "Nuclear Soft Basis Set")
3559 END IF
3560 ELSE
3561 cpabort("write_qs_kind requires qs_kind to be associated")
3562 END IF
3563
3564 END IF
3565
3566 END SUBROUTINE write_qs_kind
3567
3568! **************************************************************************************************
3569!> \brief Write an atomic kind set data set to the output unit.
3570!> \param qs_kind_set ...
3571!> \param subsys_section ...
3572!> \par History
3573!> Creation (09.02.2002,MK)
3574! **************************************************************************************************
3575 SUBROUTINE write_qs_kind_set(qs_kind_set, subsys_section)
3576 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
3577 TYPE(section_vals_type), POINTER :: subsys_section
3578
3579 CHARACTER(len=*), PARAMETER :: routinen = 'write_qs_kind_set'
3580
3581 INTEGER :: handle, ikind, nkind, output_unit
3582 TYPE(cp_logger_type), POINTER :: logger
3583 TYPE(qs_kind_type), POINTER :: qs_kind
3584
3585 CALL timeset(routinen, handle)
3586
3587 NULLIFY (logger)
3588 logger => cp_get_default_logger()
3589 output_unit = cp_print_key_unit_nr(logger, subsys_section, &
3590 "PRINT%KINDS", extension=".Log")
3591 IF (output_unit > 0) THEN
3592 IF (ASSOCIATED(qs_kind_set)) THEN
3593 WRITE (unit=output_unit, fmt="(/,/,T2,A)") "ATOMIC KIND INFORMATION"
3594 nkind = SIZE(qs_kind_set)
3595 DO ikind = 1, nkind
3596 qs_kind => qs_kind_set(ikind)
3597 CALL write_qs_kind(qs_kind, ikind, output_unit)
3598 END DO
3599 ELSE
3600 cpabort("write_qs_kind_set requires qs_kind_set to be associated")
3601 END IF
3602 END IF
3603
3604 CALL cp_print_key_finished_output(output_unit, logger, subsys_section, &
3605 "PRINT%KINDS")
3606
3607 CALL timestop(handle)
3608
3609 END SUBROUTINE write_qs_kind_set
3610
3611! **************************************************************************************************
3612!> \brief Write all the GTO basis sets of an atomic kind set to the output
3613!> unit (for the printing of the unnormalized basis sets as read from
3614!> database).
3615!> \param qs_kind_set ...
3616!> \param subsys_section ...
3617!> \par History
3618!> Creation (17.01.2002,MK)
3619! **************************************************************************************************
3620 SUBROUTINE write_gto_basis_sets(qs_kind_set, subsys_section)
3621
3622 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
3623 TYPE(section_vals_type), POINTER :: subsys_section
3624
3625 CHARACTER(LEN=*), PARAMETER :: routinen = 'write_gto_basis_sets'
3626
3627 CHARACTER(LEN=default_string_length) :: basis_type, bstring
3628 INTEGER :: handle, ibas, ikind, nkind, output_unit
3629 TYPE(cp_logger_type), POINTER :: logger
3630 TYPE(gto_basis_set_type), POINTER :: tmp_basis
3631 TYPE(qs_kind_type), POINTER :: qs_kind
3632
3633 CALL timeset(routinen, handle)
3634
3635 NULLIFY (logger)
3636 logger => cp_get_default_logger()
3637 output_unit = cp_print_key_unit_nr(logger, subsys_section, &
3638 "PRINT%KINDS/BASIS_SET", &
3639 extension=".Log")
3640 IF (output_unit > 0) THEN
3641 IF (ASSOCIATED(qs_kind_set)) THEN
3642 WRITE (unit=output_unit, fmt="(/,/,T2,A)") &
3643 "BASIS SET INFORMATION (Unnormalised Gaussian-type functions)"
3644 nkind = SIZE(qs_kind_set)
3645 DO ikind = 1, nkind
3646 qs_kind => qs_kind_set(ikind)
3647 WRITE (unit=output_unit, fmt="(/,T2,I2,A)") &
3648 ikind, ". Atomic kind: "//trim(qs_kind%name)
3649
3650 DO ibas = 1, SIZE(qs_kind%basis_sets, 1)
3651 NULLIFY (tmp_basis)
3652 CALL get_basis_from_container(qs_kind%basis_sets, basis_set=tmp_basis, &
3653 inumbas=ibas, basis_type=basis_type)
3654 IF (basis_type == "") cycle
3655 SELECT CASE (basis_type)
3656 CASE DEFAULT
3657 bstring = "Basis Set"
3658 CASE ("ORB")
3659 bstring = "Orbital Basis Set"
3660 CASE ("ORB_SOFT")
3661 bstring = "GAPW Soft Basis Set"
3662 CASE ("AUX")
3663 bstring = "Auxiliary Basis Set"
3664 CASE ("MIN")
3665 bstring = "Minimal Basis Set"
3666 CASE ("RI_AUX")
3667 bstring = "RI Auxiliary Basis Set"
3668 CASE ("AUX_FIT")
3669 bstring = "Auxiliary Fit Basis Set"
3670 CASE ("LRI_AUX")
3671 bstring = "LRI Basis Set"
3672 CASE ("P_LRI_AUX")
3673 bstring = "LRI Basis Set for TDDFPT"
3674 CASE ("RI_HFX")
3675 bstring = "RI HFX Basis Set"
3676 CASE ("NUC")
3677 bstring = "Nuclear Basis Set"
3678 IF (.NOT. ASSOCIATED(qs_kind%cneo_potential)) NULLIFY (tmp_basis)
3679 CASE ("NUC_SOFT")
3680 bstring = "Nuclear Soft Basis Set"
3681 IF (.NOT. ASSOCIATED(qs_kind%cneo_potential)) NULLIFY (tmp_basis)
3682 END SELECT
3683
3684 IF (ASSOCIATED(tmp_basis)) CALL write_gto_basis_set(tmp_basis, output_unit, bstring)
3685
3686 END DO
3687
3688 END DO
3689 ELSE
3690 cpabort("write_gto_basis_sets require qs_kind_set to be associated")
3691 END IF
3692 END IF
3693
3694 CALL cp_print_key_finished_output(output_unit, logger, subsys_section, &
3695 "PRINT%KINDS/BASIS_SET")
3696
3697 CALL timestop(handle)
3698
3699 END SUBROUTINE write_gto_basis_sets
3700
3701! **************************************************************************************************
3702!> \brief ...
3703!> \param atomic_kind ...
3704!> \param qs_kind ...
3705!> \param ncalc ...
3706!> \param ncore ...
3707!> \param nelem ...
3708!> \param edelta ...
3709!> \param rks ...
3710! **************************************************************************************************
3711 SUBROUTINE init_atom_electronic_state(atomic_kind, qs_kind, ncalc, ncore, nelem, edelta, rks)
3712
3713 TYPE(atomic_kind_type), INTENT(IN) :: atomic_kind
3714 TYPE(qs_kind_type), INTENT(IN) :: qs_kind
3715 INTEGER, DIMENSION(0:lmat, 10), INTENT(OUT) :: ncalc, ncore, nelem
3716 REAL(kind=dp), DIMENSION(0:lmat, 10, 2), &
3717 INTENT(OUT) :: edelta
3718 LOGICAL, INTENT(IN), OPTIONAL :: rks
3719
3720 INTEGER :: i, ii, is, l, ll, ne, nn, z
3721 INTEGER, DIMENSION(:), POINTER :: econf
3722 INTEGER, DIMENSION(:, :), POINTER :: addel, laddel, naddel
3723 LOGICAL :: bs_occupation, monovalent
3724 REAL(kind=dp) :: dmag, magnetization
3725 TYPE(gth_potential_type), POINTER :: gth_potential
3726 TYPE(sgp_potential_type), POINTER :: sgp_potential
3727
3728 CALL get_atomic_kind(atomic_kind, z=z)
3729 NULLIFY (gth_potential)
3730 CALL get_qs_kind(qs_kind, &
3731 gth_potential=gth_potential, &
3732 sgp_potential=sgp_potential, &
3733 magnetization=magnetization, &
3734 bs_occupation=bs_occupation, &
3735 monovalent=monovalent, &
3736 addel=addel, laddel=laddel, naddel=naddel)
3737
3738 IF (PRESENT(rks)) THEN
3739 IF (rks) THEN
3740 magnetization = 0.0_dp
3741 bs_occupation = .false.
3742 END IF
3743 END IF
3744
3745 ! electronic state
3746 nelem = 0
3747 ncore = 0
3748 ncalc = 0
3749 edelta = 0.0_dp
3750 IF (monovalent) THEN
3751 ncalc(0, 1) = 1
3752 nelem(0, 1) = 1
3753 ELSE IF (ASSOCIATED(gth_potential)) THEN
3754 CALL get_potential(gth_potential, elec_conf=econf)
3755 CALL set_pseudo_state(econf, z, ncalc, ncore, nelem)
3756 ELSE IF (ASSOCIATED(sgp_potential)) THEN
3757 CALL get_potential(sgp_potential, elec_conf=econf)
3758 CALL set_pseudo_state(econf, z, ncalc, ncore, nelem)
3759 ELSE
3760 DO l = 0, min(lmat, ubound(ptable(z)%e_conv, 1))
3761 ll = 2*(2*l + 1)
3762 nn = ptable(z)%e_conv(l)
3763 ii = 0
3764 DO
3765 ii = ii + 1
3766 IF (nn <= ll) THEN
3767 nelem(l, ii) = nn
3768 EXIT
3769 ELSE
3770 nelem(l, ii) = ll
3771 nn = nn - ll
3772 END IF
3773 END DO
3774 END DO
3775 ncalc = nelem - ncore
3776 END IF
3777
3778 ! readjust the occupation number of the orbitals as requested by user
3779 ! this is done to break symmetry (bs) and bias the initial guess
3780 ! to the pre-defined multiplicity/charge state of the atom
3781 IF (bs_occupation) THEN
3782 DO is = 1, 2
3783 DO i = 1, SIZE(addel, 1)
3784 ne = addel(i, is)
3785 l = laddel(i, is)
3786 nn = naddel(i, is) - l
3787 IF (ne /= 0) THEN
3788 IF (nn == 0) THEN
3789 DO ii = SIZE(nelem, 2), 1, -1
3790 IF (ncalc(l, ii) > 0) THEN
3791 IF ((ncalc(l, ii) + ne) < 2*(2*l + 1) + 1) THEN
3792 edelta(l, ii, is) = edelta(l, ii, is) + ne
3793 nn = ii
3794 ELSE
3795 edelta(l, ii + 1, is) = edelta(l, ii + 1, is) + ne
3796 nn = ii + 1
3797 END IF
3798 EXIT
3799 ELSE IF (ii == 1) THEN
3800 edelta(l, ii, is) = edelta(l, ii, is) + ne
3801 nn = ii
3802 END IF
3803 END DO
3804 ELSE
3805 edelta(l, nn, is) = edelta(l, nn, is) + ne
3806 END IF
3807 IF (ncalc(l, nn) + edelta(l, nn, is) < 0) THEN
3808 edelta(l, nn, is) = -ncalc(l, nn)
3809 END IF
3810 END IF
3811 END DO
3812 END DO
3813 edelta = 0.5_dp*edelta
3814 ELSE IF (magnetization /= 0.0_dp) THEN
3815 dmag = 0.5_dp*abs(magnetization)
3816 DO l = 0, min(lmat, ubound(ptable(z)%e_conv, 1))
3817 ll = 2*(2*l + 1)
3818 ii = 0
3819 DO i = 1, SIZE(ncalc, 2)
3820 IF (ncalc(l, i) == 0) cycle
3821 IF (ncalc(l, i) == ll) cycle
3822 IF (ncalc(l, i) > dmag .AND. (ll - ncalc(l, i)) > dmag) THEN
3823 ii = i
3824 EXIT
3825 END IF
3826 END DO
3827 IF (ii /= 0) THEN
3828 edelta(l, ii, 1) = magnetization*0.5_dp
3829 edelta(l, ii, 2) = -magnetization*0.5_dp
3830 EXIT
3831 END IF
3832 END DO
3833 IF (ii == 0) THEN
3834 CALL cp_abort(__location__, &
3835 "Magnetization value cannot be imposed for this atom type")
3836 END IF
3837 END IF
3838
3839 IF (qs_kind%ghost .OR. qs_kind%floating) THEN
3840 nelem = 0
3841 ncore = 0
3842 ncalc = 0
3843 edelta = 0.0_dp
3844 END IF
3845
3846 END SUBROUTINE init_atom_electronic_state
3847
3848! **************************************************************************************************
3849!> \brief ...
3850!> \param econf ...
3851!> \param z ...
3852!> \param ncalc ...
3853!> \param ncore ...
3854!> \param nelem ...
3855! **************************************************************************************************
3856 SUBROUTINE set_pseudo_state(econf, z, ncalc, ncore, nelem)
3857 INTEGER, DIMENSION(:), POINTER :: econf
3858 INTEGER, INTENT(IN) :: z
3859 INTEGER, DIMENSION(0:lmat, 10), INTENT(OUT) :: ncalc, ncore, nelem
3860
3861 CHARACTER(LEN=default_string_length) :: message
3862 INTEGER :: ii, iounit, l, ll, lmin, nc, nn
3863 INTEGER, DIMENSION(0:lmat) :: econfx
3864 TYPE(cp_logger_type), POINTER :: logger
3865
3866 NULLIFY (logger)
3867 logger => cp_get_default_logger()
3868 iounit = cp_logger_get_default_io_unit(logger)
3869
3870 econfx = 0
3871 econfx(0:SIZE(econf) - 1) = econf
3872 IF (sum(econf) >= 0) THEN
3873 lmin = min(lmat, ubound(ptable(z)%e_conv, 1))
3874 ! number of core electrons
3875 nc = z - sum(econf)
3876 ! setup ncore
3877 ncore = 0
3878 SELECT CASE (nc)
3879 CASE (0)
3880 CASE (2)
3881 ncore(0, 1) = 2
3882 CASE (10)
3883 ncore(0, 1) = 2
3884 ncore(0, 2) = 2
3885 ncore(1, 1) = 6
3886 CASE (18)
3887 ncore(0, 1) = 2
3888 ncore(0, 2) = 2
3889 ncore(0, 3) = 2
3890 ncore(1, 1) = 6
3891 ncore(1, 2) = 6
3892 CASE (28)
3893 ncore(0, 1) = 2
3894 ncore(0, 2) = 2
3895 ncore(0, 3) = 2
3896 ncore(1, 1) = 6
3897 ncore(1, 2) = 6
3898 ncore(2, 1) = 10
3899 CASE (36)
3900 ncore(0, 1) = 2
3901 ncore(0, 2) = 2
3902 ncore(0, 3) = 2
3903 ncore(0, 4) = 2
3904 ncore(1, 1) = 6
3905 ncore(1, 2) = 6
3906 ncore(1, 3) = 6
3907 ncore(2, 1) = 10
3908 CASE (46)
3909 ncore(0, 1) = 2
3910 ncore(0, 2) = 2
3911 ncore(0, 3) = 2
3912 ncore(0, 4) = 2
3913 ncore(1, 1) = 6
3914 ncore(1, 2) = 6
3915 ncore(1, 3) = 6
3916 ncore(2, 1) = 10
3917 ncore(2, 2) = 10
3918 CASE (54)
3919 ncore(0, 1) = 2
3920 ncore(0, 2) = 2
3921 ncore(0, 3) = 2
3922 ncore(0, 4) = 2
3923 ncore(0, 5) = 2
3924 ncore(1, 1) = 6
3925 ncore(1, 2) = 6
3926 ncore(1, 3) = 6
3927 ncore(1, 4) = 6
3928 ncore(2, 1) = 10
3929 ncore(2, 2) = 10
3930 CASE (60)
3931 ncore(0, 1) = 2
3932 ncore(0, 2) = 2
3933 ncore(0, 3) = 2
3934 ncore(0, 4) = 2
3935 ncore(1, 1) = 6
3936 ncore(1, 2) = 6
3937 ncore(1, 3) = 6
3938 ncore(2, 1) = 10
3939 ncore(2, 2) = 10
3940 ncore(3, 1) = 14
3941 CASE (68)
3942 ncore(0, 1) = 2
3943 ncore(0, 2) = 2
3944 ncore(0, 3) = 2
3945 ncore(0, 4) = 2
3946 ncore(0, 5) = 2
3947 ncore(1, 1) = 6
3948 ncore(1, 2) = 6
3949 ncore(1, 3) = 6
3950 ncore(1, 4) = 6
3951 ncore(2, 1) = 10
3952 ncore(2, 2) = 10
3953 ncore(3, 1) = 14
3954 CASE (78)
3955 ncore(0, 1) = 2
3956 ncore(0, 2) = 2
3957 ncore(0, 3) = 2
3958 ncore(0, 4) = 2
3959 ncore(0, 5) = 2
3960 ncore(1, 1) = 6
3961 ncore(1, 2) = 6
3962 ncore(1, 3) = 6
3963 ncore(1, 4) = 6
3964 ncore(2, 1) = 10
3965 ncore(2, 2) = 10
3966 ncore(2, 3) = 10
3967 ncore(3, 1) = 14
3968 ! 79 - 92 5f incore PP
3969 CASE (79)
3970 ncore(0, 1) = 2
3971 ncore(0, 2) = 2
3972 ncore(0, 3) = 2
3973 ncore(0, 4) = 2
3974 ncore(0, 5) = 2
3975 ncore(1, 1) = 6
3976 ncore(1, 2) = 6
3977 ncore(1, 3) = 6
3978 ncore(1, 4) = 6
3979 ncore(2, 1) = 10
3980 ncore(2, 2) = 10
3981 ncore(2, 3) = 10
3982 ncore(3, 1) = 14
3983 ncore(3, 2) = 1
3984 CASE (80)
3985 ncore(0, 1) = 2
3986 ncore(0, 2) = 2
3987 ncore(0, 3) = 2
3988 ncore(0, 4) = 2
3989 ncore(0, 5) = 2
3990 ncore(1, 1) = 6
3991 ncore(1, 2) = 6
3992 ncore(1, 3) = 6
3993 ncore(1, 4) = 6
3994 ncore(2, 1) = 10
3995 ncore(2, 2) = 10
3996 ncore(2, 3) = 10
3997 ncore(3, 1) = 14
3998 ncore(3, 2) = 2
3999 CASE (81)
4000 ncore(0, 1) = 2
4001 ncore(0, 2) = 2
4002 ncore(0, 3) = 2
4003 ncore(0, 4) = 2
4004 ncore(0, 5) = 2
4005 ncore(1, 1) = 6
4006 ncore(1, 2) = 6
4007 ncore(1, 3) = 6
4008 ncore(1, 4) = 6
4009 ncore(2, 1) = 10
4010 ncore(2, 2) = 10
4011 ncore(2, 3) = 10
4012 ncore(3, 1) = 14
4013 ncore(3, 2) = 3
4014 CASE (82)
4015 ncore(0, 1) = 2
4016 ncore(0, 2) = 2
4017 ncore(0, 3) = 2
4018 ncore(0, 4) = 2
4019 ncore(0, 5) = 2
4020 ncore(1, 1) = 6
4021 ncore(1, 2) = 6
4022 ncore(1, 3) = 6
4023 ncore(1, 4) = 6
4024 ncore(2, 1) = 10
4025 ncore(2, 2) = 10
4026 ncore(2, 3) = 10
4027 ncore(3, 1) = 14
4028 ncore(3, 2) = 4
4029 CASE (83)
4030 ncore(0, 1) = 2
4031 ncore(0, 2) = 2
4032 ncore(0, 3) = 2
4033 ncore(0, 4) = 2
4034 ncore(0, 5) = 2
4035 ncore(1, 1) = 6
4036 ncore(1, 2) = 6
4037 ncore(1, 3) = 6
4038 ncore(1, 4) = 6
4039 ncore(2, 1) = 10
4040 ncore(2, 2) = 10
4041 ncore(2, 3) = 10
4042 ncore(3, 1) = 14
4043 ncore(3, 2) = 5
4044 CASE (84)
4045 ncore(0, 1) = 2
4046 ncore(0, 2) = 2
4047 ncore(0, 3) = 2
4048 ncore(0, 4) = 2
4049 ncore(0, 5) = 2
4050 ncore(1, 1) = 6
4051 ncore(1, 2) = 6
4052 ncore(1, 3) = 6
4053 ncore(1, 4) = 6
4054 ncore(2, 1) = 10
4055 ncore(2, 2) = 10
4056 ncore(2, 3) = 10
4057 ncore(3, 1) = 14
4058 ncore(3, 2) = 6
4059 CASE (85)
4060 ncore(0, 1) = 2
4061 ncore(0, 2) = 2
4062 ncore(0, 3) = 2
4063 ncore(0, 4) = 2
4064 ncore(0, 5) = 2
4065 ncore(1, 1) = 6
4066 ncore(1, 2) = 6
4067 ncore(1, 3) = 6
4068 ncore(1, 4) = 6
4069 ncore(2, 1) = 10
4070 ncore(2, 2) = 10
4071 ncore(2, 3) = 10
4072 ncore(3, 1) = 14
4073 ncore(3, 2) = 7
4074 CASE (86)
4075 ! this is not Rn core, add double assignment below
4076 ncore(0, 1) = 2
4077 ncore(0, 2) = 2
4078 ncore(0, 3) = 2
4079 ncore(0, 4) = 2
4080 ncore(0, 5) = 2
4081 ncore(1, 1) = 6
4082 ncore(1, 2) = 6
4083 ncore(1, 3) = 6
4084 ncore(1, 4) = 6
4085 ncore(2, 1) = 10
4086 ncore(2, 2) = 10
4087 ncore(2, 3) = 10
4088 ncore(3, 1) = 14
4089 ncore(3, 2) = 8
4090 CASE (87)
4091 ncore(0, 1) = 2
4092 ncore(0, 2) = 2
4093 ncore(0, 3) = 2
4094 ncore(0, 4) = 2
4095 ncore(0, 5) = 2
4096 ncore(1, 1) = 6
4097 ncore(1, 2) = 6
4098 ncore(1, 3) = 6
4099 ncore(1, 4) = 6
4100 ncore(2, 1) = 10
4101 ncore(2, 2) = 10
4102 ncore(2, 3) = 10
4103 ncore(3, 1) = 14
4104 ncore(3, 2) = 9
4105 CASE (88)
4106 ncore(0, 1) = 2
4107 ncore(0, 2) = 2
4108 ncore(0, 3) = 2
4109 ncore(0, 4) = 2
4110 ncore(0, 5) = 2
4111 ncore(1, 1) = 6
4112 ncore(1, 2) = 6
4113 ncore(1, 3) = 6
4114 ncore(1, 4) = 6
4115 ncore(2, 1) = 10
4116 ncore(2, 2) = 10
4117 ncore(2, 3) = 10
4118 ncore(3, 1) = 14
4119 ncore(3, 2) = 10
4120 CASE (89)
4121 ncore(0, 1) = 2
4122 ncore(0, 2) = 2
4123 ncore(0, 3) = 2
4124 ncore(0, 4) = 2
4125 ncore(0, 5) = 2
4126 ncore(1, 1) = 6
4127 ncore(1, 2) = 6
4128 ncore(1, 3) = 6
4129 ncore(1, 4) = 6
4130 ncore(2, 1) = 10
4131 ncore(2, 2) = 10
4132 ncore(2, 3) = 10
4133 ncore(3, 1) = 14
4134 ncore(3, 2) = 11
4135 CASE (90)
4136 ncore(0, 1) = 2
4137 ncore(0, 2) = 2
4138 ncore(0, 3) = 2
4139 ncore(0, 4) = 2
4140 ncore(0, 5) = 2
4141 ncore(1, 1) = 6
4142 ncore(1, 2) = 6
4143 ncore(1, 3) = 6
4144 ncore(1, 4) = 6
4145 ncore(2, 1) = 10
4146 ncore(2, 2) = 10
4147 ncore(2, 3) = 10
4148 ncore(3, 1) = 14
4149 ncore(3, 2) = 12
4150 CASE (91)
4151 ncore(0, 1) = 2
4152 ncore(0, 2) = 2
4153 ncore(0, 3) = 2
4154 ncore(0, 4) = 2
4155 ncore(0, 5) = 2
4156 ncore(1, 1) = 6
4157 ncore(1, 2) = 6
4158 ncore(1, 3) = 6
4159 ncore(1, 4) = 6
4160 ncore(2, 1) = 10
4161 ncore(2, 2) = 10
4162 ncore(2, 3) = 10
4163 ncore(3, 1) = 14
4164 ncore(3, 2) = 13
4165 CASE (92)
4166 ncore(0, 1) = 2
4167 ncore(0, 2) = 2
4168 ncore(0, 3) = 2
4169 ncore(0, 4) = 2
4170 ncore(0, 5) = 2
4171 ncore(1, 1) = 6
4172 ncore(1, 2) = 6
4173 ncore(1, 3) = 6
4174 ncore(1, 4) = 6
4175 ncore(2, 1) = 10
4176 ncore(2, 2) = 10
4177 ncore(2, 3) = 10
4178 ncore(3, 1) = 14
4179 ncore(3, 2) = 14
4180 CASE DEFAULT
4181 ncore(0, 1) = -1
4182 END SELECT
4183 ! special cases of double assignments
4184 IF (z == 65 .AND. econfx(3) == 0) THEN
4185 ! 4f in core for Tb
4186 ncore = 0
4187 ncore(0, 1) = -1
4188 END IF
4189 ! if there is still no core, check for special cases
4190 IF (ncore(0, 1) <= 0) THEN
4191 IF (z >= 58 .AND. z <= 71) THEN
4192 ! 4f-in-core PPs for lanthanides
4193 nc = z - sum(econf)
4194 ! setup ncore
4195 ncore = 0
4196 SELECT CASE (nc)
4197 CASE (29:42)
4198 ncore(0, 1) = 2
4199 ncore(0, 2) = 2
4200 ncore(0, 3) = 2
4201 ncore(1, 1) = 6
4202 ncore(1, 2) = 6
4203 ncore(2, 1) = 10
4204 ncore(3, 1) = nc - 28
4205 message = "A small-core pseudopotential with 4f-in-core is used for the lanthanide "// &
4206 trim(ptable(z)%symbol)
4207 cphint(trim(message))
4208 CASE (47:60)
4209 ncore(0, 1) = 2
4210 ncore(0, 2) = 2
4211 ncore(0, 3) = 2
4212 ncore(0, 4) = 2
4213 ncore(1, 1) = 6
4214 ncore(1, 2) = 6
4215 ncore(1, 3) = 6
4216 ncore(2, 1) = 10
4217 ncore(2, 2) = 10
4218 ncore(3, 1) = nc - 46
4219 message = "A medium-core pseudopotential with 4f-in-core is used for the lanthanide "// &
4220 trim(ptable(z)%symbol)
4221 cphint(trim(message))
4222 CASE DEFAULT
4223 ncore(0, 1) = -1
4224 END SELECT
4225 END IF
4226 END IF
4227 ! if the core is established, finish the setup
4228 IF (ncore(0, 1) >= 0) THEN
4229 DO l = 0, lmin
4230 ll = 2*(2*l + 1)
4231 nn = sum(ncore(l, :)) + econfx(l)
4232 ii = 0
4233 DO
4234 ii = ii + 1
4235 IF (nn <= ll) THEN
4236 nelem(l, ii) = nn
4237 EXIT
4238 ELSE
4239 nelem(l, ii) = ll
4240 nn = nn - ll
4241 END IF
4242 END DO
4243 END DO
4244 ncalc = nelem - ncore
4245 ELSE
4246 ! test for compatibility of valence occupation and full atomic occupation
4247 IF (iounit > 0) THEN
4248 WRITE (iounit, "(/,A,A2)") "WARNING: Core states irregular for atom type ", ptable(z)%symbol
4249 WRITE (iounit, "(A,10I3)") "WARNING: Redefine ELEC_CONF in the KIND section"
4250 cpabort("Incompatible Atomic Occupations Detected")
4251 END IF
4252 END IF
4253 ELSE
4254 lmin = min(lmat, ubound(ptable(z)%e_conv, 1))
4255 ncore = 0
4256 ncalc = 0
4257 DO l = 0, lmin
4258 ll = 2*(2*l + 1)
4259 nn = abs(econfx(l))
4260 ii = 0
4261 DO
4262 ii = ii + 1
4263 IF (nn <= ll) THEN
4264 ncalc(l, ii) = -nn
4265 EXIT
4266 ELSE
4267 ncalc(l, ii) = -ll
4268 nn = nn - ll
4269 END IF
4270 END DO
4271 END DO
4272 nelem = ncalc
4273 END IF
4274
4275 END SUBROUTINE set_pseudo_state
4276
4277! **************************************************************************************************
4278!> \brief finds if a given qs run needs to use nlcc
4279!> \param qs_kind_set ...
4280!> \return ...
4281! **************************************************************************************************
4282 FUNCTION has_nlcc(qs_kind_set) RESULT(nlcc)
4283
4284 TYPE(qs_kind_type), DIMENSION(:) :: qs_kind_set
4285 LOGICAL :: nlcc
4286
4287 INTEGER :: ikind
4288 LOGICAL :: nlcc_present
4289 TYPE(gth_potential_type), POINTER :: gth_potential
4290 TYPE(sgp_potential_type), POINTER :: sgp_potential
4291
4292 nlcc = .false.
4293
4294 DO ikind = 1, SIZE(qs_kind_set)
4295 CALL get_qs_kind(qs_kind_set(ikind), gth_potential=gth_potential, sgp_potential=sgp_potential)
4296 IF (ASSOCIATED(gth_potential)) THEN
4297 CALL get_potential(potential=gth_potential, nlcc_present=nlcc_present)
4298 nlcc = nlcc .OR. nlcc_present
4299 ELSE IF (ASSOCIATED(sgp_potential)) THEN
4300 CALL get_potential(potential=sgp_potential, has_nlcc=nlcc_present)
4301 nlcc = nlcc .OR. nlcc_present
4302 END IF
4303 END DO
4304
4305 END FUNCTION has_nlcc
4306
4307! **************************************************************************************************
4308
4309END MODULE qs_kind_types
imax
static int imax(int x, int y)
Returns the larger of two given integers (missing from the C standard).
Definition dbm_internal.h:14
atom_types::read_ecp_potential
Definition atom_types.F:346
basis_set_types::read_gto_basis_set
Definition basis_set_types.F:111
external_potential_types::allocate_potential
Definition external_potential_types.F:263
external_potential_types::deallocate_potential
Definition external_potential_types.F:271
external_potential_types::get_potential
Definition external_potential_types.F:279
external_potential_types::init_potential
Definition external_potential_types.F:287
external_potential_types::read_potential
Definition external_potential_types.F:293
external_potential_types::set_potential
Definition external_potential_types.F:302
external_potential_types::write_potential
Definition external_potential_types.F:310
atom_sgp
Definition atom_sgp.F:9
atom_sgp::atom_sgp_release
subroutine, public atom_sgp_release(sgp_pot)
...
Definition atom_sgp.F:801
atom_sgp::sgp_construction
subroutine, public sgp_construction(sgp_pot, ecp_pot, upf_pot, orb_basis, error)
...
Definition atom_sgp.F:79
atom_types
Define the atom type and its sub types.
Definition atom_types.F:15
atom_types::lmat
integer, parameter, public lmat
Definition atom_types.F:68
atom_upf
Routines that process Quantum Espresso UPF files.
Definition atom_upf.F:14
atom_upf::atom_release_upf
pure subroutine, public atom_release_upf(upfpot)
...
Definition atom_upf.F:1191
atom_upf::atom_read_upf
subroutine, public atom_read_upf(pot, upf_filename, read_header, read_augmentation)
...
Definition atom_upf.F:52
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
atomic_kind_types::get_atomic_kind
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
Definition atomic_kind_types.F:131
basis_set_container_types
Definition basis_set_container_types.F:13
basis_set_container_types::remove_basis_set_container
subroutine, public remove_basis_set_container(basis)
...
Definition basis_set_container_types.F:77
basis_set_container_types::remove_basis_from_container
subroutine, public remove_basis_from_container(container, inum, basis_type)
...
Definition basis_set_container_types.F:190
basis_set_container_types::get_basis_from_container
subroutine, public get_basis_from_container(container, basis_set, inumbas, basis_type)
Retrieve a basis set from the container.
Definition basis_set_container_types.F:244
basis_set_container_types::add_basis_set_to_container
subroutine, public add_basis_set_to_container(container, basis_set, basis_set_type)
...
Definition basis_set_container_types.F:161
basis_set_types
Definition basis_set_types.F:15
basis_set_types::get_gto_basis_set
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum, ccon)
...
Definition basis_set_types.F:643
basis_set_types::create_gto_from_sto_basis
subroutine, public create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho, ngaussflex)
...
Definition basis_set_types.F:2427
basis_set_types::write_orb_basis_set
subroutine, public write_orb_basis_set(orb_basis_set, output_unit, header)
Write a Gaussian-type orbital (GTO) basis set data set to the output unit.
Definition basis_set_types.F:1984
basis_set_types::deallocate_sto_basis_set
subroutine, public deallocate_sto_basis_set(sto_basis_set)
...
Definition basis_set_types.F:2136
basis_set_types::init_aux_basis_set
subroutine, public init_aux_basis_set(gto_basis_set)
...
Definition basis_set_types.F:776
basis_set_types::allocate_gto_basis_set
subroutine, public allocate_gto_basis_set(gto_basis_set)
...
Definition basis_set_types.F:152
basis_set_types::combine_basis_sets
subroutine, public combine_basis_sets(basis_set, basis_set_add)
...
Definition basis_set_types.F:472
basis_set_types::write_gto_basis_set
subroutine, public write_gto_basis_set(gto_basis_set, output_unit, header)
Write a Gaussian-type orbital (GTO) basis set data set to the output unit.
Definition basis_set_types.F:1924
basis_set_types::allocate_sto_basis_set
subroutine, public allocate_sto_basis_set(sto_basis_set)
...
Definition basis_set_types.F:2122
basis_set_types::read_sto_basis_set
subroutine, public read_sto_basis_set(element_symbol, basis_set_name, sto_basis_set, para_env, dft_section)
...
Definition basis_set_types.F:2259
basis_set_types::init_orb_basis_set
subroutine, public init_orb_basis_set(gto_basis_set)
Initialise a Gaussian-type orbital (GTO) basis set data set.
Definition basis_set_types.F:1138
cp_control_types
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Definition cp_control_types.F:12
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_io_unit
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
Definition cp_log_handling.F:523
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
cp_output_handling
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
Definition cp_output_handling.F:25
cp_output_handling::cp_print_key_finished_output
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
Definition cp_output_handling.F:1156
cp_output_handling::cp_p_file
integer, parameter, public cp_p_file
Definition cp_output_handling.F:107
cp_output_handling::cp_print_key_should_output
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
Definition cp_output_handling.F:345
cp_output_handling::cp_print_key_unit_nr
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout, file_access)
...
Definition cp_output_handling.F:935
dft_plus_u
Add the DFT+U contribution to the Hamiltonian matrix.
Definition dft_plus_u.F:18
external_potential_types
Definition of the atomic potential types.
Definition external_potential_types.F:14
external_potential_types::set_default_all_potential
subroutine, public set_default_all_potential(potential, z, zeff_correction)
...
Definition external_potential_types.F:2576
gapw_1c_basis_set
Definition gapw_1c_basis_set.F:13
gapw_1c_basis_set::create_1c_basis
subroutine, public create_1c_basis(orb_basis, soft_basis, gapw_1c_basis, basis_1c_level)
create the one center basis from the orbital basis
Definition gapw_1c_basis_set.F:51
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:18
input_constants::gapw_1c_large
integer, parameter, public gapw_1c_large
Definition input_constants.F:248
input_constants::do_method_pdg
integer, parameter, public do_method_pdg
Definition input_constants.F:270
input_constants::do_method_pnnl
integer, parameter, public do_method_pnnl
Definition input_constants.F:270
input_constants::plus_u_lowdin
integer, parameter, public plus_u_lowdin
Definition input_constants.F:945
input_constants::gapw_1c_medium
integer, parameter, public gapw_1c_medium
Definition input_constants.F:248
input_constants::do_method_pw
integer, parameter, public do_method_pw
Definition input_constants.F:270
input_constants::do_method_rm1
integer, parameter, public do_method_rm1
Definition input_constants.F:270
input_constants::gapw_1c_small
integer, parameter, public gapw_1c_small
Definition input_constants.F:248
input_constants::do_method_pm3
integer, parameter, public do_method_pm3
Definition input_constants.F:270
input_constants::do_sirius
integer, parameter, public do_sirius
Definition input_constants.F:52
input_constants::do_method_mndo
integer, parameter, public do_method_mndo
Definition input_constants.F:270
input_constants::gapw_1c_orb
integer, parameter, public gapw_1c_orb
Definition input_constants.F:248
input_constants::gapw_1c_very_large
integer, parameter, public gapw_1c_very_large
Definition input_constants.F:248
input_constants::plus_u_tensorial
integer, parameter, public plus_u_tensorial
Definition input_constants.F:945
input_constants::do_method_mndod
integer, parameter, public do_method_mndod
Definition input_constants.F:270
input_constants::do_method_am1
integer, parameter, public do_method_am1
Definition input_constants.F:270
input_constants::do_method_dftb
integer, parameter, public do_method_dftb
Definition input_constants.F:270
input_constants::do_qs
integer, parameter, public do_qs
Definition input_constants.F:52
input_constants::do_method_xtb
integer, parameter, public do_method_xtb
Definition input_constants.F:270
input_constants::do_method_pm6fm
integer, parameter, public do_method_pm6fm
Definition input_constants.F:270
input_constants::do_method_pm6
integer, parameter, public do_method_pm6
Definition input_constants.F:270
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition input_section_types.F:15
input_section_types::section_vals_get_subs_vals2
type(section_vals_type) function, pointer, public section_vals_get_subs_vals2(section_vals, i_section, i_rep_section)
returns the values of the n-th non default subsection (null if no such section exists (not so many no...
Definition input_section_types.F:791
input_section_types::section_vals_get_subs_vals
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
Definition input_section_types.F:735
input_section_types::section_vals_get
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
Definition input_section_types.F:708
input_section_types::section_vals_val_get
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Definition input_section_types.F:1052
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
kinds::default_path_length
integer, parameter, public default_path_length
Definition kinds.F:58
mathconstants
Definition of mathematical constants and functions.
Definition mathconstants.F:16
mathconstants::pi
real(kind=dp), parameter, public pi
Definition mathconstants.F:110
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:27
orbital_pointers
Provides Cartesian and spherical orbital pointers and indices.
Definition orbital_pointers.F:15
orbital_pointers::init_orbital_pointers
subroutine, public init_orbital_pointers(maxl)
Initialize or update the orbital pointers.
Definition orbital_pointers.F:253
orbital_pointers::nco
integer, dimension(:), allocatable, public nco
Definition orbital_pointers.F:42
orbital_pointers::ncoset
integer, dimension(:), allocatable, public ncoset
Definition orbital_pointers.F:42
pao_potentials
Factory routines for potentials used e.g. by pao_param_exp and pao_ml.
Definition pao_potentials.F:12
paw_proj_set_types
Definition paw_proj_set_types.F:13
paw_proj_set_types::get_paw_proj_set
subroutine, public get_paw_proj_set(paw_proj_set, csprj, chprj, first_prj, first_prjs, last_prj, local_oce_sphi_h, local_oce_sphi_s, maxl, ncgauprj, nsgauprj, nsatbas, nsotot, nprj, o2nindex, n2oindex, rcprj, rzetprj, zisomin, zetprj)
Get informations about a paw projectors set.
Definition paw_proj_set_types.F:744
paw_proj_set_types::allocate_paw_proj_set
subroutine, public allocate_paw_proj_set(paw_proj_set)
Allocate projector type for GAPW.
Definition paw_proj_set_types.F:95
paw_proj_set_types::projectors
subroutine, public projectors(paw_proj, basis_1c, orb_basis, rc, qs_control, max_rad_local_type, force_env_section)
Initialize the projector-type set data set.
Definition paw_proj_set_types.F:180
paw_proj_set_types::deallocate_paw_proj_set
subroutine, public deallocate_paw_proj_set(paw_proj_set)
Deallocate a projector-type set data set.
Definition paw_proj_set_types.F:135
periodic_table
Periodic Table related data definitions.
Definition periodic_table.F:28
periodic_table::ptable
type(atom), dimension(0:nelem), public ptable
Definition periodic_table.F:65
periodic_table::nelem
integer, parameter, public nelem
Definition periodic_table.F:63
periodic_table::get_ptable_info
subroutine, public get_ptable_info(symbol, number, amass, ielement, covalent_radius, metallic_radius, vdw_radius, found)
Pass information about the kind given the element symbol.
Definition periodic_table.F:85
physcon
Definition of physical constants:
Definition physcon.F:68
physcon::evolt
real(kind=dp), parameter, public evolt
Definition physcon.F:183
physcon::angstrom
real(kind=dp), parameter, public angstrom
Definition physcon.F:144
physcon::bohr
real(kind=dp), parameter, public bohr
Definition physcon.F:147
qs_cneo_types
Types used by CNEO-DFT (see J. Chem. Theory Comput. 2025, 21, 16, 7865–7877).
Definition qs_cneo_types.F:15
qs_cneo_types::allocate_cneo_potential
subroutine, public allocate_cneo_potential(potential)
...
Definition qs_cneo_types.F:194
qs_cneo_types::write_cneo_potential
subroutine, public write_cneo_potential(potential, output_unit)
...
Definition qs_cneo_types.F:447
qs_cneo_types::deallocate_cneo_potential
subroutine, public deallocate_cneo_potential(potential)
...
Definition qs_cneo_types.F:210
qs_cneo_types::set_cneo_potential
subroutine, public set_cneo_potential(potential, z, mass, elec_conf, nsgf, nne, npsgf, nsotot, my_gcc_h, my_gcc_s, ovlp, kin, utrans, distance, harmonics, qlm_gg, gg, vgg, n2oindex, o2nindex, rad2l, oorad2l)
...
Definition qs_cneo_types.F:369
qs_cneo_types::get_cneo_potential
subroutine, public get_cneo_potential(potential, z, zeff, mass, elec_conf, nsgf, nne, npsgf, nsotot, my_gcc_h, my_gcc_s, ovlp, kin, utrans, distance, harmonics, qlm_gg, gg, vgg, n2oindex, o2nindex, rad2l, oorad2l)
...
Definition qs_cneo_types.F:293
qs_dftb_types
Definition of the DFTB parameter types.
Definition qs_dftb_types.F:12
qs_dftb_utils
Working with the DFTB parameter types.
Definition qs_dftb_utils.F:12
qs_dftb_utils::deallocate_dftb_atom_param
subroutine, public deallocate_dftb_atom_param(dftb_parameter)
...
Definition qs_dftb_utils.F:94
qs_dftb_utils::write_dftb_atom_param
subroutine, public write_dftb_atom_param(dftb_parameter, subsys_section)
...
Definition qs_dftb_utils.F:216
qs_dftb_utils::get_dftb_atom_param
subroutine, public get_dftb_atom_param(dftb_parameter, name, typ, defined, z, zeff, natorb, lmax, skself, occupation, eta, energy, cutoff, xi, di, rcdisp, dudq)
...
Definition qs_dftb_utils.F:124
qs_dispersion_types
Definition of disperson types for DFT calculations.
Definition qs_dispersion_types.F:12
qs_grid_atom
Definition qs_grid_atom.F:8
qs_grid_atom::deallocate_grid_atom
subroutine, public deallocate_grid_atom(grid_atom)
Deallocate a Gaussian-type orbital (GTO) basis set data set.
Definition qs_grid_atom.F:107
qs_grid_atom::allocate_grid_atom
subroutine, public allocate_grid_atom(grid_atom)
Initialize components of the grid_atom_type structure.
Definition qs_grid_atom.F:74
qs_harmonics_atom
Definition qs_harmonics_atom.F:8
qs_harmonics_atom::allocate_harmonics_atom
subroutine, public allocate_harmonics_atom(harmonics)
Allocate a spherical harmonics set for the atom grid.
Definition qs_harmonics_atom.F:66
qs_harmonics_atom::deallocate_harmonics_atom
subroutine, public deallocate_harmonics_atom(harmonics)
Deallocate the spherical harmonics set for the atom grid.
Definition qs_harmonics_atom.F:97
qs_kind_types
Define the quickstep kind type and their sub types.
Definition qs_kind_types.F:23
qs_kind_types::set_pseudo_state
subroutine, public set_pseudo_state(econf, z, ncalc, ncore, nelem)
...
Definition qs_kind_types.F:3857
qs_kind_types::has_nlcc
logical function, public has_nlcc(qs_kind_set)
finds if a given qs run needs to use nlcc
Definition qs_kind_types.F:4283
qs_kind_types::deallocate_qs_kind_set
subroutine, public deallocate_qs_kind_set(qs_kind_set)
Destructor routine for a set of qs kinds.
Definition qs_kind_types.F:278
qs_kind_types::get_qs_kind
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, hund_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, proj_shell_charge, lr_atom, do_mtlr, u_j_loop, ao_coef, init_u_ramping_each_scf, reltmat, ghost, monovalent, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
Definition qs_kind_types.F:483
qs_kind_types::init_atom_electronic_state
subroutine, public init_atom_electronic_state(atomic_kind, qs_kind, ncalc, ncore, nelem, edelta, rks)
...
Definition qs_kind_types.F:3712
qs_kind_types::init_gapw_nlcc
subroutine, public init_gapw_nlcc(qs_kind_set)
...
Definition qs_kind_types.F:1633
qs_kind_types::init_cneo_basis_set
subroutine, public init_cneo_basis_set(qs_kind_set, qs_control)
...
Definition qs_kind_types.F:1719
qs_kind_types::write_qs_kind_set
subroutine, public write_qs_kind_set(qs_kind_set, subsys_section)
Write an atomic kind set data set to the output unit.
Definition qs_kind_types.F:3576
qs_kind_types::init_gapw_basis_set
subroutine, public init_gapw_basis_set(qs_kind_set, qs_control, force_env_section, modify_qs_control)
...
Definition qs_kind_types.F:1504
qs_kind_types::init_qs_kind_set
subroutine, public init_qs_kind_set(qs_kind_set)
Initialise an atomic kind set data set.
Definition qs_kind_types.F:1432
qs_kind_types::set_qs_kind
subroutine, public set_qs_kind(qs_kind, paw_atom, ghost, floating, hard_radius, hard0_radius, covalent_radius, vdw_radius, lmax_rho0, zeff, no_optimize, dispersion, u_minus_j, hund_j, reltmat, dftb_parameter, xtb_parameter, elec_conf, pao_basis_size)
Set the components of an atomic kind data set.
Definition qs_kind_types.F:3320
qs_kind_types::check_qs_kind_set
subroutine, public check_qs_kind_set(qs_kind_set, dft_control, subsys_section)
...
Definition qs_kind_types.F:3217
qs_kind_types::write_gto_basis_sets
subroutine, public write_gto_basis_sets(qs_kind_set, subsys_section)
Write all the GTO basis sets of an atomic kind set to the output unit (for the printing of the unnorm...
Definition qs_kind_types.F:3621
qs_kind_types::create_qs_kind_set
subroutine, public create_qs_kind_set(qs_kind_set, atomic_kind_set, kind_section, para_env, force_env_section, silent)
Read an atomic kind set data set from the input file.
Definition qs_kind_types.F:3114
qs_kind_types::get_qs_kind_set
subroutine, public get_qs_kind_set(qs_kind_set, all_potential_present, tnadd_potential_present, gth_potential_present, sgp_potential_present, paw_atom_present, dft_plus_u_atom_present, maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, maxlprj, maxnset, maxsgf_set, ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, maxppnl, nelectron, maxder, max_ngrid_rad, max_sph_harm, maxg_iso_not0, lmax_rho0, basis_rcut, do_mtlr_present, basis_type, total_zeff_corr, npgf_seg, cneo_potential_present, nkind_q, natom_q)
Get attributes of an atomic kind set.
Definition qs_kind_types.F:976
semi_empirical_types
Definition of the semi empirical parameter types.
Definition semi_empirical_types.F:12
semi_empirical_types::write_se_param
subroutine, public write_se_param(sep, subsys_section)
Writes the semi-empirical type.
Definition semi_empirical_types.F:652
semi_empirical_types::semi_empirical_create
subroutine, public semi_empirical_create(sep)
Allocate semi-empirical type.
Definition semi_empirical_types.F:190
semi_empirical_types::get_se_param
subroutine, public get_se_param(sep, name, typ, defined, z, zeff, natorb, eheat, beta, sto_exponents, uss, upp, udd, uff, alp, eisol, gss, gsp, gpp, gp2, acoul, nr, de, ass, asp, app, hsp, gsd, gpd, gdd, ppddg, dpddg, ngauss)
Get info from the semi-empirical type.
Definition semi_empirical_types.F:364
semi_empirical_types::semi_empirical_release
subroutine, public semi_empirical_release(sep)
Deallocate the semi-empirical type.
Definition semi_empirical_types.F:210
semi_empirical_utils
Working with the semi empirical parameter types.
Definition semi_empirical_utils.F:12
semi_empirical_utils::se_param_set_default
subroutine, public se_param_set_default(sep, z, method)
Initialize parameter for a semi_empirival type.
Definition semi_empirical_utils.F:271
semi_empirical_utils::init_se_param
subroutine, public init_se_param(sep, orb_basis_set, ngauss)
Initialize semi_empirical type.
Definition semi_empirical_utils.F:215
soft_basis_set
Definition soft_basis_set.F:13
soft_basis_set::create_soft_basis
subroutine, public create_soft_basis(orb_basis, soft_basis, eps_fit, rc, paw_atom, paw_type_forced, gpw_r3d_rs_type_forced)
create the soft basis from a GTO basis
Definition soft_basis_set.F:61
string_utilities
Utilities for string manipulations.
Definition string_utilities.F:16
string_utilities::uppercase
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.
Definition string_utilities.F:3362
xc_input_constants
input constants for xc
Definition xc_input_constants.F:10
xc_input_constants::skala_gapw_direct_valence
integer, parameter, public skala_gapw_direct_valence
Definition xc_input_constants.F:29
xc_input_constants::skala_gapw_paw_one_center
integer, parameter, public skala_gapw_paw_one_center
Definition xc_input_constants.F:29
xc_input_constants::skala_gapw_cp2k_default
integer, parameter, public skala_gapw_cp2k_default
Definition xc_input_constants.F:29
xc_input_constants::skala_gapw_paw_one_center_split
integer, parameter, public skala_gapw_paw_one_center_split
Definition xc_input_constants.F:29
xtb_parameters
Read xTB parameters.
Definition xtb_parameters.F:12
xtb_parameters::xtb_set_kab
real(kind=dp) function, public xtb_set_kab(za, zb, xtb_control)
...
Definition xtb_parameters.F:752
xtb_types
Definition of the xTB parameter types.
Definition xtb_types.F:20
xtb_types::get_xtb_atom_param
subroutine, public get_xtb_atom_param(xtb_parameter, symbol, aname, typ, defined, z, zeff, natorb, lmax, nao, lao, rcut, rcov, kx, eta, xgamma, alpha, zneff, nshell, nval, lval, kpoly, kappa, wall, hen, zeta, xi, kappa0, alpg, occupation, ngauss, electronegativity, chmax, en, kqat2, kcn, kq)
...
Definition xtb_types.F:206
xtb_types::deallocate_xtb_atom_param
subroutine, public deallocate_xtb_atom_param(xtb_parameter)
...
Definition xtb_types.F:154
xtb_types::write_xtb_atom_param
subroutine, public write_xtb_atom_param(xtb_parameter, gfn_type, subsys_section)
...
Definition xtb_types.F:383
atom_sgp::atom_sgp_potential_type
Definition atom_sgp.F:39
atom_types::atom_ecppot_type
Definition atom_types.F:134
atomic_kind_types::atomic_kind_type
Provides all information about an atomic kind.
Definition atomic_kind_types.F:45
basis_set_container_types::basis_set_container_type
Definition basis_set_container_types.F:54
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72
basis_set_types::sto_basis_set_type
Definition basis_set_types.F:101
cp_control_types::dft_control_type
Definition cp_control_types.F:786
cp_control_types::qs_control_type
Definition cp_control_types.F:520
cp_control_types::xtb_control_type
Definition cp_control_types.F:256
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
external_potential_types::all_potential_type
Definition external_potential_types.F:75
external_potential_types::gth_potential_type
Definition external_potential_types.F:121
external_potential_types::local_potential_type
Definition external_potential_types.F:103
external_potential_types::sgp_potential_type
Definition external_potential_types.F:179
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:127
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:774
paw_proj_set_types::paw_proj_set_type
Definition paw_proj_set_types.F:52
qs_cneo_types::cneo_potential_type
Definition qs_cneo_types.F:53
qs_dftb_types::qs_dftb_atom_type
Definition qs_dftb_types.F:27
qs_dispersion_types::qs_atom_dispersion_type
Definition qs_dispersion_types.F:114
qs_grid_atom::grid_atom_type
Definition qs_grid_atom.F:44
qs_harmonics_atom::harmonics_atom_type
Definition qs_harmonics_atom.F:32
qs_kind_types::pao_descriptor_type
Holds information about a PAO descriptor.
Definition qs_kind_types.F:179
qs_kind_types::pao_potential_type
Holds information about a PAO potential.
Definition qs_kind_types.F:168
qs_kind_types::qs_kind_type
Provides all information about a quickstep kind.
Definition qs_kind_types.F:190
semi_empirical_types::semi_empirical_type
Semi-empirical type.
Definition semi_empirical_types.F:57
xtb_types::xtb_atom_type
Definition xtb_types.F:42