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